+ Make text displayed on session timeout an option to the handler.

+ Fixed various options related bugs.
This commit is contained in:
mainzelm 2003-03-17 12:31:49 +00:00
parent b93e275415
commit b74ca11656
2 changed files with 51 additions and 20 deletions

View File

@ -117,7 +117,8 @@
session-alive? session-alive?
session-surflet-name session-surflet-name
options-session-lifetime options-session-lifetime
options-cache-surflets?))) options-cache-surflets?
options-make-session-timeout-text)))
(define-interface surflets/sessions-interface (define-interface surflets/sessions-interface
(compound-interface (compound-interface
@ -131,7 +132,6 @@
session-alive? session-alive?
session-surflet-name session-surflet-name
;; FIXME: This is too much and should be restricted: ;; FIXME: This is too much and should be restricted:
session-memo
session-continuation-table session-continuation-table
session-continuation-table-lock session-continuation-table-lock
session-continuation-counter))) session-continuation-counter)))
@ -141,10 +141,16 @@
unload-surflet)) unload-surflet))
(define-interface surflet-handler/options-interface (define-interface surflet-handler/options-interface
(export options-session-lifetime (export make-surflet-options
with-session-lifetime
with-cache-surflets?
with-make-session-timeout-text
options-session-lifetime
options-cache-surflets? options-cache-surflets?
options-make-session-timeout-text
set-options-session-lifetime! set-options-session-lifetime!
set-options-cache-surflets?!)) set-options-cache-surflets?!
set-options-make-session-timeout-text))
(define-interface surflet-handler/resume-url-interface (define-interface surflet-handler/resume-url-interface
(export resume-url? (export resume-url?
@ -381,6 +387,7 @@
thread-safe-counter thread-safe-counter
threads ;SLEEP threads ;SLEEP
uri ;URI-PATH-LIST->PATH uri ;URI-PATH-LIST->PATH
(subset srfi-1 (alist-cons alist-delete!))
) )
(files surflet-handler)) (files surflet-handler))

View File

@ -191,16 +191,7 @@
(make-error-response (make-error-response
(status-code bad-request) (status-code bad-request)
(surflet-request-request s-req) (surflet-request-request s-req)
(format #f ((options-make-session-timeout-text)
"<br>
<p>There may be several reasons, why your request for a SUrflet was denied:
<ul>
<li>The SUrflet does not accept any requests any more.</li>
<li>The SUrflet URL has timed out.</li>
<li>You URL is illformed.</li>
</ul>
</p>
<p>In any case, you may try to restart the SUrflet from the <a href=\"~a\">beginning</a>. Your browser may also have cached an old session of this SUrflet. In this case, try to reload the page.</p>"
(resume-url-surflet-name path-string))))) (resume-url-surflet-name path-string)))))
(lookup-continuation-table (lookup-continuation-table
(lambda (session continuation-table continuation-id) (lambda (session continuation-table continuation-id)
@ -659,15 +650,29 @@
;;; OPTIONS: options for the surflet-handler ;;; OPTIONS: options for the surflet-handler
(define-record-type surflet-options :suflet-options (define-record-type surflet-options :suflet-options
(make-surflet-options cache-surflets? session-lifetime) (really-make-surflet-options cache-surflets? session-lifetime make-session-timeout-text)
surflet-options? surflet-options?
(cache-surflets? surflet-options-cache-surflets? set-surflet-options-cache-surflets?!) (cache-surflets? surflet-options-cache-surflets? set-surflet-options-cache-surflets?!)
;; session lifetime is in seconds ;; session lifetime is in seconds
(session-lifetime surflet-options-session-lifetime set-surflet-options-session-lifetime!)) (session-lifetime surflet-options-session-lifetime set-surflet-options-session-lifetime!)
(make-session-timeout-text surflet-options-make-session-timeout-text
set-surflet-options-make-session-timeout-text!))
(define (default-make-session-timeout-text start-url)
(format #f
"<br>
<p>There may be several reasons, why your request for a SUrflet was denied:
<ul>
<li>The SUrflet does not accept any requests any more.</li>
<li>The SUrflet URL has timed out.</li>
<li>You URL is illformed.</li>
</ul>
</p>
<p>In any case, you may try to restart the SUrflet from the <a href=\"~a\">beginning</a>. Your browser may also have cached an old session of this SUrflet. In this case, try to reload the page.</p>" start-url))
;; Constructor with defaults. ;; Constructor with defaults.
(define (make-default-surflet-options) (define (make-default-surflet-options)
(make-surflet-options #t 600)) (really-make-surflet-options #t 600 default-make-session-timeout-text))
(define (copy-surflet-options options) (define (copy-surflet-options options)
(let ((new-options (make-default-surflet-options))) (let ((new-options (make-default-surflet-options)))
@ -676,7 +681,10 @@
(surflet-options-cache-surflets? options)) (surflet-options-cache-surflets? options))
(set-surflet-options-session-lifetime! (set-surflet-options-session-lifetime!
new-options new-options
(surflet-options-session-lifetime options)))) (surflet-options-session-lifetime options))
(set-surflet-options-make-session-timeout-text!
new-options
(surflet-options-make-session-timeout-text))))
(define (make-surflet-options-transformer set-option!) (define (make-surflet-options-transformer set-option!)
(lambda (new-value . stuff) (lambda (new-value . stuff)
@ -686,12 +694,25 @@
(set-option! new-options new-value) (set-option! new-options new-value)
new-options))) new-options)))
(define (make-surflet-options . stuff)
(let loop ((options (make-default-surflet-options))
(stuff stuff))
(if (null? stuff)
options
(let* ((transformer (car stuff))
(value (cadr stuff)))
(loop (transformer value options)
(cddr stuff))))))
(define with-cache-surflets? (define with-cache-surflets?
(make-surflet-options-transformer (make-surflet-options-transformer
set-surflet-options-cache-surflets?!)) set-surflet-options-cache-surflets?!))
(define with-session-lifetime (define with-session-lifetime
(make-surflet-options-transformer (make-surflet-options-transformer
set-surflet-options-session-lifetime!)) set-surflet-options-session-lifetime!))
(define with-make-session-timeout-text
(make-surflet-options-transformer
set-surflet-options-make-session-timeout-text!))
;; Selectors for *options* (preserved-thread-fluid) ;; Selectors for *options* (preserved-thread-fluid)
(define (make-fluid-selector selector) (define (make-fluid-selector selector)
@ -703,11 +724,14 @@
(make-fluid-selector surflet-options-cache-surflets?)) (make-fluid-selector surflet-options-cache-surflets?))
(define options-session-lifetime (define options-session-lifetime
(make-fluid-selector surflet-options-session-lifetime)) (make-fluid-selector surflet-options-session-lifetime))
(define options-make-session-timeout-text
(make-fluid-selector surflet-options-make-session-timeout-text))
(define set-options-cache-surflets?! (define set-options-cache-surflets?!
(make-fluid-setter set-surflet-options-cache-surflets?!)) (make-fluid-setter set-surflet-options-cache-surflets?!))
(define set-options-session-lifetime! (define set-options-session-lifetime!
(make-fluid-setter set-surflet-options-session-lifetime!)) (make-fluid-setter set-surflet-options-session-lifetime!))
(define set-options-make-session-timeout-text
(make-fluid-setter set-surflet-options-make-session-timeout-text!))
;;; SURFLET-RESPONSE: Surflets are expected to return this object type. ;;; SURFLET-RESPONSE: Surflets are expected to return this object type.
;;; STATUS is the status code, an exact integer. See httpd/response.scm ;;; STATUS is the status code, an exact integer. See httpd/response.scm