Allow LWS in a few more places on input.
authorChris Hanson <org/chris-hanson/cph>
Wed, 24 Sep 2008 22:56:15 +0000 (22:56 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 24 Sep 2008 22:56:15 +0000 (22:56 +0000)
v7/src/runtime/http-syntax.scm

index 0e052838bc571bd030ce7df877b248a624ef0ab4..061377864ba7dfac7cec3c4d4f310ae1a338da64 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: http-syntax.scm,v 1.7 2008/09/22 08:16:44 cph Exp $
+$Id: http-syntax.scm,v 1.8 2008/09/24 22:56:15 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -365,6 +365,7 @@ USA.
   (let ((parser
         (*parser
          (seq (match (+ (char-set char-set:http-token)))
+              (noise (* (char-set char-set:wsp)))
               #\:
               (noise (* (char-set char-set:wsp)))
               (match (* (char-set char-set:http-text)))))))
@@ -464,16 +465,22 @@ USA.
   (list-parser
    (encapsulate cons
      (seq lp:token
-         #\=
+         lp:=
          lp:text))))
 
 (define lp:parameter%
   (list-parser
    (encapsulate cons
      (seq lp:token
-         (alt (seq #\= lp:text)
+         (alt (seq lp:= lp:text)
               (values #f))))))
 
+(define lp:=
+  (list-parser
+   (seq (? lp:lws)
+       #\=
+       (? lp:lws))))
+
 (define parameter%?
   (pair-predicate http-token? (opt-predicate http-text?)))
 
@@ -733,10 +740,16 @@ USA.
   (list-parser
    (encapsulate cons
      (seq lp:token-string
-         (alt (seq #\/
+         (alt (seq lp:solidus
                    lp:token-string)
               (values #f))))))
 
+(define lp:solidus
+  (list-parser
+   (seq (? lp:lws)
+       #\/
+       (? lp:lws))))
+
 (define product?
   (pair-predicate http-token-string?
                  (opt-predicate http-token-string?)))
@@ -1070,7 +1083,7 @@ USA.
   (list-parser
    (encapsulate vector
      (seq (encapsulate cons
-           (seq (alt (seq lp:token #\/)
+           (seq (alt (seq lp:token lp:solidus)
                      (values #f))
                 lp:token))
          lp:lws
@@ -1234,7 +1247,7 @@ USA.
    (list-parser
     (encapsulate cons
       (seq lp:bytes-unit
-          #\=
+          lp:=
           lp:byte-range-set))))
   (pair-predicate bytes-unit? byte-range-set?)
   (pair-writer write-bytes-unit
@@ -1387,7 +1400,7 @@ USA.
                       #\-
                       lp:decimal))
                lp:*)
-          #\/
+          lp:solidus
           (alt lp:decimal
                lp:*)))))
   (vector-predicate bytes-unit?