1.2.50

ChangeLog

@@ -1,3 +1,13 @@
+2007-03-21  Ahmon Dancy  <dancy@dancy>
+1.2.50
+
+	* rfe6834: SSL peer verification support.  Also, 'start' function
+	now allows the SSL certificate key file to be specified separately
+	from the certificate.
+
+	* bug16677: aserve could leak file descriptors if SSL (https)
+	connection fails.  
+
 2006-12-22  John Foderaro  <jkf@tiger.franz.com>
 1.2.49
 	* when response needed a string output stream and 

client.cl

@@ -24,7 +24,7 @@
 ;; Suite 330, Boston, MA  02111-1307  USA
 ;;
 ;;
-;; $Id: client.cl,v 1.53 2006/12/22 21:11:58 jkf Exp $
+;; $Id: client.cl,v 1.54 2007/03/22 16:44:42 layer Exp $
 
 ;; Description:
 ;;   http client code.
@@ -212,7 +212,14 @@
 			(external-format *default-aserve-external-format*)
 			ssl		; do an ssl connection
 			skip-body ; fcn of request object
-			timeout  
+			timeout
+			certificate
+			key
+			certificate-password
+			ca-file
+			ca-directory
+			verify
+			max-depth
 
 			;; internal
 			recursing-call ; true if we are calling ourself
@@ -239,6 +246,13 @@
 	       :external-format external-format
 	       :ssl ssl
 	       :timeout timeout
+	       :certificate certificate
+	       :key key
+	       :certificate-password certificate-password
+	       :ca-file ca-file
+	       :ca-directory ca-directory
+	       :verify verify
+	       :max-depth max-depth
 	       )))
 
     (unwind-protect
@@ -403,10 +417,18 @@
 				      *default-aserve-external-format*)
 				     ssl
 				     timeout
+				     certificate
+				     key
+				     certificate-password
+				     ca-file
+				     ca-directory
+				     verify
+				     max-depth
 				     )
 
 
-  (declare (ignorable timeout))
+  (declare (ignorable timeout certificate key certificate-password ca-file 
+		      ca-directory verify max-depth))
 
   (let (host sock port fresh-uri scheme-default-port)
     ;; start a request 
@@ -462,8 +484,20 @@ or \"foo.com:8000\", not ~s" proxy))
 
 				  ))
 	    (if* ssl
-	       then (setq sock
-		      (funcall 'socket::make-ssl-client-stream sock)))
+	       then #+(version>= 8 0)
+		    (setq sock
+		      (funcall 'socket::make-ssl-client-stream sock 
+			       :certificate certificate
+			       :key key
+			       :certificate-password certificate-password
+			       :ca-file ca-file
+			       :ca-directory ca-directory
+			       :verify verify
+			       :max-depth max-depth))
+		    #-(version>= 8 0)
+		    (setq sock
+		      (funcall 'socket::make-ssl-client-stream sock))
+		    )
 	    )
 
     #+(and allegro (version>= 6 0))

main.cl

@@ -24,7 +24,7 @@
 ;; Suite 330, Boston, MA  02111-1307  USA
 ;;
 ;;
-;; $Id: main.cl,v 1.178 2006/12/22 21:11:58 jkf Exp $
+;; $Id: main.cl,v 1.179 2007/03/22 16:44:42 layer Exp $
 
 ;; Description:
 ;;   aserve's main loop
@@ -38,7 +38,7 @@
 
 (in-package :net.aserve)
 
-(defparameter *aserve-version* '(1 2 49))
+(defparameter *aserve-version* '(1 2 50))
 
 (eval-when (eval load)
     (require :sock)
@@ -894,8 +894,13 @@ by keyword symbols and not by strings"
 		   debug-stream  ; stream to which to send debug messages
 		   accept-hook
 		   ssl		 ; enable ssl
-		   ssl-password ; for ssl: pswd to decode priv key in cert
-		   os-processes  ; to fork and run multiple instances
+		   ssl-key       ; File containing private key. 
+		   ssl-password  ; for ssl: pswd to decode priv key
+		   verify
+		   ca-file
+		   ca-directory
+		   max-depth
+		   os-processes	 ; to fork and run multiple instances
 		   (external-format nil efp); to set external format
 		   )
   ;; -exported-
@@ -904,11 +909,11 @@ by keyword symbols and not by strings"
   ;; return the server object
   #+mswindows
   (declare (ignore setuid setgid))
-  #-(version>= 6 2 beta) 
-  (declare (ignore ssl-password))
 
   (declare (ignore debug))  ; for now
 
+  (declare (ignorable ssl-key verify ca-file ca-directory max-depth))
+
   (if* debug-stream 
      then (setq *aserve-debug-stream* 
 	    (if* (eq debug-stream t)
@@ -929,10 +934,21 @@ by keyword symbols and not by strings"
 
 	  (setq accept-hook 
 	    #'(lambda (socket)
+		#+(version>= 8 0)
+		(funcall 'socket::make-ssl-server-stream socket
+			 :certificate ssl
+			 :certificate-password ssl-password
+			 :key ssl-key
+			 :verify verify
+			 :ca-file ca-file
+			 :ca-directory ca-directory
+			 :max-depth max-depth)
+		#-(version>= 8 0)
 		(funcall 'socket::make-ssl-server-stream socket
 			 :certificate ssl
-			 #+(version>= 6 2 beta) :certificate-password 
-			 #+(version>= 6 2 beta) ssl-password)))
+			 :certificate-password ssl-password)
+		))
+
 	  (setq chunking nil) ; doesn't work well through ssl
 	  (if* (not port-p)
 	     then ; ssl defaults to port 443
@@ -1359,13 +1375,13 @@ by keyword symbols and not by strings"
   ;; When this function returns the given socket has been closed.
   ;;
 
-  ; run the accept hook on the socket if there is one
-  (let ((ahook (wserver-accept-hook *wserver*)))
-    (if* ahook then (setq sock (funcall ahook sock))))
-
-
   (unwind-protect
       (let (req error-obj (chars-seen (list nil)))
+
+	;; run the accept hook on the socket if there is one
+	(let ((ahook (wserver-accept-hook *wserver*)))
+	  (if* ahook then (setq sock (funcall ahook sock))))
+
 	;; get first command
 	(loop
 

packages.cl

@@ -1,9 +1,10 @@
 #+(version= 8 0)
-(sys:defpatch "aserve" 4
+(sys:defpatch "aserve" 5
   "v1: version 1.2.45;
 v2: version 1.2.46;
 v3: version 1.2.47;
-v4: version 1.2.48, handle HTTP `204 No Content'."
+v4: version 1.2.48, handle HTTP `204 No Content';
+v5: version 1.2.50, Enhanced SSL client/server support."
   :type :system
   :post-loadable t)
 
@@ -39,7 +40,7 @@ v4: version 1.2.48, handle HTTP `204 No Content'."
 ;; Suite 330, Boston, MA  02111-1307  USA
 ;;
 ;;
-;; $Id: packages.cl,v 1.17 2006/12/22 21:11:58 jkf Exp $
+;; $Id: packages.cl,v 1.18 2007/03/22 16:44:42 layer Exp $
 
 ;; Description:
 ;;   packages and exports for AllegroServe