mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 10:30:25 -08:00
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.
This commit is contained in:
Robert Pluim
parent
04a1a53de1
commit
1560e9bf66
1 changed files with 185 additions and 244 deletions
|
|
@ -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)
|
||||
(start-process "gnutls" (generate-new-buffer "*tls*")
|
||||
"gnutls-serv" "--http"
|
||||
"--x509keyfile"
|
||||
(ert-resource-file "key.pem")
|
||||
"--x509certfile"
|
||||
(ert-resource-file "cert.pem")
|
||||
"--port" (format "%s" port)))
|
||||
(defun make-tls-server (&optional params)
|
||||
(catch 'server
|
||||
(let (port
|
||||
proc)
|
||||
(while t
|
||||
(setq port (+ 20000 (random 45535))
|
||||
proc (apply #'start-process
|
||||
"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))
|
||||
(times 0)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(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))
|
||||
(setq proc (make-network-process
|
||||
:name "bar"
|
||||
:buffer (generate-new-buffer "*foo*")
|
||||
:host "localhost"
|
||||
:service port))
|
||||
(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))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (make-network-process
|
||||
:name "bar"
|
||||
:buffer (generate-new-buffer "*foo*")
|
||||
:nowait t
|
||||
:family 'ipv4
|
||||
: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)
|
||||
(setq proc (make-network-process
|
||||
:name "bar"
|
||||
:buffer (generate-new-buffer "*foo*")
|
||||
:nowait t
|
||||
:family 'ipv4
|
||||
:tls-parameters
|
||||
(cons 'gnutls-x509pki
|
||||
(gnutls-boot-parameters
|
||||
:hostname "localhost"))
|
||||
:host "localhost"
|
||||
:service port))
|
||||
(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))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (make-network-process
|
||||
:name "bar"
|
||||
:buffer (generate-new-buffer "*foo*")
|
||||
:family 'ipv6
|
||||
:nowait t
|
||||
:tls-parameters
|
||||
(cons 'gnutls-x509pki
|
||||
(gnutls-boot-parameters
|
||||
:hostname "localhost"))
|
||||
:host "::1"
|
||||
:service 44333))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (make-network-process
|
||||
:name "bar"
|
||||
:buffer (generate-new-buffer "*foo*")
|
||||
:family 'ipv6
|
||||
:nowait t
|
||||
:tls-parameters
|
||||
(cons 'gnutls-x509pki
|
||||
(gnutls-boot-parameters
|
||||
:hostname "localhost"))
|
||||
:host "::1"
|
||||
:service port))
|
||||
(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))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (open-network-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
44334
|
||||
:type 'tls
|
||||
:nowait nil))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (open-network-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port
|
||||
:type 'tls
|
||||
:nowait nil))
|
||||
(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))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (open-network-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
44335
|
||||
:type 'tls
|
||||
:nowait t))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (open-network-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port
|
||||
:type 'tls
|
||||
:nowait t))
|
||||
(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))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (open-network-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
44336
|
||||
:type 'tls))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (open-network-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port
|
||||
:type 'tls))
|
||||
(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))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (open-network-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
44337
|
||||
:type 'tls
|
||||
:client-certificate nil))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (open-network-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port
|
||||
:type 'tls
|
||||
:client-certificate nil))
|
||||
(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))
|
||||
(times 0)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(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))
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port))
|
||||
(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))
|
||||
(times 0)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
44666
|
||||
(list :nowait nil)))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port
|
||||
(list :nowait nil)))
|
||||
(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))
|
||||
(times 0)
|
||||
(nowait nil) ; Workaround Bug#47080
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(nowait nil) ; Workaround Bug#47080
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
44667
|
||||
nowait))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port
|
||||
nowait))
|
||||
(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))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
44668
|
||||
(list :nowait t)))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port
|
||||
(list :nowait t)))
|
||||
(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))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
(nowait t)
|
||||
proc status)
|
||||
(let* ((s (make-tls-server))
|
||||
(server (car s))
|
||||
(port (cdr s))
|
||||
(times 0)
|
||||
(network-security-level 'low)
|
||||
(nowait t)
|
||||
proc status)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(sleep-for 1)
|
||||
(with-current-buffer (process-buffer server)
|
||||
(message "gnutls-serv: %s" (buffer-string)))
|
||||
|
||||
;; It takes a while for gnutls-serv to start.
|
||||
(while (and (null (ignore-errors
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
44669
|
||||
nowait))))
|
||||
(< (setq times (1+ times)) 10))
|
||||
(sit-for 0.1))
|
||||
(setq proc (open-gnutls-stream
|
||||
"bar"
|
||||
(generate-new-buffer "*foo*")
|
||||
"localhost"
|
||||
port
|
||||
nowait))
|
||||
(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 ()
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue