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

Introduce new response type :HTTP-NPH-RESPONSE for nph-... CGI 

scripts.
This commit is contained in:
sperber 2003-01-14 13:23:29 +00:00
parent da98e19193
commit 9dac2674b4
3 changed files with 37 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
scheme/httpd/core.scm
View File

@ -170,12 +170,15 @@
(let ((response ((httpd-options-request-handler options) (let ((response ((httpd-options-request-handler options)
(http-url-path (request-url req)) (http-url-path (request-url req))
req))) req)))
(if (eq? (response-code response) (cond
(status-code redirect)) ((nph-response? response)
(redirect-loop (redirect-request req response sock options)) (values req response))
(values req response)))))))) ((eq? (response-code response) (status-code redirect))
(redirect-loop (redirect-request req response sock options)))
(else
(values req response)))))))))
(lambda (req response) (lambda (req response)
(send-http-response req response (send-http-response req response
(socket:inport sock) (socket:inport sock)
(socket:outport sock) (socket:outport sock)
@ -332,21 +335,23 @@
(write-crlf port)) (write-crlf port))
(define (send-http-response request response input-port output-port options) (define (send-http-response request response input-port output-port options)
(cond
(if request ((not request)
(begin ;; We have a bad request error. Try to report this headerless.
(if (not (v0.9-request? request)) (display-http-body (response-body response) input-port output-port options)
(send-http-headers response output-port)) ;; no CLF-logging
)
(if (not (string=? (request-method request) "HEAD")) ((nph-response? response)
(display-http-body (response-body response) input-port output-port options)) (display-http-body (nph-response-body response) input-port output-port options)
(http-log request (response-code response)))
(http-log request (response-code response))) (else
(begin (if (not (v0.9-request? request))
;; We have a bad request error. Try to report this headerless. (send-http-headers response output-port))
(display-http-body (response-body response) input-port output-port options)
;; no CLF-logging (if (not (string=? (request-method request) "HEAD"))
))) (display-http-body (response-body response) input-port output-port options))
(http-log request (response-code response)))))
(define (send-http-header-fields headers port) (define (send-http-header-fields headers port)
(for-each (lambda (pair) (for-each (lambda (pair)

9
scheme/httpd/response.scm
View File

@ -15,6 +15,15 @@
(extras response-extras) (extras response-extras)
(body response-body)) (body response-body))
;; This is mainly for nph-... CGI scripts.
;; This means that the body will output the entire MIME message, not
;; just the part after the headers.
(define-record-type http-nph-response :http-nph-response
(make-nph-response body)
nph-response?
(body nph-response-body))
(define-record-type http-writer-body :http-writer-body (define-record-type http-writer-body :http-writer-body
(make-writer-body proc) (make-writer-body proc)
writer-body? writer-body?

3
scheme/packages.scm
View File

@ -273,6 +273,9 @@
response-extras response-extras
response-body response-body
make-nph-response nph-response?
nph-response-body
make-writer-body writer-body? make-writer-body writer-body?
make-reader-writer-body reader-writer-body? make-reader-writer-body reader-writer-body?
make-redirect-body redirect-body? redirect-body-location make-redirect-body redirect-body? redirect-body-location