diff --git a/src/ev/socket.lisp b/src/ev/socket.lisp index ce053a4..a7e56ee 100644 --- a/src/ev/socket.lisp +++ b/src/ev/socket.lisp @@ -49,7 +49,7 @@ :socket-data :socket-read-cb :socket-open-p - :socket-ssl-stream + :socket-ssl-handle :check-socket-open :write-socket-data @@ -75,7 +75,7 @@ (tcp-read-cb nil :type symbol) (read-cb nil :type (or null function)) (write-cb nil :type (or null function)) - (ssl-stream nil :type (or null stream)) + (ssl-handle nil :type (or null cffi:foreign-pointer)) (open-p t :type boolean) (buffer (make-output-buffer #+lispworks :output #+lispworks :static)) @@ -150,18 +150,13 @@ (when (socket-open-p socket) (when write-cb-specified-p (setf (socket-write-cb socket) write-cb)) - (let ((ssl-stream (socket-ssl-stream socket))) - (if ssl-stream - (progn - (write-sequence data ssl-stream :start start :end end) - (force-output ssl-stream)) - (if (typep data '(simple-array (unsigned-byte 8) (*))) - (fast-write-sequence data - (socket-buffer socket) - start end) - (loop for i from start upto (1- end) - for byte of-type (unsigned-byte 8) = (aref data i) - do (fast-write-byte byte (socket-buffer socket)))))))) + (if (typep data '(simple-array (unsigned-byte 8) (*))) + (fast-write-sequence data + (socket-buffer socket) + start end) + (loop for i from start upto (1- end) + for byte of-type (unsigned-byte 8) = (aref data i) + do (fast-write-byte byte (socket-buffer socket)))))) (defun write-socket-byte (socket byte &key (write-cb nil write-cb-specified-p)) (declare (optimize speed) @@ -169,9 +164,7 @@ (when (socket-open-p socket) (when write-cb-specified-p (setf (socket-write-cb socket) write-cb)) - (if (socket-ssl-stream socket) - (write-byte byte (socket-ssl-stream socket)) - (fast-write-byte byte (socket-buffer socket))))) + (fast-write-byte byte (socket-buffer socket)))) (declaim (inline reset-buffer)) (defun reset-buffer (socket) @@ -192,7 +185,11 @@ (cffi:with-pointer-to-vector-data (data-sap data) (let* ((len (length data)) (completedp nil) - (n (wsys:write fd data-sap len))) + (n (if (socket-ssl-handle socket) + (cl+ssl::ssl-write (socket-ssl-handle socket) + data-sap + len) + (wsys:write fd data-sap len)))) (declare (type fixnum len) (type fixnum n)) (case n diff --git a/src/ev/tcp.lisp b/src/ev/tcp.lisp index 05b289f..5d378df 100644 --- a/src/ev/tcp.lisp +++ b/src/ev/tcp.lisp @@ -10,7 +10,7 @@ (:import-from :woo.ev.socket :make-socket :close-socket - :socket-ssl-stream + :socket-ssl-handle :socket-fd :socket-read-cb :socket-read-watcher @@ -97,16 +97,11 @@ (buffer-len (length *input-buffer*)) (socket (deref-data-from-pointer fd)) (read-cb (socket-read-cb socket)) - (ssl-stream (socket-ssl-stream socket))) + (ssl-handle (socket-ssl-handle socket))) (loop (let ((n - (if ssl-stream - (let ((handle (cl+ssl::ssl-stream-handle ssl-stream)) - (cl+ssl::*bio-blockp* nil)) - (cl+ssl::nonblocking-ssl-funcall - ssl-stream #'integerp #'cl+ssl::ssl-read handle - (static-vectors:static-vector-pointer *input-buffer*) - buffer-len)) + (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 @@ -194,21 +189,15 @@ (cffi:foreign-slot-value *dummy-sockaddr* '(:struct wsock:sockaddr-in) 'wsock::port))) (t (values nil nil))))) -(defun make-ssl-stream (client-fd) +(defun make-ssl-handle (client-fd) (cl+ssl::ensure-initialized) - (let ((stream - (make-instance 'cl+ssl::ssl-server-stream - :socket client-fd - :input-buffer-size 0 - :output-buffer-size cl+ssl::*default-buffer-size*))) - (cl+ssl::with-new-ssl (handle) - (setf (cl+ssl::ssl-stream-handle stream) handle) - (cl+ssl::install-nonblock-flag client-fd) - (cl+ssl::ssl-set-fd handle client-fd) - (cl+ssl::ssl-set-accept-state handle) - (when cl+ssl:*default-cipher-list* - (cl+ssl::ssl-set-cipher-list handle cl+ssl:*default-cipher-list*)) - stream))) + (cl+ssl::with-new-ssl (handle) + (cl+ssl::install-nonblock-flag client-fd) + (cl+ssl::ssl-set-fd handle client-fd) + (cl+ssl::ssl-set-accept-state handle) + (when cl+ssl:*default-cipher-list* + (cl+ssl::ssl-set-cipher-list handle cl+ssl:*default-cipher-list*)) + handle)) (define-c-callback tcp-accept-cb :void ((evloop :pointer) (listener :pointer) (events :int)) (declare (ignore evloop events)) diff --git a/src/woo.lisp b/src/woo.lisp index 9037145..c0e08d0 100644 --- a/src/woo.lisp +++ b/src/woo.lisp @@ -82,13 +82,11 @@ (*listener* nil)) (labels ((start-socket (socket) (when (and ssl-key-file ssl-cert-file) - (let ((ssl-stream (woo.ev.tcp::make-ssl-stream (woo.ev.socket::socket-fd socket)))) - (setf (woo.ev.socket:socket-ssl-stream socket) ssl-stream) - (setf (cl+ssl::ssl-stream-certificate ssl-stream) ssl-cert-file - (cl+ssl::ssl-stream-key ssl-stream) ssl-key-file) + (let ((ssl-handle (woo.ev.tcp::make-ssl-handle (woo.ev.socket::socket-fd socket)))) + (setf (woo.ev.socket:socket-ssl-handle socket) ssl-handle) (cl+ssl::with-pem-password ((or ssl-key-password "")) (cl+ssl::install-key-and-cert - (cl+ssl::ssl-stream-handle ssl-stream) + ssl-handle ssl-key-file ssl-cert-file)))) (setup-parser socket) @@ -371,19 +369,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)