)
(defun server-process-filter (proc string)
- (message "Received %s" string)
(let ((prev (process-get proc 'previous-string)))
(when prev
(setq string (concat prev string))
(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
(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))
(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))
(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)))
(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))
(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)))
(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)))
(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))
(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))
(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))
(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))
(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)
"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 ()
projects / emacs.git / commitdiff