Merge pull request #115 from fukamachi/woo-ssl

SSL support with CL+SSL.

.github/workflows/ci.yml

@@ -14,6 +14,8 @@ jobs:
       - uses: actions/checkout@v4
       - name: Install dependencies from APT
         run: sudo apt-get install -y libev-dev gcc libc6-dev
+      - name: Generate server certificates
+        run: sh ./t/generate-certificates.sh
       - name: Install Roswell
         env:
           LISP: ${{ matrix.lisp }}
@@ -24,6 +26,8 @@ jobs:
         run: ros -e '(ql-dist:install-dist "http://dist.ultralisp.org/" :prompt nil)'
       - name: Install Rove
         run: ros install rove
+      - name: Install the latest Clack (for HTTPS testing with clack-test)
+        run: ros install fukamachi/clack
       - name: Run tests
         env:
           LISP: ${{ matrix.lisp }}

.gitignore

@@ -12,3 +12,4 @@ benchmark/benchmark.log
 .qlot/
 qlfile
 qlfile.lock
+t/certs/

src/ev/socket.lisp

@@ -49,6 +49,7 @@
            :socket-data
            :socket-read-cb
            :socket-open-p
+           :socket-ssl-handle
            :check-socket-open
 
            :write-socket-data
@@ -74,6 +75,7 @@
   (tcp-read-cb nil :type symbol)
   (read-cb nil :type (or null function))
   (write-cb nil :type (or null function))
+  (ssl-handle nil :type (or null cffi:foreign-pointer))
   (open-p t :type boolean)
 
   (buffer (make-output-buffer #+lispworks :output #+lispworks :static))
@@ -183,29 +185,51 @@
     (cffi:with-pointer-to-vector-data (data-sap data)
       (let* ((len (length data))
              (completedp nil)
-             (n (wsys:write fd data-sap len)))
+             (ssl-handle (socket-ssl-handle socket))
+             (n
+               #+woo-no-ssl
+               (wsys:write fd data-sap len)
+               #-woo-no-ssl
+               (if ssl-handle
+                   (cl+ssl::ssl-write ssl-handle
+                                      data-sap
+                                      len)
+                   (wsys:write fd data-sap len))))
         (declare (type fixnum len)
                  (type fixnum n))
         (case n
           (-1
-           (let ((errno (wsys:errno)))
-             (return-from flush-buffer
-               (cond
-                 ((or (= errno wsys:EWOULDBLOCK)
-                      (= errno wsys:EINTR))
-                  nil)
-                 ((or (= errno wsys:ECONNABORTED)
-                      (= errno wsys:ECONNREFUSED)
-                      (= errno wsys:ECONNRESET)
-                      (= errno wsys:EPIPE)
-                      (= errno wsys:ENOTCONN))
-                  (vom:error "Connection is already closed (Code: ~D)" errno)
-                  (close-socket socket)
-                  t)
-                 (t
-                  (vom:error "Unexpected error (Code: ~D)" errno)
-                  (close-socket socket)
-                  t)))))
+           (if ssl-handle
+               #+woo-no-ssl (close-socket socket)
+               #-woo-no-ssl
+               (let ((errno (cl+ssl::ssl-get-error ssl-handle n)))
+                 (declare (type fixnum errno))
+                 (cond
+                   ((or (= errno cl+ssl::+ssl-error-zero-return+)
+                        (= errno cl+ssl::+ssl-error-ssl+))
+                    (close-socket socket))
+                   ((= errno cl+ssl::+ssl-error-want-write+))
+                   (t
+                    (vom:error "Unexpected error (Code: ~D)" errno)
+                    (close-socket socket))))
+               (let ((errno (wsys:errno)))
+                 (return-from flush-buffer
+                   (cond
+                     ((or (= errno wsys:EWOULDBLOCK)
+                          (= errno wsys:EINTR))
+                      nil)
+                     ((or (= errno wsys:ECONNABORTED)
+                          (= errno wsys:ECONNREFUSED)
+                          (= errno wsys:ECONNRESET)
+                          (= errno wsys:EPIPE)
+                          (= errno wsys:ENOTCONN))
+                      (vom:error "Connection is already closed (Code: ~D)" errno)
+                      (close-socket socket)
+                      t)
+                     (t
+                      (vom:error "Unexpected error (Code: ~D)" errno)
+                      (close-socket socket)
+                      t))))))
           (otherwise
            (setf (socket-last-activity socket) (lev:ev-now *evloop*))
            (if (= n len)

src/ev/tcp.lisp

@@ -10,6 +10,7 @@
   (:import-from :woo.ev.socket
                 :make-socket
                 :close-socket
+                :socket-ssl-handle
                 :socket-fd
                 :socket-read-cb
                 :socket-read-watcher
@@ -95,27 +96,48 @@
   (let* ((fd (io-fd watcher))
          (buffer-len (length *input-buffer*))
          (socket (deref-data-from-pointer fd))
-         (read-cb (socket-read-cb socket)))
+         (read-cb (socket-read-cb socket))
+         (ssl-handle (socket-ssl-handle socket)))
     (loop
-      (let ((n (wsys:read fd (static-vectors:static-vector-pointer *input-buffer*) buffer-len)))
+      (let ((n
+              #+woo-no-ssl
+              (wsys:read fd (static-vectors:static-vector-pointer *input-buffer*) buffer-len)
+              #-woo-no-ssl
+              (if ssl-handle
+                  (cl+ssl::ssl-read ssl-handle (static-vectors:static-vector-pointer *input-buffer*) buffer-len)
+                  (wsys:read fd (static-vectors:static-vector-pointer *input-buffer*) buffer-len))))
         (declare (type fixnum n))
         (case n
           (-1
-           (let ((errno (wsys:errno)))
-             (cond
-               ((or (= errno wsys:EWOULDBLOCK)
-                    (= errno wsys:EINTR)))
-               ((or (= errno wsys:ECONNABORTED)
-                    (= errno wsys:ECONNREFUSED)
-                    (= errno wsys:ECONNRESET))
-                (vom:error "Connection is already closed (Code: ~D)" errno)
-                (close-socket socket))
-               ((= errno wsys:EAGAIN)
-                ;; Just to nothing
-                )
-               (t
-                (vom:error "Unexpected error (Code: ~D)" errno)
-                (close-socket socket))))
+           (if ssl-handle
+               #+woo-no-ssl (close-socket socket)
+               #-woo-no-ssl
+               (let ((errno (cl+ssl::ssl-get-error ssl-handle n)))
+                 (declare (type fixnum errno))
+                 (cond
+                   ((or (= errno cl+ssl::+ssl-error-zero-return+)
+                        (= errno cl+ssl::+ssl-error-ssl+))
+                    (close-socket socket))
+                   ((= errno cl+ssl::+ssl-error-want-read+))
+                   (t
+                    (vom:error "Unexpected error (Code: ~D)" errno)
+                    (close-socket socket))))
+               (let ((errno (wsys:errno)))
+                 (declare (type fixnum errno))
+                 (cond
+                   ((or (= errno wsys:EWOULDBLOCK)
+                        (= errno wsys:EINTR)))
+                   ((or (= errno wsys:ECONNABORTED)
+                        (= errno wsys:ECONNREFUSED)
+                        (= errno wsys:ECONNRESET))
+                    (vom:error "Connection is already closed (Code: ~D)" errno)
+                    (close-socket socket))
+                   ((= errno wsys:EAGAIN)
+                    ;; Just to nothing
+                    )
+                   (t
+                    (vom:error "Unexpected error (Code: ~D)" errno)
+                    (close-socket socket)))))
            (return))
           (0
            ;; EOF

src/ssl.lisp

@@ -0,0 +1,32 @@
+(defpackage woo.ssl
+  (:use :cl)
+  (:import-from :cl+ssl
+                :with-new-ssl
+                :install-nonblock-flag
+                :ssl-set-fd
+                :ssl-set-accept-state
+                :*default-cipher-list*
+                :ssl-set-cipher-list
+                :with-pem-password
+                :install-key-and-cert)
+  (:import-from :woo.ev.socket
+                :socket-fd
+                :socket-ssl-handle)
+  (:export :init-ssl-handle))
+(in-package :woo.ssl)
+
+(defun init-ssl-handle (socket ssl-cert-file ssl-key-file ssl-key-password)
+  (let ((client-fd (socket-fd socket)))
+    (with-new-ssl (handle)
+      (install-nonblock-flag client-fd)
+      (ssl-set-fd handle client-fd)
+      (ssl-set-accept-state handle)
+      (when *default-cipher-list*
+        (ssl-set-cipher-list handle *default-cipher-list*))
+      (setf (socket-ssl-handle socket) handle)
+      (with-pem-password ((or ssl-key-password ""))
+        (install-key-and-cert
+         handle
+         ssl-key-file
+         ssl-cert-file))
+      socket)))

src/woo.lisp

@@ -20,6 +20,8 @@
                 :socket-remote-addr
                 :socket-remote-port
                 :with-sockaddr)
+  #-woo-no-ssl
+  (:import-from :woo.ssl)
   (:import-from :woo.util
                 :integer-string-p)
   (:import-from :quri
@@ -60,10 +62,14 @@
 (defvar *default-worker-num* nil)
 
 (defun run (app &key (debug t)
-                  (port 5000) (address "127.0.0.1")
-                  listen ;; UNIX domain socket
-                  (backlog *default-backlog-size*) fd
-                  (worker-num *default-worker-num*))
+                     (port 5000) (address "127.0.0.1")
+                     listen ;; UNIX domain socket
+                     (backlog *default-backlog-size*) fd
+                     (worker-num *default-worker-num*)
+                     ssl-key-file
+                     ssl-cert-file
+                     ssl-key-password)
+  (declare (ignorable ssl-key-password))
   (assert (and (integerp backlog)
                (plusp backlog)
                (<= backlog 128)))
@@ -76,8 +82,15 @@
 
   (let ((*app* app)
         (*debug* debug)
-        (*listener* nil))
+        (*listener* nil)
+        (ssl (or ssl-key-file ssl-cert-file)))
     (labels ((start-socket (socket)
+               #-woo-no-ssl
+               (when ssl
+                 (woo.ssl:init-ssl-handle socket
+                                          ssl-cert-file
+                                          ssl-key-file
+                                          ssl-key-password))
                (setup-parser socket)
                (woo.ev.tcp:start-listening-socket socket))
              (start-multithread-server ()
@@ -120,6 +133,22 @@
                                                 :fd fd
                                                 :sockopt wsock:+SO-REUSEADDR+)))
                      (wev:close-tcp-server *listener*))))))
+      (when ssl
+        #+woo-no-ssl
+        (warn "SSL certificate is specified but Woo's SSL feature is off. Ignored.")
+        #-woo-no-ssl
+        (progn
+          (cl+ssl::ensure-initialized)
+          (when ssl-key-file
+            (setf ssl-key-file
+                  (uiop:native-namestring
+                   (or (probe-file ssl-key-file)
+                       (error "SSL private key file '~A' does not exist." ssl-key-file)))))
+          (when ssl-cert-file
+            (setf ssl-cert-file
+                  (uiop:native-namestring
+                   (or (probe-file ssl-cert-file)
+                       (error "SSL certificate '~A' does not exist." ssl-cert-file)))))))
       (if worker-num
           (start-multithread-server)
           (start-singlethread-server)))))
@@ -346,19 +375,38 @@
              (setf (getf headers :content-length) 0))
            (write-response-headers socket status headers (not close))))
         (pathname
-         (let* ((fd (wsys:open body))
-                (size #+lispworks (sys:file-size body)
-                      #+(or sbcl ccl) (fd-file-size fd)
-                      #-(or sbcl ccl lispworks) (file-size body)))
-           (unless (getf headers :content-length)
-             (setf (getf headers :content-length) size))
-           (unless (getf headers :content-type)
-             (setf (getf headers :content-type) (mimes:mime body)))
-           (wev:with-async-writing (socket :write-cb (and close
-                                                          (lambda (socket)
-                                                            (wev:close-socket socket))))
-             (write-response-headers socket status headers (not close))
-             (woo.ev.socket:send-static-file socket fd size))))
+         (cond
+           ((woo.ev.socket:socket-ssl-handle socket)
+            (with-open-file (in body :element-type '(unsigned-byte 8))
+              (let ((size (file-length in)))
+                (unless (getf headers :content-length)
+                  (setf (getf headers :content-length) size))
+                (unless (getf headers :content-type)
+                  (setf (getf headers :content-type) (mimes:mime body)))
+                (wev:with-async-writing (socket :write-cb (and close
+                                                               (lambda (socket)
+                                                                 (wev:close-socket socket))))
+                  (write-response-headers socket status headers (not close))
+                  ;; Future task: Use OpenSSL's SSL_sendfile which uses Kernel TLS.
+                  ;; TODO: Stop allocating an input buffer every time
+                  (loop with buffer = (make-array 4096 :element-type '(unsigned-byte 8))
+                        for n = (read-sequence buffer in)
+                        do (wev:write-socket-data socket buffer :end n)
+                        while (= n 4096))))))
+           (t
+            (let* ((fd (wsys:open body))
+                   (size #+lispworks (sys:file-size body)
+                         #+(or sbcl ccl) (fd-file-size fd)
+                         #-(or sbcl ccl lispworks) (file-size body)))
+              (unless (getf headers :content-length)
+                (setf (getf headers :content-length) size))
+              (unless (getf headers :content-type)
+                (setf (getf headers :content-type) (mimes:mime body)))
+              (wev:with-async-writing (socket :write-cb (and close
+                                                             (lambda (socket)
+                                                               (wev:close-socket socket))))
+                (write-response-headers socket status headers (not close))
+                (woo.ev.socket:send-static-file socket fd size))))))
         (list
          (wev:with-async-writing (socket :write-cb (and close
                                                         (lambda (socket)

t/generate-certificates.sh

@@ -0,0 +1,15 @@
+#!/bin/sh
+
+mkdir t/certs
+cd t/certs
+
+openssl genrsa -out localCA.key 2048
+openssl req -batch -new -key localCA.key -out localCA.csr \
+  -subj "/C=JP/ST=Tokyo/L=Chuo-ku/O=\"Woo\"/OU=Development/CN=localhost"
+openssl x509 -req -days 3650 -signkey localCA.key -in localCA.csr -out localCA.crt
+openssl x509 -text -noout -in localCA.crt
+openssl genrsa -out localhost.key 2048
+openssl req -batch -new -key localhost.key -out localhost.csr \
+  -subj "/C=JP/ST=Tokyo/L=Chuo-ku/O=\"Woo\"/OU=Development/CN=localhost"
+echo 'subjectAltName = DNS:localhost, DNS:localhost.localdomain, IP:127.0.0.1, DNS:app, DNS:app.localdomain' > localhost.csx
+openssl x509 -req -days 1825 -CA localCA.crt -CAkey localCA.key -CAcreateserial -in localhost.csr -extfile localhost.csx -out localhost.crt

t/woo.lisp

@@ -6,3 +6,11 @@
 
 (deftest woo-server-tests
   (clack.test.suite:run-server-tests :woo))
+
+(deftest woo-ssl-server-tests
+  (let ((clack.test:*clackup-additional-args*
+          '(:ssl-cert-file #P"t/certs/localhost.crt"
+            :ssl-key-file #P"t/certs/localhost.key"))
+        (dex:*not-verify-ssl* t)
+        (clack.test:*use-https* t))
+    (clack.test.suite:run-server-tests :woo)))

woo.asd

@@ -17,13 +17,14 @@
                "trivial-mimes"
                "vom"
                "alexandria"
-               #+sbcl "sb-posix"
-               #+(and linux (not asdf3)) "uiop"
-               #+sbcl "sb-concurrency"
-               #-sbcl "cl-speedy-queue")
+               (:feature :sbcl "sb-posix")
+               (:feature (:and :linux (:not :asdf3)) "uiop")
+               (:feature :sbcl "sb-concurrency")
+               (:feature (:not :sbcl) "cl-speedy-queue")
+               (:feature (:not :woo-no-ssl) "cl+ssl"))
   :components ((:module "src"
                 :components
-                ((:file "woo" :depends-on ("ev" "response" "worker" "signal" "specials" "util"))
+                ((:file "woo" :depends-on ("ev" "response" "worker" "ssl" "signal" "specials" "util"))
                  (:file "response" :depends-on ("ev"))
                  (:file "ev" :depends-on ("ev-packages"))
                  (:file "worker" :depends-on ("ev" "queue" "specials"))
@@ -37,6 +38,9 @@
                    (:file "tcp" :depends-on ("event-loop" "socket" "util" "condition"))
                    (:file "condition")
                    (:file "util")))
+                 (:file "ssl"
+                  :depends-on ("ev-packages")
+                  :if-feature (:not :woo-no-ssl))
                  (:module "llsocket"
                   :depends-on ("syscall")
                   :serial t