Changeset 36538 in project


Ignore:
Timestamp:
09/08/18 10:22:05 (2 months ago)
Author:
sjamaan
Message:

uri-generic: Fix unparsing of URIs with ipv6 literal host parts (C5)

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

Legend:

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

    r36522 r36538  
    250250     ;; From #1530, found by Vasilij Schneidermann
    251251     ("http://[::1]:8080" "::1"))
     252    ("ipv6-host?" ,uri-ipv6-host?
     253     ("http://[::1]/bla" #t)
     254     ("http://127.0.0.1/bla" #f)
     255     ("http://localhost/1234" #f))
     256    ("ipv6-host?" ,uri-ipv6-host?
     257     ("http://[::1]/bla" #t)
     258     ("http://127.0.0.1/bla" #f)
     259     ("http://localhost/1234" #f))
    252260    ("port" ,uri-port
    253261     ("//host:123" 123))
  • release/5/uri-generic/trunk/uri-generic.scm

    r36522 r36538  
    4141  (uri-reference make-uri update-uri update-authority
    4242   uri-reference? uri-auth uri-authority uri-scheme uri-path uri-query
    43    uri-fragment uri-host uri-port uri-username uri-password
    44    authority? authority-host authority-port
     43   uri-fragment uri-host uri-ipv6-host? uri-port
     44   uri-username uri-password
     45   authority? authority-host authority-ipv6-host? authority-port
    4546   authority-username authority-password
    4647   
     
    8687
    8788(define-record-type <URIAuth>
    88   (make-URIAuth username password host port)
     89  (make-URIAuth username password host ipv6-host? port)
    8990  URIAuth?
    9091  (username URIAuth-username URIAuth-username-set!)
    9192  (password URIAuth-password URIAuth-password-set!)
    9293  (host URIAuth-host URIAuth-host-set!)
     94  (ipv6-host? URIAuth-ipv6-host? URIAuth-ipv6-host?-set!)
    9395  (port URIAuth-port URIAuth-port-set!))
    9496
     
    105107 
    106108  (define-record-printer (<URIAuth> x out)
    107     (fprintf out "#(URIAuth host=~S port=~A)"
     109    (fprintf out "#(URIAuth host=~S~A port=~A)"
    108110             (URIAuth-host x)
     111             (if (URIAuth-ipv6-host? x) "(ipv6)" "")
    109112             (URIAuth-port x))))
    110113 (else))
     
    133136
    134137
     138(define (is-ipv6-host? h) (and (substring-index ":" h) #t))
     139
    135140(define (update-URIAuth uri-auth . args)
    136141  (let loop ((args args)
     
    138143             (new-password (URIAuth-password uri-auth))
    139144             (new-host (URIAuth-host uri-auth))
     145             (new-ipv6-host? (URIAuth-ipv6-host? uri-auth))
    140146             (new-port (URIAuth-port uri-auth)))
    141147    (cond ((null? args)
    142            (make-URIAuth new-username new-password new-host new-port))
     148           (make-URIAuth new-username new-password
     149                         new-host new-ipv6-host? new-port))
    143150          ((null? (cdr args))
    144151           (uri-error "malformed arguments to update-URIAuth"))
     
    150157                   (if (eq? key 'password) value new-password)
    151158                   (if (eq? key 'host) value new-host)
     159                   (if (eq? key 'host)
     160                       (is-ipv6-host? value)
     161                       new-ipv6-host?)
    152162                   (if (eq? key 'port) value new-port)))))))
    153163
     
    166176    (and auth (URIAuth-host auth))))
    167177
     178(define (uri-ipv6-host? x)
     179  (let ((auth (URI-authority x)))
     180    (and auth (URIAuth-ipv6-host? auth))))
     181
    168182(define (uri-port x)
    169183  (let ((auth (URI-authority x)))
     
    180194(define authority? URIAuth?)
    181195(define authority-host URIAuth-host)
     196(define authority-ipv6-host? URIAuth-ipv6-host?)
    182197(define authority-port URIAuth-port)
    183198(define authority-username URIAuth-username)
     
    204219                            ((not (eq? unset authority)) authority)
    205220                            (else (URI-authority uri)))
    206                              (make-URIAuth #f #f #f #f)))
     221                             (make-URIAuth #f #f #f #f #f)))
    207222                 (updated-auth (apply update-authority base-auth args))
    208                  (final-auth (if (uri-auth-equal? (make-URIAuth #f #f #f #f)
    209                                                   updated-auth)
    210                                #f
    211                                updated-auth)))
     223                 (final-auth (if (uri-auth-equal?
     224                                  (make-URIAuth #f #f #f #f #f)
     225                                  updated-auth)
     226                                 #f
     227                                 updated-auth)))
    212228            (make-URI scheme final-auth path query fragment)))
    213229         ((null? (cdr key/values))
     
    294310       (equal? (URIAuth-password a) (URIAuth-password b))
    295311       (equal? (URIAuth-host a) (URIAuth-host b))
     312       ;; Should always be equal if hosts are equal
     313       ;; (equal? (URIAuth-ipv6-host? a) (URIAuth-ipv6-host? b))
    296314       (equal? (URIAuth-port a) (URIAuth-port b)))))
    297315
     
    536554               ((uh rst)      (host rst))
    537555               ((up rst)      (or (port rst) (list #f rst))))
    538               (list
    539                (make-URIAuth
    540                 (and uu (uri-char-list->string uu))
    541                 (and uw (uri-char-list->string uw))
    542                 (uri-char-list->string uh)
    543                 (and (pair? up) (string->number (list->string up))))
    544                     rst)))
     556    (let ((host (uri-char-list->string uh)))
     557      (list
     558       (make-URIAuth
     559        (and uu (uri-char-list->string uu))
     560        (and uw (uri-char-list->string uw))
     561        host
     562        (is-ipv6-host? host)
     563        (and (pair? up) (string->number (list->string up))))
     564       rst))))
    545565
    546566;;  RFC3986, section 3.2.1
     
    958978                              (password (URIAuth-password authority))
    959979                              (host (URIAuth-host authority))
     980                              (ipv6? (URIAuth-ipv6-host? authority))
    960981                              (port (URIAuth-port authority)))
    961982                          (list "//" (and username (list (userinfomap
    962983                                                          username
    963984                                                          password) "@"))
    964                                 host (and port (list ":" port)))))
     985                                (if ipv6? "[" "") host (if ipv6? "]" "")
     986                                (and port (list ":" port)))))
    965987                   (path->string path)
    966988                   (and query (list "?" query))
Note: See TracChangeset for help on using the changeset viewer.