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"))))