diff --git a/scheme/httpd/surflets/surflet-handler.scm b/scheme/httpd/surflets/surflet-handler.scm index 1e5dd9d..a7e7e88 100644 --- a/scheme/httpd/surflets/surflet-handler.scm +++ b/scheme/httpd/surflets/surflet-handler.scm @@ -45,6 +45,9 @@ (http-syslog (syslog-level debug) "servlet-handler: clearing plugin cache") (reset-plugin-cache!) + (http-syslog (syslog-level debug) + "servlet-handler: clearing instance table") + (reset-instance-table!)) (make-http-error-response http-status/accepted req "plugin cache cleared")) ((or (string=? request-method "GET") ; (string=? request-method "POST")) ; do this at later time @@ -123,7 +126,7 @@ You can try starting at the beginning." )))) -(define (send-html/suspend html-tree-maker) +(define (send/suspend response-maker) (shift return (let* ((instance-id (session-instance-id)) (instance (instance-lookup instance-id)) @@ -138,28 +141,12 @@ You can try starting at the beginning." instance-id continuation-counter continuation-id))) - (make-usual-html-response - (lambda (out options) - (with-current-output-port* - out - (lambda () (SXML->HTML (html-tree-maker new-url))))))))))) + (response-maker new-url)))))) + -(define (send-html/finish html-tree) +(define (send/finish response) (instance-delete! (session-instance-id)) - (make-usual-html-response - (lambda (out options) - (with-current-output-port* ; FIXME: will change in further revision - out - (lambda () (SXML->HTML html-tree)))))) - -(define (make-usual-html-response writer-proc) - (make-response - http-status/ok - (status-code->text http-status/ok) - (time) - "text/html" - '() - (make-writer-body writer-proc))) + response) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; access to instance-table @@ -238,6 +225,16 @@ You can try starting at the beginning." (set! *plugin-table* (make-string-table)) (release-lock *plugin-table-lock*)))) +(define (reset-instance-table!) + (with-fatal-error-handler + (lambda (condtion decline) + (release-lock *instance-table-lock*) + (decline)) + (lambda () + (obtain-lock *instance-table-lock*) + (set! *instance-table* (make-integer-table)) + (release-lock *instance-table*)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SESSION (define *session* (make-thread-cell #f))