From: Ralph Ronnquist Date: Fri, 7 Jan 2022 06:35:42 +0000 (+1100) Subject: addes sitetool X-Git-Tag: 0.1~7 X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=8e2e9a68244bac0e09a1e00e7997fa57f035b79f;p=rrq%2Fhourglass.git addes sitetool --- diff --git a/sitetool/Makefile b/sitetool/Makefile new file mode 100644 index 0000000..aac1ea4 --- /dev/null +++ b/sitetool/Makefile @@ -0,0 +1,9 @@ +MAIN = sitetool.lsp +LSP = $(filter-out $(MAIN),$(wildcard *.lsp)) +TCL = $(wildcard *.tcl) +OTHER = tooltips.txt + +default: sitetool + +sitetool: $(MAIN) $(LSP) $(TCL) $(OTHER) + packnl -w $@ $^ diff --git a/sitetool/runtk.lsp b/sitetool/runtk.lsp new file mode 100644 index 0000000..a6d9d0d --- /dev/null +++ b/sitetool/runtk.lsp @@ -0,0 +1,49 @@ +; Start a sub process that runs "wish" +; Use as: +; (tk ....) to deliver tk (wish) text +; (tk:hanshake ....) does the same +; (tk:stop) to stop the sub process +(context 'tk) + +(map set '(myin tcout) (pipe)) +(map set '(tcin myout) (pipe)) + +(setf TAG "newLISP: " TAG* (length TAG)) + +(set 'SUB (process "/usr/bin/wish" tcin tcout)) + +(define (tk:tk) (apply handshake (args))) + +(define (read-tcl (DISCARD nil)) + (let ((BUFFER "")) + (when (read myin BUFFER 10000) + (unless DISCARD (println BUFFER))))) + +; function to pass commands to Tcl/Tk +(define (handshake) + (let (str "") + (write-line myout + (format "if { [catch { puts [%s] }] } { %s }" + (apply string (args)) + "tk_messageBox -message $errorInfo; exit" )) + (read-tcl true) + str)) + +(define (load-tcl FILE) + (write myout (read-file FILE))) + +(define (read-loop) + (let ((FD nil) (BUFFER)) + (while (and (setf FD (net-select (list 0 myin) "r" -1)) (member myin FD)) + (when (> (read myin BUFFER 100000)) + (if (starts-with BUFFER TAG) + (eval-string (TAG* BUFFER) MAIN) + (println BUFFER) + ))))) + +(context MAIN) + +;; exit when main window is closed +;(tk "bind . {puts {newLISP: (exit)}}") + +"runtk.lsp" diff --git a/sitetool/sitetool b/sitetool/sitetool new file mode 100755 index 0000000..fa71c0b Binary files /dev/null and b/sitetool/sitetool differ diff --git a/sitetool/sitetool.lsp b/sitetool/sitetool.lsp new file mode 100644 index 0000000..19c3e80 --- /dev/null +++ b/sitetool/sitetool.lsp @@ -0,0 +1,30 @@ +;; This is a gui tool for editing the Hourglass site configuration + +(load "runtk.lsp") + +(define (pad TXT (N 0)) + (string TXT (dup " " (max (- N (length TXT)) 0)))) + +(define (wrap TXT (WIDTH 60)) + (let ((OUT '()) (LN "") (FST 0)) + (dolist (W (parse (replace "\n" TXT " ") " ")) + (when (> (+ (length LN) (length W) FST) WIDTH) + (push (pad LN) OUT -1) + (setf LN "") + (setf FST 0)) + (extend LN (if (= FST) "" " ") W) + (setf FST 1)) + (unless (empty? LN) (push (pad LN) OUT -1)) + (join OUT "\n"))) + +; Register all tooltips +(dolist (SETTING (parse (read-file "tooltips.txt") "---\n")) + (let ((TAG (when (regex "(\\S+)" SETTING 0) $1))) + (tk (format "set desc(%s) {%s}" TAG (replace "\n" SETTING " "))))) + +(tk:load-tcl "sitetool.tcl") + +(while true + (tk:read-loop) + (println (eval-string (or (read-line) (exit)))) + ) diff --git a/sitetool/sitetool.tcl b/sitetool/sitetool.tcl new file mode 100644 index 0000000..ca44957 --- /dev/null +++ b/sitetool/sitetool.tcl @@ -0,0 +1,89 @@ + + +# Report dimensions +#puts [winfo vrootwidth .] +#puts [winfo vrootheight .] + +wm title . {Hourglass sitetool} +#wm geometry . 600x400 + +## Tell embedding newlisp to (exit) +bind . {puts {newLISP: (exit)}} + +set count 3 + +proc tooltipOn {w name} { + if {![winfo exist .balloon]} { + toplevel .balloon + wm overrideredirect .balloon 1 + label .balloon.l -foreground blue -background lightyellow \ + -highlightthick 0 -relief solid -borderwidth 1 \ + -font {sanserif} -textvariable balloon_text \ + -justify left -wrap 480 -padx 10 + pack .balloon.l + } + global desc + set ::balloon_text $desc($name) + set x [expr {[winfo rootx $w]+10}] + set y [expr {[winfo rooty $w]+[winfo height $w]+5}] + set g [format +%d+%d $x $y] + # This is probably overdoing it, but better too much than too little + wm geometry .balloon $g + wm deiconify .balloon + wm geometry .balloon $g + raise .balloon + after idle "[list wm geometry .balloon $g]; raise .balloon" +} + +proc tooltipOff {} { + if {[winfo exist .balloon]} { + wm withdraw .balloon + } +} + +proc setting {name defval} { + global count; + incr count; + set wname .fr.settings.name$count ; + set wvalue .fr.settings.value$count ; + set weq .fr.settings.eq$count ; + label $wname -text "$name" -font sanserif; + label $weq -text { }; + text $wvalue -height 1 -wrap none -padx 4 -font sanserif -width 30; + $wvalue insert end "$defval"; + grid $wname -row $count -column 0; + grid $weq -row $count -column 1; + grid $wvalue -row $count -column 2; + #pack .fr.settings ; #grid $me -row $count -column 0 -sticky w; + bind $wname [list tooltipOn $wname $name] + bind $wname {tooltipOff} +} + +frame .fr +frame .fr.settings +grid columnconfigure .fr.settings 0 -weight 1 -uniform A; + +setting {listener.net} {192.168.255} +setting {listener.ports} {80 443 1080} +setting {listener.activity.dir} {activity} +setting {listener.tap} {hourglass} + +setting {control.action} {ipset-control.lsp} +setting {control.dat} {control.dat} +setting {control.net} {10.0.0.0/24} +setting {control.extra.dat} {control-extra.dat} +setting {control.usage.dat} {usage.dat} +setting {control.usage.tmp} {.usage.dat} +setting {control.activity.gap} {10} +setting {control.activity.clip} {1000} + +setting {ipset.bin} {/usr/sbin/ipset} +setting {ipset.table} {TIMO} + +setting {wui.port} {1070} +setting {wui.passwd} {htpasswd} + +button .fr.exit -text "exit" -command {exit} +pack .fr.settings +pack .fr.exit -pady 4 +grid .fr -column 0 -row 0 -sticky w -padx {10 4} -pady {12 0} diff --git a/sitetool/tooltips.txt b/sitetool/tooltips.txt new file mode 100644 index 0000000..4adfa15 --- /dev/null +++ b/sitetool/tooltips.txt @@ -0,0 +1,61 @@ +listener.net is the first three quads of the IP address to use for the +"listener network", with a final component being +1+ for the host and ++2+ for the listener daemon. The listener daemon acts as a virtual +host and is set up vie +setup.sh+ to receive copies of some network +packets for the purpose of measuring activity. +--- +listener.ports are the port numbers of concern, separated by +whitespace or comma, towards activity detection. Only packets to these +ports will be considered. +--- +listener.activity.dir is the directory in which the activity files are +stored. The Hourglass listener daemon operates continuously and +populates one measure per day with a full sequence of (roughly) +per-minute packet count measures. +--- +listener.tap is the name to use for the network tap that is set up to +be the interface for the virtual listener host. +--- +control.action is the name of the control action script to use. +Currently only +ipset-control.lsp+ is available. +--- +control.dat is the pathname for the policy file. The content is a +newlisp format expression; a list with sublists to represent the +desired control policy. It is typically generated by the Hourglass web +service and then used by the Hourglass control bot. +--- +control.net is the IP/bits code of the network to be controlled. +--- +control.extra.dat is the pathname for the ad-hoc time override. This +is a pair of numbers that define an overriding "network open" time +period of that many hours and minutes starting at the modification +time of the file itself +--- +control.usage.dat the filename to use for the usage state. This is a +newlisp expression of the current hours and minutes of usage. The file +is generated by the Hourglass policy bot to be used and displayed via +the Hourglass web service. +--- +control.usage.tmp is the temporary filename to use for the usage state +update. The state update is written to this file which then is renamed +as per +control.usage.dat+; this process avoids the risk of the +Hourglass web service accessing an incompletely written file. +--- +control.activity.gap is how many minutes of low activity is needed for +identifying an idle period. +--- +control.activity.clip is the count measure limit for low activity. +--- +ipset.bin is the pathname for the +ipset+ binary. +--- +ipset.table is the name of the ipset set. +--- +wui.port is the port for the HTTP service. +--- +wui.passwd is the pathname for the file of authorizable users. Each +line consists of the base64 encoding of a "user:password" pair as is +used in the HTTP Basic Authorization scheme. +--- +libc is the pathname for the libc6 dynamic library. +--- +tundev is the pathname for the tuntap device generator.