Changeset 12810 in project


Ignore:
Timestamp:
12/11/08 19:36:31 (11 years ago)
Author:
sjamaan
Message:

Remove query decoding, as it is not described by the RFC

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

Legend:

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

    r12721 r12810  
    175175  '(("/foo" (path: ("/bar")) "/bar")
    176176    ("/foo" (host: "localhost") "//localhost/foo")
    177     ("http://foo" (query: ((a . "b") (c . #t) (d . "e"))) "http://foo?a=b&c&d=e")
     177    ("http://foo" (query: "a=b&c&d?=%2fe") "http://foo?a=b&c&d?=%2fe")
    178178    ("http://foo" (host: #f) "http:")
    179179    ("http://foo" (authority: #f) "http:")))
  • release/4/uri-generic/trunk/uri-generic.scm

    r12721 r12810  
    279279                                               (else (list #f rst)))))
    280280                        (make-URI scheme: (string->symbol (list->string us)) authority: ua
    281                                   path: (map uri-char-list->string up) query: (and uq (filter-map query->alist uq))
     281                                  path: (map uri-char-list->string up) query: (and uq (uri-char-list->string uq))
    282282                                  fragment: (and uf (uri-char-list->string uf)))))
    283283         (else #f))))
     
    598598
    599599;;  RFC3986, section 3.4
    600 
    601 
    602 (define query0  (many (schar ":@/?!$'()*+,;=")))
    603 (define (query1 s)
    604   (match s ((#\& . rst) (query0 rst))
    605          (else #f)))
    606 
     600;;
     601;;   query         = *( pchar / "/" / "?" )
     602
     603(define query0  (many (uchar ":@/?")))
    607604(define (query s)
    608605  (match (query0 s)
    609          ((q1 rst)   
    610                      (match ((consume query1) rst)
    611                             ((qs rst)  (list (cons q1 qs) rst))
    612                             (else (list (list q1) rst))))
    613          (else #f)))
    614 
    615 (define query-part (many (schar ":@/?!$'()*+,;")))
    616 
    617 ;; Convert an internal parser representation of a query to an alist
    618 ;; of symbol-string pairs
    619 (define (query->alist s)
    620   (match (query-part s)
    621          ((p1 (#\= . rst))  (match (query-part rst)
    622                                    ((p2 _) `(,(string->symbol (uri-char-list->string p1)) . ,(uri-char-list->string p2)))
    623                                    (else #f)))
    624          ((p1 ())   `(,(string->symbol (uri-char-list->string p1)) . #t))
    625          (else #f)))
    626  
     606         ((ss rst)  (list ss rst))
     607         (else #f)))
    627608
    628609;;  RFC3986, section 3.5
    629 
     610;;   fragment         = *( pchar / "/" / "?" )
    630611
    631612(define fragment0  (many (uchar ":@/?")))
     
    660641                                         (else (list #f rst)))))
    661642                   (make-URI scheme: #f authority: ua path: (map uri-char-list->string up)
    662                              query: (and uq (filter-map query->alist uq))
     643                             query: (and uq (uri-char-list->string uq))
    663644                             fragment: (and uf (uri-char-list->string uf))))))
    664645
     
    684665                                              (else (list #f rst)))))
    685666                        (make-URI scheme: (string->symbol (list->string us)) authority: ua
    686                                   path: (map uri-char-list->string up) query: (and uq (filter-map query->alist uq))
     667                                  path: (map uri-char-list->string up) query: (and uq (uri-char-list->string uq))
    687668                                  fragment: #f)))
    688669           (error 'absolute-uri "no scheme found in URI string"))))
     
    704685                 "")
    705686             (string-concatenate path)
    706              (if (and query (not (null? query))) (string-concatenate (cons "?" (intersperse (map (lambda (p) (if (eq? (cdr p) #t) (symbol->string (car p)) (conc (car p) "=" (cdr p)))) query) "&"))) "")
     687             (if query (string-append "?" query) "")
    707688             (if fragment (string-append  "#" fragment) "")))
    708689           (else #f))))
Note: See TracChangeset for help on using the changeset viewer.