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

34
scheme/httpd/seval.scm
View File

@ -56,9 +56,31 @@
'() '()
(make-reader-writer-body (make-reader-writer-body
(lambda (iport oport options) (lambda (iport oport options)
;;still buggy: if the body of the request is not a valid html-form-query (with-fatal-error-handler
;;or does not contain program=<stuff> we answer 200 but
;;don't send a body (as read-request-sexp throws an exception) (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)
(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)))
(let ((sexp (read-request-sexp body-length iport))) (let ((sexp (read-request-sexp body-length iport)))
(http-syslog (syslog-level debug) "read sexp: ~a" sexp) (http-syslog (syslog-level debug) "read sexp: ~a" sexp)
(emit-prolog oport) (emit-prolog oport)
@ -76,7 +98,7 @@
10 10
(receive vals (receive vals
;; Do the computation. ;; Do the computation.
(begin (emit-header oport 2 "Output from execution") (begin (emit-header oport 1 "Output from execution")
(newline oport) (newline oport)
(with-tag oport pre () (with-tag oport pre ()
(newline oport) (newline oport)
@ -85,10 +107,10 @@
(eval-safely sexp)))) (eval-safely sexp))))
;; Pretty-print the returned value(s).;; hier noch mal newline rausschreiben? ;; Pretty-print the returned value(s).;; hier noch mal newline rausschreiben?
(emit-header oport 2 "Return value(s)") (emit-header oport 1 "Return value(s)")
(with-tag oport pre () (with-tag oport pre ()
(for-each (lambda (val) (p val oport)) (for-each (lambda (val) (p val oport))
vals)))))))))))) vals)))))))))))))
;;; Read an HTTP request entity body from stdin. The Content-length: ;;; Read an HTTP request entity body from stdin. The Content-length: