From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Sat, 1 Jan 2022 12:26:04 +0000 (+1100)
Subject: debugged for change in data directory
X-Git-Tag: 0.1~29
X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=10d5ff6dcc2a35e5d690216edc16950e4fb022a9;p=rrq%2Fhourglass.git

debugged for change in data directory
---

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 6acb8fe..b8a4e56 100755
Binary files a/manager/hourglass-web and b/manager/hourglass-web differ
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)