Changeset 12984 in project


Ignore:
Timestamp:
01/11/09 19:28:08 (11 years ago)
Author:
sjamaan
Message:

Add some tests for url-formencoded stuff from the Internet-Draft by Hoehrmann. Refer to it in the comments. Implement + encoding for spaces

Location:
release/4/uri-common/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/uri-common/trunk/tests/run.scm

    r12975 r12984  
    7979     (((foo . "bar=qux")) "?foo=bar%3Dqux")
    8080     (((foo=bar . "qux")) "?foo%3Dbar=qux")
    81      (((foo . "bar") (foo . "qux")) "?foo=bar&foo=qux")) ; duplicate keys ok
     81     (((foo . "bar") (foo . "qux")) "?foo=bar;foo=qux")) ; duplicate keys ok
    8282    ))
    8383
     
    9898;; These are more specific tests for the query cases above, but
    9999;; on the direct low-level interface to make it less cumbersome
    100 (define form-urlencoded-cases
    101   `((((foo . "bar") (qux . "mooh")) "foo=bar&qux=mooh")
    102     (((foo . "b&ar") (qux . "mo;oh")) "foo=b%26ar&qux=mo;oh")
    103     (((foo . "b&ar") (qux . "mo;oh")) "foo=b&ar;qux=mo%3Boh" separator: #\;)))
     100(define form-urlencoded-hoehrmann-draft-cases
     101  `(;; This set is straight from Section 5 ("examples") in the 2006
     102    ;; Hoehrmann Internet-Draft for application/www-form-urlencoded,
     103    ;; plus two fixes for mistakes in the alternative representations
     104    ;; of the first testcase (missing spaces before and after the =).
     105    (((| a b c | . " 1  3 "))
     106     "+a+b+c+=+1++3+"
     107     "%20a%20b%20c%20=%201%20%203%20"
     108     "\u0020a\u0020b\u0020c\u0020=\u00201\u0020\u00203\u0020")
     109    (((Text . "Line1\u000ALine2"))
     110     "Text=Line1%0ALine2"
     111     "Text=Line1\u000ALine2"
     112     ;; !! "Text=Line1%0D%0ALine2"
     113     ;; !! "Text=Line1%0A%0DLine2"
     114     )
     115    ;; XXX The following 2 examples break.
     116    ;; Look into encoding for IRI's in uri-generic
     117    (((Chevron3 . "Bo\u00F6tes")) ; broken
     118     "Chevron3=Bo\u00F6tes"
     119     "Chevron3=Bo%C3%B6tes"
     120     ;; !! "Chevron3=Boo\u0308tes"
     121     )
     122    (((Lookup . "\u0000,\u2323,\u20AC")) ; broken
     123     "Lookup=%00,\u2323,\u20AC"
     124     "Lookup=\u0000,\u2323,\u20AC"
     125     ;; !! "Lookup=,\u2323,\u20AC"
     126     ;; !! "Lookup="
     127     )
     128    (((Cipher . "c=(m^e)%n"))
     129     "Cipher=c%3D(m%5Ee)%25n"
     130     "Cipher=c=(m%5Ee)%25n"
     131     "Cipher=c=(m^e)%n"
     132     "%43%69%70%68%65%72=%63%3d%28%6D%5E%65%29%25%6e"
     133     ;; !! "Cipher%3Dc%3D(m%5Ee)%25n"
     134     ;; !! "Cipher=c=(m^e)"
     135     ;; !! "Cipher=c"
     136     )
     137    (((|| . #t) (|| . #t)) ";")
     138    (((|| . #t) (|| . "")) ";=")
     139    (((|| . "") (|| . #t)) "=;")
     140    (((|| . "") (|| . "")) "=;=")
     141    (((|| . "")) "=")
     142    ;;(((|| . #t)) "")                    ; Can't be distinguished from ()
     143    (((a&b . "1") (c . "2;3") (e . "4"))
     144     "a%26b=1;c=2%3B3;e=4"
     145     "a%26b=1&c=2%3B3&e=4"
     146     "a%26b=1;c=2%3B3&e=4"
     147     "a%26b=1&c=2%3B3;e=4"
     148     ;; !! "a&b=1;c=2%3B3;e=4"
     149     ;; !! "a%26b=1&c=2;3&e=4"
     150     )
     151    (((img . #t) (avail . #t) (name . #t) (price . #t))
     152     "img;avail;name;price")))
    104153
    105 (test-group "form-urlencoding"
     154(test-group "form-urlencoding-hoehrmann-draft-cases"
    106155  (for-each (lambda (u)
    107156              (let* ((alist (first u))
    108                      (query (second u))
    109                      (args  (cddr u))
    110                      (encoded (apply form-urlencode alist args))
    111                      (decoded (apply form-urldecode query args)))
    112                 (test (sprintf "encode ~S -> ~S" alist query) query encoded)
    113                 (test (sprintf "decode ~S -> ~S" query alist) alist decoded)))
    114             form-urlencoded-cases))
     157                     (primary (second u))
     158                     (alternatives (cddr u)))
     159                (test (sprintf "encode ~S -> ~S" alist primary)
     160                      primary (form-urlencode alist))
     161                (for-each (lambda (a)
     162                            (test (sprintf "decode ~S -> ~S" a alist)
     163                                  alist (form-urldecode a)))
     164                          (cons primary alternatives))))
     165            form-urlencoded-hoehrmann-draft-cases))
  • release/4/uri-common/trunk/uri-common.scm

    r12975 r12984  
    191191;; hardcoded GET query parameters as specified in anchors.
    192192;;
    193 ;; There's also a would-be draft RFC that was intended to standardize this:
     193;; There's also a 2006 Internet-Draft by Bjoern Hoehrmann that was
     194;; intended to standardize this, but it was allowed to expire in 2007:
    194195;; http://ietfreport.isoc.org/idref/draft-hoehrmann-urlencoded
    195196
    196197;; This should be changed globally to semicolon when using XForms,
    197198;; since that's the default.
    198 (define form-urlencoded-separator (make-parameter #\&))
     199(define form-urlencoded-separator (make-parameter ";&"))
    199200
    200201(define (form-urlencode alist #!key (separator (form-urlencoded-separator)))
     
    209210                    (lambda (arg query)
    210211                      (let ((enc (lambda (s)
    211                                    (uri-encode-string
    212                                     s
    213                                     (char-set-union separator-chars
    214                                                     (char-set #\=)
    215                                                     char-set:query/fragment)))))
     212                                   (string-translate*
     213                                    (uri-encode-string
     214                                     s
     215                                     (char-set-delete
     216                                      (char-set-union separator-chars
     217                                                      (char-set #\= #\+)
     218                                                      char-set:query/fragment)
     219                                      #\space))
     220                                    '((" " . "+"))))))
    216221                        (match arg
    217222                               ((a . #f) query)
     
    230235             (let ((idx (string-index part #\=)))
    231236               (if idx
    232                    (cons (string->symbol (uri-decode-string
    233                                           (string-take part idx)))
    234                          (uri-decode-string (string-drop part (add1 idx))))
     237                   (cons (string->symbol
     238                          (uri-decode-string (string-translate*
     239                                              (string-take part idx)
     240                                              '(("+" . "%20")))))
     241                         (uri-decode-string (string-translate*
     242                                             (string-drop part (add1 idx))
     243                                             '(("+" . "%20")))))
    235244                   (cons (string->symbol (uri-decode-string part))
    236245                         #t))))
    237            (string-split query (char-set->string (->char-set separator))))
     246           (string-split query (char-set->string (->char-set separator)) #t))
    238247      '())) ; _always_ provide a list interface for the query, even if not there
    239248
Note: See TracChangeset for help on using the changeset viewer.