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

`cat ~/diff-sunet/3/log`

This commit is contained in:
interp 2003-08-01 17:33:21 +00:00
parent d26c61799b
commit f106614a75
1 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -91,7 +91,7 @@
;; Catch conditions from get-surflet-rt-structure. ;; Catch conditions from get-surflet-rt-structure.
(lambda (condition decline) (lambda (condition decline)
(delete-session! session-id) (delete-session! session-id)
(bad-gateway-error-response s-req path-string condition)) (bad-surflet-error-response s-req path-string condition))
(let ((surflet (get-surflet-rt-structure path-string surflet-path))) (let ((surflet (get-surflet-rt-structure path-string surflet-path)))
(timeout-queue-register-session! session-id (+ (time) lifetime)) (timeout-queue-register-session! session-id (+ (time) lifetime))
@ -102,7 +102,7 @@
(delete-session! session-id) (delete-session! session-id)
;; Restore correct continuation with shift. ;; Restore correct continuation with shift.
(shift unused (shift unused
(bad-gateway-error-response s-req path-string condition))) (bad-surflet-error-response s-req path-string condition)))
(with-cwd surflet-path (with-cwd surflet-path
(with-names-from-rt-structure (with-names-from-rt-structure
surflet surflet-interface surflet surflet-interface
@ -267,13 +267,13 @@
(else ;; We lose. (else ;; We lose.
(display "Error in SUrflet output.\n" out)) (display "Error in SUrflet output.\n" out))
)))) ))))
(make-error-response (status-code bad-gateway) #f (make-error-response (status-code internal-error) #f
"The SUrflet returned an invalid response object (no surflet-response).")))) "The SUrflet returned an invalid response object (no surflet-response)."))))
((and (response? response) ;; RESPONSE? refers to a HTTP-RESPONSE. ((and (response? response) ;; RESPONSE? refers to a HTTP-RESPONSE.
(redirect-body? (response-body response))) (redirect-body? (response-body response)))
response) response)
(else (else
(make-error-response (status-code bad-gateway) #f (make-error-response (status-code internal-error) #f
"The SUrflet returned an invalid response object (no surflet-response).")))) "The SUrflet returned an invalid response object (no surflet-response)."))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -542,9 +542,9 @@
;; URLs (= resume URLs). Resume URLs look like ;; URLs (= resume URLs). Resume URLs look like
;; http://localhost:8088/surflet/admin-handler.scm;k757033335;c1-684902143?return54= ;; http://localhost:8088/surflet/admin-handler.scm;k757033335;c1-684902143?return54=
(define *resume-url-regexp* (rx (submatch (* (- printing ";"))) (define *resume-url-regexp* (rx (submatch (* (- printing ";")))
";k" (submatch (+ digit)) ; Instance-ID ";k" (submatch (* digit)) ; Instance-ID
";c" (+ digit) ; Continuation Counter ";c" (+ digit) ; Continuation Counter
"-" (submatch (+ digit)))) ; Continuation-ID "-" (submatch (* digit)))) ; Continuation-ID
;; All arguments are numbers except PATH-STRING, which is a string. ;; All arguments are numbers except PATH-STRING, which is a string.
(define (make-resume-url path-string session-id continuation-counter continuation-id) (define (make-resume-url path-string session-id continuation-counter continuation-id)
@ -576,14 +576,14 @@
(let ((match (regexp-search *resume-url-regexp* resume-url))) (let ((match (regexp-search *resume-url-regexp* resume-url)))
(if match (if match
(match:substring match 1) (match:substring match 1)
#f))) (values #f #f))))
(define (resume-url? resume-url) (define (resume-url? resume-url)
(regexp-search? *resume-url-regexp* resume-url)) (regexp-search? *resume-url-regexp* resume-url))
(define (bad-gateway-error-response s-req path-string condition) (define (bad-surflet-error-response s-req path-string condition)
(make-error-response (make-error-response
(status-code bad-gateway) (status-code internal-error)
(surflet-request-request s-req) (surflet-request-request s-req)
(format #f "Error in SUrflet ~s." path-string) (format #f "Error in SUrflet ~s." path-string)
condition)) condition))