implementing chunked transfer coding:

* new predicate CHUNKED-TRANSFER-CODING?
 tests wether a request's entity body is sent in chunked
 transfer-encoding

scheme/lib/sunet-utilities.scm

@@ -126,3 +126,33 @@
     (or maybe-length
 	(http-error (status-code bad-request) req "No Content-Length header in request"))))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Decode chunked entity bodies: "chunked transfer-coding"
+
+
+;;; See RFC 2616, 3.6.1 and 19.4.6 for the composition of chunked entity bodies.
+;;; See RFC 2616, 4.4 for precedence of Transfer-encoding header over Content-length header.
+
+
+;;; Is the request's entity body sent in chunked transfer-encoding?
+;;; (See RFC 2616, 14.41 and 3.6 for syntax and semantics of Transfer-Encoding header.)
+
+(define (chunked-transfer-coding? req)
+  (let ((field-value (get-header (request-headers req) 'transfer-encoding)))
+	(if (not field-value)
+	    #f
+
+		; the field value is a list of transfer-codings (3.6),
+		; extract the last transfer-coding in the list
+	    (let* ((reversed-field-value (string-reverse field-value))
+		   (index ; does the list contain more than one element?
+		    (string-contains reversed-field-value " , "))
+		   (last-transfer-coding
+		    (if index
+			(string-trim (string-reverse (string-take reversed-field-value index)))
+			(string-trim field-value)))) 
+
+               ; the first token of the (extracted last) transfer-coding must be "chunked" to indicate chunked transfer coding
+	      (string-prefix? "chunked" last-transfer-coding)))))
+

scheme/packages.scm

@@ -248,7 +248,8 @@
 	  dotdot-check
 	  with-lock
 	  get-header
-	  get-body-length-from-content-length))
+	  get-body-length-from-content-length
+	  chunked-transfer-coding?))
 
 (define-interface handle-fatal-error-interface
   (export with-fatal-error-handler*
@@ -585,7 +586,7 @@
   (open scheme-with-scsh
 	format-net
 	sigevents
-	(subset srfi-13 (string-join string-skip string-trim-both))
+	(subset srfi-13 (string-join string-skip string-trim-both string-trim string-prefix? string-reverse string-contains string-take))
 	dns
 	let-opt				; :optional
 	locks