+ Make text displayed on session timeout an option to the handler.
+ Fixed various options related bugs.
This commit is contained in:
		
							parent
							
								
									b93e275415
								
							
						
					
					
						commit
						b74ca11656
					
				| 
						 | 
				
			
			@ -117,7 +117,8 @@
 | 
			
		|||
	   session-alive?
 | 
			
		||||
	   session-surflet-name
 | 
			
		||||
	   options-session-lifetime
 | 
			
		||||
	   options-cache-surflets?)))
 | 
			
		||||
	   options-cache-surflets?
 | 
			
		||||
           options-make-session-timeout-text)))
 | 
			
		||||
 | 
			
		||||
(define-interface surflets/sessions-interface
 | 
			
		||||
  (compound-interface
 | 
			
		||||
| 
						 | 
				
			
			@ -131,7 +132,6 @@
 | 
			
		|||
	   session-alive?
 | 
			
		||||
	   session-surflet-name
 | 
			
		||||
	   ;; FIXME: This is too much and should be restricted:
 | 
			
		||||
	   session-memo
 | 
			
		||||
	   session-continuation-table
 | 
			
		||||
	   session-continuation-table-lock
 | 
			
		||||
	   session-continuation-counter)))
 | 
			
		||||
| 
						 | 
				
			
			@ -141,10 +141,16 @@
 | 
			
		|||
	  unload-surflet))
 | 
			
		||||
 | 
			
		||||
(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-make-session-timeout-text
 | 
			
		||||
	  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
 | 
			
		||||
  (export resume-url?
 | 
			
		||||
| 
						 | 
				
			
			@ -381,6 +387,7 @@
 | 
			
		|||
	thread-safe-counter
 | 
			
		||||
	threads				;SLEEP
 | 
			
		||||
	uri				;URI-PATH-LIST->PATH
 | 
			
		||||
        (subset srfi-1 (alist-cons alist-delete!))
 | 
			
		||||
	)
 | 
			
		||||
  (files surflet-handler))
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -191,17 +191,8 @@
 | 
			
		|||
	   (make-error-response
 | 
			
		||||
	    (status-code bad-request) 
 | 
			
		||||
	    (surflet-request-request s-req)
 | 
			
		||||
	    (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>"
 | 
			
		||||
		    (resume-url-surflet-name path-string)))))
 | 
			
		||||
            ((options-make-session-timeout-text)
 | 
			
		||||
             (resume-url-surflet-name path-string)))))
 | 
			
		||||
	(lookup-continuation-table
 | 
			
		||||
	  (lambda (session continuation-table continuation-id)
 | 
			
		||||
	    (let ((continuation-table-lock (session-continuation-table-lock session)))
 | 
			
		||||
| 
						 | 
				
			
			@ -659,15 +650,29 @@
 | 
			
		|||
 | 
			
		||||
;;; OPTIONS: options for the surflet-handler
 | 
			
		||||
(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?
 | 
			
		||||
  (cache-surflets? surflet-options-cache-surflets? set-surflet-options-cache-surflets?!)
 | 
			
		||||
  ;; 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.
 | 
			
		||||
(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)
 | 
			
		||||
  (let ((new-options (make-default-surflet-options)))
 | 
			
		||||
| 
						 | 
				
			
			@ -676,7 +681,10 @@
 | 
			
		|||
     (surflet-options-cache-surflets? options))
 | 
			
		||||
    (set-surflet-options-session-lifetime!
 | 
			
		||||
     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!)
 | 
			
		||||
  (lambda (new-value . stuff)
 | 
			
		||||
| 
						 | 
				
			
			@ -686,12 +694,25 @@
 | 
			
		|||
      (set-option! new-options new-value)
 | 
			
		||||
      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?
 | 
			
		||||
  (make-surflet-options-transformer
 | 
			
		||||
   set-surflet-options-cache-surflets?!))
 | 
			
		||||
(define with-session-lifetime
 | 
			
		||||
  (make-surflet-options-transformer
 | 
			
		||||
   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)
 | 
			
		||||
(define (make-fluid-selector selector)
 | 
			
		||||
| 
						 | 
				
			
			@ -703,11 +724,14 @@
 | 
			
		|||
  (make-fluid-selector surflet-options-cache-surflets?))
 | 
			
		||||
(define 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?! 
 | 
			
		||||
  (make-fluid-setter set-surflet-options-cache-surflets?!))
 | 
			
		||||
(define set-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.
 | 
			
		||||
;;; STATUS is the status code, an exact integer. See httpd/response.scm
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue