From: Mattias Engdegård <mattiase@acm.org>
Date: Mon, 11 Apr 2022 14:22:38 +0000 (+0200)
Subject: Recognise hybrid IPv6/IPv4 addresses in textsec (bug#54624)
X-Git-Tag: emacs-29.0.90~1931^2~657
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=26db1ca80e459a640cc6648fb7f94c873def3ddd;p=emacs.git

Recognise hybrid IPv6/IPv4 addresses in textsec (bug#54624)

* lisp/international/textsec.el (textsec--ipvx-address-p):
  Recognise hybrid addresses like "::ffff:129.55.2.201".
  Combine to a single regexp and translate to rx.
  Remove some regexp ambiguity (relint complaint).
* test/lisp/international/textsec-tests.el (test-suspiction-domain):
  Add test cases.
---

diff --git a/lisp/international/textsec.el b/lisp/international/textsec.el
index cca49986fc4..3e787909384 100644
--- a/lisp/international/textsec.el
+++ b/lisp/international/textsec.el
@@ -233,12 +233,18 @@ The scripts are as defined by the Unicode Standard Annex 24 (UAX#24)."
 
 (defun textsec--ipvx-address-p (domain)
   "Return non-nil if DOMAIN is an ipv4 or ipv6 address."
-  (or (string-match-p "\\`\\([0-9]\\{1,3\\}\\.?\\)\\{1,4\\}\\'" domain)
-      (let ((ipv6 "\\([0-9a-f]\\{0,4\\}:?\\)\\{1,8\\}"))
-        ;; With brackets.
-        (or (string-match-p (format "\\`\\[%s\\]\\'" ipv6) domain)
-            ;; Without.
-            (string-match-p (format "\\`%s\\'" ipv6) domain)))))
+  ;; This is a very relaxed pattern for IPv4 or IPv6 addresses.  The
+  ;; assumption is that any malformed address accepted by this rule
+  ;; will be rejected by the actual address parser eventually.
+  (rx-let ((ipv4 (** 1 4
+                     (** 1 3 (in "0-9"))
+                     (? ".")))
+           (ipv6 (: (** 1 7
+                        (** 0 4 (in "0-9a-f"))
+                        ":")
+                    (** 0 4 (in "0-9a-f"))
+                    (? ":" ipv4))))
+    (string-match-p (rx bos (or ipv4 ipv6 (: "[" ipv6 "]")) eos) domain)))
 
 (defun textsec-domain-suspicious-p (domain)
   "Say whether DOMAIN's name looks suspicious.
diff --git a/test/lisp/international/textsec-tests.el b/test/lisp/international/textsec-tests.el
index 9216d334f87..6b0773dc407 100644
--- a/test/lisp/international/textsec-tests.el
+++ b/test/lisp/international/textsec-tests.el
@@ -126,7 +126,10 @@
   (should-not (textsec-domain-suspicious-p
                "[21a:34aa:c782:3ad2:1bf8:73f8:141:66e8]"))
   (should (textsec-domain-suspicious-p
-           "[21a:34aa:c782:3ad2:1bf8:73f8:141:66e8")))
+           "[21a:34aa:c782:3ad2:1bf8:73f8:141:66e8"))
+  (should-not (textsec-domain-suspicious-p "138.25.106.12"))
+  (should-not (textsec-domain-suspicious-p "2001:db8::ff00:42:8329"))
+  (should-not (textsec-domain-suspicious-p "::ffff:129.55.2.201")))
 
 (ert-deftest test-suspicious-local ()
   (should-not (textsec-local-address-suspicious-p "larsi"))