From: Ralph Ronnquist Date: Tue, 21 Nov 2017 10:32:31 +0000 (+1100) Subject: Capture X-Git-Tag: 0.1~40 X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=05a9c528d8aee0373f52fa1bc72250e7f3625e76;p=rrq%2Fhourglass.git Capture --- 05a9c528d8aee0373f52fa1bc72250e7f3625e76 diff --git a/control-logic.lsp b/control-logic.lsp new file mode 100644 index 0000000..79732c2 --- /dev/null +++ b/control-logic.lsp @@ -0,0 +1,106 @@ +# 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)) + +# 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 '() + GAP (or (lookup 'gap CONTROL) 15) + CLIP (or (lookup 'clip CONTROL) 1000) + ) + +# Load control mechanism +(if (lookup 'control CONTROL) (load $it) + (die "** Unknown control mechanism. Exiting!!")) +(unless control + (die "** Unknown control action. Exiting!!")) + +(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)))) + +# 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 (string "activity/" f)) $1 0)) + +# 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))))) + +# Translate timestamp into its local time (hour minute), if it's +# within the applicable open time, 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 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. +(define (minutes x) (+ (* (x 0) 60) (x 1))) +(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-file ".usage.dat" (string SUM)) +(rename-file ".usage.dat" "usage.dat") + +# Close host outside start-end times +(case MODE + (closed (do-control "close" "closed")) + (opened (do-control "open" "open")) + (timed + (when OVERRIDE (do-control "open" "override")) + (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)) + ) diff --git a/control.sh b/control.sh new file mode 100755 index 0000000..ed02b07 --- /dev/null +++ b/control.sh @@ -0,0 +1,4 @@ +#!/bin/bash + +cd $(dirname $0) +/usr/local/bin/newlisp control-logic.lsp >> /tmp/hourglass-control.log 2>&1 diff --git a/ipset-control.lsp b/ipset-control.lsp new file mode 100644 index 0000000..9c9bf93 --- /dev/null +++ b/ipset-control.lsp @@ -0,0 +1,15 @@ + +# Should load from "ipset.cfg" +(constant 'TABLE "TIMO" 'NET "192.168.104.0/24" + 'IPSET "/sbin/ipset" ) + +# Apply "add" or "del" on the controllable as needed, and exit +(define (control cmd reason) + (let ((a (case cmd ("open" "del") ("close" "add") (true "XXX")))) + (when (!= cmd (if (exec (format "%s list %s | grep %s" IPSET TABLE NET)) + "close" "open")) + (! (println (date-value) (format " ipset-control (%s): " reason) + (format "%s %s %s %s" IPSET a TABLE NET))))) + (exit 0)) + +"ipset-control.lsp" diff --git a/listener-log-ip b/listener-log-ip new file mode 100644 index 0000000..e69de29 diff --git a/listener.lsp b/listener.lsp new file mode 100644 index 0000000..bd823f2 --- /dev/null +++ b/listener.lsp @@ -0,0 +1,161 @@ +#!/usr/local/bin/newlisp +# + +# This program attaches to a tap interface for the purpose of noticing +# activity via network traffic. The program serves as a virtual host +# that receives duplicated packets, and analyses them to select those +# that indicate activity. +# Optional arguments: +# -t tap = use the given tap rather than "tap0". + +(signal 2 (fn (x) (exit 0))) + +# The following is for Devuan GNU+Linux +(constant 'LIBC (exists file? '("/lib/x86_64-linux-gnu/libc.so.6" + "/lib/i386-linux-gnu/libc.so.6" + ))) +(import LIBC "ioctl" "int" "int" "long" "void*" ) +(import LIBC "perror" "void" "char*" ) +(import LIBC "ntohl" "int" "int" ) +(import LIBC "ntohs" "int" "int" ) +(import LIBC "htons" "int" "int" ) +(import LIBC "htonl" "int" "int" ) + +# Report low level system error and exit +(define (die s) (perror s) (exit 1)) + +# Utility function to find a command line argument key and optionally +# the subsequent value, if a non-nil default value is given. +(define (mainarg k (v nil)) + (let ((a (member k (main-args)))) + (if (null? a) v (nil? v) true (null? (1 a)) v (a 1)))) + +# Set logging mode. +(constant 'listener-log-ip (mainarg "-l" nil)) + +# Open the tap named by "-t tapX" on the command line, or "tap0" byt +# default. Then make a TUNSETIFF call to initialize it (as +# IFF_TAP|IFF_NO_PI). +(constant 'IFNAME (mainarg "-t" "tap0") 'IFD (open "/dev/net/tun" "u") ) +(unless (number? IFD) (die "open")) +(unless (zero? (ioctl IFD 0x400454ca (pack "s16 u s22" IFNAME 0x1002 ""))) + (die (string "set " IFNAME))) + +# The TCP ports of interest +(constant 'PORTS '(80 443)) + +# Set up for optional tracking of IP addresses +(define counter:counter nil) + +# This function accumulates packet size per ip+port, for monitored the +# ports. This accumulates traffic in both directions. +(define (track-data) ; buffer + (write-line 2 "track-data") + (let ((ips (explode (unpack "bbbb bbbb" ((+ 12 14) buffer)) 4))) + (dotimes (i 2) + (when (member (ports i) PORTS) + (let ((k (string (join (map string (ips i)) ".") "." (ports i)))) + (counter x (+ (length buffer) (or (counter x) 0)))))))) + +(define (track-data-reset) + (map delete (symbols counter))) + +(track-data-reset) + +# Mark the minute of t as an active minute. More exactly, it issues a +# mark if it now is more than 60 seconds from the last issued mark. +# This funcion collates all given ips, and it extends the log line +# with the list of ips used during the minute. +(setf next-mark 0 packet-count 0) +(define (mark-active t) ; buffer + (when listener-log-ip (track-data)) + (inc packet-count) + ;(write-line 2 (string (list t packet-count ports (counter)))) + (when (>= t next-mark) + (let ((d (format "activity/%d%02d%02d-network.dat" (0 3 (date-list t)))) + (c (map string (counter)))) + (append-file d (string t " " packet-count " " (join c " ") "\n")) + (setf next-mark (+ t 60) packet-count 0) + (when listener-log-ip (track-data-reset)) + ))) + +# Handle an ARP request. This picks up IP address from the request. +# The MAC address is formed from the IP address with 2 before and 2 +# after. +(define (arp-request-handler) ; buffer + (letn ((MYIP (unpack "bbbb" (38 buffer))) (MYMAC (flat (list 2 MYIP 2)))) + (write IFD (pack "bbbbbb bbbbbb u u u b b u bbbbbb bbbb bbbbbb bbbb" + (flat (list (unpack "bbbbbb" (6 buffer)) + MYMAC + (map htons '(0x0806 0x1 0x0800 )) + 0x06 0x04 + (htons 0x2) + MYMAC MYIP + (unpack "bbbbbb bbbb" (22 buffer)) + )) + )))) + +# Handle an ARP packet. It recognizes the ARP command involved, and +# dispatches to the associated handler, if any. +(define (arp-handler) ; buffer + (case (ntohs ((unpack "u" (20 buffer)) 0)) ; ARP command + (0x0001 (and arp-request-handler (arp-request-handler))) + (true nil) ; ignore + )) + +# Handle a TCP packet. It reviews the ports involved, and if any is +# among the interesting ports, then it marks activity together with ip +# and port of sender and receiver. +(define (tcp-handler) ; buffer ihl + (let ((ports (map ntohs (unpack "uu" ((+ ihl 14) buffer))))) + (when (intersect ports PORTS) (mark-active (date-value))))) + +(define (udp-handler) ; buffer ihl + (let ((ports (map ntohs (unpack "uu" ((+ ihl 14) buffer))))) + (when (intersect ports PORTS) (mark-active (date-value))))) + +# Handle an IPv4 packet. It recognises the IPv4 protocol concerned, +# and dispatches to the associated handler, if any. +(define (ipv4-handler) ; buffer + (let ((ihl (* (& 0x0F ((unpack "b" (14 buffer)) 0)) 4))) + (case ((unpack "b" (23 buffer)) 0) ; protocol + (0x01 (and icmp-handler (icmp-handler))) + (0x02 (and igmp-handler (igmp-handler))) + (0x04 (and ipip-handler (ipip-handler))) + (0x06 (and tcp-handler (tcp-handler))) + (0x11 (and udp-handler (udp-handler))) + (true nil) ; ignore + ) + )) + +# This function handles an Ethernet packet by recognising the packet +# type, and dispatch to the associated handler, if any. +(define (handle-packet) ; buffer + (when (> n 14) + (case (ntohs ((unpack "u" (12 buffer)) 0)) ; Ethertype + (0x0806 (and arp-handler (arp-handler))) + (0x0800 (and ipv4-handler (ipv4-handler))) + (0x86DD (and ipv6-handler (ipv6-handler))) + (true nil) ; ignore all else + ))) + +# Read and handle a packet from the tap. The program handles ARP +# requests by emitting an appropriate ARP response, and it handles TCP +# packets to certain ports, which are seen as indications of activity. +(define (handle-tap) + (let ((buffer "")(n nil)) + (if (setf n (read IFD buffer 8000)) (handle-packet) + (begin (write-line 2 (format "IFD error")) (exit 1))))) + +# This function gets invoked prior to the interactive prompt. It'll +# listen for data on the tap, and handle that, and also wake up every +# second, so as to allow a timer effect to be set up. +(define (ioselect s) + (letn ((fds (list IFD)) (fdx nil)) + (until (member 0 (setf fdx (or (net-select fds "r" 10000000) '()))) + (when fdx (handle-tap)))) + nil) + +(prompt-event ioselect) +(close 0) +(while true (ioselect)) diff --git a/manager/.htpasswd b/manager/.htpasswd new file mode 100644 index 0000000..d045b17 --- /dev/null +++ b/manager/.htpasswd @@ -0,0 +1,2 @@ +cmFscGg6aGVsbG8= +bGluOmhlbGxv diff --git a/manager/basic_login.sh b/manager/basic_login.sh new file mode 100755 index 0000000..54fbcb1 --- /dev/null +++ b/manager/basic_login.sh @@ -0,0 +1,42 @@ +#!/bin/bash +# +# Ensure there is an HTTP_AUTHORIZATION environment variable +# with appropriate content + +# root user:password +login_check() { + D=$(pwd) + while [ ! -f $D/.htpasswd ] ; do + [ "$D" = "$1" ] && return 0 + if [ "$D" = / ] ; then + logger BAD FAILURE + return 1 + fi + D=$(dirname $D) + done + if [ -z "$2" ] || ! grep -q "$2" $D/.htpasswd ; then + cat < +;; function to process a string template and replace key tokens as +;; declared in a rules list of token-to-replacement associations with +;; their associated values. It offers a similar function to , +;; but for strings, and using string pattern match without +;; tokenization to determine the replacement points. Further, it +;; evaluates the rule value parts to make the replacements. +;; +;; The module was developed as a means to separate +;; logic and rendering in newlisp CGI scripting, and thereby +;; facilitate a higher degree of modularisation, in the aim of +;; increasing the maintainability. It supports the design principle +;; where the handling of a request is directed to a newlisp "logic +;; script" that implements the request logic, and finishes by response +;; rendering via an call. +;; +;; By virtue of the replacement value evaluation, the response +;; rendering is more than a substitution of keywords. Rather it +;; selectively transitions back into newlisp evaluation, e.g., to pick +;; up particulars from the logic context, and transform and combine +;; them for rendering purposes. +;; +;; This makes it easy to achieve a consistent appearance across all +;; response pages, by sharing inclusion fragments. For example, +;; response templates may include a common ingress fragment, common +;; component fragments, and a common egress fragment. Such fragments +;; may be included generically by using <?newlisp ?> or +;; <EVAL>..</EVAL> phrases to invoke for the +;; inclusion fragments, or it may be done specifically by special +;; replacement rules. +; +;;
+; +;; @syntax (expand-string ) +;; The function processes the given text for the +;; occurrences of the rule keys, and replaces these with the values +;; obtained by evaluating the associated value expressions. The result +;; is the new string with replacements. Note that a value expression +;; may affect variable , which is the rest of the input following +;; the expanding key, to optionally consume additional text in the +;; replacement. See function <.expand-map> for an example. +; +;; @syntax (expand-file file rules) +;; The function reads the file and expand it using +;; with the rules. +; +;; @syntax (.expand-eval ) +;; This function is intended as expansion value function for an +;; rule, to implement template expression +;; evaluation. The parameter tells the context for symbol +;; creations. The optional parameter tells the end of the +;; replacement fragment. This function extracts the text fragment +;; until the nearest text, then evaluates this with +;; , makes the result a string, and uses that as value to +;; replace the whole block. See below how a +;; rule using this function may look. +; +;; @syntax (.expand-cond ) +;; +;; This function is intended as an expansion value function for an +;; rule, to implement template fragment conditional +;; cascade. The optional parameter tells the pattern that +;; divides the cascaded parts, which is "<ELSEIF/>" by default, +;; and the optional parameter tells the end of the whole cascade +;; fragment, which is "</IF>" by default. Note that the +;; pattern is a divider between the conditional parts. and thereby +;; both the end of the preceding part, and the beginning of the +;; succeeding part. +;; +;; The cascaded parts are processed in order, for selecting one to +;; include and expand recursively. To this end, each part starts with +;; an s-expression, that gets evaluated to determine whether the part +;; should be included or not. If the value is nil, the the part is +;; ignored, and the processing continues with the next part. If the +;; value is non-nil, the rest of the part is expanded recursively via +;; , and this is then returned as the expansion result +;; of the cascade. If none of the parts is selected, the cascade +;; expansion results in the empty string. +; +;; @syntax (.expand-map ) +;; This function is intended as expansion value function for an +;; rule, to implement template fragment +;; repetition. The optional parameter tells the context for +;; symbol creations. The optional parameter tells the end of the +;; fragment portion, which is "</MAP>" by default. The function +;; pulls two s-expression from the template using . The +;; first is a list of keys, and the second a list of binding lists for +;; those keys. The rest of the fragment is then expanded recursively, +;; repeatedly, with the keys having their subsequent bindings, and the +;; block is replaced by the concatenation of these results. See +;; below how a rule using this function may +;; look. +; +;; @syntax (.expand-markdown ) +; +;; This function is intended as expansion value function for an +;; rule, to implement template fragment markdown +;; processing. It first passes the fragment for recursive +;; expand-string processing, the uses the +;; @link http://daringfireball.net/projects/markdown markdown +;; program to translate the fragment into html. +; +;; @syntax (mapv ) +;; This is a utility macro to both lookup a name in the current rules, +;; and bind its value as the value for that variable. This is +;; typically used for referring to a <MAP> variable. +; +;; @syntax default-expand-rules +;; This constant holds a few default rules for using repetition end +;; expression evaluation. Currently set to the following: +;; 
+;; (constant 'default-expand-rules
+;;           '(("<MAP1>" (.expand-map MAIN "</MAP1>"))
+;;             ("<MAP2>" (.expand-map MAIN "</MAP2>"))
+;;             ("<MAP3>" (.expand-map MAIN "</MAP3>"))
+;;             ("<MAP>" (.expand-map MAIN "</MAP>"))
+;;             ("<EVAL>" (.expand-eval MAIN "</EVAL>"))))
+;;             ("<?newlisp" (.expand-eval MAIN "?>"))
+;;             ("<markdown>" (.expand-eval MAIN "</markdown>"))
+;;            ))
+;;
These default rules obviously favours HTML templates. +;; +;;
§
+;;

Examples

+;; Example: The following is an illustration of +;; using <.expand-map>: +;; 
(expand-string
+;;          "<MAP>(A B) '((1 2) (3 4)) A B B A</MAP>"
+;;          '(("<MAP>" (.expand-map)) ))
+;;
+;; The example results in the string " 1 2 2 1 3 4 4 3". +;; +;; Note that the binding lists expression is evaluated in the given +;; context, or MAIN, if nil is given. Thus, the rule above is +;; equivalent with the following: (.expand-map MAIN "</MAP>") +;; +;; Note also that the fragment blocks cannot be nested. To achieve +;; nested repetition, use several tag pairs, as in the following rule set: +;; 
 '(("<MAP1>" (.expand-map nil "</MAP1>"))
+;;   ("<MAP2>" (.expand-map nil "</MAP2>"))
+;;   ("<MAP3>" (.expand-map nil "</MAP3>")) )
+;; In that case, the outer expansion keys may be used in the inner +;; repetition although they are not actually bound to the values. +;; +;; Example: +;; 
(expand-string
+;;          {<EVAL>(first (exec "uname -mrs"))</EVAL>}
+;;          default-expand-rules )
+;; This example results in the machine details as reported by the +;; program with the <-mrs> command line argument. +;; +;; Example: This example illustrates HTML rendering, with a +;; template file that includes certain keys for expansion. In this +;; case I have a list if paragraps as value of variable , and +;; want them inserted nicely into an HTML page. Note that the spaces +;; following the two s-expressions in the <MAP>..</MAP> +;; construct are compulsory, and they get consumed by the +;; function. +; +;; 
 @PAGEDOCTYPE@
+;; <html><head><title>@TITLE@</title></head>
+;; <body><h1>@TITLE@</h1>
+;; <MAP>(text) texts <p>text</p></MAP>
+;; </body></html>
+; +;; This template would be used in a context that provides suitable +;; expansion rules for the "@PAGEDOCTYPE@" and "@TITLE@" keys, as well +;; as the default "<MAP>" expansion rule. +;; +;; Example: This example illustrates the use of a conditional +;; cascade template fragment. It expands to one of the sentences +;; depending on the conditions. +;; +;; 
 <IF> (> (setf cnt (length (index fresh strawberries))) 10)
+;; Mostly fresh strawberries.
+;; <ELSEIF/> (> cnt 5) Many strawberries are fresh.
+;; <ELSEIF/> (> cnt) At least some strawberries are fresh.
+;; <ELSEIF/> true None of the strawberries are fresh.
+;; </IF>
+; +;; Thus in the example, if the list has more than 10 +;; elements qualified as , then the expansion is "Mostly fresh +;; strawberries.". As a side effect, the count is cached by the first +;; evaluation, regardless of the value, and this is then used in the +;; subsequent expressions. +;; +;; Example: This example illustrates the use of a markdown, +;; where the template is somewhat more readable. +;; 
+;; <markdown>
+;; # This is a H1 header

+;; A first paragraph.

+;; ## Then a H2 header

+;; And a second paragraph with [this link](http://www.realthing.com.au) to somewhere.

+;; * A list item
+;; * and another list item
+;;   1. with a numbered sub item in the item
+;;   1. and a second sub item

+;; and so on...
+;; </markdown>
+;;
+;; Note that the markdown block is expanded recursively before being +;; passed to the markdown processor. Thus, that inner expansion may +;; result in markdown as well as raw HTML (which the markdown +;; processor digests without ado). + +############################################################ + +(define (rule-key rule) + (replace "[\\?*.()]" (first rule) (string "\\" $it) 0)) + +(define (expand-string txt (rules default-expand-rules)) + (if (null? rules) txt + (let ((pat (string "(" (join (map string (map rule-key rules)) "|") ")")) + (out "") (i 0)) + (while (setf i (find pat txt 0)) + (extend out (0 i txt)) + (setf txt ((+ i (length $1)) txt)) + (extend out (string (eval (lookup $1 rules))))) + (extend out txt)))) + +(define (expand-file file (rules default-expand-rules)) + ;(write-line 2 (string "expand-file " file " " rules)) + (expand-string (read-file file) rules)) + +(define (.expand-map ctx (end "")) ; uses txt rules + (let ((A (map term (read-expr txt (or ctx MAIN) nil 0))) + (dlist (read-expr txt (or ctx MAIN) nil $count)) + (frag ($count (- (find end txt nil $count) $count) txt)) + (out "")) + (setf txt ((+ $count (length frag) (length end)) txt)) + (dolist (d (eval dlist)) + (extend out (expand-string frag (extend (map list A d) rules)))) + out)) + +(define (.expand-eval ctx (end "")) ; uses txt rules + (let ((frag (0 (find end txt nil 0) txt))) + (setf txt ((+ (length frag) (length end)) txt)) + (string (eval-string frag)))) + +(define (.expand-cond ctx (mid "") (end "")) + (let ((frag (0 (find end txt nil 0) txt)) (fi 0) (ti 0) (ex nil) (out "")) + (setf txt ((+ (length frag) (length end)) txt)) + (while (and (null? ex) (< fi (length frag))) + (setf ex (read-expr frag (or ctx MAIN) nil fi)) + (setf fi $count) + (setf ti (or (find mid frag nil fi) (length frag))) + (if (setf ex (eval ex)) + (setf out (fi (- ti fi) frag)) + (setf fi (+ ti (length mid))))) + (expand-string out rules))) + +; Process a block for markdown after recursive expansion +(define (.expand-markdown ctx end) ; uses + (let ((frag (0 (find end txt nil 0) txt))) + (setf txt ((+ (length frag) (length end)) txt)) + (letn (f (string "/tmp/markdown-" (date-value))) + (when (exec (format "/usr/bin/markdown --html4tags > %s" f) + (expand-string frag rules)) + (read-file f))))) + +(constant 'default-expand-rules + '(("" (.expand-map MAIN "")) + ("" (.expand-map MAIN "")) + ("" (.expand-map MAIN "")) + ("" (.expand-map MAIN "")) + ("" (.expand-eval MAIN "")) + ("" (.expand-cond MAIN "" "")) + ("")) + ("" (.expand-markdown MAIN "")) + )) + +(define-macro (mapv name) (set name (lookup (string name) rules))) + +(global 'expand-string 'expand-file '.expand-map 'default-expand-rules 'mapv) + +"expand-string.lsp" + diff --git a/manager/history.lsp b/manager/history.lsp new file mode 100644 index 0000000..3002839 --- /dev/null +++ b/manager/history.lsp @@ -0,0 +1,50 @@ +(load "expand-string.lsp") + +# Make a plot file with 0-24 vertically, days horizontally +# Relative now... + +(setf + NOW (now) + TZ (NOW -2) + TZTODAY (- (date-value (0 3 NOW)) (* TZ 60)) + DAYSEC (* 24 3600) + ) + +(define (plotpoint x) + (when x + (letn ((n (div (- x TZTODAY) DAYSEC)) + (d (if (< n) (- (int n) 1) (int n))) + (s (mul 24 (if (< n) (sub n d) (sub n d))))) + (list d s)) + )) + +(define (usage x) + (and (regex "([0-9]+) ([0-9]+)" x 0) + (> (int $2 0 10) 1000) + (plotpoint (int $1 0 10)))) + +(define (usage-file dat) + (clean null? + (map usage + (parse (read-file (format "../activity/%s" dat)) "\n")))) + +(setf + USAGE (sort (flat (map usage-file (directory "../activity" "^[^.]")) 1) <) + MAP '() + ) + +(dolist (u USAGE) + (unless (assoc (u 0) MAP) (push (list (u 0)) MAP)) + (push (u 1) (assoc (u 0) MAP) -1)) + +(define (mkmap x) + (let ((s (dup "." (* 24 4)))) + (dolist (e x) (setf (s (int (mul e 4))) "X")) + s)) + +(setf MAP (map (fn (x) (list (x 0) (mkmap (1 x)))) MAP)) + +(println (expand-file "tmpl/history-page.html")) +(exit 0) +(load + \ No newline at end of file diff --git a/manager/index.lsp b/manager/index.lsp new file mode 100644 index 0000000..1dcc89e --- /dev/null +++ b/manager/index.lsp @@ -0,0 +1,3 @@ +(load "expand-string.lsp") +(println (expand-file "tmpl/index-page.html")) +(exit 0) diff --git a/manager/roles.txt b/manager/roles.txt new file mode 100644 index 0000000..61c5b95 --- /dev/null +++ b/manager/roles.txt @@ -0,0 +1,2 @@ +ralph:. +lin:. diff --git a/manager/tmpl/controls-form.html b/manager/tmpl/controls-form.html new file mode 100644 index 0000000..84b2611 --- /dev/null +++ b/manager/tmpl/controls-form.html @@ -0,0 +1,81 @@ +Hourglass Controls + + + +
+

Control Settings

+
+ + + + + + + + + (@DN @MODE @START @LIMIT @END) TIMES + + + + + + + + +
WeekdayToggleStartLimitEnd
+ + + + + + + +
+
+
+ + idle minutes between activity sessions. +
+
+ + networks packets in a minute, to count as activity. +
+
+
+ + +
+
+
+ + diff --git a/manager/tmpl/history-page.html b/manager/tmpl/history-page.html new file mode 100644 index 0000000..312f41c --- /dev/null +++ b/manager/tmpl/history-page.html @@ -0,0 +1,11 @@ +Hourglass Controls + + + + + + (@DAY @TIMES) MAP + +
|---v---v---v---4am-v---v---v---8am-v---v---v---12--v---v---v---4pm-v---v---v---8pm-v---v---v---
@DAY
@TIMES
+ + diff --git a/manager/tmpl/index-page.html b/manager/tmpl/index-page.html new file mode 100644 index 0000000..ae8870a --- /dev/null +++ b/manager/tmpl/index-page.html @@ -0,0 +1,12 @@ + +Hourglass + + + + + + + + diff --git a/manager/tmpl/snippets.html b/manager/tmpl/snippets.html new file mode 100644 index 0000000..c8cad29 --- /dev/null +++ b/manager/tmpl/snippets.html @@ -0,0 +1,10 @@ +
+
+ Allow another + + minutes of open time. +
+
diff --git a/manager/tmpl/usage-form.html b/manager/tmpl/usage-form.html new file mode 100644 index 0000000..922f3dd --- /dev/null +++ b/manager/tmpl/usage-form.html @@ -0,0 +1,25 @@ +Hourglass Controls + + + + +

Today's usage:

+ extra time. +
+ + +
+
+ +
+ + diff --git a/manager/usage-extra.lsp b/manager/usage-extra.lsp new file mode 100644 index 0000000..e0cad6a --- /dev/null +++ b/manager/usage-extra.lsp @@ -0,0 +1,12 @@ +(define (set-usage-extra m) + (let ((h (/ m 60))) + (setf m (- m (* h 60))) + (write-file "../control-extra.dat" (format "%d %d\n" h m)))) + +(catch + (let ((data "")(b "") (c '()) (v nil)) + (while (read 0 b 1000) (extend data b)) + (setf v (map (fn (x) (parse x "=")) (parse data "&"))) + (set-usage-extra (int (or (lookup "minutes" v) "0") 0 10)))) + +"usage-extra.lsp" diff --git a/manager/usage.lsp b/manager/usage.lsp new file mode 100644 index 0000000..89fc09a --- /dev/null +++ b/manager/usage.lsp @@ -0,0 +1,35 @@ +(load "expand-string.lsp") + +(when (= (env "REQUEST_METHOD") "POST") + (load "usage-extra.lsp") + ) + +(define (get-remote-user) + (and (regex "^([^:]+):" (base64-dec (6 (env "HTTP_AUTHORIZATION"))) 0) $1)) + +(constant + 'ADMIN (member (get-remote-user) '("ralph" "lin")) + 'USAGE (read-expr (read-file "../usage.dat")) + 'extra-options '(0 10 30 60) + 'EXTRAFILE "../control-extra.dat" + 'EXTRATM (file-info EXTRAFILE 6) + 'TM (date-value) + 'EXTRA (and (regex "([0-9]+) ([0-9]+)" (or (read-file EXTRAFILE) "") 0) + (list (int $1 0 10) (int $2 0 10))) + ) + +(define (tm2time tm) + (if (> tm) + (letn ((m (/ tm 60)) (h (/ m 60))) (list h (- m (* 60 h)))) + '(0 0)) + ) + +(define (time2tm t) + (+ (* 3600 (t 0)) (* 60 (t 1)))) + +(setf X '(0 0)) +(when (and EXTRATM EXTRA (>= TM EXTRATM)) + (setf X (tm2time (- (+ EXTRATM (time2tm EXTRA)) TM)))) + +(println (expand-file "tmpl/usage-form.html" )) +(exit 0) diff --git a/manager/www/controls.cgi b/manager/www/controls.cgi new file mode 100755 index 0000000..78e9171 --- /dev/null +++ b/manager/www/controls.cgi @@ -0,0 +1,3 @@ +#!/bin/bash + +. ../basic_login.sh controls.lsp diff --git a/manager/www/history.cgi b/manager/www/history.cgi new file mode 100755 index 0000000..27d6114 --- /dev/null +++ b/manager/www/history.cgi @@ -0,0 +1,3 @@ +#!/bin/bash + +. ../basic_login.sh history.lsp diff --git a/manager/www/hourglass.css b/manager/www/hourglass.css new file mode 100644 index 0000000..1a378de --- /dev/null +++ b/manager/www/hourglass.css @@ -0,0 +1,60 @@ +body { + text-align: center; +} +p { + margin-left: 300px; +} + +#header { +} +.logo { +} +.logo img{ + float: right; + height: 60px; + padding: 10px; +} +.title { + padding-top: 24px; + text-align: center; + font-size: 32pt; + font-weight: bold; +} +#usage { + margin-top: 10px; + width: 100%; + height: 200px; + border: none; + overflow: hidden; +} +#history { + width: 80%; + height: 120px; +} +#controls { + width: 60%; + height: 430px; +// border: none; +} +#form_submit { + margin-top: 10px +} +#extras { + text-align: left; + display: inline-block; + margin-top: 10px; +} +#extra_usage_form { + display: inline; + margin-left: 10px; +} +#extra_time { + font-size: 12pt; +} +.extra { + margin-top: 6px; +} +table tr td { + padding-top: 6px; + padding-right: 6px; +} diff --git a/manager/www/images/hourglass.png b/manager/www/images/hourglass.png new file mode 100644 index 0000000..b8023fe Binary files /dev/null and b/manager/www/images/hourglass.png differ diff --git a/manager/www/index.cgi b/manager/www/index.cgi new file mode 100755 index 0000000..3cb49bf --- /dev/null +++ b/manager/www/index.cgi @@ -0,0 +1,3 @@ +#!/bin/bash + +. ../basic_login.sh index.lsp diff --git a/manager/www/usage.cgi b/manager/www/usage.cgi new file mode 100755 index 0000000..1e36c70 --- /dev/null +++ b/manager/www/usage.cgi @@ -0,0 +1,3 @@ +#!/bin/bash + +. ../basic_login.sh usage.lsp diff --git a/setup.sh b/setup.sh new file mode 100755 index 0000000..e4bcc64 --- /dev/null +++ b/setup.sh @@ -0,0 +1,36 @@ +#!/bin/bash + +CMD=${1-start} +NET=192.168.249 +TAP=tap0 + +cd $(dirname $0) + +RULE=( ! -o $TAP -j TEE --gateway $NET.2 --oif $TAP ) +case "$CMD" in + start) + if ifconfig $TAP >& /dev/null ; then + echo "Already started" + else + date >> /tmp/hourglass-listener.log + newlisp listener.lsp >> /tmp/hourglass-listener.log 2>&1 & + while sleep 1 ; do + ifconfig $TAP >& /dev/null && break + echo $TAP not up yet + done + ifconfig $TAP $NET.1 up + iptables -t mangle -A FORWARD ${RULE[@]} + fi + ;; + stop) + iptables -t mangle -F FORWARD + if ifconfig $TAP >& /dev/null ; then + pkill -2 -f listener.lsp + else + echo "Already stopped" + fi + ;; + *) + echo "Unknown: $CMD" + ;; +esac