diff options
| author | Lars Ingebrigtsen <larsi@gnus.org> | 2016-02-08 15:28:50 +1100 |
|---|---|---|
| committer | Lars Ingebrigtsen <larsi@gnus.org> | 2016-02-08 15:28:50 +1100 |
| commit | f29b6cf37964859f40586e218abc37c3232f8480 (patch) | |
| tree | 97750a570551f091c9f68ad64f9379b95ac4fc48 /test/lisp/net/network-stream-tests.el | |
| parent | 4f50d8db8c54ca3fb80cd52c34099c4c0a8fb7dd (diff) | |
| download | emacs-f29b6cf37964859f40586e218abc37c3232f8480.tar.gz emacs-f29b6cf37964859f40586e218abc37c3232f8480.tar.bz2 emacs-f29b6cf37964859f40586e218abc37c3232f8480.zip | |
Add a TLS connection test
* test/lisp/net/network-stream-tests.el (connect-to-tls): Add
a TLS connection test.
Diffstat (limited to 'test/lisp/net/network-stream-tests.el')
| -rw-r--r-- | test/lisp/net/network-stream-tests.el | 47 |
1 files changed, 43 insertions, 4 deletions
diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el index f52a69e05d6..478b8248eb3 100644 --- a/test/lisp/net/network-stream-tests.el +++ b/test/lisp/net/network-stream-tests.el @@ -22,6 +22,8 @@ ;;; Code: +(require 'gnutls) + (ert-deftest make-local-unix-server () (let* ((file (make-temp-name "/tmp/server-test")) (server @@ -101,7 +103,7 @@ :buffer (generate-new-buffer "*foo*") :host (system-name) :service port))) - (with-current-buffer "*foo*" + (with-current-buffer (process-buffer proc) (process-send-string proc "echo foo") (sleep-for 0.1) (should (equal (buffer-string) "foo\n"))) @@ -114,7 +116,7 @@ :buffer (generate-new-buffer "*foo*") :host "localhost" :service port))) - (with-current-buffer "*foo*" + (with-current-buffer (process-buffer proc) (process-send-string proc "echo foo") (sleep-for 0.1) (should (equal (buffer-string) "foo\n"))) @@ -127,7 +129,7 @@ :buffer (generate-new-buffer "*foo*") :host "127.0.0.1" :service port))) - (with-current-buffer "*foo*" + (with-current-buffer (process-buffer proc) (process-send-string proc "echo foo") (sleep-for 0.1) (should (equal (buffer-string) "foo\n"))) @@ -147,10 +149,47 @@ t))) (while (eq (process-status proc) 'connect) (sit-for 0.1)) - (with-current-buffer "*foo*" + (with-current-buffer (process-buffer proc) (process-send-string proc "echo foo") (sleep-for 0.1) (should (equal (buffer-string) "foo\n"))) (delete-process server))) +(defun make-tls-server () + (start-process "openssl" (generate-new-buffer "*tls*") "openssl" + "s_server" "-key" "lisp/net/key.pem" + "-cert" "lisp/net/cert.pem" + "-accept" "44330" + "-www")) + +(ert-deftest connect-to-tls () + (let ((server (make-tls-server)) + (times 0) + proc status) + (sleep-for 1) + (with-current-buffer (process-buffer server) + (message "openssl: %s" (buffer-string))) + + ;; It takes a while for openssl to start. + (while (and (null (ignore-errors + (setq proc (make-network-process + :name "bar" + :buffer (generate-new-buffer "*foo*") + :host "localhost" + :service 44330)))) + (< (setq times (1+ times)) 10)) + (sit-for 0.1)) + (should proc) + (gnutls-negotiate :process proc + :type 'gnutls-x509pki + :hostname "localhost") + (delete-process server) + (setq status (gnutls-peer-status proc)) + (should (consp status)) + (delete-process proc) + (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"))))) + ;;; network-stream-tests.el ends here |