lifted out siteconfig loading to separate script
[rrq/hourglass.git] / manager / basic_login.lsp
1 ;;
2 ;; This script is written with the expectation that it is an embedded
3 ;; newlisp executable invked via .cgi links from within the
4 ;; subdirectory www
5 ;;
6 ;; Its (main-args 0) has a final path component X.cgi that links to
7 ;; this file as a packnl embedding that will use that X part of its
8 ;; name to determine th actual script. That lookup will also use the
9 ;; "role base" as declared in "roles.txt"
10
11 (load "siteconfig.lsp")
12
13 (write-line 2 (string (date-value) " " (main-args)))
14 (unless (ends-with (main-args 0) ".cgi")
15   (if (exists file? (list (main-args 1)
16                           (string (main-args 1) ".lsp")))
17       (load $it)
18     (write-line 2 (string "Unknown command " (main-args 1))))
19   (exit 0))
20
21
22 ;; This script is executed in (protected) subdirectory www
23 (change-dir "..")
24
25 ;; Needs an HTTP_AUTHORIZATION environment variable
26 (when (empty? (setf AUTH (env "HTTP_AUTHORIZATION")))
27   (write-line 1 (read-file "tmpl/unauthorized.http"))
28   (exit 0))
29
30 ;; Must find that value in .htpasswd
31 (unless (ref (6 AUTH) (parse (read-file ".htpasswd") "\n"))
32   (write-line 1 (read-file "tmpl/unauthorized.http"))
33   (exit 0))
34
35 ;; Determine actual script name respecting given role, if any.
36 (define (role-script (ROLE "."))
37   (let ((CMD (and (regex "([^/]*).cgi$" (main-args 0) 0) $1)))
38     (if (= "." ROLE) (string CMD ".lsp") (format "%s/%s.lsp" ROLE CMD))))
39
40 (setf
41  REMOTE_USER (and (regex "([^:]+):" (base64-dec (6 AUTH)) 0) $1)
42  SCRIPT (role-script)
43  )
44 (env "REMOTE_USER" REMOTE_USER)
45 (env "ROLE" ROLE)
46
47 (unless (file? SCRIPT)
48   (write 1 "\nBroken.\n")
49   (exit 0))
50
51 (load SCRIPT)
52 (exit 0)