projects
/
rrq
/
hourglass.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
lifted out siteconfig loading to separate script
[rrq/hourglass.git]
/
manager
/
basic_login.lsp
diff --git
a/manager/basic_login.lsp
b/manager/basic_login.lsp
index 14117d45eb3856dfa90346aa0d34a90cccd349ff..8ca9920882219ae4895b247b59b63097403d375a 100644
(file)
--- a/
manager/basic_login.lsp
+++ b/
manager/basic_login.lsp
@@
-8,6
+8,9
@@
;; name to determine th actual script. That lookup will also use the
;; "role base" as declared in "roles.txt"
;; name to determine th actual script. That lookup will also use the
;; "role base" as declared in "roles.txt"
+(load "siteconfig.lsp")
+
+(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")))
(unless (ends-with (main-args 0) ".cgi")
(if (exists file? (list (main-args 1)
(string (main-args 1) ".lsp")))
@@
-15,12
+18,13
@@
(write-line 2 (string "Unknown command " (main-args 1))))
(exit 0))
(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
;; 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
(exit 0))
;; Must find that value in .htpasswd
@@
-28,11
+32,14
@@
(write-line 1 (read-file "tmpl/unauthorized.http"))
(exit 0))
(write-line 1 (read-file "tmpl/unauthorized.http"))
(exit 0))
+;; Determine actual script name respecting given role, if any.
+(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
(setf
- ROLES (map (fn (x) (parse x ":")) (parse (read-file "roles.txt") "\n"))
REMOTE_USER (and (regex "([^:]+):" (base64-dec (6 AUTH)) 0) $1)
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))
+ SCRIPT (role-script)
)
(env "REMOTE_USER" REMOTE_USER)
(env "ROLE" ROLE)
)
(env "REMOTE_USER" REMOTE_USER)
(env "ROLE" ROLE)