sunet/web-server/root/surflets/admin-handler.scm

85 lines
2.6 KiB
Scheme
Raw Normal View History

2003-01-19 11:57:27 -05:00
(define-structure surflet surflet-interface
(open scheme-with-scsh
handle-fatal-error
let-opt
2003-01-19 11:57:27 -05:00
surflets
surflets/error
surflet-handler/options
)
(begin
(define (get-option-change return-address update-text options)
(send-html/suspend
(lambda (new-url)
`(html
2003-01-19 11:57:27 -05:00
(title "SUrflet Adminstration - Handler options")
(body
2003-01-19 11:57:27 -05:00
(h1 "SUrflet Administration")
(h2 "Handler options")
,(and (pair? update-text) update-text)
(p "These are the runtime configurable options of the handler:")
2003-01-19 11:57:27 -05:00
(surflet-form
,new-url
POST
(table
,@(map (lambda (option)
(let ((text (car option))
(input-field (cadr option))
(submit-button (caddr option)))
`(tr (td ,text)
(td ,input-field)
(td ,submit-button))))
options)))
(hr)
(p (url ,(return-address new-url) "Return to adminstration menu.") (br)
(url "/" "Return to main menu."))))
)))
(define submit-timeout (make-submit-button "Change"))
(define return-address (make-address))
(define submit-cache (make-submit-button "Change"))
(define (handler-options req . maybe-update-text)
(let* ((update-text `(font (@ (color "red"))
,(:optional maybe-update-text "")))
(number-field
(make-number-field (options-session-lifetime)))
(cache-checkbox (make-checkbox (options-cache-surflets?)))
(options `(("Current session lifetime: " ,number-field ,submit-timeout)
2003-01-19 11:57:27 -05:00
("Cache SUrflets?" ,cache-checkbox ,submit-cache)))
(req (get-option-change return-address update-text options))
(bindings (get-bindings req)))
(cond
((returned-via? return-address bindings)
(return-to-main-page req))
((returned-via? submit-timeout bindings)
(let ((result (input-field-value number-field bindings)))
(if result
(if (and (integer? result)
(> result 0))
(begin
(set-options-session-lifetime! result)
(handler-options req
(format #f "Session lifetime changed to ~a."
(options-session-lifetime))))
(error "not a positive integer"))
(handler-options req "Please enter a valid, positive integer number"))))
((returned-via? submit-cache bindings)
2003-02-19 13:48:24 -05:00
(let ((cache-plugins? (input-field-value cache-checkbox bindings)))
(set-options-cache-surflets?! cache-plugins?)
(handler-options req
(format #f "Caching turned ~s."
(if cache-plugins? "on" "off")))))
(else
(error "unexpected return" bindings)))))
(define (return-to-main-page req)
(send-error (status-code moved-perm) req
"admin.scm" "admin.scm"))
(define (main req)
(handler-options req))
))