master fc1b7b720b: Teach 'network-lookup-address-info' to validate numeric addresses

[Robert Pluim]

branch: master
commit fc1b7b720b5771a330f36e9a52688d73b790e478
Author: Robert Pluim <rpluim@gmail.com>
Commit: Robert Pluim <rpluim@gmail.com>

    Teach 'network-lookup-address-info' to validate numeric addresses
    
    * src/process.c (Fnetwork_lookup_address_info): Add optional 'hints'
    argument, pass AI_NUMERICHOST to 'getaddrinfo' if it's 'numeric'.
    (syms_of_process): Add 'numeric' symbol.
    * doc/lispref/processes.texi (Misc Network): Expunge passive voice.
    Update 'network-lookup-address-info' description.
    * test/src/process-tests.el (lookup-hints-specification):
    (lookup-hints-values): Test new functionality.
    * etc/NEWS: Announce change.
---
 doc/lispref/processes.texi | 46 +++++++++++++++++++++++++++-------------
 etc/NEWS                   |  9 ++++++++
 src/process.c              | 27 +++++++++++++++++-------
 test/src/process-tests.el  | 52 ++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 112 insertions(+), 22 deletions(-)

diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index 80c371e1c6..a7dccd774b 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -3204,20 +3204,38 @@ If the vector does not include the port number, 
@var{p}, or if
 @code{:@var{p}} suffix.
 @end defun
 
-@defun network-lookup-address-info name &optional family
-This function is used to perform hostname lookups on @var{name}, which
-is expected to be an ASCII-only string, otherwise an error is
-signaled. Call @code{puny-encode-domain} on @var{name}
-first if you wish to lookup internationalized hostnames.
-
-If successful it returns a list of Lisp representations of network
-addresses, otherwise it returns @code{nil}.  In the latter case, it
-also displays the error message hopefully explaining what went wrong.
-
-By default both IPv4 and IPv6 lookups are attempted.  The optional
-argument @var{family} controls this behavior, specifying the symbol
-@code{ipv4} or @code{ipv6} restricts lookups to IPv4 and IPv6
-respectively.
+@defun network-lookup-address-info name &optional family hints
+Perform hostname lookups on @var{name}, which is expected to be an
+ASCII-only string, otherwise signal an error. Call
+@code{puny-encode-domain} on @var{name} first if you wish to lookup
+internationalized hostnames.
+
+If successful, return a list of Lisp representations of network
+addresses (@pxref{Network Processes} for a description of the
+format.), otherwise return @code{nil}.  In the latter case, also log
+an error message hopefully explaining what went wrong.
+
+By default, attempt both IPv4 and IPv6 lookups.  The optional argument
+@var{family} controls this behavior, specifying the symbol @code{ipv4}
+or @code{ipv6} restricts lookups to IPv4 and IPv6 respectively.
+
+If optional argument @var{hints} is @code{numeric}, treat the hostname
+as a numerical IP address (and do not perform DNS lookups).  This can
+be used to check whether a string is a valid numerical representation
+of an IP address, or to convert a numerical string to its canonical
+representation. e.g.
+
+@example
+(network-lookup-address-info "127.1" 'ipv4 'numeric)
+    @result{} ([127 0 0 1 0])
+
+(network-lookup-address-info "::1" nil 'numeric)
+    @result{} ([0 0 0 0 0 0 0 1 0])
+@end example
+
+Be warned that there are some surprising valid forms,
+especially for IPv4, e.g ``0xe3010203'' and ``0343.1.2.3'' are both
+valid, as are ``0'' and ``1'' (but they are invalid for IPv6).
 @end defun
 
 @node Serial Ports
diff --git a/etc/NEWS b/etc/NEWS
index 1d0e45fdcc..c8e4a065fe 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -407,6 +407,15 @@ This command duplicates the current line the specified 
number of times.
 ---
 ** Files with the ".eld" extension are now visited in 'lisp-data-mode'.
 
++++
+** 'network-lookup-address-info' can now check numeric IP address validity.
+Specifying 'numeric as the new optional 'hints' argument makes it
+check if the passed address is a valid IPv4/IPv6 address (without DNS
+traffic).
+
+    (network-lookup-address-info "127.1" 'ipv4 'numeric)
+    => ([127 0 0 1 0])
+
 +++
 ** New command 'find-sibling-file'.
 This command jumps to a file considered a "sibling file", which is
diff --git a/src/process.c b/src/process.c
index d6d51b26e1..1ac5a509e5 100644
--- a/src/process.c
+++ b/src/process.c
@@ -4641,15 +4641,20 @@ network_lookup_address_info_1 (Lisp_Object host, const 
char *service,
 }
 
 DEFUN ("network-lookup-address-info", Fnetwork_lookup_address_info,
-       Snetwork_lookup_address_info, 1, 2, 0,
+       Snetwork_lookup_address_info, 1, 3, 0,
        doc: /* Look up Internet Protocol (IP) address info of NAME.
-Optional parameter FAMILY controls whether to look up IPv4 or IPv6
+Optional argument FAMILY controls whether to look up IPv4 or IPv6
 addresses.  The default of nil means both, symbol `ipv4' means IPv4
-only, symbol `ipv6' means IPv6 only.  Returns a list of addresses, or
-nil if none were found.  Each address is a vector of integers, as per
-the description of ADDRESS in `make-network-process'.  In case of
-error displays the error message.  */)
-     (Lisp_Object name, Lisp_Object family)
+only, symbol `ipv6' means IPv6 only.
+Optional argument HINTS allows specifying the hints passed to the
+underlying library call.  The only supported value is `numeric', which
+means treat NAME as a numeric IP address.  This also suppresses DNS
+traffic.
+Return a list of addresses, or nil if none were found.  Each address
+is a vector of integers, as per the description of ADDRESS in
+`make-network-process'.  In case of error log the error message
+returned from the lookup.  */)
+  (Lisp_Object name, Lisp_Object family, Lisp_Object hint)
 {
   Lisp_Object addresses = Qnil;
   Lisp_Object msg = Qnil;
@@ -4667,9 +4672,14 @@ error displays the error message.  */)
     hints.ai_family = AF_INET6;
 #endif
   else
-    error ("Unsupported lookup type");
+    error ("Unsupported family");
   hints.ai_socktype = SOCK_DGRAM;
 
+  if (EQ (hint, Qnumeric))
+    hints.ai_flags = AI_NUMERICHOST;
+  else if (!NILP (hint))
+    error ("Unsupported hints value");
+
   msg = network_lookup_address_info_1 (name, NULL, &hints, &res);
   if (!EQ (msg, Qt))
     message ("%s", SSDATA(msg));
@@ -8515,6 +8525,7 @@ syms_of_process (void)
 #ifdef AF_INET6
   DEFSYM (Qipv6, "ipv6");
 #endif
+  DEFSYM (Qnumeric, "numeric");
   DEFSYM (Qdatagram, "datagram");
   DEFSYM (Qseqpacket, "seqpacket");
 
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index f1ed7e18d5..aab95b2d73 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -378,6 +378,58 @@ See Bug#30460."
   (when (ipv6-is-available)
     (should (network-lookup-address-info "localhost" 'ipv6)))))
 
+(ert-deftest lookup-hints-specification ()
+  "`network-lookup-address-info' should only accept valid hints arg."
+  (should-error (network-lookup-address-info "1.1.1.1" nil t))
+  (should-error (network-lookup-address-info "1.1.1.1" 'ipv4 t))
+  (should (network-lookup-address-info "1.1.1.1" nil 'numeric))
+  (should (network-lookup-address-info "1.1.1.1" 'ipv4 'numeric))
+  (when (ipv6-is-available)
+    (should-error (network-lookup-address-info "::1" nil t))
+    (should-error (network-lookup-address-info "::1" 'ipv6 't))
+    (should (network-lookup-address-info "::1" nil 'numeric))
+    (should (network-lookup-address-info "::1" 'ipv6 'numeric))))
+
+(ert-deftest lookup-hints-values ()
+  "`network-lookup-address-info' should succeed/fail in looking up various 
numeric IP addresses."
+  (let ((ipv4-invalid-addrs
+         '("localhost" "343.1.2.3" "1.2.3.4.5"))
+        ;; These are valid for IPv4 but invalid for IPv6
+        (ipv4-addrs
+         '("127.0.0.1" "127.0.1" "127.1" "127" "1" "0"
+           "0xe3010203" "0xe3.1.2.3" "227.0x1.2.3"
+           "034300201003" "0343.1.2.3" "227.001.2.3"))
+        (ipv6-only-invalid-addrs
+         '("fe80:1" "e301:203:1" "e301::203::1"
+           "1:2:3:4:5:6:7:8:9" "0xe301:203::1"
+           "343:10001:2::3"
+           ;; "00343:1:2::3" is invalid on GNU/Linux and FreeBSD, but
+           ;; valid on macOS.  macOS is wrong here, but such is life.
+           ))
+        ;; These are valid for IPv6 but invalid for IPv4
+        (ipv6-addrs
+         '("fe80::1" "e301::203:1" "e301:203::1"
+           "e301:0203::1" "::1" "::0"
+           "0343:1:2::3" "343:001:2::3")))
+    (dolist (a ipv4-invalid-addrs)
+      (should-not (network-lookup-address-info a nil 'numeric))
+      (should-not (network-lookup-address-info a 'ipv4 'numeric)))
+    (dolist (a ipv6-addrs)
+      (should-not (network-lookup-address-info a 'ipv4 'numeric)))
+    (dolist (a ipv4-addrs)
+      (should (network-lookup-address-info a nil 'numeric))
+      (should (network-lookup-address-info a 'ipv4 'numeric)))
+    (when (ipv6-is-available)
+      (dolist (a ipv4-addrs)
+        (should-not (network-lookup-address-info a 'ipv6 'numeric)))
+      (dolist (a ipv6-only-invalid-addrs)
+        (should-not (network-lookup-address-info a 'ipv6 'numeric)))
+      (dolist (a ipv6-addrs)
+        (should (network-lookup-address-info a nil 'numeric))
+        (should (network-lookup-address-info a 'ipv6 'numeric))
+        (should (network-lookup-address-info (upcase a) nil 'numeric))
+        (should (network-lookup-address-info (upcase a) 'ipv6 'numeric))))))
+
 (ert-deftest lookup-unicode-domains ()
   "Unicode domains should fail."
   (skip-unless internet-is-working)