From d4da90648e04dadbe8d1c1ee91932e094b175e66 Mon Sep 17 00:00:00 2001 From: Dimitri Fontaine Date: Wed, 12 Feb 2020 00:01:07 +0100 Subject: [PATCH] Implement proper hostname parsing, following labels specifications. Bug report #1053 was the occasion to wander in the specification for DNS hostnames and their label components, and the syntactic rules for those. It turns out that my implementation was nothing like the specs: https://en.wikipedia.org/wiki/Domain_Name_System#Domain_name_syntax Fixes #1053. --- src/parsers/command-db-uri.lisp | 34 +++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) diff --git a/src/parsers/command-db-uri.lisp b/src/parsers/command-db-uri.lisp index 8ada563..6c2b790 100644 --- a/src/parsers/command-db-uri.lisp +++ b/src/parsers/command-db-uri.lisp @@ -70,12 +70,42 @@ (declare (ignore unix)) (list :unix (when socket-directory (text socket-directory))))) -(defrule network-name (and namestring (* (and "." namestring))) +;;; +;;; See https://en.wikipedia.org/wiki/Hostname#Restrictions_on_valid_hostnames +;;; +;;; The characters allowed in labels are a subset of the ASCII character +;;; set, consisting of characters a through z, A through Z, digits 0 through +;;; 9, and hyphen. +;;; +;;; This rule is known as the LDH rule (letters, digits, hyphen). +;;; +;;; - Domain names are interpreted in case-independent manner. +;;; - Labels may not start or end with a hyphen. +;;; - An additional rule requires that top-level domain names should not be +;;; all-numeric. +;;; +(defrule network-label-letters-digit (or (alpha-char-p character) + (digit-char-p character))) + +(defrule network-label-with-hyphen + (and network-label-letters-digit + (+ (or (and #\- (& network-label-letters-digit)) + network-label-letters-digit)) + (! #\-)) + (:text t)) + +(defrule network-label-no-hyphen (+ network-label-letters-digit) + (:text t)) + +(defrule network-label (or network-label-with-hyphen network-label-no-hyphen) + (:identity t)) + +(defrule network-hostname (and network-label (* (and "." network-label))) (:lambda (name) (let ((host (text name))) (list :host (unless (string= "" host) host))))) -(defrule hostname (or ipv4 ipv6 socket-directory network-name) +(defrule hostname (or ipv4 ipv6 socket-directory network-hostname) (:identity t)) (defun process-hostname (hostname)