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 (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)
(let ((sexp (read-request-sexp body-length iport))) ;; no matter what kind of error (might be a server internal error), we emit this webpage:
(http-syslog (syslog-level debug) "read sexp: ~a" sexp) (emit-prolog oport)
(emit-prolog oport) (with-tag oport html (xmlnsdecl-attr)
(with-tag oport html (xmlnsdecl-attr) (newline oport)
(newline oport) (with-tag oport head ()
(with-tag oport head () (newline oport)
(newline oport) (emit-title oport "No Program")
(emit-title oport "Scheme program output")
(newline oport)) (newline oport))
(newline oport) (newline oport)
(with-tag oport body ()
(with-tag oport body ()
(newline oport) (newline oport)
(do/timeout (emit-header oport 1 "No Program")
10 (newline oport)
(receive vals (with-tag oport p ()
;; Do the computation. (display
(begin (emit-header oport 2 "Output from execution") "No program was found in the body of the request.
(newline oport) The request's body must be form-url encoded and contain a \"program=<sexp>\" pair."
(with-tag oport pre () oport)
(newline oport) (newline oport))
(force-output oport); In case we're gunned down. (newline oport))
(with-current-output-port oport (newline oport)))
(eval-safely sexp))))
;; Pretty-print the returned value(s).;; hier noch mal newline rausschreiben? (let ((sexp (read-request-sexp body-length iport)))
(emit-header oport 2 "Return value(s)") (http-syslog (syslog-level debug) "read sexp: ~a" sexp)
(with-tag oport pre () (emit-prolog oport)
(for-each (lambda (val) (p val oport)) (with-tag oport html (xmlnsdecl-attr)
vals)))))))))))) (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: ;;; Read an HTTP request entity body from stdin. The Content-length: