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

Properly handle HEAD requests. 

Properly handle HTTP 0.9 requests.
This commit is contained in:
sperber 2002-08-26 11:11:40 +00:00
parent 038947a515
commit af95d497af
1 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
scheme/httpd/core.scm
View File

@ -166,7 +166,9 @@
req))) req)))
(values req response))))) (values req response)))))
(lambda (req response) (lambda (req response)
(send-http-response response (socket:outport sock) options)
(send-http-response req response (socket:outport sock) options)
(http-log req http-status/ok)))))) (http-log req http-status/ok))))))
;;;; HTTP request parsing ;;;; HTTP request parsing
@ -274,8 +276,7 @@
(else (list (substring s start (string-length s))))))) (else (list (substring s start (string-length s)))))))
(else '())))) (else '()))))
(define (send-http-response response port options) (define (send-http-headers response port)
(display server/protocol port) (display server/protocol port)
(write-char #\space port) (write-char #\space port)
(display (response-code response) port) (display (response-code response) port)
@ -283,18 +284,24 @@
(display (response-message response) port) (display (response-message response) port)
(write-crlf port) (write-crlf port)
(send-http-headers (send-http-header-fields
(list (cons 'server server/version) (list (cons 'server server/version)
(cons 'content-type (response-mime response)) (cons 'content-type (response-mime response))
(cons 'date (time->http-date-string (response-seconds response)))) (cons 'date (time->http-date-string (response-seconds response))))
port) port)
(send-http-headers (response-extras response) port) (send-http-header-fields (response-extras response) port)
(write-crlf port) (write-crlf port))
(display-http-body (response-body response) port options)) (define (send-http-response request response port options)
(define (send-http-headers headers port) (if (not (v0.9-request? request))
(send-http-headers response port)
(if (not (string=? (request:method request) "HEAD"))
(display-http-body (response-body response) port options))))
(define (send-http-header-fields headers port)
(for-each (lambda (pair) (for-each (lambda (pair)
(display (car pair) port) (display (car pair) port)
(display ": " port) (display ": " port)