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*")
150 (should (eq (process-status proc) 'connect))
151 (while (eq (process-status proc) 'connect)
153 (with-current-buffer (process-buffer proc)
154 (process-send-string proc "echo foo")
156 (should (equal (buffer-string) "foo\n")))
157 (delete-process server)))
159 (defconst network-stream-tests--datadir
160 (expand-file-name "test/data/net" source-directory))
162 (defun make-tls-server (port)
163 (start-process "gnutls" (generate-new-buffer "*tls*")
164 "gnutls-serv" "--http"
166 (concat network-stream-tests--datadir "/key.pem")
168 (concat network-stream-tests--datadir "/cert.pem")
169 "--port" (format "%s" port)))
171 (ert-deftest connect-to-tls-ipv4-wait ()
172 (skip-unless (executable-find "gnutls-serv"))
173 (skip-unless (gnutls-available-p))
174 (let ((server (make-tls-server 44332))
178 (with-current-buffer (process-buffer server)
179 (message "gnutls-serv: %s" (buffer-string)))
181 ;; It takes a while for gnutls-serv to start.
182 (while (and (null (ignore-errors
183 (setq proc (make-network-process
185 :buffer (generate-new-buffer "*foo*")
188 (< (setq times (1+ times)) 10))
191 (gnutls-negotiate :process proc
192 :type 'gnutls-x509pki
193 :hostname "localhost")
194 (delete-process server)
195 (setq status (gnutls-peer-status proc))
196 (should (consp status))
197 (delete-process proc)
198 ;; This sleep-for is needed for the native MS-Windows build. If
199 ;; it is removed, the next test mysteriously fails because the
200 ;; initial part of the echo is not received.
202 (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
203 (should (stringp issuer))
204 (setq issuer (split-string issuer ","))
205 (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
207 (ert-deftest connect-to-tls-ipv4-nowait ()
208 (skip-unless (executable-find "gnutls-serv"))
209 (skip-unless (gnutls-available-p))
210 (let ((server (make-tls-server 44331))
214 (with-current-buffer (process-buffer server)
215 (message "gnutls-serv: %s" (buffer-string)))
217 ;; It takes a while for gnutls-serv to start.
218 (while (and (null (ignore-errors
219 (setq proc (make-network-process
221 :buffer (generate-new-buffer "*foo*")
224 (cons 'gnutls-x509pki
225 (gnutls-boot-parameters
226 :hostname "localhost"))
229 (< (setq times (1+ times)) 10))
232 (while (eq (process-status proc) 'connect)
234 (delete-process server)
235 (setq status (gnutls-peer-status proc))
236 (should (consp status))
237 (delete-process proc)
238 (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
239 (should (stringp issuer))
240 (setq issuer (split-string issuer ","))
241 (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
243 (ert-deftest connect-to-tls-ipv6-nowait ()
244 (skip-unless (executable-find "gnutls-serv"))
245 (skip-unless (gnutls-available-p))
246 (skip-unless (not (eq system-type 'windows-nt)))
247 (skip-unless (featurep 'make-network-process '(:family ipv6)))
248 (let ((server (make-tls-server 44333))
252 (with-current-buffer (process-buffer server)
253 (message "gnutls-serv: %s" (buffer-string)))
255 ;; It takes a while for gnutls-serv to start.
256 (while (and (null (ignore-errors
257 (setq proc (make-network-process
259 :buffer (generate-new-buffer "*foo*")
263 (cons 'gnutls-x509pki
264 (gnutls-boot-parameters
265 :hostname "localhost"))
268 (< (setq times (1+ times)) 10))
271 (while (eq (process-status proc) 'connect)
273 (delete-process server)
274 (setq status (gnutls-peer-status proc))
275 (should (consp status))
276 (delete-process proc)
277 (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
278 (should (stringp issuer))
279 (setq issuer (split-string issuer ","))
280 (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
282 ;;; network-stream-tests.el ends here