scsh-conservatory
/
sunet
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix handling of "npg-" scripts by using make-nph-response.

This commit is contained in:
mainzelm 2003-01-15 14:03:30 +00:00
parent 7170593056
commit 7e274597a4
1 changed files with 15 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
scheme/httpd/cgi-server.scm
View File

@ -121,14 +121,6 @@
(cond (cond
((or (string=? request-method "GET") ((or (string=? request-method "GET")
(string=? request-method "POST")) ; Could do others also. (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) (case (file-not-executable? filename)
((search-denied permission) ((search-denied permission)
(make-error-response (status-code forbidden) req (make-error-response (status-code forbidden) req
@ -137,6 +129,8 @@
(make-error-response (status-code not-found) req (make-error-response (status-code not-found) req
"File or directory doesn't exist.")) "File or directory doesn't exist."))
(else (else
(if nph?
(cgi-make-nph-response (run/port* doit))
(cgi-make-response (run/port* doit) path req))))) (cgi-make-response (run/port* doit) path req)))))
(else (else
@ -275,6 +269,11 @@
(close-input-port script-port))))))) (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) (define (uri-has-protocol? loc)
(receive (proto path search frag) (receive (proto path search frag)
(parse-uri loc) (parse-uri loc)