fix \!tz exploit, add persistent greets

opfez 2021-05-26 10:05:39 +00:00
parent 23c4a2cf00
commit 46844f7735
2 changed files with 41 additions and 9 deletions

View File

@ -10,8 +10,10 @@
(ice-9 regex)
(rnrs exceptions))
(define +channels+ '("#tildetown" "#bots"))
;; (define +channels+ '("#bots"))
;; (define +channels+ '("#tildetown" "#bots"))
(define +channels+ '("#bots"))
(load "greets.scm")
(define (scdr lst)
"Safe CDR. Returns CDR of lst, if it is a list. Returns lst otherwise."
@ -87,6 +89,8 @@
(define (send-action stream 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)
"Remove escaped chars to avoid fooling the bot into performing bad actions."
(define (remove-escaped-chars lst)
@ -97,6 +101,15 @@
(else (cons (car lst) (remove-escaped-chars (cdr lst))))))
(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)
"Evaluate the given string in a sandbox without crashing on errors."
(guard (ex
@ -118,7 +131,7 @@
(define (timezone user)
(let ((path (string-append "/home/" user "/.tz")))
(if (access? path R_OK)
(read-file path)
(remove-newlines (read-file path))
(string-append user
" has not set their timezone. Use `echo '<timezone here>' > ~/.tz' to add your timezone."))))
@ -161,19 +174,30 @@
(else "Symbol not found in documentation."))))
(define *left-greets* '())
(define *right-greets* '())
(define (greets category name)
(if (not (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
(define (inc-left-greets name)
(if (not (assoc name *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)
(if (not (assoc name *right-greets*))
@ -238,9 +262,11 @@
" vs \\o - "
(number->string (all-greets *left-greets*)))))
((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)))
((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)))
((and (= 7 (length data))
(equal? (list-tail data 4) '("ACTION" "shoots" "anna")))
(send-action stream chn "dies")

greets.scm 100644
View File

@ -0,0 +1,6 @@
(define *left-greets* (list
(cons "opfez" 1)
(define *right-greets* (list
(cons "opfez" 3)