fix \!tz exploit, add persistent greets
parent
23c4a2cf00
commit
46844f7735
44
anna.scm
44
anna.scm
|
@ -10,8 +10,10 @@
|
||||||
(ice-9 regex)
|
(ice-9 regex)
|
||||||
(rnrs exceptions))
|
(rnrs exceptions))
|
||||||
|
|
||||||
(define +channels+ '("#tildetown" "#bots"))
|
;; (define +channels+ '("#tildetown" "#bots"))
|
||||||
;; (define +channels+ '("#bots"))
|
(define +channels+ '("#bots"))
|
||||||
|
|
||||||
|
(load "greets.scm")
|
||||||
|
|
||||||
(define (scdr lst)
|
(define (scdr lst)
|
||||||
"Safe CDR. Returns CDR of lst, if it is a list. Returns lst otherwise."
|
"Safe CDR. Returns CDR of lst, if it is a list. Returns lst otherwise."
|
||||||
|
@ -87,6 +89,8 @@
|
||||||
(define (send-action stream chn action)
|
(define (send-action stream chn action)
|
||||||
(format stream "PRIVMSG ~a :\x01ACTION ~a\x01\r\n" chn action))
|
(format stream "PRIVMSG ~a :\x01ACTION ~a\x01\r\n" chn action))
|
||||||
|
|
||||||
|
;;; TODO: this can be refactored into a function that takes one char and
|
||||||
|
;;; removes it, and composing that into more complex functions.
|
||||||
(define (input-filter str)
|
(define (input-filter str)
|
||||||
"Remove escaped chars to avoid fooling the bot into performing bad actions."
|
"Remove escaped chars to avoid fooling the bot into performing bad actions."
|
||||||
(define (remove-escaped-chars lst)
|
(define (remove-escaped-chars lst)
|
||||||
|
@ -97,6 +101,15 @@
|
||||||
(else (cons (car lst) (remove-escaped-chars (cdr lst))))))
|
(else (cons (car lst) (remove-escaped-chars (cdr lst))))))
|
||||||
(list->string (remove-escaped-chars (string->list str))))
|
(list->string (remove-escaped-chars (string->list str))))
|
||||||
|
|
||||||
|
(define (remove-newlines str)
|
||||||
|
(define (remove-newlines-aux lst)
|
||||||
|
(cond ((null? lst) '())
|
||||||
|
((or (equal? (string (car lst)) "\n")
|
||||||
|
(equal? (string (car lst)) "\r"))
|
||||||
|
(remove-newlines-aux (cdr lst)))
|
||||||
|
(else (cons (car lst) (remove-newlines-aux (cdr lst))))))
|
||||||
|
(list->string (remove-newlines-aux (string->list str))))
|
||||||
|
|
||||||
(define (evaluate str)
|
(define (evaluate str)
|
||||||
"Evaluate the given string in a sandbox without crashing on errors."
|
"Evaluate the given string in a sandbox without crashing on errors."
|
||||||
(guard (ex
|
(guard (ex
|
||||||
|
@ -118,7 +131,7 @@
|
||||||
(define (timezone user)
|
(define (timezone user)
|
||||||
(let ((path (string-append "/home/" user "/.tz")))
|
(let ((path (string-append "/home/" user "/.tz")))
|
||||||
(if (access? path R_OK)
|
(if (access? path R_OK)
|
||||||
(read-file path)
|
(remove-newlines (read-file path))
|
||||||
(string-append user
|
(string-append user
|
||||||
" has not set their timezone. Use `echo '<timezone here>' > ~/.tz' to add your timezone."))))
|
" has not set their timezone. Use `echo '<timezone here>' > ~/.tz' to add your timezone."))))
|
||||||
|
|
||||||
|
@ -161,19 +174,30 @@
|
||||||
sublink)))
|
sublink)))
|
||||||
(else "Symbol not found in documentation."))))
|
(else "Symbol not found in documentation."))))
|
||||||
|
|
||||||
(define *left-greets* '())
|
|
||||||
(define *right-greets* '())
|
|
||||||
|
|
||||||
(define (greets category name)
|
(define (greets category name)
|
||||||
(if (not (assoc name category))
|
(if (not (assoc name category))
|
||||||
"0"
|
"0"
|
||||||
(number->string (cdr (assoc name category)))))
|
(number->string (cdr (assoc name category)))))
|
||||||
|
|
||||||
|
(define (write-greets)
|
||||||
|
(define (greet-values alst)
|
||||||
|
(define (actual-values al)
|
||||||
|
(cond ((null? al) (format #f "~%"))
|
||||||
|
(else (string-append (format #f "~%(cons ~s ~s)" (caar al) (cdar al))
|
||||||
|
(actual-values (cdr al))))))
|
||||||
|
(format #f "(list ~a)" (actual-values alst)))
|
||||||
|
(call-with-output-file "greets.scm" (lambda (stream)
|
||||||
|
(format stream
|
||||||
|
"(define *left-greets* ~a)~%(define *right-greets* ~a)~%"
|
||||||
|
(greet-values *left-greets*)
|
||||||
|
(greet-values *right-greets*)))))
|
||||||
|
|
||||||
|
|
||||||
;; has to be separate functions since modifying the argument won't change global state
|
;; has to be separate functions since modifying the argument won't change global state
|
||||||
(define (inc-left-greets name)
|
(define (inc-left-greets name)
|
||||||
(if (not (assoc name *left-greets*))
|
(if (not (assoc name *left-greets*))
|
||||||
(set! *left-greets* (acons name 1 *left-greets*))
|
(set! *left-greets* (acons name 1 *left-greets*))
|
||||||
(assoc-set! *left-greets* name (+ 1 (cdr (assoc name *left-greets*))))))
|
(set! *left-greets* (assoc-set! *left-greets* name (+ 1 (cdr (assoc name *left-greets*)))))))
|
||||||
|
|
||||||
(define (inc-right-greets name)
|
(define (inc-right-greets name)
|
||||||
(if (not (assoc name *right-greets*))
|
(if (not (assoc name *right-greets*))
|
||||||
|
@ -238,9 +262,11 @@
|
||||||
" vs \\o - "
|
" vs \\o - "
|
||||||
(number->string (all-greets *left-greets*)))))
|
(number->string (all-greets *left-greets*)))))
|
||||||
((string-contains (empty-list->string (concat-messages data 3 (length data))) "\\o")
|
((string-contains (empty-list->string (concat-messages data 3 (length data))) "\\o")
|
||||||
(inc-left-greets (get-username (car data))))
|
(inc-left-greets (get-username (car data)))
|
||||||
|
(write-greets))
|
||||||
((string-contains (empty-list->string (concat-messages data 3 (length data))) "o/")
|
((string-contains (empty-list->string (concat-messages data 3 (length data))) "o/")
|
||||||
(inc-right-greets (get-username (car data))))
|
(inc-right-greets (get-username (car data)))
|
||||||
|
(write-greets))
|
||||||
((and (= 7 (length data))
|
((and (= 7 (length data))
|
||||||
(equal? (list-tail data 4) '("ACTION" "shoots" "anna")))
|
(equal? (list-tail data 4) '("ACTION" "shoots" "anna")))
|
||||||
(send-action stream chn "dies")
|
(send-action stream chn "dies")
|
||||||
|
|
|
@ -0,0 +1,6 @@
|
||||||
|
(define *left-greets* (list
|
||||||
|
(cons "opfez" 1)
|
||||||
|
))
|
||||||
|
(define *right-greets* (list
|
||||||
|
(cons "opfez" 3)
|
||||||
|
))
|
Loading…
Reference in New Issue