prepare for POST requests
This commit is contained in:
		
							parent
							
								
									30aca350b9
								
							
						
					
					
						commit
						091f5ab590
					
				| 
						 | 
					@ -37,7 +37,31 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define form-query parse-html-form-query)
 | 
					(define form-query parse-html-form-query)
 | 
				
			||||||
(define (get-bindings request)
 | 
					(define (get-bindings request)
 | 
				
			||||||
  (form-query (http-url:search (request:url request))))
 | 
					  (let ((request-method (request:method request)))
 | 
				
			||||||
 | 
					    (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)))
 | 
				
			||||||
 | 
					     (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 (extract-bindings bindings key)
 | 
					(define (extract-bindings bindings key)
 | 
				
			||||||
  (let ((key (if (symbol? key) (symbol->string key) key)))
 | 
					  (let ((key (if (symbol? key) (symbol->string key) key)))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue