control-logic.lsp

   1 # Apply timing control to this host
   2 # This is run as a cron job to either "close" or "open" the blocking of
   3 # the host via a configured control implementation.
   4
   5 # File control.dat defines the limits, and control mechanism.
   6 # File activity-$date.dat is the local activity.
   7
   8 (define (die)
   9   (write-line 2 (join (map string args)))
  10   (exit 1))
  11
  12 (constant
  13  'NOW (date-value)
  14  'ACTDIR SITE:listener.activity.dir
  15  'CONTROL.DAT SITE:control.dat
  16  'EXTRA.DAT SITE:control.extra.dat
  17  'USAGE.DAT SITE:control.usage.dat
  18  'USAGE.TMP SITE:control.usage.tmp
  19  'ACTION SITE:control.action
  20  )
  21
  22 # Set current time variables in local timezone
  23 (map set '(YEAR MONTH DATE HOUR MINUTE SECOND DOY DOW)
  24      (date-list (+ NOW (* 60 (now 0 -2)))))
  25 ;(println (list YEAR MONTH DATE HOUR MINUTE SECOND DOY DOW))
  26
  27 (setf
  28  DAY (list YEAR MONTH DATE)
  29  HM (list HOUR MINUTE)
  30  TOTAL '()
  31  GAP SITE:control.activity.gap
  32  CLIP SITE:control.activity.clip
  33  )
  34
  35 # Load CONTROL.DAT
  36 # (( weekday start limit stop ) ... )
  37 (setf CONTROL (read-expr (or (read-file CONTROL.DAT)
  38                              (die "** Missing " CONTROL.DAT " ** Exiting."))
  39                          ))
  40
  41 (write-line 2 (string (list CONTROL DOW)))
  42
  43 (map set '(dow MODE START LIMIT END)
  44      (or (assoc DOW CONTROL)
  45          (assoc 'policy CONTROL)
  46          (list DOW (6 30) 120 (20 0)))
  47      )
  48
  49 # Load the configured control mechanism
  50 (if (file? ACTION) (load ACTION)
  51   (die "** Unknown control mechanism. Exiting!!"))
  52 (unless control
  53   (die "** Control function (control cmd reason) not defined. Exiting!!"))
  54
  55 ;; Apply control command with reason, then exit
  56 (define (do-control x r) (control x r) (exit 0))
  57
  58 ;; Utility: Combine an (hour minutes) pair into total minutes
  59 (define (minutes x) (+ (* (x 0) 60) (x 1)))
  60
  61 ;; Utility: Combine hours and minutes into total seconds
  62 (define (seconds H M) (+ (* 3600 H) (* 60 M)))
  63
  64 # Apply EXTRA.DAT. This is a pair of hours and minutes to force open,
  65 # relative to the modification time of the file.
  66 (setf OVERRIDE
  67       (when (regex "([0-9]+) ([0-9]+)" (or (read-file EXTRA.DAT) "") 0)
  68         (<= NOW (+ (file-info EXTRA.DAT 6) (seconds (int $1) (int $2))))))
  69
  70 ;;==== Utilities for activity data
  71 # Activity is lines of timestamps. Collect TOTAL as list of unique
  72 # time values (H M) within the start-end time span.
  73
  74 (define (log-name-fmt t)
  75   (format "%d%02d%02d-.*\\.dat" (0 3 (date-list t))))
  76
  77 (define (log-lines f)
  78   (find-all "([0-9]+( \\S+)?).*" (read-file (format "%s/%s" ACTDIR f)) $1 0))
  79
  80 # Collect all timestamps of the UTC date of the given time stamp
  81 (define (logs t)
  82   (flat (map log-lines (directory ACTDIR (log-name-fmt t)))))
  83
  84 # Translate timestamp into its local time (hour minute), if it's
  85 # within the applicable day, null otherwise.
  86 (define (period-minute x)
  87   (when x
  88     (letn ((d (date-list (+ (int x 0 10) (* 60 (now 0 -2)))))
  89            (tm (3 2 d))
  90            (on (if (regex "^[0-9]+ ([0-9]+)$" x 0) (> (int $1 0 10) CLIP) 1))
  91            )
  92       (and on (= (0 3 d) DAY) tm)))) ; (>= tm START) (< tm END) tm))))
  93 ;; ======
  94
  95 # Collect all mentioned minutes from the activity logs
  96 (setf TOTAL
  97       (unique
  98        (clean null?
  99               (map period-minute
 100                    (sort (extend (logs (- NOW 86400)) (logs NOW)))))))
 101
 102 # Add all mentioned minutes, and fill in any time periods of less than
 103 # the configured GAP minutes between them.
 104 (setf SUM 0)
 105 (when TOTAL
 106   (setf  LAST (minutes (pop TOTAL) SUM 1))
 107   (dolist (x TOTAL)
 108     (letn ((M (minutes x)) (V (- M LAST)))
 109       (inc SUM (if (< V GAP) V 1))
 110       (setf LAST M)))
 111   )
 112
 113 # Rework SUM into (h m) format
 114 (setf SUM (letn ((h (/ SUM 60)) (m (- SUM (* 60 h)))) (list h m)))
 115
 116 # Write out current usage with atomic update (jic)
 117 (write-file USAGE.TMP (string SUM))
 118 (rename-file USAGE.TMP USAGE.DAT)
 119
 120 # Apply current policy setting
 121 ; ** Note that do-control exits
 122 (when OVERRIDE (do-control "open" "override"))
 123 (case MODE
 124   (closed (do-control "close" "closed"))
 125   (opened (do-control "open" "open"))
 126   (timed ;; Close host outside start-end times
 127    (when (< HM START) (do-control "close" "early"))
 128    (when (>= HM END) (do-control "close" "late"))
 129    (when (> SUM LIMIT) (do-control "close" "usage"))
 130    (do-control "open" "usage")
 131    )
 132   (true (die "Unknown control mode " MODE))
 133   )