fixes; first version

[rrq/hourglass.git] / control-logic.lsp

diff --git a/control-logic.lsp b/control-logic.lsp
index 79732c2ca821723807ffa098e566011f600ce051..2d2cd3e4efcac3ed4824390b071bda48bd59cc20 100644 (file)
--- a/control-logic.lsp
+++ b/control-logic.lsp
@@ -9,40 +9,65 @@
   (write-line 2 (join (map string args)))
   (exit 1))
 
   (write-line 2 (join (map string args)))
   (exit 1))
 

-(constant 'NOW (date-value))
+(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))
 
 
 # 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))
 

-# Load "control.dat"
-# ( (control "file") (gap minutes) ( weekday start limit stop ) ... )
-(setf  CONTROL (read-expr (read-file "control.dat")))
-(map set '(dow MODE START LIMIT END)
-     (or (assoc DOW CONTROL) (list DOW (6 30) 120 (20 0))))

 (setf
  DAY (list YEAR MONTH DATE)
  HM (list HOUR MINUTE)
  TOTAL '()
 (setf
  DAY (list YEAR MONTH DATE)
  HM (list HOUR MINUTE)
  TOTAL '()

- GAP (or (lookup 'gap CONTROL) 15)
- CLIP (or (lookup 'clip CONTROL) 1000)
+ GAP SITE:control.activity.gap
+ CLIP SITE:control.activity.clip

  )
 
  )
 

-# Load control mechanism
-(if (lookup 'control CONTROL) (load $it)
+# 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 "** Unknown control mechanism. Exiting!!"))
 (unless control

-    (die "** Unknown control action. Exiting!!"))
+  (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))
 
 (define (do-control x r) (control x r) (exit 0))
 

-(when (file? "control-extra.dat")
-  (let ((f (file-info "control-extra.dat" 6))
-        (x (regex "([0-9]+) ([0-9]+)" (read-file "control-extra.dat") 0)))
-    (when (and f x (<= NOW (+ f (* 3600 (int $1 0 10)) (* 60 (int $2 0 10)))))
-      (setf OVERRIDE true))))
+;; 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.
 
 # Activity is lines of timestamps. Collect TOTAL as list of unique
 # time values (H M) within the start-end time span.
 


@@ -50,21 +75,22 @@
   (format "%d%02d%02d-.*\\.dat" (0 3 (date-list t))))
 
 (define (log-lines f)
   (format "%d%02d%02d-.*\\.dat" (0 3 (date-list t))))
 
 (define (log-lines f)

-  (find-all "([0-9]+( \\S+)?).*" (read-file (string "activity/" f)) $1 0))
+  (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)
 
 # Collect all timestamps of the UTC date of the given time stamp
 (define (logs t)

-  (flat (map log-lines (directory "activity" (log-name-fmt t)))))
+  (flat (map log-lines (directory ACTDIR (log-name-fmt t)))))

 
 # Translate timestamp into its local time (hour minute), if it's
 
 # Translate timestamp into its local time (hour minute), if it's

-# within the applicable open time, null otherwise.
+# 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))
            )
 (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 START) (< tm END) tm))))
+      (and on (= (0 3 d) DAY) tm)))) ; (>= tm START) (< tm END) tm))))
+;; ======

 
 # Collect all mentioned minutes from the activity logs
 (setf TOTAL
 
 # Collect all mentioned minutes from the activity logs
 (setf TOTAL


@@ -75,7 +101,6 @@
 
 # Add all mentioned minutes, and fill in any time periods of less than
 # the configured GAP minutes between them.
 
 # Add all mentioned minutes, and fill in any time periods of less than
 # the configured GAP minutes between them.

-(define (minutes x) (+ (* (x 0) 60) (x 1)))

 (setf SUM 0)
 (when TOTAL
   (setf  LAST (minutes (pop TOTAL) SUM 1))
 (setf SUM 0)
 (when TOTAL
   (setf  LAST (minutes (pop TOTAL) SUM 1))


@@ -88,15 +113,17 @@
 # Rework SUM into (h m) format
 (setf SUM (letn ((h (/ SUM 60)) (m (- SUM (* 60 h)))) (list h m)))
 
 # Rework SUM into (h m) format
 (setf SUM (letn ((h (/ SUM 60)) (m (- SUM (* 60 h)))) (list h m)))
 

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

 
 

-# Close host outside start-end times
+# 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"))
 (case MODE
   (closed (do-control "close" "closed"))
   (opened (do-control "open" "open"))

-  (timed 
-   (when OVERRIDE (do-control "open" "override"))
+  (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"))
    (when (< HM START) (do-control "close" "early"))
    (when (>= HM END) (do-control "close" "late"))
    (when (> SUM LIMIT) (do-control "close" "usage"))