scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Remove surflet-path bug in SURFLET-HANDLER. 

The surflet-path could be given either explicitly or by options-structure.
This introduced an unexpected behavior: the explicitly given surflet-path
argument was completely ignored when options were given.
Now we accept only one argument to SURFLET-HANDLER that must be an option,
like HTTPD does it.
This commit is contained in:
interp 2003-07-18 15:06:53 +00:00
parent 0a510b7c76
commit 2067f77670
2 changed files with 26 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
scheme/httpd/surflets/start-surflet-server
View File

@ -21,6 +21,7 @@ exec scsh -lm $sunet/packages.scm -lm $ssax/lib/packages.scm -lm $sunet/httpd/su
; rman-gateway
; info-gateway
surflet-handler
surflet-handler/options
let-opt
scsh
scheme)
@ -201,7 +202,12 @@ exec scsh -lm $sunet/packages.scm -lm $ssax/lib/packages.scm -lm $sunet/httpd/su
"text/plain"))
(make-file-directory-options))))
(cons "img" (rooted-file-handler images-dir))
(cons "surflet" (surflet-handler surflet-dir)))
(cons "surflet" (surflet-handler
(with-surflet-path surflet-dir)))
(cons "surflets" (surflet-handler
(with-surflet-path surflet-dir
(with-session-lifetime 1300))))
)
(rooted-file-or-directory-handler htdocs-dir))))
)
))

40
scheme/httpd/surflets/surflet-handler.scm
View File

@ -38,27 +38,25 @@
;; Loads a new or resumes a suspended SUrflet; returns a
;; (HTTP-)RESPONSE. SURFLET-PATH is a string pointing to the real
;; directory where the SUrflets are searched.
(define (surflet-handler surflet-path . maybe-options)
(let-optionals maybe-options
((options (with-surflet-path surflet-path (make-default-surflet-options))))
(set-thread-fluid! *options* options)
(spawn surveillance-thread)
(lambda (path req)
(if (pair? path) ; need at least one element
(let ((request-method (request-method req))
(path-string (uri-path->uri path)))
(if (or (string=? request-method "GET")
(string=? request-method "POST"))
(make-input-response
(lambda (input-port)
(let ((s-req (make-surflet-request req input-port)))
(if (resume-url? path-string)
(resume-url path-string (options-surflet-path) s-req)
(launch-new-session path-string (options-surflet-path) s-req)))))
(make-error-response (status-code method-not-allowed) req
request-method)))
(make-error-response (status-code bad-request) req
(format #f "Bad path: ~s" path))))))
(define (surflet-handler options)
(set-thread-fluid! *options* options)
(spawn surveillance-thread)
(lambda (path req)
(if (pair? path) ; need at least one element
(let ((request-method (request-method req))
(path-string (uri-path->uri path)))
(if (or (string=? request-method "GET")
(string=? request-method "POST"))
(make-input-response
(lambda (input-port)
(let ((s-req (make-surflet-request req input-port)))
(if (resume-url? path-string)
(resume-url path-string (options-surflet-path) s-req)
(launch-new-session path-string (options-surflet-path) s-req)))))
(make-error-response (status-code method-not-allowed) req
request-method)))
(make-error-response (status-code bad-request) req
(format #f "Bad path: ~s" path)))))
;;; LAUNCH-NEW-SESSION
;; Loads and runs a new session of a SUrflet installing the RESET