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

@(load "config")
@(load "utils")
@(do
   (cond
     (t (daemon nil nil)
        (openlog `txrban-@self` log-pid log-authpriv))
     (nil (set *stdlog* *stdout*)))

   (defvar *access-hist* (hash :equal-based))
   (defvar *points* (hash :equal-based))
   (defvar *banned* (hash :equal-based))
   (defvar *extrainfo* (hash :equal-based))

   (defvar *off* "") ;; set this to "#" to comment out commands

   ;;; 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)
     (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))))))
     (process-histories time)
     (do-expiry time))

   (defun get-info (ip)
     [*extrainfo* ip])

   (defun clear (ip)
     (del [*access-hist* ip])
     (del [*extrainfo* ip])
     (del [*points* ip])
     (unban 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))
            (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
                   (hrtime howlong) (time-string-local time "%c"))
          (set [*banned* ip] ^(,new-until ,*time)))
         ((> 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))))))

   (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))
                (long-count (length nacc))
                (short-count (count-if (op >= @1 short-range) nacc)))
           (if nacc
             (set [*access-hist* ip] 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*))))))

   (defun do-expiry (now-time)
     (dohash (ip timeinfo *banned*)
       (if (<= (car timeinfo) now-time)
         (unban ip))))

   (defun unban (ip)
     (sh `@{*off*}iptables -D INPUT -s @ip -i @{*iface*} -j DROP`)
     (debug "unbanned ~a\n" ip)
     (del [*banned* ip])))