Skip to content

Commit

Permalink
HTTPS support for static files.
Browse files Browse the repository at this point in the history
  • Loading branch information
@fukamachi
fukamachi committed Aug 11, 2024
1 parent 74ef1df commit 168c584
Show file tree
Hide file tree
Showing 3 changed files with 62 additions and 59 deletions.
33 changes: 15 additions & 18 deletions src/ev/socket.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -49,7 +49,7 @@
:socket-data
:socket-read-cb
:socket-open-p
:socket-ssl-stream
:socket-ssl-handle
:check-socket-open

:write-socket-data
Expand All @@ -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))
Expand Down Expand Up @@ -150,28 +150,21 @@
(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)
(type (unsigned-byte 8) byte))
(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)
Expand All @@ -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
Expand Down
35 changes: 12 additions & 23 deletions src/ev/tcp.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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))
Expand Down
53 changes: 35 additions & 18 deletions src/woo.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down

0 comments on commit 168c584

Please sign in to comment.