From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Sat, 1 Jan 2022 11:03:41 +0000 (+1100)
Subject: changed into packnl embedding
X-Git-Tag: 0.1~34
X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=cb0bad5aa28b439d25f978173798a4c17e91bdb8;p=rrq%2Fhourglass.git

changed into packnl embedding
---

diff --git a/manager/basic_login.lsp b/manager/basic_login.lsp
new file mode 100644
index 0000000..14117d4
--- /dev/null
+++ b/manager/basic_login.lsp
@@ -0,0 +1,45 @@
+;;
+;; This script is written with the expectation that it is an embedded
+;; newlisp executable invked via .cgi links from within the
+;; subdirectory www
+;;
+;; Its (main-args 0) has a final path component X.cgi that links to
+;; this file as a packnl embedding that will use that X part of its
+;; name to determine th actual script. That lookup will also use the
+;; "role base" as declared in "roles.txt"
+
+(unless (ends-with (main-args 0) ".cgi")
+  (if (exists file? (list (main-args 1)
+                          (string (main-args 1) ".lsp")))
+      (load $it)
+    (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"))
+  (exit 0))
+
+;; Must find that value in .htpasswd
+(unless (ref (6 AUTH) (parse (read-file ".htpasswd") "\n"))
+  (write-line 1 (read-file "tmpl/unauthorized.http"))
+  (exit 0))
+
+(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))
+ )
+(env "REMOTE_USER" REMOTE_USER)
+(env "ROLE" ROLE)
+
+(unless (file? SCRIPT)
+  (write 1 "\nBroken.\n")
+  (exit 0))
+
+(load SCRIPT)
+(exit 0)
diff --git a/manager/hourglass-web b/manager/hourglass-web
new file mode 100755
index 0000000..6acb8fe
Binary files /dev/null and b/manager/hourglass-web differ
diff --git a/manager/install.lsp b/manager/install.lsp
new file mode 100644
index 0000000..6e234d2
--- /dev/null
+++ b/manager/install.lsp
@@ -0,0 +1,20 @@
+#!/usr/bin/newlisp
+#
+# Install the Hourglass service to new directory www
+
+(when (directory? "www")
+  (write-line 2 "** directory www exists. aborting")
+  (exit 1))
+
+(define (copy-out F)
+  (write-file F (read-file F)))
+
+(make-dir "www")
+(make-dir "www/images")
+(copy-out "www/hourglass.css")
+(copy-out "www/images/hourglass.png")
+
+(! "ln -sTf ../hourglass-web www/index.cgi")
+(! "ln -sTf ../hourglass-web www/history.cgi")
+(! "ln -sTf ../hourglass-web www/usage.cgi")
+(! "ln -sTf ../hourglass-web www/controls.cgi")
diff --git a/manager/tmpl/broken.http b/manager/tmpl/broken.http
new file mode 100644
index 0000000..65b0902
--- /dev/null
+++ b/manager/tmpl/broken.http
@@ -0,0 +1,2 @@
+
+Broken
diff --git a/manager/tmpl/unauthorized.http b/manager/tmpl/unauthorized.http
new file mode 100644
index 0000000..c549985
--- /dev/null
+++ b/manager/tmpl/unauthorized.http
@@ -0,0 +1,2 @@
+Status: 401 Unauthorized
+WWW-Authenticate: Basic realm="Hourglass"