56 lines
1.7 KiB
Scheme
56 lines
1.7 KiB
Scheme
(define-structure servlet servlet-interface
|
|
(open scsh
|
|
scheme
|
|
handle-fatal-error
|
|
let-opt
|
|
servlets
|
|
servlet-handler/admin
|
|
httpd-responses
|
|
)
|
|
(begin
|
|
|
|
(define (get-option-change number-field update-text)
|
|
(send-html/suspend
|
|
(lambda (new-url)
|
|
`(html
|
|
(title "Servlet Adminstration - Handler options")
|
|
(body
|
|
(h1 "Servlet Administration")
|
|
(h2 "Handler options")
|
|
,(and (pair? update-text) update-text)
|
|
(p "These are the runtime configurable options of the handler:")
|
|
(table
|
|
(servlet-form ,new-url
|
|
(tr (td "Current instance lifetime: ")
|
|
(td ,number-field)
|
|
(td ,(make-submit-button "Change")))))
|
|
(hr)
|
|
(URL ,(make-callback return-to-main-page) "Return to main page")))
|
|
)))
|
|
|
|
(define (handler-options req . maybe-update-text)
|
|
(let* ((update-text `(font (@ (color "red"))
|
|
,(:optional maybe-update-text "")))
|
|
(number-field
|
|
(make-number-input-field `(@ ((value ,(options-instance-lifetime))))))
|
|
(req (get-option-change number-field update-text)))
|
|
(with-fatal-error-handler
|
|
(lambda (condition more)
|
|
(handler-options req "Please enter a valid, positive integer number"))
|
|
(set-options-instance-lifetime
|
|
(let ((result (input-field-value number-field (get-bindings req))))
|
|
(if (and (integer? result)
|
|
(> result 0))
|
|
(handler-options req
|
|
(format #f "Instance lifetime changed to ~a."
|
|
(options-instance-lifetime)))
|
|
(error "not a positive integer")))))))
|
|
|
|
(define (return-to-main-page req)
|
|
(send/finish (make-http-error-response http-status/moved-perm req
|
|
"admin.scm" "admin.scm")))
|
|
|
|
(define (main req)
|
|
(handler-options req))
|
|
|
|
)) |