Make tls tests use random port

* test/lisp/net/network-stream-tests.el (server-process-filter): Remove 'message' call. (make-tls-server): Try random ports until we find one that's unused and use it. Adjust all callers.
author: Robert Pluim 2025-06-20 12:09:14 +0200
committer: Robert Pluim 2025-06-20 12:09:14 +0200
commit: 1560e9bf66597b3bf7f389ed22ad4524ca89d4e2 (patch)
tree: 0fedcb84acfbbed1292924fcdada1fbd44e72fd8 /test
parent: 04a1a53de19e74e06aba5c05f73aa6b1fdccae4f (diff)
download: emacs-1560e9bf66597b3bf7f389ed22ad4524ca89d4e2.tar.gz
emacs-1560e9bf66597b3bf7f389ed22ad4524ca89d4e2.zip
1 files changed, 185 insertions, 244 deletions
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index d868562f5cf..41ca0264907 100644
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -125,7 +125,6 @@
  )
 (defun server-process-filter (proc string)
-  (message "Received %s" string)
  (let ((prev (process-get proc 'previous-string)))
    (when prev
      (setq string (concat prev string))
@@ -244,36 +243,52 @@
      (should (equal (buffer-string) "foo\n")))
    (delete-process server)))
-(defun make-tls-server (port)
+(defun make-tls-server (&optional params)
-  (start-process "gnutls" (generate-new-buffer "*tls*")
+  (catch 'server
-                 "gnutls-serv" "--http"
+    (let (port
-                 "--x509keyfile"
+          proc)
-                 (ert-resource-file "key.pem")
+      (while t
-                 "--x509certfile"
+        (setq port (+ 20000 (random 45535))
-                 (ert-resource-file "cert.pem")
+              proc (apply #'start-process
-                 "--port" (format "%s" port)))
+                          "gnutls" (generate-new-buffer "*tls*")
+                          "gnutls-serv" "--http"
+                          "--x509keyfile"
+                          (ert-resource-file "key.pem")
+                          "--x509certfile"
+                          (ert-resource-file "cert.pem")
+                          "--port" (format "%s" port)
+                          params))
+        (while (not (eq (process-status proc) 'run))
+          (sit-for 0.1))
+        (with-current-buffer (process-buffer proc)
+          (when (eq
+                 (catch 'status
+                   (while t
+                     (goto-char (point-min))
+                     (when (search-forward (format "port %s..." port) nil t)
+                       (if (looking-at "done")
+                           (throw 'status 'done))
+                       (if (looking-at "bind() failed")
+                           (throw 'status 'failed)))
+                     (sit-for 0.1)))
+                 'done)
+            (throw 'server (cons proc port))))
+        (delete-process proc)))))
 (ert-deftest connect-to-tls-ipv4-wait ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44332))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        proc status)
+         (port (cdr s))
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (make-network-process
-          (with-current-buffer (process-buffer server)
+                      :name "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      :buffer (generate-new-buffer "*foo*")
+                      :host "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      :service port))
-          (while (and (null (ignore-errors
-                              (setq proc (make-network-process
-                                          :name "bar"
-                                          :buffer (generate-new-buffer "*foo*")
-                                          :host "localhost"
-                                          :service 44332))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
          (gnutls-negotiate :process proc
                            :type 'gnutls-x509pki
@@ -294,33 +309,25 @@
 (ert-deftest connect-to-tls-ipv4-nowait ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44331))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (network-security-level 'low)
+         (port (cdr s))
-        proc status)
+         (times 0)
+         (network-security-level 'low)
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (make-network-process
-          (with-current-buffer (process-buffer server)
+                      :name "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      :buffer (generate-new-buffer "*foo*")
+                      :nowait t
-          ;; It takes a while for gnutls-serv to start.
+                      :family 'ipv4
-          (while (and (null (ignore-errors
+                      :tls-parameters
-                              (setq proc (make-network-process
+                      (cons 'gnutls-x509pki
-                                          :name "bar"
+                            (gnutls-boot-parameters
-                                          :buffer (generate-new-buffer "*foo*")
+                             :hostname "localhost"))
-                                          :nowait t
+                      :host "localhost"
-                                          :family 'ipv4
+                      :service port))
-                                          :tls-parameters
-                                          (cons 'gnutls-x509pki
-                                                (gnutls-boot-parameters
-                                                 :hostname "localhost"))
-                                          :host "localhost"
-                                          :service 44331))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
-          (should proc)
-          (setq times 0)
          (while (and (eq (process-status proc) 'connect)
                      (< (setq times (1+ times)) 10))
            (sit-for 0.1))
@@ -339,33 +346,26 @@
  (skip-unless (gnutls-available-p))
  (skip-when (eq system-type 'windows-nt))
  (skip-unless (featurep 'make-network-process '(:family ipv6)))
-  (let ((server (make-tls-server 44333))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (network-security-level 'low)
+         (port (cdr s))
-        proc status)
+         (times 0)
+         (network-security-level 'low)
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (make-network-process
-          (with-current-buffer (process-buffer server)
+                      :name "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      :buffer (generate-new-buffer "*foo*")
+                      :family 'ipv6
-          ;; It takes a while for gnutls-serv to start.
+                      :nowait t
-          (while (and (null (ignore-errors
+                      :tls-parameters
-                              (setq proc (make-network-process
+                      (cons 'gnutls-x509pki
-                                          :name "bar"
+                            (gnutls-boot-parameters
-                                          :buffer (generate-new-buffer "*foo*")
+                             :hostname "localhost"))
-                                          :family 'ipv6
+                      :host "::1"
-                                          :nowait t
+                      :service port))
-                                          :tls-parameters
-                                          (cons 'gnutls-x509pki
-                                                (gnutls-boot-parameters
-                                                 :hostname "localhost"))
-                                          :host "::1"
-                                          :service 44333))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
-          (setq times 0)
          (while (and (eq (process-status proc) 'connect)
                      (< (setq times (1+ times)) 10))
            (sit-for 0.1))
@@ -382,27 +382,20 @@
 (ert-deftest open-network-stream-tls-wait ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44334))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (network-security-level 'low)
+         (port (cdr s))
-        proc status)
+         (network-security-level 'low)
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-network-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port
-          (while (and (null (ignore-errors
+                      :type 'tls
-                              (setq proc (open-network-stream
+                      :nowait nil))
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44334
-                                          :type 'tls
-                                          :nowait nil))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
          (skip-when (eq (process-status proc) 'connect)))
      (if (process-live-p server) (delete-process server)))
@@ -421,29 +414,22 @@
 (ert-deftest open-network-stream-tls-nowait ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44335))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (network-security-level 'low)
+         (port (cdr s))
-        proc status)
+         (times 0)
+         (network-security-level 'low)
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-network-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port
-          (while (and (null (ignore-errors
+                      :type 'tls
-                              (setq proc (open-network-stream
+                      :nowait t))
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44335
-                                          :type 'tls
-                                          :nowait t))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
-          (setq times 0)
          (while (and (eq (process-status proc) 'connect)
                      (< (setq times (1+ times)) 10))
            (sit-for 0.1))
@@ -464,26 +450,19 @@
 (ert-deftest open-network-stream-tls ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44336))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (network-security-level 'low)
+         (port (cdr s))
-        proc status)
+         (network-security-level 'low)
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-network-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port
-          (while (and (null (ignore-errors
+                      :type 'tls))
-                              (setq proc (open-network-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44336
-                                          :type 'tls))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
          (skip-when (eq (process-status proc) 'connect)))
      (if (process-live-p server) (delete-process server)))
@@ -502,27 +481,20 @@
 (ert-deftest open-network-stream-tls-nocert ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44337))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (network-security-level 'low)
+         (port (cdr s))
-        proc status)
+         (network-security-level 'low)
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-network-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port
-          (while (and (null (ignore-errors
+                      :type 'tls
-                              (setq proc (open-network-stream
+                      :client-certificate nil))
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44337
-                                          :type 'tls
-                                          :client-certificate nil))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
          (skip-when (eq (process-status proc) 'connect)))
      (if (process-live-p server) (delete-process server)))
@@ -541,25 +513,19 @@
 (ert-deftest open-gnutls-stream-new-api-default ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44665))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        proc status)
+         (port (cdr s))
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-gnutls-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port))
-          (while (and (null (ignore-errors
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44665))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
+          (skip-when (eq (process-status proc) 'connect)))
      (if (process-live-p server) (delete-process server)))
    (setq status (gnutls-peer-status proc))
    (should (consp status))
@@ -571,31 +537,25 @@
    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
      (should (stringp issuer))
      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))
+      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 (ert-deftest open-gnutls-stream-new-api-wait ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44666))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        proc status)
+         (port (cdr s))
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-gnutls-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port
-          (while (and (null (ignore-errors
+                      (list :nowait nil)))
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44666
-                                          (list :nowait nil)))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
+          (skip-when (eq (process-status proc) 'connect)))
      (if (process-live-p server) (delete-process server)))
    (setq status (gnutls-peer-status proc))
    (should (consp status))
@@ -607,32 +567,26 @@
    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
      (should (stringp issuer))
      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))
+      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 (ert-deftest open-gnutls-stream-old-api-wait ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44667))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (nowait nil) ; Workaround Bug#47080
+         (port (cdr s))
-        proc status)
+         (nowait nil) ; Workaround Bug#47080
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-gnutls-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port
-          (while (and (null (ignore-errors
+                      nowait))
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44667
-                                          nowait))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
+          (skip-when (eq (process-status proc) 'connect)))
      (if (process-live-p server) (delete-process server)))
    (setq status (gnutls-peer-status proc))
    (should (consp status))
@@ -644,33 +598,26 @@
    (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
      (should (stringp issuer))
      (setq issuer (split-string issuer ","))
-      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))
+      (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 (ert-deftest open-gnutls-stream-new-api-nowait ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44668))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (network-security-level 'low)
+         (port (cdr s))
-        proc status)
+         (times 0)
+         (network-security-level 'low)
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-gnutls-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port
-          (while (and (null (ignore-errors
+                      (list :nowait t)))
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44668
-                                          (list :nowait t)))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
-          (setq times 0)
          (while (and (eq (process-status proc) 'connect)
                      (< (setq times (1+ times)) 10))
            (sit-for 0.1))
@@ -687,27 +634,21 @@
 (ert-deftest open-gnutls-stream-old-api-nowait ()
  (skip-unless (executable-find "gnutls-serv"))
  (skip-unless (gnutls-available-p))
-  (let ((server (make-tls-server 44669))
+  (let* ((s (make-tls-server))
-        (times 0)
+         (server (car s))
-        (network-security-level 'low)
+         (port (cdr s))
-        (nowait t)
+         (times 0)
-        proc status)
+         (network-security-level 'low)
+         (nowait t)
+         proc status)
    (unwind-protect
        (progn
-          (sleep-for 1)
+          (setq proc (open-gnutls-stream
-          (with-current-buffer (process-buffer server)
+                      "bar"
-            (message "gnutls-serv: %s" (buffer-string)))
+                      (generate-new-buffer "*foo*")
+                      "localhost"
-          ;; It takes a while for gnutls-serv to start.
+                      port
-          (while (and (null (ignore-errors
+                      nowait))
-                              (setq proc (open-gnutls-stream
-                                          "bar"
-                                          (generate-new-buffer "*foo*")
-                                          "localhost"
-                                          44669
-                                          nowait))))
-                      (< (setq times (1+ times)) 10))
-            (sit-for 0.1))
          (should proc)
          (setq times 0)
          (while (and (eq (process-status proc) 'connect)
@@ -730,14 +671,14 @@
    "bar"
    (generate-new-buffer "*foo*")
    "localhost"
-    44777
+    (+ 20000 (random 45535))
    (list t)))
  (should-error
   (open-gnutls-stream
    "bar"
    (generate-new-buffer "*foo*")
    "localhost"
-    44777
+    (+ 20000 (random 45535))
    (vector :nowait t))))
 (ert-deftest check-network-process-coding-system-bind ()
author	Robert Pluim	2025-06-20 12:09:14 +0200
committer	Robert Pluim	2025-06-20 12:09:14 +0200
commit	1560e9bf66597b3bf7f389ed22ad4524ca89d4e2 (patch)
tree	0fedcb84acfbbed1292924fcdada1fbd44e72fd8 /test
parent	04a1a53de19e74e06aba5c05f73aa6b1fdccae4f (diff)
download	emacs-1560e9bf66597b3bf7f389ed22ad4524ca89d4e2.tar.gz emacs-1560e9bf66597b3bf7f389ed22ad4524ca89d4e2.zip

diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index d868562f5cf..41ca0264907 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el
@@ -125,7 +125,6 @@
125	)	125	)
126		126
127	(defun server-process-filter (proc string)	127	(defun server-process-filter (proc string)
128	(message "Received %s" string)
129	(let ((prev (process-get proc 'previous-string)))	128	(let ((prev (process-get proc 'previous-string)))
130	(when prev	129	(when prev
131	(setq string (concat prev string))	130	(setq string (concat prev string))
@@ -244,36 +243,52 @@
244	(should (equal (buffer-string) "foo\n")))	243	(should (equal (buffer-string) "foo\n")))
245	(delete-process server)))	244	(delete-process server)))
246		245
247	(defun make-tls-server (port)	246	(defun make-tls-server (&optional params)
248	(start-process "gnutls" (generate-new-buffer "tls")	247	(catch 'server
249	"gnutls-serv" "--http"	248	(let (port
250	"--x509keyfile"	249	proc)
251	(ert-resource-file "key.pem")	250	(while t
252	"--x509certfile"	251	(setq port (+ 20000 (random 45535))
253	(ert-resource-file "cert.pem")	252	proc (apply #'start-process
254	"--port" (format "%s" port)))	253	"gnutls" (generate-new-buffer "tls")
		254	"gnutls-serv" "--http"
		255	"--x509keyfile"
		256	(ert-resource-file "key.pem")
		257	"--x509certfile"
		258	(ert-resource-file "cert.pem")
		259	"--port" (format "%s" port)
		260	params))
		261	(while (not (eq (process-status proc) 'run))
		262	(sit-for 0.1))
		263	(with-current-buffer (process-buffer proc)
		264	(when (eq
		265	(catch 'status
		266	(while t
		267	(goto-char (point-min))
		268	(when (search-forward (format "port %s..." port) nil t)
		269	(if (looking-at "done")
		270	(throw 'status 'done))
		271	(if (looking-at "bind() failed")
		272	(throw 'status 'failed)))
		273	(sit-for 0.1)))
		274	'done)
		275	(throw 'server (cons proc port))))
		276	(delete-process proc)))))
255		277
256	(ert-deftest connect-to-tls-ipv4-wait ()	278	(ert-deftest connect-to-tls-ipv4-wait ()
257	(skip-unless (executable-find "gnutls-serv"))	279	(skip-unless (executable-find "gnutls-serv"))
258	(skip-unless (gnutls-available-p))	280	(skip-unless (gnutls-available-p))
259	(let ((server (make-tls-server 44332))	281	(let* ((s (make-tls-server))
260	(times 0)	282	(server (car s))
261	proc status)	283	(port (cdr s))
		284	proc status)
262	(unwind-protect	285	(unwind-protect
263	(progn	286	(progn
264	(sleep-for 1)	287	(setq proc (make-network-process
265	(with-current-buffer (process-buffer server)	288	:name "bar"
266	(message "gnutls-serv: %s" (buffer-string)))	289	:buffer (generate-new-buffer "foo")
267		290	:host "localhost"
268	;; It takes a while for gnutls-serv to start.	291	:service port))
269	(while (and (null (ignore-errors
270	(setq proc (make-network-process
271	:name "bar"
272	:buffer (generate-new-buffer "foo")
273	:host "localhost"
274	:service 44332))))
275	(< (setq times (1+ times)) 10))
276	(sit-for 0.1))
277	(should proc)	292	(should proc)
278	(gnutls-negotiate :process proc	293	(gnutls-negotiate :process proc
279	:type 'gnutls-x509pki	294	:type 'gnutls-x509pki
@@ -294,33 +309,25 @@
294	(ert-deftest connect-to-tls-ipv4-nowait ()	309	(ert-deftest connect-to-tls-ipv4-nowait ()
295	(skip-unless (executable-find "gnutls-serv"))	310	(skip-unless (executable-find "gnutls-serv"))
296	(skip-unless (gnutls-available-p))	311	(skip-unless (gnutls-available-p))
297	(let ((server (make-tls-server 44331))	312	(let* ((s (make-tls-server))
298	(times 0)	313	(server (car s))
299	(network-security-level 'low)	314	(port (cdr s))
300	proc status)	315	(times 0)
		316	(network-security-level 'low)
		317	proc status)
301	(unwind-protect	318	(unwind-protect
302	(progn	319	(progn
303	(sleep-for 1)	320	(setq proc (make-network-process
304	(with-current-buffer (process-buffer server)	321	:name "bar"
305	(message "gnutls-serv: %s" (buffer-string)))	322	:buffer (generate-new-buffer "foo")
306		323	:nowait t
307	;; It takes a while for gnutls-serv to start.	324	:family 'ipv4
308	(while (and (null (ignore-errors	325	:tls-parameters
309	(setq proc (make-network-process	326	(cons 'gnutls-x509pki
310	:name "bar"	327	(gnutls-boot-parameters
311	:buffer (generate-new-buffer "foo")	328	:hostname "localhost"))
312	:nowait t	329	:host "localhost"
313	:family 'ipv4	330	:service port))
314	:tls-parameters
315	(cons 'gnutls-x509pki
316	(gnutls-boot-parameters
317	:hostname "localhost"))
318	:host "localhost"
319	:service 44331))))
320	(< (setq times (1+ times)) 10))
321	(sit-for 0.1))
322	(should proc)
323	(setq times 0)
324	(while (and (eq (process-status proc) 'connect)	331	(while (and (eq (process-status proc) 'connect)
325	(< (setq times (1+ times)) 10))	332	(< (setq times (1+ times)) 10))
326	(sit-for 0.1))	333	(sit-for 0.1))
@@ -339,33 +346,26 @@
339	(skip-unless (gnutls-available-p))	346	(skip-unless (gnutls-available-p))
340	(skip-when (eq system-type 'windows-nt))	347	(skip-when (eq system-type 'windows-nt))
341	(skip-unless (featurep 'make-network-process '(:family ipv6)))	348	(skip-unless (featurep 'make-network-process '(:family ipv6)))
342	(let ((server (make-tls-server 44333))	349	(let* ((s (make-tls-server))
343	(times 0)	350	(server (car s))
344	(network-security-level 'low)	351	(port (cdr s))
345	proc status)	352	(times 0)
		353	(network-security-level 'low)
		354	proc status)
346	(unwind-protect	355	(unwind-protect
347	(progn	356	(progn
348	(sleep-for 1)	357	(setq proc (make-network-process
349	(with-current-buffer (process-buffer server)	358	:name "bar"
350	(message "gnutls-serv: %s" (buffer-string)))	359	:buffer (generate-new-buffer "foo")
351		360	:family 'ipv6
352	;; It takes a while for gnutls-serv to start.	361	:nowait t
353	(while (and (null (ignore-errors	362	:tls-parameters
354	(setq proc (make-network-process	363	(cons 'gnutls-x509pki
355	:name "bar"	364	(gnutls-boot-parameters
356	:buffer (generate-new-buffer "foo")	365	:hostname "localhost"))
357	:family 'ipv6	366	:host "::1"
358	:nowait t	367	:service port))
359	:tls-parameters
360	(cons 'gnutls-x509pki
361	(gnutls-boot-parameters
362	:hostname "localhost"))
363	:host "::1"
364	:service 44333))))
365	(< (setq times (1+ times)) 10))
366	(sit-for 0.1))
367	(should proc)	368	(should proc)
368	(setq times 0)
369	(while (and (eq (process-status proc) 'connect)	369	(while (and (eq (process-status proc) 'connect)
370	(< (setq times (1+ times)) 10))	370	(< (setq times (1+ times)) 10))
371	(sit-for 0.1))	371	(sit-for 0.1))
@@ -382,27 +382,20 @@
382	(ert-deftest open-network-stream-tls-wait ()	382	(ert-deftest open-network-stream-tls-wait ()
383	(skip-unless (executable-find "gnutls-serv"))	383	(skip-unless (executable-find "gnutls-serv"))
384	(skip-unless (gnutls-available-p))	384	(skip-unless (gnutls-available-p))
385	(let ((server (make-tls-server 44334))	385	(let* ((s (make-tls-server))
386	(times 0)	386	(server (car s))
387	(network-security-level 'low)	387	(port (cdr s))
388	proc status)	388	(network-security-level 'low)
		389	proc status)
389	(unwind-protect	390	(unwind-protect
390	(progn	391	(progn
391	(sleep-for 1)	392	(setq proc (open-network-stream
392	(with-current-buffer (process-buffer server)	393	"bar"
393	(message "gnutls-serv: %s" (buffer-string)))	394	(generate-new-buffer "foo")
394		395	"localhost"
395	;; It takes a while for gnutls-serv to start.	396	port
396	(while (and (null (ignore-errors	397	:type 'tls
397	(setq proc (open-network-stream	398	:nowait nil))
398	"bar"
399	(generate-new-buffer "foo")
400	"localhost"
401	44334
402	:type 'tls
403	:nowait nil))))
404	(< (setq times (1+ times)) 10))
405	(sit-for 0.1))
406	(should proc)	399	(should proc)
407	(skip-when (eq (process-status proc) 'connect)))	400	(skip-when (eq (process-status proc) 'connect)))
408	(if (process-live-p server) (delete-process server)))	401	(if (process-live-p server) (delete-process server)))
@@ -421,29 +414,22 @@
421	(ert-deftest open-network-stream-tls-nowait ()	414	(ert-deftest open-network-stream-tls-nowait ()
422	(skip-unless (executable-find "gnutls-serv"))	415	(skip-unless (executable-find "gnutls-serv"))
423	(skip-unless (gnutls-available-p))	416	(skip-unless (gnutls-available-p))
424	(let ((server (make-tls-server 44335))	417	(let* ((s (make-tls-server))
425	(times 0)	418	(server (car s))
426	(network-security-level 'low)	419	(port (cdr s))
427	proc status)	420	(times 0)
		421	(network-security-level 'low)
		422	proc status)
428	(unwind-protect	423	(unwind-protect
429	(progn	424	(progn
430	(sleep-for 1)	425	(setq proc (open-network-stream
431	(with-current-buffer (process-buffer server)	426	"bar"
432	(message "gnutls-serv: %s" (buffer-string)))	427	(generate-new-buffer "foo")
433		428	"localhost"
434	;; It takes a while for gnutls-serv to start.	429	port
435	(while (and (null (ignore-errors	430	:type 'tls
436	(setq proc (open-network-stream	431	:nowait t))
437	"bar"
438	(generate-new-buffer "foo")
439	"localhost"
440	44335
441	:type 'tls
442	:nowait t))))
443	(< (setq times (1+ times)) 10))
444	(sit-for 0.1))
445	(should proc)	432	(should proc)
446	(setq times 0)
447	(while (and (eq (process-status proc) 'connect)	433	(while (and (eq (process-status proc) 'connect)
448	(< (setq times (1+ times)) 10))	434	(< (setq times (1+ times)) 10))
449	(sit-for 0.1))	435	(sit-for 0.1))
@@ -464,26 +450,19 @@
464	(ert-deftest open-network-stream-tls ()	450	(ert-deftest open-network-stream-tls ()
465	(skip-unless (executable-find "gnutls-serv"))	451	(skip-unless (executable-find "gnutls-serv"))
466	(skip-unless (gnutls-available-p))	452	(skip-unless (gnutls-available-p))
467	(let ((server (make-tls-server 44336))	453	(let* ((s (make-tls-server))
468	(times 0)	454	(server (car s))
469	(network-security-level 'low)	455	(port (cdr s))
470	proc status)	456	(network-security-level 'low)
		457	proc status)
471	(unwind-protect	458	(unwind-protect
472	(progn	459	(progn
473	(sleep-for 1)	460	(setq proc (open-network-stream
474	(with-current-buffer (process-buffer server)	461	"bar"
475	(message "gnutls-serv: %s" (buffer-string)))	462	(generate-new-buffer "foo")
476		463	"localhost"
477	;; It takes a while for gnutls-serv to start.	464	port
478	(while (and (null (ignore-errors	465	:type 'tls))
479	(setq proc (open-network-stream
480	"bar"
481	(generate-new-buffer "foo")
482	"localhost"
483	44336
484	:type 'tls))))
485	(< (setq times (1+ times)) 10))
486	(sit-for 0.1))
487	(should proc)	466	(should proc)
488	(skip-when (eq (process-status proc) 'connect)))	467	(skip-when (eq (process-status proc) 'connect)))
489	(if (process-live-p server) (delete-process server)))	468	(if (process-live-p server) (delete-process server)))
@@ -502,27 +481,20 @@
502	(ert-deftest open-network-stream-tls-nocert ()	481	(ert-deftest open-network-stream-tls-nocert ()
503	(skip-unless (executable-find "gnutls-serv"))	482	(skip-unless (executable-find "gnutls-serv"))
504	(skip-unless (gnutls-available-p))	483	(skip-unless (gnutls-available-p))
505	(let ((server (make-tls-server 44337))	484	(let* ((s (make-tls-server))
506	(times 0)	485	(server (car s))
507	(network-security-level 'low)	486	(port (cdr s))
508	proc status)	487	(network-security-level 'low)
		488	proc status)
509	(unwind-protect	489	(unwind-protect
510	(progn	490	(progn
511	(sleep-for 1)	491	(setq proc (open-network-stream
512	(with-current-buffer (process-buffer server)	492	"bar"
513	(message "gnutls-serv: %s" (buffer-string)))	493	(generate-new-buffer "foo")
514		494	"localhost"
515	;; It takes a while for gnutls-serv to start.	495	port
516	(while (and (null (ignore-errors	496	:type 'tls
517	(setq proc (open-network-stream	497	:client-certificate nil))
518	"bar"
519	(generate-new-buffer "foo")
520	"localhost"
521	44337
522	:type 'tls
523	:client-certificate nil))))
524	(< (setq times (1+ times)) 10))
525	(sit-for 0.1))
526	(should proc)	498	(should proc)
527	(skip-when (eq (process-status proc) 'connect)))	499	(skip-when (eq (process-status proc) 'connect)))
528	(if (process-live-p server) (delete-process server)))	500	(if (process-live-p server) (delete-process server)))
@@ -541,25 +513,19 @@
541	(ert-deftest open-gnutls-stream-new-api-default ()	513	(ert-deftest open-gnutls-stream-new-api-default ()
542	(skip-unless (executable-find "gnutls-serv"))	514	(skip-unless (executable-find "gnutls-serv"))
543	(skip-unless (gnutls-available-p))	515	(skip-unless (gnutls-available-p))
544	(let ((server (make-tls-server 44665))	516	(let* ((s (make-tls-server))
545	(times 0)	517	(server (car s))
546	proc status)	518	(port (cdr s))
		519	proc status)
547	(unwind-protect	520	(unwind-protect
548	(progn	521	(progn
549	(sleep-for 1)	522	(setq proc (open-gnutls-stream
550	(with-current-buffer (process-buffer server)	523	"bar"
551	(message "gnutls-serv: %s" (buffer-string)))	524	(generate-new-buffer "foo")
552		525	"localhost"
553	;; It takes a while for gnutls-serv to start.	526	port))
554	(while (and (null (ignore-errors
555	(setq proc (open-gnutls-stream
556	"bar"
557	(generate-new-buffer "foo")
558	"localhost"
559	44665))))
560	(< (setq times (1+ times)) 10))
561	(sit-for 0.1))
562	(should proc)	527	(should proc)
		528	(skip-when (eq (process-status proc) 'connect)))
563	(if (process-live-p server) (delete-process server)))	529	(if (process-live-p server) (delete-process server)))
564	(setq status (gnutls-peer-status proc))	530	(setq status (gnutls-peer-status proc))
565	(should (consp status))	531	(should (consp status))
@@ -571,31 +537,25 @@
571	(let ((issuer (plist-get (plist-get status :certificate) :issuer)))	537	(let ((issuer (plist-get (plist-get status :certificate) :issuer)))
572	(should (stringp issuer))	538	(should (stringp issuer))
573	(setq issuer (split-string issuer ","))	539	(setq issuer (split-string issuer ","))
574	(should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))	540	(should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
575		541
576	(ert-deftest open-gnutls-stream-new-api-wait ()	542	(ert-deftest open-gnutls-stream-new-api-wait ()
577	(skip-unless (executable-find "gnutls-serv"))	543	(skip-unless (executable-find "gnutls-serv"))
578	(skip-unless (gnutls-available-p))	544	(skip-unless (gnutls-available-p))
579	(let ((server (make-tls-server 44666))	545	(let* ((s (make-tls-server))
580	(times 0)	546	(server (car s))
581	proc status)	547	(port (cdr s))
		548	proc status)
582	(unwind-protect	549	(unwind-protect
583	(progn	550	(progn
584	(sleep-for 1)	551	(setq proc (open-gnutls-stream
585	(with-current-buffer (process-buffer server)	552	"bar"
586	(message "gnutls-serv: %s" (buffer-string)))	553	(generate-new-buffer "foo")
587		554	"localhost"
588	;; It takes a while for gnutls-serv to start.	555	port
589	(while (and (null (ignore-errors	556	(list :nowait nil)))
590	(setq proc (open-gnutls-stream
591	"bar"
592	(generate-new-buffer "foo")
593	"localhost"
594	44666
595	(list :nowait nil)))))
596	(< (setq times (1+ times)) 10))
597	(sit-for 0.1))
598	(should proc)	557	(should proc)
		558	(skip-when (eq (process-status proc) 'connect)))
599	(if (process-live-p server) (delete-process server)))	559	(if (process-live-p server) (delete-process server)))
600	(setq status (gnutls-peer-status proc))	560	(setq status (gnutls-peer-status proc))
601	(should (consp status))	561	(should (consp status))
@@ -607,32 +567,26 @@
607	(let ((issuer (plist-get (plist-get status :certificate) :issuer)))	567	(let ((issuer (plist-get (plist-get status :certificate) :issuer)))
608	(should (stringp issuer))	568	(should (stringp issuer))
609	(setq issuer (split-string issuer ","))	569	(setq issuer (split-string issuer ","))
610	(should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))	570	(should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
611		571
612	(ert-deftest open-gnutls-stream-old-api-wait ()	572	(ert-deftest open-gnutls-stream-old-api-wait ()
613	(skip-unless (executable-find "gnutls-serv"))	573	(skip-unless (executable-find "gnutls-serv"))
614	(skip-unless (gnutls-available-p))	574	(skip-unless (gnutls-available-p))
615	(let ((server (make-tls-server 44667))	575	(let* ((s (make-tls-server))
616	(times 0)	576	(server (car s))
617	(nowait nil) ; Workaround Bug#47080	577	(port (cdr s))
618	proc status)	578	(nowait nil) ; Workaround Bug#47080
		579	proc status)
619	(unwind-protect	580	(unwind-protect
620	(progn	581	(progn
621	(sleep-for 1)	582	(setq proc (open-gnutls-stream
622	(with-current-buffer (process-buffer server)	583	"bar"
623	(message "gnutls-serv: %s" (buffer-string)))	584	(generate-new-buffer "foo")
624		585	"localhost"
625	;; It takes a while for gnutls-serv to start.	586	port
626	(while (and (null (ignore-errors	587	nowait))
627	(setq proc (open-gnutls-stream
628	"bar"
629	(generate-new-buffer "foo")
630	"localhost"
631	44667
632	nowait))))
633	(< (setq times (1+ times)) 10))
634	(sit-for 0.1))
635	(should proc)	588	(should proc)
		589	(skip-when (eq (process-status proc) 'connect)))
636	(if (process-live-p server) (delete-process server)))	590	(if (process-live-p server) (delete-process server)))
637	(setq status (gnutls-peer-status proc))	591	(setq status (gnutls-peer-status proc))
638	(should (consp status))	592	(should (consp status))
@@ -644,33 +598,26 @@
644	(let ((issuer (plist-get (plist-get status :certificate) :issuer)))	598	(let ((issuer (plist-get (plist-get status :certificate) :issuer)))
645	(should (stringp issuer))	599	(should (stringp issuer))
646	(setq issuer (split-string issuer ","))	600	(setq issuer (split-string issuer ","))
647	(should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC"))))))	601	(should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
648		602
649	(ert-deftest open-gnutls-stream-new-api-nowait ()	603	(ert-deftest open-gnutls-stream-new-api-nowait ()
650	(skip-unless (executable-find "gnutls-serv"))	604	(skip-unless (executable-find "gnutls-serv"))
651	(skip-unless (gnutls-available-p))	605	(skip-unless (gnutls-available-p))
652	(let ((server (make-tls-server 44668))	606	(let* ((s (make-tls-server))
653	(times 0)	607	(server (car s))
654	(network-security-level 'low)	608	(port (cdr s))
655	proc status)	609	(times 0)
		610	(network-security-level 'low)
		611	proc status)
656	(unwind-protect	612	(unwind-protect
657	(progn	613	(progn
658	(sleep-for 1)	614	(setq proc (open-gnutls-stream
659	(with-current-buffer (process-buffer server)	615	"bar"
660	(message "gnutls-serv: %s" (buffer-string)))	616	(generate-new-buffer "foo")
661		617	"localhost"
662	;; It takes a while for gnutls-serv to start.	618	port
663	(while (and (null (ignore-errors	619	(list :nowait t)))
664	(setq proc (open-gnutls-stream
665	"bar"
666	(generate-new-buffer "foo")
667	"localhost"
668	44668
669	(list :nowait t)))))
670	(< (setq times (1+ times)) 10))
671	(sit-for 0.1))
672	(should proc)	620	(should proc)
673	(setq times 0)
674	(while (and (eq (process-status proc) 'connect)	621	(while (and (eq (process-status proc) 'connect)
675	(< (setq times (1+ times)) 10))	622	(< (setq times (1+ times)) 10))
676	(sit-for 0.1))	623	(sit-for 0.1))
@@ -687,27 +634,21 @@
687	(ert-deftest open-gnutls-stream-old-api-nowait ()	634	(ert-deftest open-gnutls-stream-old-api-nowait ()
688	(skip-unless (executable-find "gnutls-serv"))	635	(skip-unless (executable-find "gnutls-serv"))
689	(skip-unless (gnutls-available-p))	636	(skip-unless (gnutls-available-p))
690	(let ((server (make-tls-server 44669))	637	(let* ((s (make-tls-server))
691	(times 0)	638	(server (car s))
692	(network-security-level 'low)	639	(port (cdr s))
693	(nowait t)	640	(times 0)
694	proc status)	641	(network-security-level 'low)
		642	(nowait t)
		643	proc status)
695	(unwind-protect	644	(unwind-protect
696	(progn	645	(progn
697	(sleep-for 1)	646	(setq proc (open-gnutls-stream
698	(with-current-buffer (process-buffer server)	647	"bar"
699	(message "gnutls-serv: %s" (buffer-string)))	648	(generate-new-buffer "foo")
700		649	"localhost"
701	;; It takes a while for gnutls-serv to start.	650	port
702	(while (and (null (ignore-errors	651	nowait))
703	(setq proc (open-gnutls-stream
704	"bar"
705	(generate-new-buffer "foo")
706	"localhost"
707	44669
708	nowait))))
709	(< (setq times (1+ times)) 10))
710	(sit-for 0.1))
711	(should proc)	652	(should proc)
712	(setq times 0)	653	(setq times 0)
713	(while (and (eq (process-status proc) 'connect)	654	(while (and (eq (process-status proc) 'connect)
@@ -730,14 +671,14 @@
730	"bar"	671	"bar"
731	(generate-new-buffer "foo")	672	(generate-new-buffer "foo")
732	"localhost"	673	"localhost"
733	44777	674	(+ 20000 (random 45535))
734	(list t)))	675	(list t)))
735	(should-error	676	(should-error
736	(open-gnutls-stream	677	(open-gnutls-stream
737	"bar"	678	"bar"
738	(generate-new-buffer "foo")	679	(generate-new-buffer "foo")
739	"localhost"	680	"localhost"
740	44777	681	(+ 20000 (random 45535))
741	(vector :nowait t))))	682	(vector :nowait t))))
742		683
743	(ert-deftest check-network-process-coding-system-bind ()	684	(ert-deftest check-network-process-coding-system-bind ()