projects
/
rrq
/
hourglass.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
14d1288
)
debugged for change in data directory
author
Ralph Ronnquist
<ralph.ronnquist@gmail.com>
Sat, 1 Jan 2022 12:26:04 +0000
(23:26 +1100)
committer
Ralph Ronnquist
<ralph.ronnquist@gmail.com>
Sat, 1 Jan 2022 12:26:04 +0000
(23:26 +1100)
manager/basic_login.lsp
patch
|
blob
|
history
manager/controls.lsp
patch
|
blob
|
history
manager/history.lsp
patch
|
blob
|
history
manager/hourglass-web
patch
|
blob
|
history
manager/index.lsp
patch
|
blob
|
history
manager/tmpl/controls-form.html
patch
|
blob
|
history
manager/usage.lsp
patch
|
blob
|
history
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"
;; 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")))
(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))
(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
+30,16
@@
(write-line 1 (read-file "tmpl/unauthorized.http"))
(exit 0))
(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)
(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 ROL
SE
) "child")
- SCRIPT (
format "%s/%s" ROLE (main-args 1)
)
+ ROLE (or (lookup REMOTE_USER ROL
ES
) "child")
+ SCRIPT (
role-script ROLE
)
)
(env "REMOTE_USER" REMOTE_USER)
(env "ROLE" ROLE)
)
(env "REMOTE_USER" REMOTE_USER)
(env "ROLE" ROLE)
diff --git
a/manager/controls.lsp
b/manager/controls.lsp
index 60c00b5148ee19976c3d0d6286de0997b0b79496..12d3fbb7154d46d2a1a1f7f895b649f60d6e9118 100644
(file)
--- 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)))
(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)
(println (expand-file "tmpl/controls-form.html" ))
(exit 0)
diff --git
a/manager/history.lsp
b/manager/history.lsp
index 2192ac5be7f4e2db67756004c8efd9f54a3b575a..fdf12198c59c74622889e89f8977fe3070db3a25 100644
(file)
--- a/
manager/history.lsp
+++ b/
manager/history.lsp
@@
-44,6
+44,7
@@
(setf MAP (map (fn (x) (list (x 0) (mkmap (1 x)))) MAP))
(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
(println (expand-file "tmpl/history-page.html"))
(exit 0)
(load
diff --git
a/manager/hourglass-web
b/manager/hourglass-web
index 6acb8fe1ed8e94526fc07db67cc0ac9630f2cdaa..b8a4e56f64f058469dfc3a33c5de0934a9658ee2 100755
(executable)
Binary files a/manager/hourglass-web and b/manager/hourglass-web differ
diff --git
a/manager/index.lsp
b/manager/index.lsp
index 1dcc89e39a6ec54f13688a934b91d10c6f9c89bc..16003fb1506b69d6408de4d23ee208b655448005 100644
(file)
--- a/
manager/index.lsp
+++ b/
manager/index.lsp
@@
-1,3
+1,6
@@
(load "expand-string.lsp")
(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)
(println (expand-file "tmpl/index-page.html"))
(exit 0)
diff --git
a/manager/tmpl/controls-form.html
b/manager/tmpl/controls-form.html
index dca8debd1e2fd1d89848a950c9ab0bdfbfd944af..88dd6fa4eeac134a783f1d9576cfb975ee007020 100644
(file)
--- 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 ?>">
</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" >
</div>
</div>
<div id="form_submit" class="extra" >
diff --git
a/manager/usage.lsp
b/manager/usage.lsp
index e53a4ac467e794f6d48c55747589145f1dd089ed..c5de943e49f03624ac421bd0bc46e6992b94c25d 100644
(file)
--- 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))))
(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)
(println (expand-file "tmpl/usage-form.html" ))
(exit 0)