# Apply timing control to this host
# This is run as a cron job to either "close" or "open" the blocking of
# the host via a configured control implementation.

# File control.dat defines the limits, and control mechanism.
# File activity-$date.dat is the local activity.

(define (die)
  (write-line 2 (join (map string args)))
  (exit 1))

(constant
 'NOW (date-value)
 'ACTDIR SITE:listener.activity.dir
 'CONTROL.DAT SITE:control.dat
 'EXTRA.DAT SITE:control.extra.dat
 'USAGE.DAT SITE:control.usage.dat
 'USAGE.TMP SITE:control.usage.tmp
 'ACTION SITE:control.action
 )

# Set current time variables in local timezone
(map set '(YEAR MONTH DATE HOUR MINUTE SECOND DOY DOW)
     (date-list (+ NOW (* 60 (now 0 -2)))))
;(println (list YEAR MONTH DATE HOUR MINUTE SECOND DOY DOW))

(setf
 DAY (list YEAR MONTH DATE)
 HM (list HOUR MINUTE)
 TOTAL '()
 GAP SITE:control.activity.gap
 CLIP SITE:control.activity.clip
 )

# Load CONTROL.DAT
# (( weekday start limit stop ) ... )
(setf CONTROL (read-expr (or (read-file CONTROL.DAT)
                             (die "** Missing " CONTROL.DAT " ** Exiting."))
                         ))

(write-line 2 (string (list CONTROL DOW)))

(map set '(dow MODE START LIMIT END)
     (or (assoc DOW CONTROL)
         (assoc 'policy CONTROL)
         (list DOW (6 30) 120 (20 0)))
     )

# Load the configured control mechanism
(if (file? ACTION) (load ACTION)
  (die "** Unknown control mechanism. Exiting!!"))
(unless control
  (die "** Control function (control cmd reason) not defined. Exiting!!"))

;; Apply control command with reason, then exit
(define (do-control x r) (control x r) (exit 0))

;; Utility: Combine an (hour minutes) pair into total minutes
(define (minutes x) (+ (* (x 0) 60) (x 1)))

;; Utility: Combine hours and minutes into total seconds
(define (seconds H M) (+ (* 3600 H) (* 60 M)))

# Apply EXTRA.DAT. This is a pair of hours and minutes to force open,
# relative to the modification time of the file.
(setf OVERRIDE
      (when (regex "([0-9]+) ([0-9]+)" (or (read-file EXTRA.DAT) "") 0)
        (<= NOW (+ (file-info EXTRA.DAT 6) (seconds (int $1) (int $2))))))

;;==== Utilities for activity data
# Activity is lines of timestamps. Collect TOTAL as list of unique
# time values (H M) within the start-end time span.

(define (log-name-fmt t)
  (format "%d%02d%02d-.*\\.dat" (0 3 (date-list t))))

(define (log-lines f)
  (find-all "([0-9]+( \\S+)?).*" (read-file (format "%s/%s" ACTDIR f)) $1 0))

# Collect all timestamps of the UTC date of the given time stamp
(define (logs t)
  (flat (map log-lines (directory ACTDIR (log-name-fmt t)))))

# Translate timestamp into its local time (hour minute), if it's
# within the applicable day, null otherwise.
(define (period-minute x)
  (when x
    (letn ((d (date-list (+ (int x 0 10) (* 60 (now 0 -2)))))
           (tm (3 2 d))
           (on (if (regex "^[0-9]+ ([0-9]+)$" x 0) (> (int $1 0 10) CLIP) 1))
           )
      (and on (= (0 3 d) DAY) tm)))) ; (>= tm START) (< tm END) tm))))
;; ======

# Collect all mentioned minutes from the activity logs
(setf TOTAL
      (unique
       (clean null?
              (map period-minute
                   (sort (extend (logs (- NOW 86400)) (logs NOW)))))))

# Add all mentioned minutes, and fill in any time periods of less than
# the configured GAP minutes between them.
(setf SUM 0)
(when TOTAL
  (setf  LAST (minutes (pop TOTAL) SUM 1))
  (dolist (x TOTAL)
    (letn ((M (minutes x)) (V (- M LAST)))
      (inc SUM (if (< V GAP) V 1))
      (setf LAST M)))
  )

# Rework SUM into (h m) format
(setf SUM (letn ((h (/ SUM 60)) (m (- SUM (* 60 h)))) (list h m)))

# Write out current usage with atomic update (jic)
(write-file USAGE.TMP (string SUM))
(rename-file USAGE.TMP USAGE.DAT)

# Apply current policy setting
; ** Note that do-control exits
(when OVERRIDE (do-control "open" "override"))
(case MODE
  (closed (do-control "close" "closed"))
  (opened (do-control "open" "open"))
  (timed ;; Close host outside start-end times
   (when (< HM START) (do-control "close" "early"))
   (when (>= HM END) (do-control "close" "late"))
   (when (> SUM LIMIT) (do-control "close" "usage"))
   (do-control "open" "usage")
   )
  (true (die "Unknown control mode " MODE))
  )