diff --git a/scheme/httpd/surflets/surflet-handler.scm b/scheme/httpd/surflets/surflet-handler.scm index 17ad340..c38f5a8 100644 --- a/scheme/httpd/surflets/surflet-handler.scm +++ b/scheme/httpd/surflets/surflet-handler.scm @@ -75,37 +75,21 @@ (if (pair? path) ; need at least one element (let ((request-method (request:method req)) (path-string (uri-path-list->path path))) - (cond -; ((string=? path-string "profile") ; triggers profiling -; (http-syslog (syslog-level debug) -; "profiling: triggered in servlet-handler [~a]" -; (profile-space)) ; PROFILE -; (make-http-error-response http-status/accepted req "profiled")) -; ((string=? path-string "reset") ; triggers cache clearing -; (http-syslog (syslog-level debug) -; "servlet-handler: clearing servlet cache") -; (reset-servlet-cache!) -; (http-syslog (syslog-level debug) -; "servlet-handler: clearing instance table") -; (reset-instance-table!) -; (make-http-error-response http-status/accepted req "servlet cache cleared")) - ((or (string=? request-method "GET") - (string=? request-method "POST")) ; do this at later time -; ) - (let ((response - (if (resume-url? path-string) - (resume-url path-string servlet-path req) - (launch-new-instance path-string servlet-path req)))) - (if (redirect-body? (response-body response)) - ;; prefix with servlet-path - (make-redirect-response - (path-list->file-name - (list (directory-as-file-name servlet-prefix) - (redirect-body-location (response-body response))))) - response))) - (else - (make-http-error-response http-status/method-not-allowed req - request-method)))) + (if (or (string=? request-method "GET") + (string=? request-method "POST")) + (let ((response + (if (resume-url? path-string) + (resume-url path-string servlet-path req) + (launch-new-instance path-string servlet-path req)))) + (if (redirect-body? (response-body response)) + ;; Pefix it with servlet-prefix. + (make-redirect-response + (path-list->file-name + (list (directory-as-file-name servlet-prefix) + (redirect-body-location (response-body response))))) + response)) + (make-http-error-response http-status/method-not-allowed req + request-method))) (make-http-error-response http-status/bad-request req (format #f "Bad path: ~s" path)))))