Changeset 13176 in project


Ignore:
Timestamp:
02/03/09 23:48:32 (11 years ago)
Author:
sjamaan
Message:

Work on normalization and add tests for that

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

Legend:

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

    r12999 r13176  
    77     ("http:" http)
    88     ("" #f))
     9    ("port" ,uri-port
     10     ("http://a" 80)
     11     ("http://a:8080" 8080)
     12     ("https://a" 443)
     13     ("https://a:1" 1))
    914    ("username" ,uri-username
    1015     ("//foo" #f)
     
    2530     ("//foo:bar%2Equx@" "bar.qux" "//foo:bar.qux@"))
    2631    ("path" ,uri-path
    27      ("//foo" ())   ; Can path ever be #f?
     32     ("http://foo" (/ ""))
     33     ("http://foo/" (/ ""))
     34     ("//foo" (/ ""))
     35     ("//foo/" (/ ""))
    2836     ("foo%20bar" ("foo bar"))
    2937     ("foo%2Fbar" ("foo/bar"))
     
    7381(define update-cases
    7482  `(("query" query:
    75      (((foo . "bar?qux")) "?foo=bar?qux")
    76      (((foo?bar . "qux")) "?foo?bar=qux")
    77      (((foo . "bar&qux")) "?foo=bar%26qux")
    78      (((foo&bar . "qux")) "?foo%26bar=qux")
    79      (((foo . "bar=qux")) "?foo=bar%3Dqux")
    80      (((foo=bar . "qux")) "?foo%3Dbar=qux")
    81      (((foo . "bar") (foo . "qux")) "?foo=bar;foo=qux")) ; duplicate keys ok
     83     ("" ((foo . "bar?qux")) "?foo=bar?qux")
     84     ("" ((foo?bar . "qux")) "?foo?bar=qux")
     85     ("" ((foo . "bar&qux")) "?foo=bar%26qux")
     86     ("" ((foo&bar . "qux")) "?foo%26bar=qux")
     87     ("" ((foo . "bar=qux")) "?foo=bar%3Dqux")
     88     ("" ((foo=bar . "qux")) "?foo%3Dbar=qux")
     89     ("" ((foo . "bar") (foo . "qux")) "?foo=bar;foo=qux")) ; duplicate keys ok
     90    ("port" port:
     91     ("http://a" 80 "http://a")
     92     ("http://a:1234" 8080 "http://a:8080"))
     93    ("scheme" scheme:    ;; scheme causes reset of port, in all cases
     94     ("https://a" http "http://a")
     95     ("https://a:80" http "http://a")
     96     ("https://a:123" http "http://a")
     97     ("http://a:8080" https "https://a"))
    8298    ))
    8399
     
    87103               (for-each (lambda (u)
    88104                           (let* ((slotname (cadr p))
    89                                   (input (first u))
    90                                   (oexp (second u))
     105                                  (input (second u))
     106                                  (oexp (third u))
    91107                                  (oact (update-uri
    92                                          (uri-reference "")
     108                                         (uri-reference (first u))
    93109                                         slotname input)))
    94110                             (test (sprintf "~S -> ~S" input oexp)
     
    169185                          (cons primary alternatives))))
    170186            form-urlencoded-hoehrmann-draft-cases))
     187
     188(test-group "miscellaneous"
     189  (test "scheme doesn't reset port if port given"
     190        (uri-reference "https://foo:123")
     191        (update-uri (uri-reference "http://foo:8080")
     192                    port: 123 scheme: 'https)))
  • release/4/uri-common/trunk/uri-common.scm

    r13087 r13176  
    8181           (URI-common-fragment x)))
    8282
    83 (define (decode-string* s)
    84   (and s (generic:uri-decode-string s)))
     83;;; Conversion procedures
     84(define (uri->uri-generic uri)
     85  (URI-common-generic uri))
    8586
    8687(define (uri-reference u)
    8788  (uri-generic->uri (generic:uri-reference u)))
     89
    8890(define (absolute-uri u)
    8991  (uri-generic->uri (generic:absolute-uri u)))
     
    98100                   fragment: (decode-string* (generic:uri-fragment uri))))
    99101
    100 (define (uri->uri-generic uri)
    101   (URI-common-generic uri))
    102 
    103 ;; Accessors
     102(define (decode-string* s)
     103  (and s (generic:uri-decode-string s)))
     104
     105;;; Accessors
    104106(define uri?         URI-common?)
    105107(define uri-scheme   (compose generic:uri-scheme URI-common-generic))
     
    107109(define uri-password URI-common-password)
    108110(define uri-host     URI-common-host)
    109 (define uri-path     URI-common-path)
    110111(define uri-query    URI-common-query)
    111112(define uri-fragment URI-common-fragment)
     113
     114(define (uri-path uc)
     115  (let ((path (URI-common-path uc)))
     116    ;; does not apply for relative references
     117    ;; XXX: Make a "relative-ref?" predicate (or something like that)
     118    (if (and (uri-host uc)
     119             (or (eq? path '()) (eq? path #f)))
     120        '(/ "")
     121        path)))
    112122
    113123(define (uri-port uc)
     
    116126        (alist-ref (generic:uri-scheme u) default-ports))))
    117127
    118 ;; Normalize an URI, but only if there's a scheme present
    119 ;; - Remove port if it's the default port for this scheme
    120 ;; - Make path empty path if not specified
    121 (define (normalize-uri u)
    122   (let ((port (generic:uri-port u)))
    123     (when (generic:uri-scheme u)
    124      (when (eqv? port (alist-ref (generic:uri-scheme u) default-ports))
    125        (set! u (generic:update-uri u port: #f))))
    126     (when (or (not (generic:uri-path u)) (null? (generic:uri-path u)))
    127       (set! u (generic:update-uri u uri-path: '(/ ""))))
    128     u))
    129 
    130 (define (encode-string* s . rest)
    131   (and s (apply generic:uri-encode-string s rest)))
    132 
     128;;; Updaters
    133129(define update-uri
    134130  (let ((unset (list 'unset)))
     
    137133                (host unset) (port unset)
    138134                (path unset) (query unset) (fragment unset))
    139       (let ((uc (update-URI-common uc))) ;; new copy
     135      (let* ((uc (update-URI-common uc)) ; new copy
     136             (actual-scheme (if (eq? scheme unset)
     137                                (generic:uri-scheme (URI-common-generic uc))
     138                                scheme))
     139             (path (if (and actual-scheme (or (eq? path #f) (eq? path '())))
     140                       '(/ "") ; normalize path
     141                       path))
     142             ;; XXX is this really the desired behaviour?
     143             ;; maybe simpler is better: do not reset to #f on default port?
     144             (port (if (or
     145                        (and (not (eq? scheme unset)) ; scheme specified...
     146                             (eq? port unset)) ; ...and no explicit port?
     147                        (default-port? port actual-scheme)) ; or default port?
     148                       #f               ; then clear port
     149                       port)))
     150        ;; This code is ugly!
    140151        (unless (eq? scheme unset)
    141152          (URI-common-generic-set!
     
    177188          (URI-common-fragment-set! uc fragment))
    178189        uc))))
     190
     191(define (encode-string* s . rest)
     192  (and s (apply generic:uri-encode-string s rest)))
     193
     194(define (default-port? port scheme)
     195  (eqv? port (alist-ref scheme default-ports)))
    179196
    180197(define (encode-path p)
     
    190207   generic:char-set:sub-delims))
    191208
    192 ;; Handling of application/x-www-form-urlencoded data
     209;;; Handling of application/x-www-form-urlencoded data
    193210;;
    194211;; This implements both HTML 4's specification
     
    264281                (else (map generic:uri-decode-string p)))))
    265282
     283;;; Miscellaneous procedures
    266284
    267285;; Simple convenience procedures
     
    273291    (uri-generic->uri (apply proc (map URI-common-generic args)))))
    274292
     293;; TODO: What about normalization issues here? Right now uri-relative-from
     294;; gives a nonempty reference when uri1 has path=() and uri2 has path=(/ "")
     295;; This could be considered a bug.  Same for uri->string and with port-nrs
     296;; However, URIs with paths updated by this egg do not have that problem.
    275297(define uri-relative-to             (wrap generic:uri-relative-to))
    276298(define uri-relative-from           (wrap generic:uri-relative-from))
Note: See TracChangeset for help on using the changeset viewer.