1 ;;; network-stream-tests.el --- tests for network processes -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2016 Free Software Foundation, Inc.
5 ;; Author: Lars Ingebrigtsen <larsi@gnus.org>
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software: you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
29 (ert-deftest make-local-unix-server ()
30 (skip-unless (featurep 'make-network-process '(:family local)))
31 (let* ((file (make-temp-name "/tmp/server-test"))
36 :buffer (get-buffer-create "*server*")
40 (should (equal (process-contact server :local) file))
41 (delete-file (process-contact server :local))))
43 (ert-deftest make-ipv4-tcp-server-with-unspecified-port ()
52 (should (and (arrayp (process-contact server :local))
53 (numberp (aref (process-contact server :local) 4))
54 (> (aref (process-contact server :local) 4) 0)))
55 (delete-process server)))
57 (ert-deftest make-ipv4-tcp-server-with-specified-port ()
66 (should (and (arrayp (process-contact server :local))
67 (= (aref (process-contact server :local) 4) 57869)))
68 (delete-process server)))
70 (defun make-server (host)
76 :coding 'raw-text-unix
77 :buffer (get-buffer-create "*server*")
79 :sentinel 'server-sentinel
80 :filter 'server-process-filter
83 (defun server-sentinel (_proc _msg)
86 (defun server-process-filter (proc string)
87 (message "Received %s" string)
88 (let ((prev (process-get proc 'previous-string)))
90 (setq string (concat prev string))
91 (process-put proc 'previous-string nil)))
92 (if (and (not (string-match "\n" string))
93 (> (length string) 0))
94 (process-put proc 'previous-string string))
95 (let ((command (split-string string)))
97 ((equal (car command) "echo")
98 (process-send-string proc (concat (cadr command) "\n")))
102 (ert-deftest echo-server-with-dns ()
103 (let* ((server (make-server (system-name)))
104 (port (aref (process-contact server :local) 4))
105 (proc (make-network-process :name "foo"
106 :buffer (generate-new-buffer "*foo*")
109 (with-current-buffer (process-buffer proc)
110 (process-send-string proc "echo foo")
112 (should (equal (buffer-string) "foo\n")))
113 (delete-process server)))
115 (ert-deftest echo-server-with-localhost ()
116 (let* ((server (make-server 'local))
117 (port (aref (process-contact server :local) 4))
118 (proc (make-network-process :name "foo"
119 :buffer (generate-new-buffer "*foo*")
122 (with-current-buffer (process-buffer proc)
123 (process-send-string proc "echo foo")
125 (should (equal (buffer-string) "foo\n")))
126 (delete-process server)))
128 (ert-deftest echo-server-with-ip ()
129 (let* ((server (make-server 'local))
130 (port (aref (process-contact server :local) 4))
131 (proc (make-network-process :name "foo"
132 :buffer (generate-new-buffer "*foo*")
135 (with-current-buffer (process-buffer proc)
136 (process-send-string proc "echo foo")
138 (should (equal (buffer-string) "foo\n")))
139 (delete-process server)))
141 (ert-deftest echo-server-nowait ()
142 (let* ((server (make-server 'local))
143 (port (aref (process-contact server :local) 4))
144 (proc (make-network-process :name "foo"
145 :buffer (generate-new-buffer "*foo*")
149 (should (eq (process-status proc) 'connect))
150 (while (eq (process-status proc) 'connect)
152 (with-current-buffer (process-buffer proc)
153 (process-send-string proc "echo foo")
155 (should (equal (buffer-string) "foo\n")))
156 (delete-process server)))
158 (defun make-tls-server (port)
159 (start-process "gnutls" (generate-new-buffer "*tls*")
160 "gnutls-serv" "--http"
161 "--x509keyfile" "data/net/key.pem"
162 "--x509certfile" "data/net/cert.pem"
163 "--port" (format "%s" port)))
165 (ert-deftest connect-to-tls-ipv4-wait ()
166 (skip-unless (executable-find "gnutls-serv"))
167 (skip-unless (gnutls-available-p))
168 (let ((server (make-tls-server 44332))
172 (with-current-buffer (process-buffer server)
173 (message "gnutls-serv: %s" (buffer-string)))
175 ;; It takes a while for gnutls-serv to start.
176 (while (and (null (ignore-errors
177 (setq proc (make-network-process
179 :buffer (generate-new-buffer "*foo*")
182 (< (setq times (1+ times)) 10))
185 (gnutls-negotiate :process proc
186 :type 'gnutls-x509pki
187 :hostname "localhost")
188 (delete-process server)
189 (setq status (gnutls-peer-status proc))
190 (should (consp status))
191 (delete-process proc)
192 ;; This sleep-for is needed for the native MS-Windows build. If
193 ;; it is removed, the next test mysteriously fails because the
194 ;; initial part of the echo is not received.
196 (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
197 (should (stringp issuer))
198 (setq issuer (split-string issuer ","))
199 (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
201 (ert-deftest connect-to-tls-ipv4-nowait ()
202 (skip-unless (executable-find "gnutls-serv"))
203 (skip-unless (gnutls-available-p))
204 (let ((server (make-tls-server 44331))
208 (with-current-buffer (process-buffer server)
209 (message "gnutls-serv: %s" (buffer-string)))
211 ;; It takes a while for gnutls-serv to start.
212 (while (and (null (ignore-errors
213 (setq proc (make-network-process
215 :buffer (generate-new-buffer "*foo*")
218 (cons 'gnutls-x509pki
219 (gnutls-boot-parameters
220 :hostname "localhost"))
223 (< (setq times (1+ times)) 10))
226 (while (eq (process-status proc) 'connect)
228 (delete-process server)
229 (setq status (gnutls-peer-status proc))
230 (should (consp status))
231 (delete-process proc)
232 (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
233 (should (stringp issuer))
234 (setq issuer (split-string issuer ","))
235 (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
237 (ert-deftest connect-to-tls-ipv6-nowait ()
238 (skip-unless (executable-find "gnutls-serv"))
239 (skip-unless (gnutls-available-p))
240 (skip-unless (not (eq system-type 'windows-nt)))
241 (skip-unless (featurep 'make-network-process '(family ipv6)))
242 (let ((server (make-tls-server 44333))
246 (with-current-buffer (process-buffer server)
247 (message "gnutls-serv: %s" (buffer-string)))
249 ;; It takes a while for gnutls-serv to start.
250 (while (and (null (ignore-errors
251 (setq proc (make-network-process
253 :buffer (generate-new-buffer "*foo*")
257 (cons 'gnutls-x509pki
258 (gnutls-boot-parameters
259 :hostname "localhost"))
262 (< (setq times (1+ times)) 10))
265 (while (eq (process-status proc) 'connect)
267 (delete-process server)
268 (setq status (gnutls-peer-status proc))
269 (should (consp status))
270 (delete-process proc)
271 (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
272 (should (stringp issuer))
273 (setq issuer (split-string issuer ","))
274 (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
276 ;;; network-stream-tests.el ends here