Merge remote-tracking branch 'origin/netsec'

2 files changed, 98 insertions, 0 deletions

diff --git a/test/lisp/net/nsm-tests.el b/test/lisp/net/nsm-tests.el
new file mode 100644
index 00000000000..bf6ac04b527
--- /dev/null
+++ b/test/lisp/net/nsm-tests.el
@@ -0,0 +1,69 @@
+;;; network-stream-tests.el --- tests for network security manager -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Author: Robert Pluim <rpluim@gmail.com>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+
+;;; Code:
+
+(require 'nsm)
+(eval-when-compile (require 'cl-lib))
+
+(ert-deftest nsm-check-local-subnet-ipv4 ()
+  "Check that nsm can be avoided for local subnets."
+  (let ((local-ip '[172 26 128 160 0])
+        (mask '[255 255 255 0 0])
+
+        (wrong-length-mask '[255 255 255])
+        (wrong-mask '[255 255 255 255 0])
+        (remote-ip-yes '[172 26 128 161 0])
+        (remote-ip-no '[172 26 129 161 0]))
+
+    (should (eq t (nsm-network-same-subnet local-ip mask remote-ip-yes)))
+    (should (eq nil (nsm-network-same-subnet local-ip mask remote-ip-no)))
+    (should-error (nsm-network-same-subnet local-ip wrong-length-mask remote-ip-yes))
+    (should (eq nil (nsm-network-same-subnet local-ip wrong-mask remote-ip-yes)))
+    (should (eq t (nsm-should-check "google.com")))
+    (should (eq t (nsm-should-check "127.1")))
+    (should (eq t (nsm-should-check "localhost")))
+    (let ((nsm-trust-local-network t))
+      (should (eq t (nsm-should-check "google.com")))
+      (should (eq nil (nsm-should-check "127.1")))
+      (should (eq nil (nsm-should-check "localhost"))))))
+
+;; FIXME This will never return true, since
+;; network-interface-list only gives the primary address of each
+;; interface, which will be the IPv4 one
+(defun nsm-ipv6-is-available ()
+  (and (featurep 'make-network-process '(:family ipv6))
+       (cl-rassoc-if
+        (lambda (elt)
+          (eq 9 (length elt)))
+        (network-interface-list))))
+
+(ert-deftest nsm-check-local-subnet-ipv6 ()
+  (skip-unless (nsm-ipv6-is-available))
+  (should (eq t (nsm-should-check "::1")))
+  (let ((nsm-trust-local-network t))
+    (should (eq nil (nsm-should-check "::1")))))
+
+
+;;; nsm-tests.el ends here
diff --git a/test/src/process-tests.el b/test/src/process-tests.el
index 7745fccaf9d..724da1c3e72 100644
--- a/test/src/process-tests.el
+++ b/test/src/process-tests.el
@@ -22,6 +22,7 @@
 ;;; Code:
 
 (require 'ert)
+(require 'puny)
 
 ;; Timeout in seconds; the test fails if the timeout is reached.
 (defvar process-test-sentinel-wait-timeout 2.0)
@@ -322,5 +323,33 @@ See Bug#30460."
                                                   invocation-directory))
                  :stop t)))
 
+(ert-deftest lookup-family-specification ()
+  "network-lookup-address-info should only accept valid family symbols."
+  (should-error (network-lookup-address-info "google.com" 'both))
+  (should (network-lookup-address-info "google.com" 'ipv4))
+  (should (network-lookup-address-info "google.com" 'ipv6)))
+
+(ert-deftest lookup-unicode-domains ()
+  "Unicode domains should fail"
+  (should-error (network-lookup-address-info "faß.de"))
+  (should (length (network-lookup-address-info (puny-encode-domain "faß.de")))))
+
+(ert-deftest unibyte-domain-name ()
+  "Unibyte domain names should work"
+  (should (length (network-lookup-address-info (string-to-unibyte "google.com")))))
+
+(ert-deftest lookup-google ()
+  "Check that we can look up google IP addresses"
+  (let ((addresses-both (network-lookup-address-info "google.com"))
+        (addresses-v4 (network-lookup-address-info "google.com" 'ipv4))
+        (addresses-v6 (network-lookup-address-info "google.com" 'ipv6)))
+    (should (length addresses-both))
+    (should (length addresses-v4))
+    (should (length addresses-v6))))
+
+(ert-deftest non-existent-lookup-failure ()
+  "Check that looking up non-existent domain returns nil"
+  (should (eq nil (network-lookup-address-info "emacs.invalid"))))
+
 (provide 'process-tests)
 ;; process-tests.el ends here.