From f8559581d2a5e998ef4a91b73536ffa3a99e884b Mon Sep 17 00:00:00 2001
From: vibr <vibr>
Date: Sat, 14 Aug 2004 21:18:12 +0000
Subject: [PATCH] GET-NUMERIC-FIELD-VALUE now uses GET-HEADER from
 utilities.scm and returns #f if GET-HEADER does so

adapted GET-CONTENT-LENGHT
---
 scheme/httpd/seval.scm | 40 ++++++++++++++++++++++++----------------
 1 file changed, 24 insertions(+), 16 deletions(-)

diff --git a/scheme/httpd/seval.scm b/scheme/httpd/seval.scm
index 4c1108f..99b2297 100644
--- a/scheme/httpd/seval.scm
+++ b/scheme/httpd/seval.scm
@@ -113,28 +113,34 @@
 ;; generalized function to get a field value of the form 1*DIGIT
 
 ;; check wether a header-field with name field-name is contained in req;
-;; if so, check wether ist field-content conforms to 
+;; if not, return #f,
+;; if there is one, check wether its field-content conforms to 
 ;; field-content = *LWS 1*DIGIT *LWS
 ;; (i.e. optional leading whitespaces, at least one digit, optional trailing whitespace);
 ;; if so, return digit as a number
 
 ;; req is a request record, field-name a symbol
 (define (get-numeric-field-value req field-name)
-  (let* 
+  (let 
       ;;take first Content-length: header (RFC 2616 allows only one Content-length: header)
-      ((field-content (get-header (request-headers req) field-name))
-       (field-value-start (string-skip field-content char-set:whitespace));; skip whitespace, ;;char-set:whitespace = LWS from RFC2616?
-       (field-value (if field-value-start			;;yes, field content contained non-whitespace chars
-			(string->number (substring field-content   
-						   field-value-start
-						   (string-length field-content))) ;;trailing whitespace? RFC allows it! ->
-			;; probably read-rfc822-headers in rfc822.scm should do the job of skipping leading and trailing whitespace?*
-			(http-error (status-code bad-request) req 
-				    (format #f "~A header contained only whitespace" field-name)))))
-    (if (and (integer? field-value) (>= field-value 0)) ;;yes, field value contained only digits
-	field-value
-	(http-error (status-code bad-request) req
-		    (format #f "~A header contained characters other than digits" field-name)))))
+      ((field-content (get-header (request-headers req) field-name)))
+    (if field-content
+	(let*
+	    ((field-value-start (string-skip field-content char-set:whitespace));; skip whitespace, ;;char-set:whitespace = LWS from RFC2616?
+	     (field-value (if field-value-start			;;yes, field content contained non-whitespace chars
+			      (string->number (substring field-content   
+							 field-value-start
+							 (string-length field-content))) ;;trailing whitespace? RFC allows it! ->
+			      ;; probably read-rfc822-headers in rfc822.scm should do the job of skipping leading and trailing whitespace?*
+			      (http-error (status-code bad-request) req 
+					  (format #f "~A header contained only whitespace" field-name)))))
+	  (if (and (integer? field-value) (>= field-value 0)) ;;yes, field value contained only digits
+	      field-value
+	      (http-error (status-code bad-request) req
+			  (format #f "~A header contained characters other than digits" field-name))))
+	#f)))
+
+
 
 
 ;;* RFC 2616, 4.2: The field-content does not include any leading or
@@ -145,6 +151,8 @@
 ;;field value.
 
 (define (get-content-length req)
-  (get-numeric-field-value req 'content-length))
+  (let ((maybe-length (get-numeric-field-value req 'content-length)))
+    (or maybe-length
+	(http-error (status-code bad-request) req "No Content-Length header in request"))))