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 ; rman-gateway
; info-gateway ; info-gateway
surflet-handler surflet-handler
surflet-handler/options
let-opt let-opt
scsh scsh
scheme) scheme)
@ -201,7 +202,12 @@ exec scsh -lm $sunet/packages.scm -lm $ssax/lib/packages.scm -lm $sunet/httpd/su
"text/plain")) "text/plain"))
(make-file-directory-options)))) (make-file-directory-options))))
(cons "img" (rooted-file-handler images-dir)) (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)))) (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 ;; Loads a new or resumes a suspended SUrflet; returns a
;; (HTTP-)RESPONSE. SURFLET-PATH is a string pointing to the real ;; (HTTP-)RESPONSE. SURFLET-PATH is a string pointing to the real
;; directory where the SUrflets are searched. ;; directory where the SUrflets are searched.
(define (surflet-handler surflet-path . maybe-options) (define (surflet-handler options)
(let-optionals maybe-options (set-thread-fluid! *options* options)
((options (with-surflet-path surflet-path (make-default-surflet-options)))) (spawn surveillance-thread)
(set-thread-fluid! *options* options) (lambda (path req)
(spawn surveillance-thread) (if (pair? path) ; need at least one element
(lambda (path req) (let ((request-method (request-method req))
(if (pair? path) ; need at least one element (path-string (uri-path->uri path)))
(let ((request-method (request-method req)) (if (or (string=? request-method "GET")
(path-string (uri-path->uri path))) (string=? request-method "POST"))
(if (or (string=? request-method "GET") (make-input-response
(string=? request-method "POST")) (lambda (input-port)
(make-input-response (let ((s-req (make-surflet-request req input-port)))
(lambda (input-port) (if (resume-url? path-string)
(let ((s-req (make-surflet-request req input-port))) (resume-url path-string (options-surflet-path) s-req)
(if (resume-url? path-string) (launch-new-session path-string (options-surflet-path) s-req)))))
(resume-url path-string (options-surflet-path) s-req) (make-error-response (status-code method-not-allowed) req
(launch-new-session path-string (options-surflet-path) s-req))))) request-method)))
(make-error-response (status-code method-not-allowed) req (make-error-response (status-code bad-request) req
request-method))) (format #f "Bad path: ~s" path)))))
(make-error-response (status-code bad-request) req
(format #f "Bad path: ~s" path))))))
;;; LAUNCH-NEW-SESSION ;;; LAUNCH-NEW-SESSION
;; Loads and runs a new session of a SUrflet installing the RESET ;; Loads and runs a new session of a SUrflet installing the RESET