Introduce new response type :HTTP-NPH-RESPONSE for nph-... CGI

scripts.

scheme/httpd/core.scm

@@ -170,10 +170,13 @@
 	       (let ((response ((httpd-options-request-handler options)
 				(http-url-path (request-url req))
 				req)))
-	       (if (eq? (response-code response) 
-			(status-code redirect))
-		   (redirect-loop (redirect-request req response sock options))
-		   (values req response))))))))
+		 (cond
+		  ((nph-response? response)
+		   (values req response))
+		  ((eq? (response-code response) (status-code redirect))
+		   (redirect-loop (redirect-request req response sock options)))
+		  (else
+		   (values req response)))))))))
       (lambda (req response)
 	
 	(send-http-response req response 
@@ -332,21 +335,23 @@
   (write-crlf port))
 
 (define (send-http-response request response input-port output-port options)
+  (cond
+   ((not request)
+    ;; We have a bad request error. Try to report this headerless.
+    (display-http-body (response-body response) input-port output-port options)
+    ;; no CLF-logging
+    )
+   ((nph-response? response)
+    (display-http-body (nph-response-body response) input-port output-port options)
+    (http-log request (response-code response)))
+   (else
+    (if (not (v0.9-request? request))
+	(send-http-headers response output-port))
     
-  (if request
-      (begin
-	(if (not (v0.9-request? request))
-	    (send-http-headers response output-port))
+    (if (not (string=? (request-method request) "HEAD"))
+	(display-http-body (response-body response) input-port output-port options))
     
-	(if (not (string=? (request-method request) "HEAD"))
-	    (display-http-body (response-body response) input-port output-port options))
-
-	(http-log request (response-code response)))
-      (begin
-	;; We have a bad request error. Try to report this headerless.
-	(display-http-body (response-body response) input-port output-port options)
-	;; no CLF-logging
-	)))
+    (http-log request (response-code response)))))
 
 (define (send-http-header-fields headers port)
   (for-each (lambda (pair)

scheme/httpd/response.scm

@@ -15,6 +15,15 @@
   (extras response-extras)
   (body response-body))
 
+;; This is mainly for nph-... CGI scripts.
+;; This means that the body will output the entire MIME message, not
+;; just the part after the headers.
+
+(define-record-type http-nph-response :http-nph-response
+  (make-nph-response body)
+  nph-response?
+  (body nph-response-body))
+
 (define-record-type http-writer-body :http-writer-body
   (make-writer-body proc)
   writer-body?

scheme/packages.scm

@@ -273,6 +273,9 @@
 	  response-extras
 	  response-body
 
+	  make-nph-response nph-response?
+	  nph-response-body
+
 	  make-writer-body writer-body?
 	  make-reader-writer-body reader-writer-body?
 	  make-redirect-body redirect-body? redirect-body-location