Force the result of the servlet to be printed into a string-port.

The servlet programmer is (nearly) unaware of this.

This removes the problem that arises if send/suspend is called in HTTPD
while transmitting data to the browser.

scheme/httpd/surflets/packages.scm

@@ -127,6 +127,7 @@
 	sxml-to-html			;SXML->HTML
 	scsh				;regexp et al.
 ;	httpd-file-directory-handlers	;send-file-response
+	srfi-6				;string-ports
 	handle
 	scheme
 	)

scheme/httpd/surflets/surflet-handler.scm

@@ -246,7 +246,7 @@
 						     session-id 
 						     continuation-counter
 						     continuation-id)))
-		       (response-maker new-url)))))
+		       (make-servlet-response (response-maker new-url))))))
 	       (make-error-response (status-code not-found) #f
 					 "The URL refers to a servlet, whose session is no longer alive.")))))
 
@@ -257,6 +257,31 @@
 (define (send response)
   (shift unsused response))
 
+(define (make-servlet-response response)
+  (let ((servlet-out-port (open-output-string))
+	(servlet-in-port #f) ;; FIXME: no input-port available
+	(options #f))			;; FIXME: No access to httpd-options :-(
+    (if (writer-body? (response-body response))
+	(begin
+	  ;; Error-handler is already installed.
+	  ;; Force string-output to resolve all send/... calls. 
+	  (display-http-body (response-body response)
+			     servlet-in-port servlet-out-port 
+			     options)
+	  ;; Create write-out-response for webserver.
+	  (make-response
+	   (response-code response)
+	   (response-message response)
+	   (response-seconds response)
+	   (response-mime response)
+	   (response-extras response)
+	   (make-writer-body
+	    (lambda (out options)
+	      (display (get-output-string servlet-out-port) out)))))
+	(make-error-response (status-code bad-gateway) #f 
+			     "The servlet returned an invalid response object (no writer-body)."))))
+
+    
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; access to session-table
 (define (session-lookup session-id)

scheme/httpd/surflets/surflets.scm

@@ -4,10 +4,9 @@
 (define (send-html/suspend html-tree-maker)
   (send/suspend 
    (lambda (new-url)
-     (let ((html-page (servlet-XML->HTML #f (html-tree-maker new-url))))
-       (make-usual-html-response
-	(lambda (out options)
-	  (display html-page out)))))))
+     (make-usual-html-response
+      (lambda (out options)
+	(display (servlet-XML->HTML #f (html-tree-maker new-url)) out))))))
 
 (define (send-html/finish html-tree)
   (do-sending send/finish html-tree))