From d915722a9bca35257a558226348479c52f45a68f Mon Sep 17 00:00:00 2001
From: vibr <vibr>
Date: Fri, 15 Apr 2005 12:31:43 +0000
Subject: [PATCH] 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 | 30 ++++++++++++++++++++++++++++++
 scheme/packages.scm            |  5 +++--
 2 files changed, 33 insertions(+), 2 deletions(-)

diff --git a/scheme/lib/sunet-utilities.scm b/scheme/lib/sunet-utilities.scm
index 4eb882b..ddb6ced 100644
--- a/scheme/lib/sunet-utilities.scm
+++ b/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)))))
+
diff --git a/scheme/packages.scm b/scheme/packages.scm
index 92ba8ba..225742f 100644
--- a/scheme/packages.scm
+++ b/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