Replace parallel hashes with one hash of client structs.

1 files changed, 57 insertions, 50 deletions

diff --git a/txrban.txr b/txrban.txr
index 98f2a5c..9b2db6c 100644
--- a/txrban.txr
+++ b/txrban.txr
@@ -1,18 +1,22 @@
 @(load "config")
 @(load "utils")
 @(do
-   (cond
-     (t (daemon nil nil)
-        (openlog `txrban-@self` log-pid log-authpriv))
-     (nil (set *stdlog* *stdout*)))
+   (defstruct client-info nil
+     (ip nil)
+     (access-hist nil)
+     (points 0)
+     (banned nil)
+     (extrainfo nil))
 
-   (defvar *access-hist* (hash :equal-based))
-   (defvar *points* (hash :equal-based))
-   (defvar *banned* (hash :equal-based))
-   (defvar *extrainfo* (hash :equal-based))
+   (defvarl client-hash (hash :equal-based))
 
    (defvar *off* "") ;; set this to "#" to comment out commands
 
+   (defun get-client-info (ip)
+     (hash-update-1 client-hash ip [iff have
+                                     identity
+                                     (ret (new client-info ip ip))] nil))
+
    ;;; Report activity of an ip address, for a given time
    ;;; Levels are 0 through 5. 0 is normal access: client isn't
    ;;; doing anything wrong, but should be monitored for excessive activity.
@@ -20,69 +24,72 @@
    ;;; 5 points lead to a ban, whose severity depends on how many
    ;;; points in excess of 5 there are.
    (defun report (ip time level : extrainfo)
-     (push time [*access-hist* ip])
-     (if (and extrainfo (not (memqual extrainfo [*extrainfo* ip])))
-       (push extrainfo [*extrainfo* ip]))
-     (if (> level 0)
-       (let* ((points (inc [*points* ip 0] level))
-              (severity (- points 5)))
-         (if (>= severity 0)
-           (progn
-             (del [*points* ip])
-             (ban ip time (ban-duration severity))))))
+     (let ((cli (get-client-info ip)))
+       (push time cli.access-hist)
+       (when extrainfo
+         (pushnew extrainfo cli.extrainfo))
+
+       (if (> level 0)
+         (let* ((points (inc cli.points level))
+                (severity (- points 5)))
+           (if (>= severity 0)
+             (progn
+               (set cli.points 0)
+               (ban cli time (ban-duration severity))))))
      (process-histories time)
-     (do-expiry time))
+     (do-expiry time)))
 
    (defun get-info (ip)
-     [*extrainfo* ip])
+     (iflet ((cli [client-hash ip]))
+       cli.extrainfo))
 
    (defun clear (ip)
-     (del [*access-hist* ip])
-     (del [*extrainfo* ip])
-     (del [*points* ip])
-     (unban ip))
+     (del [client-hash ip]))
 
    (defun ban-duration (severity)
      [*ban-duration* (min (- (length *ban-duration*) 1) severity)])
 
-   (defun ban (ip time howlong)
-     (let* ((banned [*banned* ip])
-            (until (car banned))
+   (defun ban (cli time howlong)
+     (let* ((until (if cli.banned (to cli.banned)))
             (new-until (+ time howlong)))
        (cond
-         ((not banned)
-          (sh `@{*off*}iptables -I INPUT 1 -s @ip -i @{*iface*} -j DROP`)
-          (debug "banned ~a for ~a starting on ~a\n" ip
+         ((not cli.banned)
+          (sh `@{*off*}iptables -I INPUT 1 -s @{cli.ip} -i @{*iface*} -j DROP`)
+          (debug "banned ~a for ~a starting on ~a\n" cli.ip
                    (hrtime howlong) (time-string-local time "%c"))
-          (set [*banned* ip] ^(,new-until ,*time)))
+          (set cli.banned (rcons time new-until)))
          ((> new-until until)
-            (debug "extending ban on ~a for ~a starting on ~a\n" ip
-                   (hrtime howlong) (time-string-local time "%c"))
-            (set [*banned* ip] ^(,new-until ,*time))))))
+          (debug "extending ban on ~a for ~a starting on ~a\n" cli.ip
+                 (hrtime howlong) (time-string-local time "%c"))
+          (set cli.banned (rcons time new-until))))))
 
    (defun process-histories (time)
      (let ((long-range (- time *long-period*))
            (short-range (- time *short-period*)))
-       (dohash (ip acc *access-hist*)
-         (let* ((nacc (remove-if (op < @1 long-range) acc))
+       (dohash (ip cli client-hash)
+         (let* ((nacc (remove-if (op < @1 long-range) cli.access-hist))
                 (long-count (length nacc))
                 (short-count (count-if (op >= @1 short-range) nacc)))
            (if nacc
-             (set [*access-hist* ip] nacc)
+             (set cli.access-hist nacc)
              (progn
-               (del [*access-hist* ip])
-               (del [*extrainfo* ip])))
-           (if (> long-count *long-limit*)
-             (ban ip time *long-ban*))
-             (if (> short-count *short-limit*)
-               (ban ip time *short-ban*))))))
+               (set cli.access-hist nil)
+               (set cli.extrainfo nil)))
+           (cond
+             ((> long-count *long-limit*) (ban cli time *long-ban*))
+             ((> short-count *short-limit*) (ban cli time *short-ban*)))))))
 
    (defun do-expiry (now-time)
-     (dohash (ip timeinfo *banned*)
-       (if (<= (car timeinfo) now-time)
-         (unban ip))))
+     (dohash (ip cli client-hash)
+       (if (and cli.banned (<= (to cli.banned) now-time))
+         (unban cli))))
+
+   (defun unban (cli)
+     (sh `@{*off*}iptables -D INPUT -s @{cli.ip} -i @{*iface*} -j DROP`)
+     (debug "unbanned ~a\n" cli.ip)
+     (set cli.banned nil))
 
-   (defun unban (ip)
-     (sh `@{*off*}iptables -D INPUT -s @ip -i @{*iface*} -j DROP`)
-     (debug "unbanned ~a\n" ip)
-     (del [*banned* ip])))
+   (cond
+     (t (daemon nil nil)
+        (openlog `txrban-@self` log-pid log-authpriv))
+     (nil (set *stdlog* *stdout*))))