85 lines
2.6 KiB
Scheme
85 lines
2.6 KiB
Scheme
(define-structure surflet surflet-interface
|
|
(open scheme-with-scsh
|
|
handle-fatal-error
|
|
let-opt
|
|
surflets
|
|
surflets/error
|
|
surflet-handler/options
|
|
)
|
|
(begin
|
|
|
|
(define (get-option-change return-address update-text options)
|
|
(send-html/suspend
|
|
(lambda (new-url)
|
|
`(html
|
|
(title "SUrflet Adminstration - Handler options")
|
|
(body
|
|
(h1 "SUrflet Administration")
|
|
(h2 "Handler options")
|
|
,(and (pair? update-text) update-text)
|
|
(p "These are the runtime configurable options of the handler:")
|
|
(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)
|
|
("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)
|
|
(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))
|
|
|
|
)) |