diff --git a/scheme/httpd/surflets/packages.scm b/scheme/httpd/surflets/packages.scm index daca407..2bc83d7 100644 --- a/scheme/httpd/surflets/packages.scm +++ b/scheme/httpd/surflets/packages.scm @@ -177,6 +177,7 @@ parse-html-forms sxml-to-html ; SXML->HTML srfi-1 ; FILTER + (subset rfc822 (get-header)) (subset srfi-13 (string-index)) sxml-tree-trans url diff --git a/scheme/httpd/surflets/surflet-handler.scm b/scheme/httpd/surflets/surflet-handler.scm index 7c4efcd..d90cc6b 100644 --- a/scheme/httpd/surflets/surflet-handler.scm +++ b/scheme/httpd/surflets/surflet-handler.scm @@ -89,8 +89,8 @@ ; (reset-instance-table!) ; (make-http-error-response http-status/accepted req "servlet cache cleared")) ((or (string=? request-method "GET") -; (string=? request-method "POST")) ; do this at later time - ) + (string=? request-method "POST")) ; do this at later time +; ) (let ((response (if (resume-url? path-string) (resume-url path-string servlet-path req) @@ -119,11 +119,12 @@ (memo (make-memo))) (table-set! *instance-table* instance-id (make-instance path-string ; used to make - ; redirections to origin + ; redirections to origin memo (make-integer-table) ; continuation table (make-lock) ; continuation table lock - (make-thread-safe-counter))) ; continuation counter + (make-thread-safe-counter) ; continuation counter + #f)) ; servlet-data (release-lock *instance-table-lock*) (register-session! instance-id 'no-return) (let ((servlet diff --git a/scheme/httpd/surflets/surflets.scm b/scheme/httpd/surflets/surflets.scm index 5a5cfdf..df59e2e 100644 --- a/scheme/httpd/surflets/surflets.scm +++ b/scheme/httpd/surflets/surflets.scm @@ -41,27 +41,28 @@ (cond ((string=? request-method "GET") (form-query (http-url:search (request:url request)))) -; ((string=? request-method "POST") -; (let* ((content-length (get-content-length (request:headers request))) -; (form-data (read-line **IN**))) -; (form-query form-data))) + ((string=? request-method "POST") + (let* ((content-length (get-content-length (request:headers request))) + (input-port (socket:inport (request:socket request))) + (form-data (read-string content-length input-port))) + (form-query form-data))) (else (error "unsupported request type"))))) ;; Will be needed when we handle POST requests. -;(define (get-content-length headers) -; (cond ((get-header headers 'content-length) => -; ;; adopted from httpd/cgi-server.scm -; (lambda (content-length) ; Skip initial whitespace (& other non-digits). -; (let ((first-digit (string-index content-length char-set:digit)) -; (content-length-len (string-length content-length))) -; (if first-digit -; (number->string (substring content-length first-digit -; content-length-len)) -; ;; http-status/bad-request req -; `(error "Illegal `Content-length:' header."))))) -; (else -; (error "No Content-length specified for POST data.")))) +(define (get-content-length headers) + (cond ((get-header headers 'content-length) => + ;; adopted from httpd/cgi-server.scm + (lambda (content-length) ; Skip initial whitespace (& other non-digits). + (let ((first-digit (string-index content-length char-set:digit)) + (content-length-len (string-length content-length))) + (if first-digit + (string->number (substring content-length first-digit + content-length-len)) + ;; http-status/bad-request req + `(error "Illegal `Content-length:' header."))))) + (else + (error "No Content-length specified for POST data.")))) (define (extract-bindings bindings key) (let ((key (if (symbol? key) (symbol->string key) key))) @@ -144,7 +145,7 @@ (define (make-servlet-form call-back-function attributes elems) `(" #\newline