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 ;; This file is part of GNU Emacs.
   8
   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.
  13
  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.
  18
  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/>.
  21
  22 ;;; Commentary:
  23
  24
  25 ;;; Code:
  26
  27 (require 'gnutls)
  28
  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"))
  32          (server
  33           (make-network-process
  34            :name "server"
  35            :server t
  36            :buffer (get-buffer-create "*server*")
  37            :noquery t
  38            :family 'local
  39            :service file)))
  40     (should (equal (process-contact server :local) file))
  41     (delete-file (process-contact server :local))))
  42
  43 (ert-deftest make-local-tcp-server-with-unspecified-port ()
  44   (let ((server
  45          (make-network-process
  46           :name "server"
  47           :server t
  48           :noquery t
  49           :family 'ipv4
  50           :service t
  51           :host 'local)))
  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)))
  56
  57 (ert-deftest make-local-tcp-server-with-specified-port ()
  58   (let ((server
  59          (make-network-process
  60           :name "server"
  61           :server t
  62           :noquery t
  63           :family 'ipv4
  64           :service 57869
  65           :host 'local)))
  66     (should (and (arrayp (process-contact server :local))
  67                  (= (aref (process-contact server :local) 4) 57869)))
  68     (delete-process server)))
  69
  70 (defun make-server (host)
  71   (make-network-process
  72    :name "server"
  73    :server t
  74    :noquery t
  75    :family 'ipv4
  76    :coding 'raw-text-unix
  77    :buffer (get-buffer-create "*server*")
  78    :service t
  79    :sentinel 'server-sentinel
  80    :filter 'server-process-filter
  81    :host host))
  82
  83 (defun server-sentinel (_proc _msg)
  84   )
  85
  86 (defun server-process-filter (proc string)
  87   (message "Received %s" string)
  88   (let ((prev (process-get proc 'previous-string)))
  89     (when prev
  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)))
  96     (cond
  97      ((equal (car command) "echo")
  98       (process-send-string proc (concat (cadr command) "\n")))
  99      (t
 100       ))))
 101
 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*")
 107                                      :host (system-name)
 108                                      :service port)))
 109     (with-current-buffer (process-buffer proc)
 110       (process-send-string proc "echo foo")
 111       (sleep-for 0.1)
 112       (should (equal (buffer-string) "foo\n")))
 113     (delete-process server)))
 114
 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*")
 120                                      :host "localhost"
 121                                      :service port)))
 122     (with-current-buffer (process-buffer proc)
 123       (process-send-string proc "echo foo")
 124       (sleep-for 0.1)
 125       (should (equal (buffer-string) "foo\n")))
 126     (delete-process server)))
 127
 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*")
 133                                      :host "127.0.0.1"
 134                                      :service port)))
 135     (with-current-buffer (process-buffer proc)
 136       (process-send-string proc "echo foo")
 137       (sleep-for 0.1)
 138       (should (equal (buffer-string) "foo\n")))
 139     (delete-process server)))
 140
 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*")
 146                                      :host "localhost"
 147                                      :nowait t
 148                                      :service port)))
 149     (should (eq (process-status proc) 'connect))
 150     (should (null (ignore-errors
 151                     (process-send-string proc "echo bar")
 152                     t)))
 153     (while (eq (process-status proc) 'connect)
 154       (sit-for 0.1))
 155     (with-current-buffer (process-buffer proc)
 156       (process-send-string proc "echo foo")
 157       (sleep-for 0.1)
 158       (should (equal (buffer-string) "foo\n")))
 159     (delete-process server)))
 160
 161 (defun make-tls-server ()
 162   (start-process "gnutls" (generate-new-buffer "*tls*")
 163                  "gnutls-serv" "--http"
 164                  "--x509keyfile" "lisp/net/key.pem"
 165                  "--x509certfile" "lisp/net/cert.pem"
 166                  "--port" "44330"))
 167
 168 (ert-deftest connect-to-tls-ipv4-wait ()
 169   (skip-unless (executable-find "gnutls-serv"))
 170   (skip-unless (gnutls-available-p))
 171   (let ((server (make-tls-server))
 172         (times 0)
 173         proc status)
 174     (sleep-for 1)
 175     (with-current-buffer (process-buffer server)
 176       (message "gnutls-serv: %s" (buffer-string)))
 177
 178     ;; It takes a while for gnutls-serv to start.
 179     (while (and (null (ignore-errors
 180                         (setq proc (make-network-process
 181                                     :name "bar"
 182                                     :buffer (generate-new-buffer "*foo*")
 183                                     :host "localhost"
 184                                     :service 44330))))
 185                 (< (setq times (1+ times)) 10))
 186       (sit-for 0.1))
 187     (should proc)
 188     (gnutls-negotiate :process proc
 189                       :type 'gnutls-x509pki
 190                       :hostname "localhost")
 191     (delete-process server)
 192     (setq status (gnutls-peer-status proc))
 193     (should (consp status))
 194     (delete-process proc)
 195     (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
 196       (should (stringp issuer))
 197       (setq issuer (split-string issuer ","))
 198       (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 199
 200 (ert-deftest connect-to-tls-ipv6-nowait ()
 201   (skip-unless (executable-find "gnutls-serv"))
 202   (skip-unless (gnutls-available-p))
 203   (let ((server (make-tls-server))
 204         (times 0)
 205         proc status)
 206     (sleep-for 1)
 207     (with-current-buffer (process-buffer server)
 208       (message "gnutls-serv: %s" (buffer-string)))
 209
 210     ;; It takes a while for gnutls-serv to start.
 211     (while (and (null (ignore-errors
 212                         (setq proc (make-network-process
 213                                     :name "bar"
 214                                     :buffer (generate-new-buffer "*foo*")
 215                                     :family 'ipv6
 216                                     :nowait t
 217                                     :host "::1"
 218                                     :service 44330))))
 219                 (< (setq times (1+ times)) 10))
 220       (sit-for 0.1))
 221     (should proc)
 222     (gnutls-negotiate :process proc
 223                       :type 'gnutls-x509pki
 224                       :hostname "localhost")
 225     (delete-process server)
 226     (setq status (gnutls-peer-status proc))
 227     (should (consp status))
 228     (delete-process proc)
 229     (let ((issuer (plist-get (plist-get status :certificate) :issuer)))
 230       (should (stringp issuer))
 231       (setq issuer (split-string issuer ","))
 232       (should (equal (nth 3 issuer) "O=Emacs Test Servicess LLC")))))
 233
 234 ;;; network-stream-tests.el ends here