Permalink
Browse files

v1.3.44 - add :test-ssl argument to start

If an ssl server is being started and :test-ssl is true then
check before start returns if the certificates are valid and if
not signal an error.

test added: yes
tests run: yes

<release-note>
Added a :test-ssl argument to net.aserve:start enabling
a user to test immediately if they've suppplied a valid certificate
for an incoming http SSL request.
</release-note>

Documention changes made to aserve.html.

Change-Id: I8f2b1eeae9a756d0ad0a5c2b77b10e1708f6525a
Reviewed-on: https://gerrit.franz.com:9080/6607
Reviewed-by: John Foderaro <jkf@franz.com>
Reviewed-by: Kevin Layer <layer@franz.com>
Tested-by: Kevin Layer <layer@franz.com>
  • Loading branch information...
1 parent e8e8a97 commit 4878fd63216a75ae0f4543ae9e9d9b954ac477e4 John Foderaro committed with dklayer Oct 28, 2016
Showing with 101 additions and 8 deletions.
  1. +7 −1 doc/aserve.html
  2. +22 −2 main.cl
  3. +3 −2 packages.cl
  4. +69 −3 test/t-aserve.cl
View
@@ -230,7 +230,7 @@ <h2 align="left">In<a name="introduction"></a>troduction</h2>
os-processes
external-format compress<br>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
-ssl-key ssl-password ssl-method ca-file ca-directory verify max-depth)</font></strong></p>
+ssl-key ssl-password ssl-method test-ssl ca-file ca-directory verify max-depth)</font></strong></p>
<p>If no arguments are given then <strong>start</strong>&nbsp; starts
a multi-threaded web
server on port 80, which is the standard web server
@@ -358,6 +358,12 @@ <h2 align="left">In<a name="introduction"></a>troduction</h2>
<li><span style="font-weight: bold;">ssl-method</span> - see <a
href="#ssltls">SSL/TLS</a> for the use of this argument.<br>
</li>
+ <li><span style="font-weight: bold;">test-ssl</span> - If the use of SSL is
+ specified by other arguments then this will cause an SSL test to immediately
+ be done and if it fails an error will be signalled. This allows you to
+ verify the SSL certificate is valid before the start function returns. The default value for <strong>test-ssl</strong> is nil (meaning perform no test).
+ </li>
+
<li><span style="font-weight: bold;">os-processes</span> - if given
it should be an integer number of
operating system processes in which to run AllegroServe.&nbsp; This is
View
@@ -19,7 +19,7 @@
#+ignore
(check-smp-consistency)
-(defparameter *aserve-version* '(1 3 43))
+(defparameter *aserve-version* '(1 3 44))
(eval-when (eval load)
(require :sock)
@@ -1231,10 +1231,11 @@ by keyword symbols and not by strings"
accept-hook
ssl ; enable ssl
ssl-args ; plist of make-ssl-server-stream args
- ; overrides other ssl args when specified
+ ; overrides other ssl args when specified
ssl-key ; File containing private key.
ssl-password ; for ssl: pswd to decode priv key
ssl-method ; protocols for ssl server
+ test-ssl ; test ssl cert on startup
verify
ca-file
ca-directory
@@ -1314,6 +1315,25 @@ by keyword symbols and not by strings"
:certificate ssl
:certificate-password ssl-password)
))
+
+ (if* test-ssl
+ then ;; test the accept hook to see if the
+ ;; certificates are correct
+ (let (csock psock sock)
+ (unwind-protect
+ (progn
+ (setq psock (socket:make-socket :connect :passive))
+ (setq csock (socket:make-socket
+ :connect :active
+ :remote-host "127.1"
+ :remote-port (socket:local-port psock)))
+ (setq sock (socket:accept-connection psock))
+ ;; if the verification fails the appropriate
+ ;; error will be signalled
+ (funcall accept-hook sock))
+ (progn (and sock (close sock))
+ (and psock (close psock))
+ (and csock (close csock))))))
(if* (not port-p)
then ;; ssl defaults to port 443
View
@@ -5,8 +5,9 @@
;; See the file LICENSE for the full license governing this code.
#+(version= 10 0)
-(sys:defpatch "aserve" 8
- "v8: 1.3.43: don't log when client closes connection early;
+(sys:defpatch "aserve" 9
+ "v9: 1.3.44: add :test-ssl argument to start function;
+v8: 1.3.43: don't log when client closes connection early;
v7: 1.3.42: internal improvements to server body access;
v6: 1.3.41: fix multi-directory clp file rewriting;
v5: 1.3.40: add methods for socket-bytes-read|written;
View
@@ -330,7 +330,11 @@
(stop-aserve-running)
(stop-proxy-running)
(stop-proxy-running)
- )))
+ ))
+
+ (if* (and ssl (errorset (as-require :ssl)))
+ then (test-aserve-extra-ssl))
+ )
(if* (or (> util.test::*test-errors* 0)
(> util.test::*test-successes* 0)
(> util.test::*test-unexpected-failures* 0))
@@ -342,9 +346,11 @@
-(defun start-aserve-running (&optional ssl)
+(defun start-aserve-running (&optional ssl (test-ssl t))
;; start aserve, return the port on which we've started aserve
- (let ((wserver (start :port nil :server :new :ssl-args (and ssl (list :certificate ssl))
+ (let ((wserver (start :port nil :server :new :ssl-args (and ssl (list :certificate ssl))
+ :test-ssl test-ssl
+
:listeners 20 ; must be at least 3 for keep-alive to be possible
))); let the system pick a port
(setq *wserver* wserver)
@@ -2690,6 +2696,66 @@ Returns a vector."
(test nil (null (search "after 1510" b)))
)))
+
+
+(defun test-aserve-extra-ssl ()
+ ;; tests run with no aserve server running
+ (let ((seen-error-1 nil) ; normal ssl start
+ (seen-error-2 nil) ; bogus pem file but don't test
+ (seen-error-3 nil) ; bogus pem file and do test
+
+ )
+ (let (*wserver*)
+
+ ; valid ssl startup
+ (handler-case
+ (net.aserve:start :ssl (merge-pathnames "server.pem"
+ *aserve-load-truename*)
+ :server :new
+ :port nil
+ :test-ssl t)
+ (error (c)
+ c
+ (setq seen-error-1 t)))
+
+ (test nil seen-error-1)
+ (and *wserver* (shutdown))
+
+ (setq *wserver* nil)
+
+ ;; bogus ssl cert but don't test
+ (handler-case
+ (net.aserve:start :ssl (merge-pathnames "not-exist-server.pem"
+ *aserve-load-truename*)
+ :port nil
+ :server :new
+ )
+ (error (c)
+ c
+ (setq seen-error-2 t)))
+
+ (test nil seen-error-2)
+ (and *wserver* (shutdown))
+
+ (setq *wserver* nil)
+
+ ;; bogus ssl cert and do test
+ (handler-case
+ (net.aserve:start :ssl (merge-pathnames "not-exist-server.pem"
+ *aserve-load-truename*)
+ :port nil
+ :server :new
+ :test-ssl t)
+ (error (c)
+ c
+ (setq seen-error-3 t)))
+
+ (test t seen-error-3)
+ (and *wserver* (shutdown)))))
+
+
+
+
;; (net.aserve::debug-on :xmit)
;; (net.aserve::debug-off :body)

0 comments on commit 4878fd6

Please sign in to comment.