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

* Changed calls to HTTP-LOG to calls to HTTP-SYSLOG (spec of httpd changed) 

* Corrected test for NPH- scripts (prefix) (formerly -NPH scripts (suffix))
  according to the CGI/1.1 spec.
This commit is contained in:
interp 2002-04-14 16:57:38 +00:00
parent d42e360dfd
commit 15d1ab7b23
1 changed files with 6 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
cgi-server.scm
View File

@ -71,7 +71,7 @@
;;; - If the script begins with "nph-" its output is the entire reply. ;;; - If the script begins with "nph-" its output is the entire reply.
;;; Otherwise, it replies to the server, we peel off a little header ;;; Otherwise, it replies to the server, we peel off a little header
;;; that is used to construct the real header for the reply. ;;; that is used to construct the real header for the reply.
;;; See the "spec" for further details. ;;; See the "spec" for further details. (URL above).
;;; ;;;
;;; The "spec" also talks about PUT, but when I tried this on a dummy script, ;;; The "spec" also talks about PUT, but when I tried this on a dummy script,
;;; the NSCA httpd server generated buggy output. So I am only implementing ;;; the NSCA httpd server generated buggy output. So I am only implementing
@ -96,7 +96,8 @@
(http-error http-reply/bad-request req (http-error http-reply/bad-request req
(format #f "CGI scripts may not contain \"..\" elements.")))) (format #f "CGI scripts may not contain \"..\" elements."))))
(nph? (string-suffix? "-nph" prog)) ; PROG end in "-nph" ? (nph? (string-prefix? "nph-" prog)) ; PROG starts with "nph-" ?
; why did we had (string-suffix? "-nph" prog) here?
(search (http-url:search (request:url req))) ; Compute the (search (http-url:search (request:url req))) ; Compute the
(argv (if (and search (not (string-index search #\=))) ; argv list. (argv (if (and search (not (string-index search #\=))) ; argv list.
@ -110,7 +111,7 @@
(dup->outport (current-output-port) 1) (dup->outport (current-output-port) 1)
(apply exec/env filename env argv)))) (apply exec/env filename env argv))))
(http-log "search: ~s, argv: ~s~%" search argv) (http-syslog (syslog-level debug) "[cgi-server] search: ~s, argv: ~s~%" search argv)
(let ((request-method (request:method req))) (let ((request-method (request:method req)))
(cond (cond
((or (string=? request-method "GET") ((or (string=? request-method "GET")
@ -256,7 +257,7 @@
"CGI script generated multi-line status header"))))) "CGI script generated multi-line status header")))))
(out (current-output-port))) (out (current-output-port)))
(http-log "headers: ~s~%" headers) (http-syslog (syslog-level debug) "[cgi-server] headers: ~s~%" headers)
;; Send the reply header back to the client ;; Send the reply header back to the client
;; (unless it's a headerless HTTP 0.9 reply). ;; (unless it's a headerless HTTP 0.9 reply).
(if (not (v0.9-request? req)) (if (not (v0.9-request? req))
@ -266,7 +267,7 @@
(if loc (format out "Location: ~a\r~%" loc)) (if loc (format out "Location: ~a\r~%" loc))
(write-crlf out))) (write-crlf out)))
(http-log "request:method=~a~%" (request:method req)) (http-syslog (syslog-level debug) "[cgi-server] request:method=~a~%" (request:method req))
;; Copy the reply body back to the client and close the script port ;; Copy the reply body back to the client and close the script port
;; (unless it's a bodiless HEAD transaction). ;; (unless it's a bodiless HEAD transaction).
(if (not (string=? (request:method req) "HEAD")) (if (not (string=? (request:method req) "HEAD"))