fix \!tz exploit, add persistent greets

anna.scm

@@ -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 @@
                        sublink)))
      (else "Symbol not found in documentation."))))
 
-(define *left-greets* '())
-(define *right-greets* '())
-
 (define (greets category name)
   (if (not (assoc name category))
       "0"
       (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)))
+      (write-greets))
      ((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))
            (equal? (list-tail data 4) '("ACTION" "shoots" "anna")))
       (send-action stream chn "dies")

greets.scm

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