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

Corrected bug: SEVAL now generates a response-body even if the request's body isn't 

form-url encoded or doesn't contain a program
This commit is contained in:
vibr 2004-08-15 12:44:55 +00:00
parent 38f2594ba5
commit cd22ab11d4
1 changed files with 53 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
scheme/httpd/seval.scm
View File

@ -56,39 +56,61 @@
'()
(make-reader-writer-body
(lambda (iport oport options)
;;still buggy: if the body of the request is not a valid html-form-query
;;or does not contain program=<stuff> we answer 200 but
;;don't send a body (as read-request-sexp throws an exception)
(let ((sexp (read-request-sexp body-length iport)))
(http-syslog (syslog-level debug) "read sexp: ~a" sexp)
(emit-prolog oport)
(with-tag oport html (xmlnsdecl-attr)
(newline oport)
(with-tag oport head ()
(newline oport)
(emit-title oport "Scheme program output")
(with-fatal-error-handler
(lambda (c decline)
;; no matter what kind of error (might be a server internal error), we emit this webpage:
(emit-prolog oport)
(with-tag oport html (xmlnsdecl-attr)
(newline oport)
(with-tag oport head ()
(newline oport)
(emit-title oport "No Program")
(newline oport))
(newline oport)
(with-tag oport body ()
(newline oport)
(with-tag oport body ()
(newline oport)
(do/timeout
10
(receive vals
;; Do the computation.
(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.
(with-current-output-port oport
(eval-safely sexp))))
(emit-header oport 1 "No Program")
(newline oport)
(with-tag oport p ()
(display
"No program was found in the body of the request.
The request's body must be form-url encoded and contain a \"program=<sexp>\" pair."
oport)
(newline oport))
(newline oport))
(newline oport)))
;; Pretty-print the returned value(s).;; hier noch mal newline rausschreiben?
(emit-header oport 2 "Return value(s)")
(with-tag oport pre ()
(for-each (lambda (val) (p val oport))
vals))))))))))))
(let ((sexp (read-request-sexp body-length iport)))
(http-syslog (syslog-level debug) "read sexp: ~a" sexp)
(emit-prolog oport)
(with-tag oport html (xmlnsdecl-attr)
(newline oport)
(with-tag oport head ()
(newline oport)
(emit-title oport "Scheme program output")
(newline oport))
(newline oport)
(with-tag oport body ()
(newline oport)
(do/timeout
10
(receive vals
;; Do the computation.
(begin (emit-header oport 1 "Output from execution")
(newline oport)
(with-tag oport pre ()
(newline oport)
(force-output oport); In case we're gunned down.
(with-current-output-port oport
(eval-safely sexp))))
;; Pretty-print the returned value(s).;; hier noch mal newline rausschreiben?
(emit-header oport 1 "Return value(s)")
(with-tag oport pre ()
(for-each (lambda (val) (p val oport))
vals)))))))))))))
;;; Read an HTTP request entity body from stdin. The Content-length: