debugged for change in data directory

[rrq/hourglass.git] / manager / basic_login.lsp

diff --git a/manager/basic_login.lsp b/manager/basic_login.lsp
index 14117d45eb3856dfa90346aa0d34a90cccd349ff..7231ef0e0e7f7b3b62d4f5965a3655dafd7d5497 100644 (file)
--- 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)