From 10d5ff6dcc2a35e5d690216edc16950e4fb022a9 Mon Sep 17 00:00:00 2001
From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Sat, 1 Jan 2022 23:26:04 +1100
Subject: [PATCH] debugged for change in data directory

---
 manager/basic_login.lsp         |  15 +++++++++++----
 manager/controls.lsp            |   1 +
 manager/history.lsp             |   1 +
 manager/hourglass-web           | Bin 478398 -> 479008 bytes
 manager/index.lsp               |   3 +++
 manager/tmpl/controls-form.html |   1 +
 manager/usage.lsp               |   1 +
 7 files changed, 18 insertions(+), 4 deletions(-)

diff --git a/manager/basic_login.lsp b/manager/basic_login.lsp
index 14117d4..7231ef0 100644
--- a/manager/basic_login.lsp
+++ b/manager/basic_login.lsp
@@ -8,6 +8,7 @@
 ;; name to determine th actual script. That lookup will also use the
 ;; "role base" as declared in "roles.txt"
 
+(write-line 2 (string (date-value) " " (main-args)))
 (unless (ends-with (main-args 0) ".cgi")
   (if (exists file? (list (main-args 1)
                           (string (main-args 1) ".lsp")))
@@ -15,12 +16,13 @@
     (write-line 2 (string "Unknown command " (main-args 1))))
   (exit 0))
 
+
 ;; This script is executed in (protected) subdirectory www
 (change-dir "..")
 
 ;; Needs an HTTP_AUTHORIZATION environment variable
-(unless (setf AUTH (env "HTTP_AUTHORIZATION"))
-  (write-line 2 (read-file "tmpl/unauthorized.http"))
+(when (empty? (setf AUTH (env "HTTP_AUTHORIZATION")))
+  (write-line 1 (read-file "tmpl/unauthorized.http"))
   (exit 0))
 
 ;; Must find that value in .htpasswd
@@ -28,11 +30,16 @@
   (write-line 1 (read-file "tmpl/unauthorized.http"))
   (exit 0))
 
+(define (role-script ROLE)
+  (let ((CMD (and (regex "([^/]*).cgi$" (main-args 0) 0) $1)))
+    (if (= "." ROLE) (string CMD ".lsp")
+      (format "%s/%s.lsp" ROLE CMD))))
+
 (setf
  ROLES (map (fn (x) (parse x ":")) (parse (read-file "roles.txt") "\n"))
  REMOTE_USER (and (regex "([^:]+):" (base64-dec (6 AUTH)) 0) $1)
- ROLE (or (lookup REMOTE_USER ROLSE) "child")
- SCRIPT (format "%s/%s" ROLE (main-args 1))
+ ROLE (or (lookup REMOTE_USER ROLES) "child")
+ SCRIPT (role-script ROLE)
  )
 (env "REMOTE_USER" REMOTE_USER)
 (env "ROLE" ROLE)
diff --git a/manager/controls.lsp b/manager/controls.lsp
index 60c00b5..12d3fbb 100644
--- a/manager/controls.lsp
+++ b/manager/controls.lsp
@@ -36,5 +36,6 @@
 (for (h 1 8) (dolist (m '(0 30))
                (push (format "%02d:%02d" h m) limit-options -1)))
 
+(println "Status 200 OK\nContent-Type: text/html\n\n")
 (println (expand-file "tmpl/controls-form.html" ))
 (exit 0)
diff --git a/manager/history.lsp b/manager/history.lsp
index 2192ac5..fdf1219 100644
--- a/manager/history.lsp
+++ b/manager/history.lsp
@@ -44,6 +44,7 @@
 
 (setf MAP (map (fn (x) (list (x 0) (mkmap (1 x)))) MAP))
 
+(println "Status 200 OK\nContent-Type: text/html\n\n")
 (println (expand-file "tmpl/history-page.html"))
 (exit 0)
 (load
diff --git a/manager/hourglass-web b/manager/hourglass-web
index 6acb8fe1ed8e94526fc07db67cc0ac9630f2cdaa..b8a4e56f64f058469dfc3a33c5de0934a9658ee2 100755
GIT binary patch
delta 1036
zcmbVLOKTHR6ebT(le8G2x-)RNZOx1&X&!C*uxYVvP}=m7M-gdiJI&mrLno7A=C*06
zP?hXN#Elmb#DAcOFdK2@UIhPu;A`PVTnpZ`R!Zrna%XkUch32~^PPG7B=r1Q=uXqs
zbT>UsZ}ZG+`0Vwhl5yvo7aqHk4NGG*qH6}l1WGouG^2`=s)*p0qHj_eiFi^?(Ts><
zRc%?8`7XeBzSaiKj>bAQP@*-H?TqsuZ4l<Ke30Qce30--DZIK^ye{(xKG@h(X{9wo
zvg$gG*kwyI8RqA+899I`>6D=)P0miCq!_9I(JI|WA}!tOTfQtu%T=xWC<lzmt*<*S
z$cS>$K&zmXMiM0lJ^u-5wIos9HpAoqDX^8gRZ|#}9=or{ZsiV&P+*0&Up`Rc$4HDU
z_sS!Jz?x#yRDVRJWjqx3mk7V_hc0)fz+d{|{JG;A`4>Mt?Mft4fh(A;D=N17n-;aH
z!LVF6m?(&fl?V8XYY^h^0?^=N?ZTZf|JV)>d&6^?B1&~jEUI4L*fcS0h=ong&lSZ6
zg+cLHbpQ1Y5ofgnO6~|LFokW}n25!2ex_thiXmcHq_|_!5oC0m^{um-UNTAsk@=e$
zG4=gf7<8qawjhMPPP`Lt_qzw;jv%z_=8<X0JNKqx%60nASx+K4&=PiWSUU08h-RpC
zd*29Q=ZP2|&BCQ2ku=45GTp$_>vJZu@WJC58cZE5Ik^Bz2j(-g^To`{Vj+{~pB5n0
zel!rwL4r@^V2JPK;H$Hd2k(FA4{^E*LH?)!6P`qDm<LP1oarL`hED&es%@dBrit)#
zrJ_+?<;qRCkkbrvlOYpkrAf=I{S-k%sfmEV65Rhc(`0nqpbcHKO>CXW_!t=r`0?<h
SbgH5NH|o}glU{<mKmP#2J3sLN

delta 538
zcmYLGO=}Zj5N1C*jcbI2=s_?tZX2>IB-y0Fq~st)3ki)$+-wVeG<MCtNf(n{yYKen
zAfmW;Z+R&N5j=VDBEo_PFWx=*13VNxdGO$|;BFP1(+o57JkLDy`c?MRVfI<T1$-a`
zVlejsjzytbu7^KFm~reqz;|{y4=-TXnGi~ul7M_lLR9uW+b4yI?GUW6tptq3m35=Z
zz9irgJ3a&VYxW2gazKWtj9hPO`Y4m(wu|{3&Epe%Xi{>miUmu?cu!SPS+srBRJJ3*
zLao25qCDKTCzh;A*uSB-dd7dC94+OjjC!}diptcqor39&DVA0CQG%m<d8sTlu<e=_
znvR8!Jwl1&W3gBox{mL;6I!%PUt(z;F0<KL*b|}_OD18)-X!5=xOEQh@a$>_GE7K8
zjav>IDaecLTMwkUcvWWHJY>S>=V7zTYn2!%8=f>_z@H-BTLV2#!gp(Mllu$QxCJG?
zz7&sM3a@nFrywkA)wq0`j_r(vDjpe=1C$4>Ey2YFg*baCHw~lrAhxKhx9+YOt!_tF
zBeyga7o&TRBIdL*CVs&qQ#X3ZE+wAIKI>39mGWDMdaU~byWWSd5HUp&W(*Mj=`z>h
WwxHGOY-a#|sBXXsgl{)t|JNURZJLn)

diff --git a/manager/index.lsp b/manager/index.lsp
index 1dcc89e..16003fb 100644
--- a/manager/index.lsp
+++ b/manager/index.lsp
@@ -1,3 +1,6 @@
 (load "expand-string.lsp")
+(write-line 2 (string "index.lsp"))
+(write-line 2 (string (expand-file "tmpl/index-page.html")))
+(println "Status 200 OK\nContent-Type: text/html\n\n")
 (println (expand-file "tmpl/index-page.html"))
 (exit 0)
diff --git a/manager/tmpl/controls-form.html b/manager/tmpl/controls-form.html
index dca8deb..88dd6fa 100644
--- a/manager/tmpl/controls-form.html
+++ b/manager/tmpl/controls-form.html
@@ -72,6 +72,7 @@
 	</div>
 	<div id="net_field" class="extra">
 	  <input type="textfield" name="net" value="<?newlisp NET ?>">
+	  controlled network.
 	</div>
       </div>
       <div id="form_submit" class="extra" >
diff --git a/manager/usage.lsp b/manager/usage.lsp
index e53a4ac..c5de943 100644
--- a/manager/usage.lsp
+++ b/manager/usage.lsp
@@ -29,5 +29,6 @@
 (when (and EXTRATM EXTRA (>= TM EXTRATM))
   (setf X (tm2time (- (+ EXTRATM  (time2tm EXTRA)) TM))))
 
+(println "Status 200 OK\nContent-Type: text/html\n\n")
 (println (expand-file "tmpl/usage-form.html" ))
 (exit 0)
-- 
2.39.2