;; Author: Lars Ingebrigtsen <larsi@gnus.org>
+;; 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
(require 'gnutls)
(ert-deftest make-local-unix-server ()
+ (skip-unless (featurep 'make-network-process '(:family local)))
(let* ((file (make-temp-name "/tmp/server-test"))
(server
(make-network-process
(should (equal (process-contact server :local) file))
(delete-file (process-contact server :local))))
-(ert-deftest make-local-tcp-server-with-unspecified-port ()
+(ert-deftest make-ipv4-tcp-server-with-unspecified-port ()
(let ((server
(make-network-process
:name "server"
(> (aref (process-contact server :local) 4) 0)))
(delete-process server)))
-(ert-deftest make-local-tcp-server-with-specified-port ()
+(ert-deftest make-ipv4-tcp-server-with-specified-port ()
(let ((server
(make-network-process
:name "server"
:nowait t
:service port)))
(should (eq (process-status proc) 'connect))
- (should (null (ignore-errors
- (process-send-string proc "echo bar")
- t)))
(while (eq (process-status proc) 'connect)
(sit-for 0.1))
(with-current-buffer (process-buffer proc)
(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"))
+(defun make-tls-server (port)
+ (start-process "gnutls" (generate-new-buffer "*tls*")
+ "gnutls-serv" "--http"
+ "--x509keyfile" "data/net/key.pem"
+ "--x509certfile" "data/net/cert.pem"
+ "--port" (format "%s" port)))
-(ert-deftest connect-to-tls ()
- (let ((server (make-tls-server))
+(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)
(sleep-for 1)
(with-current-buffer (process-buffer server)
- (message "openssl: %s" (buffer-string)))
+ (message "gnutls-serv: %s" (buffer-string)))
- ;; It takes a while for openssl to start.
+ ;; 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 44330))))
+ :service 44332))))
(< (setq times (1+ times)) 10))
(sit-for 0.1))
(should proc)
(setq status (gnutls-peer-status proc))
(should (consp status))
(delete-process proc)
+ ;; This sleep-for is needed for the native MS-Windows build. If
+ ;; it is removed, the next test mysteriously fails because the
+ ;; initial part of the echo is not received.
+ (sleep-for 0.1)
+ (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")))))
+
+(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)
+ proc status)
+ (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
+ :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)
+ (while (eq (process-status proc) 'connect)
+ (sit-for 0.1))
+ (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")))))
+
+(ert-deftest connect-to-tls-ipv6-nowait ()
+ (skip-unless (executable-find "gnutls-serv"))
+ (skip-unless (gnutls-available-p))
+ (skip-unless (not (eq system-type 'windows-nt)))
+ (skip-unless (featurep 'make-network-process '(:family ipv6)))
+ (let ((server (make-tls-server 44333))
+ (times 0)
+ proc status)
+ (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))
+ (should proc)
+ (while (eq (process-status proc) 'connect)
+ (sit-for 0.1))
+ (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 ","))