Changeset 12975 in project


Ignore:
Timestamp:
01/11/09 01:33:01 (11 years ago)
Author:
sjamaan
Message:

Add optional separator, as both a parameter and an argument to URL decode procedure, plus lots of documentation because this urldecoding stuff is pretty badly specified

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

Legend:

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

    r12927 r12975  
    9595                         (cddr p))))
    9696            update-cases))
     97
     98;; These are more specific tests for the query cases above, but
     99;; 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: #\;)))
     104
     105(test-group "form-urlencoding"
     106  (for-each (lambda (u)
     107              (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))
  • release/4/uri-common/trunk/uri-common.scm

    r12927 r12975  
    22;; URI-common provides URI handling procedures for common URI schemes
    33;; that are based on the generic syntax such as http, https, file, ftp.
    4 ;; It also provides automatic x-www-form-encoded query argument
     4;; It also provides automatic form-urlencoded query argument
    55;; encoding/decoding
    66;;
     
    4545   uri-common-host uri-common-port uri-common-path
    4646   uri-common-query uri-common-fragment uri-common-generic
    47    uri-common->string
     47   uri-common->string form-urlencode form-urldecode
    4848   char-set:query/fragment)
    4949
     
    8484                     host: (decode-string* (uri-host uri))
    8585                     path: (decode-path (uri-path uri))
    86                      query: (decode-query (uri-query uri))
     86                     query: (form-urldecode (uri-query uri))
    8787                     fragment: (decode-string* (uri-fragment uri))
    8888                     )))
     
    115115    u))
    116116
    117 (define (decode-string* s)
    118   (and s (uri-decode-string s)))
    119 
    120 (define (decode-path p)
     117(define update-uri-common
     118  (let ((unset (list 'unset)))
     119    (lambda (uc #!key
     120                (scheme unset) (username unset) (password unset) (host unset)
     121                (path unset) (query unset) (fragment unset))
     122      (let ((uc (update-URI-common uc))) ;; new copy
     123        (unless (eq? scheme unset)
     124          (URI-common-generic-set!
     125           uc (update-uri (URI-common-generic uc) scheme: scheme)))
     126        (unless (eq? username unset)
     127          (URI-common-generic-set!
     128           uc (update-uri (URI-common-generic uc)
     129                          username: (encode-string* username)))
     130          (URI-common-username-set! uc username))
     131        (unless (eq? password unset)
     132          (URI-common-generic-set!
     133           uc (update-uri (URI-common-generic uc)
     134                          password: (encode-string* password)))
     135          (URI-common-password-set! uc password))
     136        (unless (eq? host unset)
     137          (URI-common-generic-set!
     138           uc (update-uri (URI-common-generic uc)
     139                          host: (encode-string* host)))
     140          (URI-common-host-set! uc host))
     141        (unless (eq? path unset)
     142          (URI-common-generic-set!
     143           uc (update-uri (URI-common-generic uc)
     144                          path: (encode-path path)))
     145          (URI-common-path-set! uc path))
     146        (unless (eq? query unset)
     147          (URI-common-generic-set!
     148           uc (update-uri (URI-common-generic uc)
     149                          query: (form-urlencode query)))
     150          (URI-common-query-set! uc query))
     151        (unless (eq? fragment unset)
     152          (URI-common-generic-set!
     153           uc (update-uri (URI-common-generic uc)
     154                          fragment: (encode-string* fragment
     155                                                    char-set:query/fragment)))
     156          (URI-common-fragment-set! uc fragment))
     157        uc))))
     158
     159
     160(define (encode-string* s . rest)
     161  (and s (apply uri-encode-string s rest)))
     162
     163(define (encode-path p)
    121164  (and p (match p
    122                 (('/ . rst) (cons '/ (map uri-decode-string rst)))
    123                 (else (map uri-decode-string p)))))
    124 
    125 (define (decode-query q)
    126   (if q
     165                (('/ . rst) (cons '/ (map uri-encode-string rst)))
     166                (else (map uri-encode-string p)))))
     167
     168;; Characters allowed in queries and fragments
     169(define char-set:query/fragment
     170  (char-set-difference
     171   (char-set-complement char-set:uri-unreserved)
     172   (string->char-set ":@?/")
     173   char-set:sub-delims))
     174
     175;; Handling of application/x-www-form-urlencoded data
     176;;
     177;; This implements both HTML 4's specification
     178;; (http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4.1)
     179;; and XHTML XForms' specification
     180;; (http://www.w3.org/TR/xforms/#structure-model-submission)
     181;;
     182;; The latter is a more generalised form of the former, as it allows
     183;; the user to specify a custom separator character.  The HTML 4
     184;; spec also contains a recommendation
     185;; (http://www.w3.org/TR/html401/appendix/notes.html#h-B.2.2)
     186;; that semicolons should be used instead of ampersands as a separator.
     187;; However, it provides no mechanism to select the separator to use
     188;; when submitting a form, which makes it a pretty useless recommendation.
     189;; This recommendation also complicates matters on the server because one
     190;; would need to handle both form-generated GET query parameters and
     191;; hardcoded GET query parameters as specified in anchors.
     192;;
     193;; There's also a would-be draft RFC that was intended to standardize this:
     194;; http://ietfreport.isoc.org/idref/draft-hoehrmann-urlencoded
     195
     196;; This should be changed globally to semicolon when using XForms,
     197;; since that's the default.
     198(define form-urlencoded-separator (make-parameter #\&))
     199
     200(define (form-urlencode alist #!key (separator (form-urlencoded-separator)))
     201  (and alist (not (null? alist))
     202       (let* ((separator-chars (->char-set separator))
     203              (join-string (string-take
     204                            (if (string? separator-chars)
     205                                separator-chars
     206                                (char-set->string separator-chars)) 1)))
     207         (string-join
     208          (reverse (fold
     209                    (lambda (arg query)
     210                      (let ((enc (lambda (s)
     211                                   (uri-encode-string
     212                                    s
     213                                    (char-set-union separator-chars
     214                                                    (char-set #\=)
     215                                                    char-set:query/fragment)))))
     216                        (match arg
     217                               ((a . #f) query)
     218                               ((a . #t) (cons (enc (->string a)) query))
     219                               ((a . b) (cons
     220                                         (sprintf "~A=~A"
     221                                                  (enc (->string a))
     222                                                  (enc b))
     223                                         query)))))
     224                    '() alist))
     225          join-string))))
     226
     227(define (form-urldecode query #!key (separator (form-urlencoded-separator)))
     228  (if query
    127229      (map (lambda (part)
    128230             (let ((idx (string-index part #\=)))
     
    133235                   (cons (string->symbol (uri-decode-string part))
    134236                         #t))))
    135            (string-split q "&"))
     237           (string-split query (char-set->string (->char-set separator))))
    136238      '())) ; _always_ provide a list interface for the query, even if not there
    137239
    138 (define update-uri-common
    139   (let ((unset (list 'unset)))
    140     (lambda (uc #!key
    141                 (scheme unset) (username unset) (password unset) (host unset)
    142                 (path unset) (query unset) (fragment unset))
    143       (let ((uc (update-URI-common uc))) ;; new copy
    144         (unless (eq? scheme unset)
    145           (URI-common-generic-set!
    146            uc (update-uri (URI-common-generic uc) scheme: scheme)))
    147         (unless (eq? username unset)
    148           (URI-common-generic-set!
    149            uc (update-uri (URI-common-generic uc)
    150                           username: (encode-string* username)))
    151           (URI-common-username-set! uc username))
    152         (unless (eq? password unset)
    153           (URI-common-generic-set!
    154            uc (update-uri (URI-common-generic uc)
    155                           password: (encode-string* password)))
    156           (URI-common-password-set! uc password))
    157         (unless (eq? host unset)
    158           (URI-common-generic-set!
    159            uc (update-uri (URI-common-generic uc)
    160                           host: (encode-string* host)))
    161           (URI-common-host-set! uc host))
    162         (unless (eq? path unset)
    163           (URI-common-generic-set!
    164            uc (update-uri (URI-common-generic uc)
    165                           path: (encode-path path)))
    166           (URI-common-path-set! uc path))
    167         (unless (eq? query unset)
    168           (URI-common-generic-set!
    169            uc (update-uri (URI-common-generic uc)
    170                           query: (encode-query query)))
    171           (URI-common-query-set! uc query))
    172         (unless (eq? fragment unset)
    173           (URI-common-generic-set!
    174            uc (update-uri (URI-common-generic uc)
    175                           fragment: (encode-string* fragment
    176                                                     char-set:query/fragment)))
    177           (URI-common-fragment-set! uc fragment))
    178         uc))))
    179 
    180 
    181 (define (encode-string* s . rest)
    182   (and s (apply uri-encode-string s rest)))
    183 
    184 (define (encode-path p)
     240(define (decode-string* s)
     241  (and s (uri-decode-string s)))
     242
     243(define (decode-path p)
    185244  (and p (match p
    186                 (('/ . rst) (cons '/ (map uri-encode-string rst)))
    187                 (else (map uri-encode-string p)))))
    188 
    189 ;; Characters allowed in queries and fragments
    190 (define char-set:query/fragment
    191   (char-set-difference
    192    (char-set-complement char-set:uri-unreserved)
    193    (string->char-set ":@?/")
    194    char-set:sub-delims))
    195 
    196 (define (encode-query q)
    197   (and q (not (null? q))
    198        (string-join
    199         (reverse (fold
    200                   (lambda (arg query)
    201                     (let ((enc (lambda (s)
    202                                  (uri-encode-string
    203                                   s (string->char-set "&="
    204                                      char-set:query/fragment)))))
    205                      (match arg
    206                             ((a . #f) query)
    207                             ((a . #t) (cons (enc (->string a)) query))
    208                             ((a . b) (cons
    209                                       (sprintf "~A=~A"
    210                                                (enc (->string a))
    211                                                (enc b))
    212                                       query)))))
    213                   '() q))
    214         "&")))
     245                (('/ . rst) (cons '/ (map uri-decode-string rst)))
     246                (else (map uri-decode-string p)))))
     247
    215248
    216249;; Simple convenience procedures
Note: See TracChangeset for help on using the changeset viewer.