From 4bbab89d9ccbb26346899d1f496c97604fec567b Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 30 Sep 2020 11:54:29 -0600 Subject: [PATCH] Add support for square brackets around IPv6 addresses to explicity show port number (thanks to Philipp Marek) --- debian/changelog | 7 +++++++ src.lisp | 41 +++++++++++++++++++++++++++++++++++++---- 2 files changed, 44 insertions(+), 4 deletions(-) diff --git a/debian/changelog b/debian/changelog index 1eab622..c4b991b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,10 @@ +cl-puri (1:1.5.7.2-1) unstable; urgency=medium + + * Add support for square brackets around IPv6 addresses to + explicity show port number (thanks to Philipp Marek) + + -- Kevin M. Rosenberg Tue, 29 Sep 2020 15:55:37 +0000 + cl-puri (1:1.5.7.1-1) unstable; urgency=medium * Rework test suite for newer versions of ASDF diff --git a/src.lisp b/src.lisp index ee5f5ad..4a4d5db 100644 --- a/src.lisp +++ b/src.lisp @@ -34,6 +34,7 @@ #:uri-host #:uri-port #:uri-path #:uri-query + #:uri-is-ip6 #:uri-fragment #:uri-plist #:uri-authority ; pseudo-slot accessor @@ -238,6 +239,10 @@ :initarg :parsed-path :initform nil :accessor .uri-parsed-path) + (is-ip6 + :initarg :is-ip6 + :initform nil + :accessor uri-is-ip6) (hashcode ;; cached sxhash, so we don't have to compute it more than once. :initarg :hashcode :initform nil :accessor uri-hashcode))) @@ -362,7 +367,7 @@ #\Rubout ;; (code-char #x7f) ;; `unwise': #\{ #\} #\| #\\ #\^ #\[ #\] #\`)) - "Excluded charcters from RFC2369 (http://www.ietf.org/rfc/rfc2396.txt 2.4.3)") + "Excluded charcters from RFC2396 (http://www.ietf.org/rfc/rfc2396.txt 2.4.3)") (defun reserved-char-vector (chars &key except) (do* ((a (make-array 128 :element-type 'bit :initial-element 0)) @@ -421,19 +426,27 @@ (append *excluded-characters* '(#\& #\~ #\/ #\?)))) (defparameter *illegal-characters* - (reserved-char-vector (remove #\# *excluded-characters*))) + (reserved-char-vector (set-difference *excluded-characters* + '(#\# #\[ #\])))) (defparameter *strict-illegal-query-characters* (reserved-char-vector (append '(#\?) (remove #\# *excluded-characters*)))) (defparameter *illegal-query-characters* (reserved-char-vector *excluded-characters* :except '(#\^ #\| #\#))) +(defparameter *valid-ip6-characters* + (reserved-char-vector + '#.(nconc (gen-char-range-list #\a #\f) + (gen-char-range-list #\A #\F) + (gen-char-range-list #\0 #\9) + '(#\: #\])))) + (defun parse-uri (thing &key (class 'uri) &aux escape) (when (uri-p thing) (return-from parse-uri thing)) (setq escape (escape-p thing)) - (multiple-value-bind (scheme host port path query fragment) + (multiple-value-bind (scheme host port path query fragment is-ip6) (parse-uri-string thing) (when scheme (setq scheme @@ -481,6 +494,7 @@ (make-instance 'uri :scheme scheme :host host + :is-ip6 is-ip6 :port port :path path :query query @@ -490,6 +504,7 @@ (make-instance class :scheme scheme :host host + :is-ip6 is-ip6 :port port :path path :query query @@ -514,6 +529,7 @@ ;; simulating: ;; ^(([^:/?#]+):)? ;; (//([^/?#]*))? + ;; May include a []-pair for ipv6 ;; ([^?#]*) ;; (\?([^#]*))? ;; (#(.*))? @@ -523,6 +539,7 @@ (tokval nil) (scheme nil) (host nil) + (is-ip6 nil) (port nil) (path-components '()) (query nil) @@ -562,10 +579,14 @@ URI ~s contains illegal character ~s at position ~d." (#\? (return :question)) (#\# (return :hash)))) (:query (case c (#\# (return :hash)))) + (:ip6 (case c + (#\] (return :close-bracket)))) (:rest) (t (case c (#\: (return :colon)) (#\? (return :question)) + (#\[ (return :open-bracket)) + (#\] (return :close-bracket)) (#\# (return :hash)) (#\/ (return :slash))))) (incf start))) @@ -643,11 +664,20 @@ URI ~s contains illegal character ~s at position ~d." (setq state 6)) (:end (push "/" path-components) (setq state 9)))) + (66 ;; seen [:]//[ + (ecase (read-token :ip6 *valid-ip6-characters*) + (:string (setq host tokval) + (setq is-ip6 t) + (setq state 67)))) + (67 ;; seen [:]//[ip6] + (ecase (read-token t) + (:close-bracket (setq state 11)))) (4 ;; seen [:]// (ecase (read-token t) (:colon (failure)) (:question (failure)) (:hash (failure)) + (:open-bracket (setq state 66)) (:slash (if* (and (equalp "file" scheme) (null host)) @@ -725,7 +755,7 @@ URI ~s contains illegal character ~s at position ~d." (values scheme host port (apply #'concatenate 'string (nreverse path-components)) - query fragment))) + query fragment is-ip6))) ;; URN parsing: (15 ;; seen urn:, read nid now (case (read-token :colon *valid-nid-characters*) @@ -829,6 +859,7 @@ URI ~s contains illegal character ~s at position ~d." (setf (uri-string uri) (let ((scheme (uri-scheme uri)) (host (uri-host uri)) + (is-ip6 (uri-is-ip6 uri)) (port (uri-port uri)) (path (uri-path uri)) (query (uri-query uri)) @@ -841,9 +872,11 @@ URI ~s contains illegal character ~s at position ~d." *reserved-characters* escape)) (when scheme ":") (when (or host (eq :file scheme)) "//") + (when is-ip6 "[") (when host (encode-escaped-encoding host *reserved-authority-characters* escape)) + (when is-ip6 "]") (when port ":") (when port #-allegro (format nil "~D" port) -- 2.34.1