let forms do POST requests by default (currently unchangeable)

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

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 

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)
   `("<form" ,@(map (lambda (attribute-value)
 		     ((enattr (car attribute-value)) (cadr attribute-value)))
-		   `((method "GET")
+		   `((method "POST")
 		     (action ,call-back-function)
 		     ,@attributes))
     #\> #\newline