ssl.lisp 1 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
2
3 ;;; Copyright (c) 2004-2010, Dr. Edmund Weitz. All rights reserved.
4
5 ;;; Redistribution and use in source and binary forms, with or without
6 ;;; modification, are permitted provided that the following conditions
7 ;;; are met:
8
9 ;;; * Redistributions of source code must retain the above copyright
10 ;;; notice, this list of conditions and the following disclaimer.
11
12 ;;; * Redistributions in binary form must reproduce the above
13 ;;; copyright notice, this list of conditions and the following
14 ;;; disclaimer in the documentation and/or other materials
15 ;;; provided with the distribution.
16
17 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
18 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
19 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
20 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
21 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
22 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
23 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
24 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
25 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28
29 (in-package :hunchentoot)
30
31 (defclass ssl-acceptor (acceptor)
32 ((ssl-certificate-file :initarg :ssl-certificate-file
33 :reader acceptor-ssl-certificate-file
34 :documentation "A pathname designator for a
35 certificate file in PEM format.")
36 (ssl-privatekey-file :initarg :ssl-privatekey-file
37 :reader acceptor-ssl-privatekey-file
38 :documentation "A pathname designator for a
39 private key file in PEM format, or \(only on LispWorks) NIL if the
40 certificate file contains the private key.")
41 (ssl-privatekey-password :initform nil
42 :initarg :ssl-privatekey-password
43 :reader acceptor-ssl-privatekey-password
44 :documentation "The password for the
45 private key file or NIL for no password."))
46 (:default-initargs
47 :port 443)
48 (:documentation "Create and START an instance of this class
49 \(instead of ACCEPTOR) if you want an https server. There are two
50 required initargs, :SSL-CERTIFICATE-FILE and :SSL-PRIVATEKEY-FILE, for
51 pathname designators denoting the certificate file and the key file in
52 PEM format. On LispWorks, you can have both in one file in which case
53 the second initarg is optional. You can also use the
54 :SSL-PRIVATEKEY-PASSWORD initarg to provide a password \(as a string)
55 for the key file \(or NIL, the default, for no password).
56
57 The default port for SSL-ACCEPTOR instances is 443 instead of 80"))
58
59 ;; general implementation
60
61 (defmethod acceptor-ssl-p ((acceptor ssl-acceptor))
62 t)
63
64 (defmethod initialize-instance :after ((acceptor ssl-acceptor) &rest initargs)
65 (declare (ignore initargs))
66 ;; LispWorks can read both from the same file, so we can default one
67 #+:lispworks
68 (unless (slot-boundp acceptor 'ssl-privatekey-file)
69 (setf (slot-value acceptor 'ssl-privatekey-file)
70 (acceptor-ssl-certificate-file acceptor)))
71 ;; OpenSSL doesn't know much about Lisp pathnames...
72 (setf (slot-value acceptor 'ssl-privatekey-file)
73 (namestring (truename (acceptor-ssl-privatekey-file acceptor)))
74 (slot-value acceptor 'ssl-certificate-file)
75 (namestring (truename (acceptor-ssl-certificate-file acceptor)))))
76
77 ;; usocket implementation
78
79 #-:lispworks
80 (defmethod initialize-connection-stream ((acceptor ssl-acceptor) stream)
81 ;; attach SSL to the stream if necessary
82 (call-next-method acceptor
83 (cl+ssl:make-ssl-server-stream stream
84 :certificate (acceptor-ssl-certificate-file acceptor)
85 :key (acceptor-ssl-privatekey-file acceptor)
86 :password (acceptor-ssl-privatekey-password acceptor))))
87
88 ;; LispWorks implementation
89
90 #+:lispworks
91 (defun make-ssl-server-stream (socket-stream &key certificate-file privatekey-file privatekey-password)
92 "Given the acceptor socket stream SOCKET-STREAM attaches SSL to the
93 stream using the certificate file CERTIFICATE-FILE and the private key
94 file PRIVATEKEY-FILE. Both of these values must be namestrings
95 denoting the location of the files and will be fed directly to
96 OpenSSL. If PRIVATEKEY-PASSWORD is not NIL then it should be the
97 password for the private key file \(if necessary). Returns the
98 stream."
99 (flet ((ctx-configure-callback (ctx)
100 (when privatekey-password
101 (comm:set-ssl-ctx-password-callback ctx :password privatekey-password))
102 (comm:ssl-ctx-use-certificate-file ctx
103 certificate-file
104 comm:ssl_filetype_pem)
105 (comm:ssl-ctx-use-privatekey-file ctx
106 privatekey-file
107 comm:ssl_filetype_pem)))
108 (comm:attach-ssl socket-stream
109 :ctx-configure-callback #'ctx-configure-callback)
110 socket-stream))
111
112 #+:lispworks
113 (defmethod initialize-connection-stream ((acceptor ssl-acceptor) stream)
114 ;; attach SSL to the stream if necessary
115 (call-next-method acceptor
116 (make-ssl-server-stream stream
117 :certificate-file (acceptor-ssl-certificate-file acceptor)
118 :privatekey-file (acceptor-ssl-privatekey-file acceptor)
119 :privatekey-password (acceptor-ssl-privatekey-password acceptor))))