diff --git a/scheme/httpd/cgi-server.scm b/scheme/httpd/cgi-server.scm index 99efc72..6dcc51d 100644 --- a/scheme/httpd/cgi-server.scm +++ b/scheme/httpd/cgi-server.scm @@ -121,22 +121,16 @@ (cond ((or (string=? request-method "GET") (string=? request-method "POST")) ; Could do others also. - (if nph? - (let ((stat (wait (fork doit)))) - (if (not (zero? stat)) - (make-error-response - (status-code bad-request) req - (format #f "Could not execute CGI script ~a." - filename)) - stat)) ;; FIXME! must return http-response object! - (case (file-not-executable? filename) - ((search-denied permission) - (make-error-response (status-code forbidden) req - "Permission denied.")) - ((no-directory nonexistent) - (make-error-response (status-code not-found) req - "File or directory doesn't exist.")) - (else + (case (file-not-executable? filename) + ((search-denied permission) + (make-error-response (status-code forbidden) req + "Permission denied.")) + ((no-directory nonexistent) + (make-error-response (status-code not-found) req + "File or directory doesn't exist.")) + (else + (if nph? + (cgi-make-nph-response (run/port* doit)) (cgi-make-response (run/port* doit) path req))))) (else @@ -275,6 +269,11 @@ (close-input-port script-port))))))) +(define (cgi-make-nph-response script-port) + (make-nph-response + (make-writer-body (lambda (out options) + (copy-inport->outport script-port out))))) + (define (uri-has-protocol? loc) (receive (proto path search frag) (parse-uri loc)