txrban.txr


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95

@(include "config")
@(include "utils")
@(do
   (defstruct client-info nil
     (ip nil)
     (access-hist nil)
     (points 0)
     (banned nil)
     (extrainfo nil))

   (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.
   ;;; Any other level is points which are accumulated.
   ;;; 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)
     (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)))

   (defun get-info (ip)
     (iflet ((cli [client-hash ip]))
       cli.extrainfo))

   (defun clear (ip)
     (del [client-hash ip]))

   (defun ban-duration (severity)
     [*ban-duration* (min (- (length *ban-duration*) 1) severity)])

   (defun ban (cli time howlong)
     (let* ((until (if cli.banned (to cli.banned)))
            (new-until (+ time howlong)))
       (cond
         ((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 cli.banned (rcons time new-until)))
         ((> new-until until)
          (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 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 cli.access-hist nacc)
             (progn
               (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 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))

   (cond
     (t (daemon nil nil)
        (openlog `txrban-@self` log-pid log-authpriv))
     (nil (set *stdlog* *stdout*))))