From aa2f04195e9826f98a7304228933de3f223c80b8 Mon Sep 17 00:00:00 2001 From: mainzelm Date: Wed, 24 Oct 2001 11:02:46 +0000 Subject: [PATCH] + Moved http-error from the forked process into the server process. + Set stdin and stdout to the current-in/output-port after forking. --- cgi-server.scm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/cgi-server.scm b/cgi-server.scm index 2077c53..ecaffec 100644 --- a/cgi-server.scm +++ b/cgi-server.scm @@ -106,10 +106,9 @@ (env (cgi-env req bin-dir (cdr path))) (doit (lambda () - (apply exec/env filename env argv) - (http-error http-reply/bad-request req - (format #f "Could not execute CGI script ~a." - filename))))) + (dup->inport (current-input-port) 0) + (dup->outport (current-output-port) 1) + (apply exec/env filename env argv)))) (http-log "search: ~s, argv: ~s~%" search argv) (let ((request-method (request:method req))) @@ -117,7 +116,12 @@ ((or (string=? request-method "GET") (string=? request-method "POST")) ; Could do others also. (if nph? - (wait (fork doit)) + (let ((stat (wait (fork doit)))) + (if (not (zero? stat)) + (http-error http-reply/bad-request req + (format #f "Could not execute CGI script ~a." + filename)) + stat)) (cgi-send-reply (run/port* doit) req))) (else (http-error http-reply/method-not-allowed req)))))