* new response body: :HTTP-READER-WRITER-BODY

* hand over SOCKET:INPORT to SEND-HTTP-RESPONSE
* apply this to seval-handler
This commit is contained in:
interp 2002-08-28 16:44:07 +00:00
parent 57c6710012
commit 62b3307fb2
4 changed files with 51 additions and 40 deletions

View File

@ -157,16 +157,16 @@
(decline))))
(lambda ()
(let* ((req (parse-http-request sock options))
(response
(with-current-input-port
(socket:inport sock)
((httpd-options-path-handler options)
(response ((httpd-options-path-handler options)
(http-url:path (request:url req))
req))))
req)))
(values req response)))))
(lambda (req response)
(send-http-response req response (socket:outport sock) options)
(send-http-response req response
(socket:inport sock)
(socket:outport sock)
options)
(http-log req http-status/ok))))))
@ -292,13 +292,13 @@
(write-crlf port))
(define (send-http-response request response port options)
(define (send-http-response request response input-port output-port options)
(if (not (v0.9-request? request))
(send-http-headers response port))
(send-http-headers response output-port))
(if (not (string=? (request:method request) "HEAD"))
(display-http-body (response-body response) port options)))
(display-http-body (response-body response) input-port output-port options)))
(define (send-http-header-fields headers port)
(for-each (lambda (pair)

View File

@ -20,8 +20,18 @@
writer-body?
(proc writer-body-proc))
(define (display-http-body body port options)
((writer-body-proc body) port options))
(define-record-type :http-reader-writer-body
(make-reader-writer-body proc)
reader-writer-body?
(proc reader-writer-body-proc))
(define (display-http-body body iport oport options)
(cond
((writer-body? body)
((writer-body-proc body) oport options))
((reader-writer-body? body)
((reader-writer-body-proc body) iport oport options))))
(define-syntax define-http-status-codes

View File

@ -81,38 +81,38 @@
(make-http-error-response http-status/method-not-allowed req)))))
(define (seval path req)
(let ((sexp (read-request-sexp req)))
(http-syslog (syslog-level debug) "read sexp: ~a" sexp)
(make-response
http-status/ok
(status-code->text http-status/ok)
(time)
"text/html"
'()
(make-writer-body
(lambda (port options)
(with-tag port HEAD ()
(newline port)
(emit-title port "Scheme program output"))
(newline port)
(make-reader-writer-body
(lambda (iport oport options)
(let ((sexp (read-request-sexp req iport)))
(http-syslog (syslog-level debug) "read sexp: ~a" sexp)
(with-tag oport HEAD ()
(newline oport)
(emit-title oport "Scheme program output"))
(newline oport)
(with-tag port BODY ()
(newline port)
(with-tag oport BODY ()
(newline oport)
(do/timeout
10
(receive vals
;; Do the computation.
(begin (emit-header port 2 "Output from execution")
(newline port)
(with-tag port PRE ()
(newline port)
(force-output port); In case we're gunned down.
(begin (emit-header oport 2 "Output from execution")
(newline oport)
(with-tag oport PRE ()
(newline oport)
(force-output oport); In case we're gunned down.
(eval-safely sexp)))
;; Pretty-print the returned value(s).
(emit-header port 2 "Return value(s)")
(with-tag port PRE ()
(for-each (lambda (val) (p val port))
(emit-header oport 2 "Return value(s)")
(with-tag oport PRE ()
(for-each (lambda (val) (p val oport))
vals))))))))))
@ -123,7 +123,7 @@
;;; string, extract <stuff>, uri-decode it, parse that into an s-expression,
;;; and return it.
(define (read-request-sexp req)
(define (read-request-sexp req iport)
(cond
((get-header (request:headers req) 'content-length) =>
(lambda (cl-str) ; Take the first Content-length: header,
@ -133,7 +133,7 @@
cl-start
(string-length cl-str)))
0)) ; All whitespace?? -- WTF.
(qs (read-string cl)) ; Read in CL chars,
(qs (read-string cl iport)) ; Read in CL chars,
(q (parse-html-form-query qs)) ; and parse them up.
(s (cond ((assoc "program" q) => cdr)
(else (signal 'seval-no-program)))))

View File

@ -332,6 +332,7 @@
response-body
make-writer-body writer-body?
make-reader-writer-body reader-writer-body?
display-http-body
;; Integer reply codes