Changeset 36537 in project


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

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

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

Legend:

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

    r36521 r36537  
    252252     ;; From #1530, found by Vasilij Schneidermann
    253253     ("http://[::1]:8080" "::1"))
     254    ("ipv6-host?" ,uri-ipv6-host?
     255     ("http://[::1]/bla" #t)
     256     ("http://127.0.0.1/bla" #f)
     257     ("http://localhost/1234" #f))
     258    ("ipv6-host?" ,uri-ipv6-host?
     259     ("http://[::1]/bla" #t)
     260     ("http://127.0.0.1/bla" #f)
     261     ("http://localhost/1234" #f))
    254262    ("port" ,uri-port
    255263     ("//host:123" 123))
  • release/4/uri-generic/trunk/uri-generic.scm

    r36521 r36537  
    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   
     
    8990
    9091(define-record-type <URIAuth>
    91   (make-URIAuth username password host port)
     92  (make-URIAuth username password host ipv6-host? port)
    9293  URIAuth?
    9394  (username URIAuth-username URIAuth-username-set!)
    9495  (password URIAuth-password URIAuth-password-set!)
    9596  (host URIAuth-host URIAuth-host-set!)
     97  (ipv6-host? URIAuth-ipv6-host? URIAuth-ipv6-host?-set!)
    9698  (port URIAuth-port URIAuth-port-set!))
    9799
     
    108110 
    109111  (define-record-printer (<URIAuth> x out)
    110     (fprintf out "#(URIAuth host=~S port=~A)"
     112    (fprintf out "#(URIAuth host=~S~A port=~A)"
    111113             (URIAuth-host x)
     114             (if (URIAuth-ipv6-host? x) "(ipv6)" "")
    112115             (URIAuth-port x))))
    113116 (else))
     
    136139
    137140
     141(define (is-ipv6-host? h) (and (substring-index ":" h) #t))
     142
    138143(define (update-URIAuth uri-auth . args)
    139144  (let loop ((args args)
     
    141146             (new-password (URIAuth-password uri-auth))
    142147             (new-host (URIAuth-host uri-auth))
     148             (new-ipv6-host? (URIAuth-ipv6-host? uri-auth))
    143149             (new-port (URIAuth-port uri-auth)))
    144150    (cond ((null? args)
    145            (make-URIAuth new-username new-password new-host new-port))
     151           (make-URIAuth new-username new-password
     152                         new-host new-ipv6-host? new-port))
    146153          ((null? (cdr args))
    147154           (uri-error "malformed arguments to update-URIAuth"))
     
    153160                   (if (eq? key 'password) value new-password)
    154161                   (if (eq? key 'host) value new-host)
     162                   (if (eq? key 'host)
     163                       (is-ipv6-host? value)
     164                       new-ipv6-host?)
    155165                   (if (eq? key 'port) value new-port)))))))
    156166
     
    169179    (and auth (URIAuth-host auth))))
    170180
     181(define (uri-ipv6-host? x)
     182  (let ((auth (URI-authority x)))
     183    (and auth (URIAuth-ipv6-host? auth))))
     184
    171185(define (uri-port x)
    172186  (let ((auth (URI-authority x)))
     
    183197(define authority? URIAuth?)
    184198(define authority-host URIAuth-host)
     199(define authority-ipv6-host? URIAuth-ipv6-host?)
    185200(define authority-port URIAuth-port)
    186201(define authority-username URIAuth-username)
     
    207222                            ((not (eq? unset authority)) authority)
    208223                            (else (URI-authority uri)))
    209                              (make-URIAuth #f #f #f #f)))
     224                             (make-URIAuth #f #f #f #f #f)))
    210225                 (updated-auth (apply update-authority base-auth args))
    211                  (final-auth (if (uri-auth-equal? (make-URIAuth #f #f #f #f)
    212                                                   updated-auth)
    213                                #f
    214                                updated-auth)))
     226                 (final-auth (if (uri-auth-equal?
     227                                  (make-URIAuth #f #f #f #f #f)
     228                                  updated-auth)
     229                                 #f
     230                                 updated-auth)))
    215231            (make-URI scheme final-auth path query fragment)))
    216232         ((null? (cdr key/values))
     
    297313       (equal? (URIAuth-password a) (URIAuth-password b))
    298314       (equal? (URIAuth-host a) (URIAuth-host b))
     315       ;; Should always be equal if hosts are equal
     316       ;; (equal? (URIAuth-ipv6-host? a) (URIAuth-ipv6-host? b))
    299317       (equal? (URIAuth-port a) (URIAuth-port b)))))
    300318
     
    539557               ((uh rst)      (host rst))
    540558               ((up rst)      (or (port rst) (list #f rst))))
    541               (list
    542                (make-URIAuth
    543                 (and uu (uri-char-list->string uu))
    544                 (and uw (uri-char-list->string uw))
    545                 (uri-char-list->string uh)
    546                 (and (pair? up) (string->number (list->string up))))
    547                     rst)))
     559    (let ((host (uri-char-list->string uh)))
     560      (list
     561       (make-URIAuth
     562        (and uu (uri-char-list->string uu))
     563        (and uw (uri-char-list->string uw))
     564        host
     565        (is-ipv6-host? host)
     566        (and (pair? up) (string->number (list->string up))))
     567       rst))))
    548568
    549569;;  RFC3986, section 3.2.1
     
    961981                              (password (URIAuth-password authority))
    962982                              (host (URIAuth-host authority))
     983                              (ipv6? (URIAuth-ipv6-host? authority))
    963984                              (port (URIAuth-port authority)))
    964985                          (list "//" (and username (list (userinfomap
    965986                                                          username
    966987                                                          password) "@"))
    967                                 host (and port (list ":" port)))))
     988                                (if ipv6? "[" "") host (if ipv6? "]" "")
     989                                (and port (list ":" port)))))
    968990                   (path->string path)
    969991                   (and query (list "?" query))
Note: See TracChangeset for help on using the changeset viewer.