fix \!tz exploit, add persistent greets

master
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) (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")

6
greets.scm 100644
View File

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