Add a TLS connection test

* test/lisp/net/network-stream-tests.el (connect-to-tls): Add
a TLS connection test.

diff --git a/test/lisp/net/cert.pem b/test/lisp/net/cert.pem
new file mode 100644 (file)
index 0000000..4df4e92
--- /dev/null
+++ b/test/lisp/net/cert.pem
@@ -0,0 +1,25 @@
+-----BEGIN CERTIFICATE-----
+MIIELTCCAxWgAwIBAgIJAI6LqlFyaPRkMA0GCSqGSIb3DQEBCwUAMIGsMQswCQYD
+VQQGEwJBVTEYMBYGA1UECAwPTmV3IFNvdXRoIFdhbGVzMQ8wDQYDVQQHDAZTeWRu
+ZXkxITAfBgNVBAoMGEVtYWNzIFRlc3QgU2VydmljZXNzIExMQzESMBAGA1UECwwJ
+QXV0b21hdGVkMRcwFQYDVQQDDA50ZXN0LmVtYWNzLnpvdDEiMCAGCSqGSIb3DQEJ
+ARYTZW1hY3MtZGV2ZWxAZnNmLm9yZzAeFw0xNjAyMDgwNDA0MzJaFw0xNjAzMDkw
+NDA0MzJaMIGsMQswCQYDVQQGEwJBVTEYMBYGA1UECAwPTmV3IFNvdXRoIFdhbGVz
+MQ8wDQYDVQQHDAZTeWRuZXkxITAfBgNVBAoMGEVtYWNzIFRlc3QgU2VydmljZXNz
+IExMQzESMBAGA1UECwwJQXV0b21hdGVkMRcwFQYDVQQDDA50ZXN0LmVtYWNzLnpv
+dDEiMCAGCSqGSIb3DQEJARYTZW1hY3MtZGV2ZWxAZnNmLm9yZzCCASIwDQYJKoZI
+hvcNAQEBBQADggEPADCCAQoCggEBAM52lP7k1rBpctBX1irRVgDerxqlFSTkvg8L
+WmRCfwm3XY8EZWqM/8Eex5soH7myRlWfUH/cKxbqScZqXotj0hlPxdRkM6gWgHS9
+Mml7wnz2LZGvD5PfMfs+yBHKAMrqortFXCKksHsYIJ66l9gJMm1G5XjWha6CaEr/
+k2bE5Ovw0fB2B4vH0OqhJzGyenJOspXZz1ttn3h3UC5fbDXS8fUM9k/FbgJKypWr
+zB3P12GcMR939FsR5sqa8nNoCMw+WBzs4XuM5Ad+s/UtEaZvmtwvLwmdB7cgCEyM
+x5gaM969SlpOmuy7dDTCCK3lBl6B5dgFKvVcChYwSW+xJz5tfL0CAwEAAaNQME4w
+HQYDVR0OBBYEFG3YhH7ZzEdOGstkT67uUh1RylNjMB8GA1UdIwQYMBaAFG3YhH7Z
+zEdOGstkT67uUh1RylNjMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQELBQADggEB
+ADnJL2tBMnPepywA57yDfJz54FvrqRd+UAjSiB7/QySDpHnTM3b3sXWfwAkXPTjM
+c+jRW2kfdnL6OQW2tpcpPZANGnwK8MJrtGcbHhtPXjgDRhVZp64hsB7ayS+l0Dm7
+2ZBbi2SF8FgZVcQy0WD01ir2raSODo124dMrq+3aHP77YLbiNEKj+wFoDbndQ1FQ
+gtIJBE80FADoqc7LnBrpA20aVlfqhKZqe+leYDSZ+CE1iwlPdvD+RTUxVDs5EfpB
+qVOHDlzEfVmcMnddKTV8pNYuo93AG4s0KdrGG9RwSvtLaOoHd2i6RmIs+Yiumbau
+mXodMxxAEW/cM7Ita/2QVmk=
+-----END CERTIFICATE-----

diff --git a/test/lisp/net/key.pem b/test/lisp/net/key.pem
new file mode 100644 (file)
index 0000000..5db58f5
--- /dev/null
+++ b/test/lisp/net/key.pem
@@ -0,0 +1,28 @@
+-----BEGIN PRIVATE KEY-----
+MIIEvgIBADANBgkqhkiG9w0BAQEFAASCBKgwggSkAgEAAoIBAQDOdpT+5NawaXLQ
+V9Yq0VYA3q8apRUk5L4PC1pkQn8Jt12PBGVqjP/BHsebKB+5skZVn1B/3CsW6knG
+al6LY9IZT8XUZDOoFoB0vTJpe8J89i2Rrw+T3zH7PsgRygDK6qK7RVwipLB7GCCe
+upfYCTJtRuV41oWugmhK/5NmxOTr8NHwdgeLx9DqoScxsnpyTrKV2c9bbZ94d1Au
+X2w10vH1DPZPxW4CSsqVq8wdz9dhnDEfd/RbEebKmvJzaAjMPlgc7OF7jOQHfrP1
+LRGmb5rcLy8JnQe3IAhMjMeYGjPevUpaTprsu3Q0wgit5QZegeXYBSr1XAoWMElv
+sSc+bXy9AgMBAAECggEAaqHkIiGeoE5V9jTncAXeHWTlmyVX3k4luy9p6A5P/nyt
+3YevuXBJRzzWatQ2Tno8yUwXD3Ju7s7ie4/EdMmBYYFJ84AtDctRXPm6Z7B7qn6a
+2ntH2F+WOOUb/9QMxMCae44/H8VfQLQdZN2KPxHA8Z+ENPzW3mKL6vBE+PcIJLK2
+kTXQdCEIuUb1v4kxKYfjyyHAQ9yHvocUvZdodGHrpmWOr/2QCrqCjwiKnXyvdJMi
+JQ4a3dU+JG5Zwr2hScyeLgS4p+M3A2NY+oIACn2rCcsIKC6uvBK3wAbhssaY8z9c
+5kap862oMBNmPCxPuQTIIO7ptla0EWHktpFxnu7GIQKBgQDvKyXt82zGHiOZ9acx
+4fV7t3NF2MNd9fOn59NYWYRSs2gaEjit6BnsCgiKZOJJ2YFsggBiQMiWuEzwqIdW
+bOH8W5AubTxnE2OjeIpH5r8AXI6I/pKdOedM86oeElbL0p53OZqSqBK6vA5SnE76
+fZwC505h/mqH2E6AdKpcyL7sJwKBgQDc/jc4MkVnqF7xcYoJrYEbnkhwqRxIM+0Y
+HY2qXszWQPgjae3NK1rw/PEOATzWrHLvRS/utQ8yeLUAZIGsFY8+c1kjvkvl4ZK2
+OnsEOVLmEwjDqqnq3JFYCVSkXfLBGRD3wGldzkCQljOiGuJ/Co1rGHk7CfBmxX2p
+kxdts5OKewKBgQDTRsSc7Zs7cMh2a0GlmTyoa6iTHSeIy4rQ2sQimgGApSfjUBFt
+30l28G4XA4O7RT9FwZnhMeWA75JYTigwOsNvkNtPiAQB8mjksclGNxqnkRwA/RI7
+fjlMCzxOkFjIeWivXd2kjIDvIM1uQNKsCWZWUks12e/1zSmb5HPSvyuZpQKBgQDQ
+qVgKP604ysmav9HOgXy+Tx2nAoYpxp2/f2gbzZcrVfz1szdN2fnsQWh6CMEhEYMU
+WQeBJIRM65w72qp1iYXPOaqZDT0suWiFl4I/4sBbbO2BkssNb2Xs8iJxcCOeH8Td
+qVfTssNTwf7OuQPTYGtXC6ysCh5ra13Tl4cvlbdhsQKBgFHXP+919wSncLS+2ySD
+waBzG6GyVOgV+FE3DrM3Xp4S6fldWYAndKHQ1HjJVDY8SkC2Tk1D7QSQnmS+ZzYs
+YqzcnkPCTHLb6wCErs4ZiW0gn9xJnfxyv6wPujsayL4TMsmsqkj/IAB61UjwaA/a
+Z+rUw/WkcNPD59AD1J0eeSZu
+-----END PRIVATE KEY-----

diff --git a/test/lisp/net/network-stream-tests.el b/test/lisp/net/network-stream-tests.el
index f52a69e05d618d5b16c4e54996d2aa7dc4a037c0..478b8248eb3734cca0051121ebd214af62c4566b 100644 (file)
--- a/test/lisp/net/network-stream-tests.el
+++ b/test/lisp/net/network-stream-tests.el
@@ -22,6 +22,8 @@
 
 ;;; Code:
 
+(require 'gnutls)
+
 (ert-deftest make-local-unix-server ()
   (let* ((file (make-temp-name "/tmp/server-test"))
          (server
@@ -101,7 +103,7 @@
                                      :buffer (generate-new-buffer "*foo*")
                                      :host (system-name)
                                      :service port)))
-    (with-current-buffer "*foo*"
+    (with-current-buffer (process-buffer proc)
       (process-send-string proc "echo foo")
       (sleep-for 0.1)
       (should (equal (buffer-string) "foo\n")))
@@ -114,7 +116,7 @@
                                      :buffer (generate-new-buffer "*foo*")
                                      :host "localhost"
                                      :service port)))
-    (with-current-buffer "*foo*"
+    (with-current-buffer (process-buffer proc)
       (process-send-string proc "echo foo")
       (sleep-for 0.1)
       (should (equal (buffer-string) "foo\n")))
@@ -127,7 +129,7 @@
                                      :buffer (generate-new-buffer "*foo*")
                                      :host "127.0.0.1"
                                      :service port)))
-    (with-current-buffer "*foo*"
+    (with-current-buffer (process-buffer proc)
       (process-send-string proc "echo foo")
       (sleep-for 0.1)
       (should (equal (buffer-string) "foo\n")))
@@ -147,10 +149,47 @@
                     t)))
     (while (eq (process-status proc) 'connect)
       (sit-for 0.1))
-    (with-current-buffer "*foo*"
+    (with-current-buffer (process-buffer proc)
       (process-send-string proc "echo foo")
       (sleep-for 0.1)
       (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"))
+
+(ert-deftest connect-to-tls ()
+  (let ((server (make-tls-server))
+        (times 0)
+        proc status)
+    (sleep-for 1)
+    (with-current-buffer (process-buffer server)
+      (message "openssl: %s" (buffer-string)))
+
+    ;; It takes a while for openssl to start.
+    (while (and (null (ignore-errors
+                        (setq proc (make-network-process
+                                    :name "bar"
+                                    :buffer (generate-new-buffer "*foo*")
+                                    :host "localhost"
+                                    :service 44330))))
+                (< (setq times (1+ times)) 10))
+      (sit-for 0.1))
+    (should proc)
+    (gnutls-negotiate :process proc
+                      :type 'gnutls-x509pki
+                      :hostname "localhost")
+    (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")))))
+
 ;;; network-stream-tests.el ends here