From a1c19f76d666178fa228496d18778c366fced010 Mon Sep 17 00:00:00 2001
From: Thomas Schaper <thomas@libremail.nl>
Date: Sat, 3 Jun 2017 15:17:21 +0200
Subject: [PATCH 1/2] Add a test for ssl verification

---
 test/drakma-test.lisp | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/test/drakma-test.lisp b/test/drakma-test.lisp
index 7173033..d6a1ca0 100644
--- a/test/drakma-test.lisp
+++ b/test/drakma-test.lisp
@@ -48,6 +48,15 @@
       (is (> (length body-or-stream) 0))
       (is (= 200 status-code)))))
 
+(test ssl-verify
+  (let ((drakma:*header-stream* *standard-output*))
+    (multiple-value-bind (body-or-stream status-code)
+        (drakma:http-request "https://self-signed.badssl.com/" :verify :optional)
+      (is (> (length body-or-stream) 0))
+      (is (= 200 status-code)))
+    (signals cl+ssl:ssl-error-verify
+      (drakma:http-request "https://self-signed.badssl.com"))))
+
 (test post-google
   (let ((drakma:*header-stream* *standard-output*))
     (multiple-value-bind (body-or-stream status-code headers uri stream must-close reason-phrase)

From 49c17e11f44d2aa76a2ba7185487345a0f18472e Mon Sep 17 00:00:00 2001
From: Thomas Schaper <thomas@libremail.nl>
Date: Sat, 3 Jun 2017 15:17:53 +0200
Subject: [PATCH 2/2] Change the default ssl verification to `:required`

As most implementations can verify SSL certificates they should probably
do so. This also makes sure all checks that cl+ssl can do are done.
---
 request.lisp |  5 +++--
 util.lisp    | 43 ++++++++++++++++++++++++-------------------
 2 files changed, 27 insertions(+), 21 deletions(-)

diff --git a/request.lisp b/request.lisp
index de82b2f..e228f8f 100644
--- a/request.lisp
+++ b/request.lisp
@@ -193,7 +193,7 @@ headers of the chunked stream \(if any) as a second value."
                               certificate
                               key
                               certificate-password
-                              verify
+                              (verify :required)
                               (max-depth 10)
                               ca-file
                               ca-directory
@@ -272,7 +272,8 @@ is presented by the server in an SSL connection.  It can be specified
 either as NIL if no check should be performed, :OPTIONAL to verify the
 server's certificate if it presented one or :REQUIRED to verify the
 server's certificate and fail if an invalid or no certificate was
-presented.
+presented. Verification does not work when using mocl or Allegro,
+please note that it DOES work for Allegro CL Express.
 
 MAX-DEPTH can be specified to change the maximum allowed certificate
 signing depth that is accepted.  The default is 10.
diff --git a/util.lisp b/util.lisp
index 7ba39d2..a6d86d2 100644
--- a/util.lisp
+++ b/util.lisp
@@ -326,25 +326,30 @@ which are not meant as separators."
       (warn ":max-depth, :ca-file and :ca-directory arguments not available on this platform"))
     (rt:start-ssl http-stream :verify verify))
   #+(and (or :allegro-cl-express (not :allegro)) (not :mocl-ssl) (not :drakma-no-ssl))
-  (let ((s http-stream)
-        (ctx (cl+ssl:make-context :verify-depth max-depth
-                                  :verify-mode (if (eql verify :required)
-                                                   cl+ssl:+ssl-verify-peer+
-                                                   cl+ssl:+ssl-verify-none+)
-                                  :verify-location (or (and ca-file ca-directory
-                                                            (list ca-file ca-directory))
-                                                       ca-file ca-directory
-                                                       :default))))
-    (cl+ssl:with-global-context (ctx)
-      (cl+ssl:make-ssl-client-stream
-       (cl+ssl:stream-fd s)
-       :hostname hostname
-       :close-callback (lambda ()
-                         (close s)
-                         (cl+ssl:ssl-ctx-free ctx))
-       :certificate certificate
-       :key key
-       :password certificate-password)))
+  (let ((old-verify-p (cl+ssl:ssl-check-verify-p)))
+    (unwind-protect
+         (progn
+           (setf (cl+ssl:ssl-check-verify-p) (eql verify :required))
+           (let ((s http-stream)
+                 (ctx (cl+ssl:make-context :verify-depth max-depth
+                                           :verify-mode (if (eql verify :required)
+                                                            cl+ssl:+ssl-verify-peer+
+                                                            cl+ssl:+ssl-verify-none+)
+                                           :verify-location (or (and ca-file ca-directory
+                                                                     (list ca-file ca-directory))
+                                                                ca-file ca-directory
+                                                                :default))))
+             (cl+ssl:with-global-context (ctx)
+               (cl+ssl:make-ssl-client-stream
+                (cl+ssl:stream-fd s)
+                :hostname hostname
+                :close-callback (lambda ()
+                                  (close s)
+                                  (cl+ssl:ssl-ctx-free ctx))
+                :certificate certificate
+                :key key
+                :password certificate-password))))
+      (setf (cl+ssl:ssl-check-verify-p) old-verify-p)))
   #+:drakma-no-ssl
   (error "SSL not supported. Remove :drakma-no-ssl from *features* to enable SSL"))