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 'NOW (date-value))
  13
  14 # Set current time variables in local timezone
  15 (map set '(YEAR MONTH DATE HOUR MINUTE SECOND DOY DOW)
  16      (date-list (+ NOW (* 60 (now 0 -2)))))
  17 ;(println (list YEAR MONTH DATE HOUR MINUTE SECOND DOY DOW))
  18
  19 # Load "control.dat"
  20 # ( (control "file") (gap minutes) ( weekday start limit stop ) ... )
  21 (setf  CONTROL (read-expr (read-file "control.dat")))
  22 (map set '(dow MODE START LIMIT END)
  23      (or (assoc DOW CONTROL) (list DOW (6 30) 120 (20 0))))
  24 (setf
  25  DAY (list YEAR MONTH DATE)
  26  HM (list HOUR MINUTE)
  27  TOTAL '()
  28  GAP (or (lookup 'gap CONTROL) 15)
  29  CLIP (or (lookup 'clip CONTROL) 1000)
  30  )
  31
  32 # Load control mechanism
  33 (if (lookup 'control CONTROL) (load $it)
  34   (die "** Unknown control mechanism. Exiting!!"))
  35 (unless control
  36     (die "** Unknown control action. Exiting!!"))
  37
  38 (define (do-control x r) (control x r) (exit 0))
  39
  40 (when (file? "control-extra.dat")
  41   (let ((f (file-info "control-extra.dat" 6))
  42         (x (regex "([0-9]+) ([0-9]+)" (read-file "control-extra.dat") 0)))
  43     (when (and f x (<= NOW (+ f (* 3600 (int $1 0 10)) (* 60 (int $2 0 10)))))
  44       (setf OVERRIDE true))))
  45
  46 # Activity is lines of timestamps. Collect TOTAL as list of unique
  47 # time values (H M) within the start-end time span.
  48
  49 (define (log-name-fmt t)
  50   (format "%d%02d%02d-.*\\.dat" (0 3 (date-list t))))
  51
  52 (define (log-lines f)
  53   (find-all "([0-9]+( \\S+)?).*" (read-file (string "activity/" f)) $1 0))
  54
  55 # Collect all timestamps of the UTC date of the given time stamp
  56 (define (logs t)
  57   (flat (map log-lines (directory "activity" (log-name-fmt t)))))
  58
  59 # Translate timestamp into its local time (hour minute), if it's
  60 # within the applicable day, null otherwise.
  61 (define (period-minute x)
  62   (when x
  63     (letn ((d (date-list (+ (int x 0 10) (* 60 (now 0 -2)))))
  64            (tm (3 2 d))
  65            (on (if (regex "^[0-9]+ ([0-9]+)$" x 0) (> (int $1 0 10) CLIP) 1))
  66            )
  67       (and on (= (0 3 d) DAY) tm)))) ; (>= tm START) (< tm END) tm))))
  68
  69 # Collect all mentioned minutes from the activity logs
  70 (setf TOTAL
  71       (unique
  72        (clean null?
  73               (map period-minute
  74                    (sort (extend (logs (- NOW 86400)) (logs NOW)))))))
  75
  76 # Add all mentioned minutes, and fill in any time periods of less than
  77 # the configured GAP minutes between them.
  78 (define (minutes x) (+ (* (x 0) 60) (x 1)))
  79 (setf SUM 0)
  80 (when TOTAL
  81   (setf  LAST (minutes (pop TOTAL) SUM 1))
  82   (dolist (x TOTAL)
  83     (letn ((M (minutes x)) (V (- M LAST)))
  84       (inc SUM (if (< V GAP) V 1))
  85       (setf LAST M)))
  86   )
  87
  88 # Rework SUM into (h m) format
  89 (setf SUM (letn ((h (/ SUM 60)) (m (- SUM (* 60 h)))) (list h m)))
  90
  91 (write-file ".usage.dat" (string SUM))
  92 (rename-file ".usage.dat" "usage.dat")
  93
  94 # Close host outside start-end times
  95 (case MODE
  96   (closed (do-control "close" "closed"))
  97   (opened (do-control "open" "open"))
  98   (timed
  99    (when OVERRIDE (do-control "open" "override"))
 100    (when (< HM START) (do-control "close" "early"))
 101    (when (>= HM END) (do-control "close" "late"))
 102    (when (> SUM LIMIT) (do-control "close" "usage"))
 103    (do-control "open" "usage")
 104    )
 105   (true (die "Unknown control mode " MODE))
 106   )