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

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

@ -121,22 +121,16 @@
(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? (case (file-not-executable? filename)
(let ((stat (wait (fork doit)))) ((search-denied permission)
(if (not (zero? stat)) (make-error-response (status-code forbidden) req
(make-error-response "Permission denied."))
(status-code bad-request) req ((no-directory nonexistent)
(format #f "Could not execute CGI script ~a." (make-error-response (status-code not-found) req
filename)) "File or directory doesn't exist."))
stat)) ;; FIXME! must return http-response object! (else
(case (file-not-executable? filename) (if nph?
((search-denied permission) (cgi-make-nph-response (run/port* doit))
(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
(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)