code.delx.au - gnu-emacs/blob - test/lisp/net/network-stream-tests.el

   1 ;;; network-stream-tests.el --- tests for network processes       -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2016 Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Ingebrigtsen <larsi@gnus.org>
   6
   7 ;; GNU Emacs is free software: you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation, either version 3 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;;; Commentary:
  21
  22
  23 ;;; Code:
  24
  25 (require 'gnutls)
  26
  27 (ert-deftest make-local-unix-server ()
  28   (let* ((file (make-temp-name "/tmp/server-test"))
  29          (server
  30           (make-network-process
  31            :name "server"
  32            :server t
  33            :buffer (get-buffer-create "*server*")
  34            :noquery t
  35            :family 'local
  36            :service file)))
  37     (should (equal (process-contact server :local) file))
  38     (delete-file (process-contact server :local))))
  39
  40 (ert-deftest make-ipv4-tcp-server-with-unspecified-port ()
  41   (let ((server
  42          (make-network-process
  43           :name "server"
  44           :server t
  45           :noquery t
  46           :family 'ipv4
  47           :service t
  48           :host 'local)))
  49     (should (and (arrayp (process-contact server :local))
  50                  (numberp (aref (process-contact server :local) 4))
  51                  (> (aref (process-contact server :local) 4) 0)))
  52     (delete-process server)))
  53
  54 (ert-deftest make-ipv4-tcp-server-with-specified-port ()
  55   (let ((server
  56          (make-network-process
  57           :name "server"
  58           :server t
  59           :noquery t
  60           :family 'ipv4
  61           :service 57869
  62           :host 'local)))
  63     (should (and (arrayp (process-contact server :local))
  64                  (= (aref (process-contact server :local) 4) 57869)))
  65     (delete-process server)))
  66
  67 (defun make-server (host)
  68   (make-network-process
  69    :name "server"
  70    :server t
  71    :noquery t
  72    :family 'ipv4
  73    :coding 'raw-text-unix
  74    :buffer (get-buffer-create "*server*")
  75    :service t
  76    :sentinel 'server-sentinel
  77    :filter 'server-process-filter
  78    :host host))
  79
  80 (defun server-sentinel (_proc _msg)
  81   )
  82
  83 (defun server-process-filter (proc string)
  84   (message "Received %s" string)
  85   (let ((prev (process-get proc 'previous-string)))
  86     (when prev
  87       (setq string (concat prev string))
  88       (process-put proc 'previous-string nil)))
  89   (if (and (not (string-match "\n" string))
  90            (> (length string) 0))
  91       (process-put proc 'previous-string string))
  92   (let ((command (split-string string)))
  93     (cond
  94      ((equal (car command) "echo")
  95       (process-send-string proc (concat (cadr command) "\n")))
  96      (t
  97       ))))
  98
  99 (ert-deftest echo-server-with-dns ()
 100   (let* ((server (make-server (system-name)))
 101          (port (aref (process-contact server :local) 4))
 102          (proc (make-network-process :name "foo"
 103                                      :buffer (generate-new-buffer "*foo*")
 104                                      :host (system-name)
 105                                      :service port)))
 106     (with-current-buffer (process-buffer proc)
 107       (process-send-string proc "echo foo")
 108       (sleep-for 0.1)
 109       (should (equal (buffer-string) "foo\n")))
 110     (delete-process server)))
 111
 112 (ert-deftest echo-server-with-localhost ()
 113   (let* ((server (make-server 'local))
 114          (port (aref (process-contact server :local) 4))
 115          (proc (make-network-process :name "foo"
 116                                      :buffer (generate-new-buffer "*foo*")
 117                                      :host "localhost"
 118                                      :service port)))
 119     (with-current-buffer (process-buffer proc)
 120       (process-send-string proc "echo foo")
 121       (sleep-for 0.1)
 122       (should (equal (buffer-string) "foo\n")))
 123     (delete-process server)))
 124
 125 (ert-deftest echo-server-with-ip ()
 126   (let* ((server (make-server 'local))
 127          (port (aref (process-contact server :local) 4))
 128          (proc (make-network-process :name "foo"
 129                                      :buffer (generate-new-buffer "*foo*")
 130                                      :host "127.0.0.1"
 131                                      :service port)))
 132     (with-current-buffer (process-buffer proc)
 133       (process-send-string proc "echo foo")
 134       (sleep-for 0.1)
 135       (should (equal (buffer-string) "foo\n")))
 136     (delete-process server)))
 137
 138 (ert-deftest echo-server-nowait ()
 139   (let* ((server (make-server 'local))
 140          (port (aref (process-contact server :local) 4))
 141          (proc (make-network-process :name "foo"
 142                                      :buffer (generate-new-buffer "*foo*")
 143                                      :host "localhost"
 144                                      :nowait t
 145                                      :service port)))
 146     (should (eq (process-status proc) 'connect))
 147     (while (eq (process-status proc) 'connect)
 148       (sit-for 0.1))
 149     (with-current-buffer (process-buffer proc)
 150       (process-send-string proc "echo foo")
 151       (sleep-for 0.1)
 152       (should (equal (buffer-string) "foo\n")))
 153     (delete-process server)))
 154
 155 (defun make-tls-server (port)
 156   (start-process "gnutls" (generate-new-buffer "*tls*")
 157                  "gnutls-serv" "--http"
 158                  "--x509keyfile" "lisp/net/key.pem"
 159                  "--x509certfile" "lisp/net/cert.pem"
 160                  "--port" (format "%s" port)))
 161
 162 (ert-deftest connect-to-tls-ipv4-wait ()
 163   (skip-unless (executable-find "gnutls-serv"))
 164   (skip-unless (gnutls-available-p))
 165   (let ((server (make-tls-server 44332))
 166         (times 0)
 167         proc status)
 168     (sleep-for 1)
 169     (with-current-buffer (process-buffer server)
 170       (message "gnutls-serv: %s" (buffer-string)))
 171
 172     ;; It takes a while for gnutls-serv to start.
 173     (while (and (null (ignore-errors
 174                         (setq proc (make-network-process
 175                                     :name "bar"
 176                                     :buffer (generate-new-buffer "*foo*")
 177                                     :host "localhost"
 178                                     :service 44332))))
 179                 (< (setq times (1+ times)) 10))
 180       (sit-for 0.1))
 181     (should proc)
 182     (gnutls-negotiate :process proc
 183                       :type 'gnutls-x509pki
 184                       :hostname "localhost")
 185     (delete-process server)
 186     (setq status (gnutls-peer-status proc))
 187     (should (consp status))
 188     (delete-process proc)
 189     (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
 190       (should (stringp issuer))
 191       (setq issuer (split-string issuer ","))
 192       (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 193
 194 (ert-deftest connect-to-tls-ipv4-nowait ()
 195   (skip-unless (executable-find "gnutls-serv"))
 196   (skip-unless (gnutls-available-p))
 197   (let ((server (make-tls-server 44331))
 198         (times 0)
 199         proc status)
 200     (sleep-for 1)
 201     (with-current-buffer (process-buffer server)
 202       (message "gnutls-serv: %s" (buffer-string)))
 203
 204     ;; It takes a while for gnutls-serv to start.
 205     (while (and (null (ignore-errors
 206                         (setq proc (make-network-process
 207                                     :name "bar"
 208                                     :buffer (generate-new-buffer "*foo*")
 209                                     :nowait t
 210                                     :tls-parameters
 211                                     (cons 'gnutls-x509pki
 212                                           (gnutls-boot-parameters
 213                                            :hostname "localhost"))
 214                                     :host "localhost"
 215                                     :service 44331))))
 216                 (< (setq times (1+ times)) 10))
 217       (sit-for 0.1))
 218     (should proc)
 219     (while (eq (process-status proc) 'connect)
 220       (sit-for 0.1))
 221     (delete-process server)
 222     (setq status (gnutls-peer-status proc))
 223     (should (consp status))
 224     (delete-process proc)
 225     (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
 226       (should (stringp issuer))
 227       (setq issuer (split-string issuer ","))
 228       (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 229
 230 (ert-deftest connect-to-tls-ipv6-nowait ()
 231   (skip-unless (executable-find "gnutls-serv"))
 232   (skip-unless (gnutls-available-p))
 233   (let ((server (make-tls-server 44333))
 234         (times 0)
 235         proc status)
 236     (sleep-for 1)
 237     (with-current-buffer (process-buffer server)
 238       (message "gnutls-serv: %s" (buffer-string)))
 239
 240     ;; It takes a while for gnutls-serv to start.
 241     (while (and (null (ignore-errors
 242                         (setq proc (make-network-process
 243                                     :name "bar"
 244                                     :buffer (generate-new-buffer "*foo*")
 245                                     :family 'ipv6
 246                                     :nowait t
 247                                     :tls-parameters
 248                                     (cons 'gnutls-x509pki
 249                                           (gnutls-boot-parameters
 250                                            :hostname "localhost"))
 251                                     :host "::1"
 252                                     :service 44333))))
 253                 (< (setq times (1+ times)) 10))
 254       (sit-for 0.1))
 255     (should proc)
 256     (while (eq (process-status proc) 'connect)
 257       (sit-for 0.1))
 258     (delete-process server)
 259     (setq status (gnutls-peer-status proc))
 260     (should (consp status))
 261     (delete-process proc)
 262     (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
 263       (should (stringp issuer))
 264       (setq issuer (split-string issuer ","))
 265       (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 266
 267 ;;; network-stream-tests.el ends here