ssl-set-global-default-verify-paths

ffi.lisp

@@ -245,18 +245,9 @@
     :pointer                            ; *X509_NAME
   (x509 :pointer))
 
-(cffi:defcfun ("SSL_CTX_get_cert_store" ssl-ctx-get-cert-store)
-    :pointer
-  (ctx :pointer))
-(cffi:defcfun ("SSL_CTX_set_cert_store" ssl-ctx-set-cert-store)
-    :void
-  (ctx :pointer)
-  (x509-store :pointer))
-(cffi:defcfun ("X509_STORE_new" x509-store-new)
-    :pointer)
-(cffi:defcfun("X509_STORE_set_default_paths" x509-store-set-default-paths)
+(cffi:defcfun ("SSL_CTX_set_default_verify_paths" ssl-ctx-set-default-verify-paths)
     :int
-  (x509-store :pointer))
+  (ctx :pointer))
 
 ;;; Funcall wrapper
 ;;;

package.lisp

@@ -19,6 +19,7 @@
            #:random-bytes
            #:ssl-check-verify-p
            #:ssl-load-global-verify-locations
+           #:ssl-set-global-default-verify-paths
            #:ssl-error-verify
            #:ssl-error-stream
            #:ssl-error-code))

ssl-verify-test.lisp

@@ -115,8 +115,8 @@ T6MVYory7prWbBaGPKsGw0VgrV9OGbxhbw9EOEYSOgdejvbi9VhgMvEpDYFN7Hnq
 (defun test-loom-client (&optional show-text-p)
   (test-https-client-2 "secure.loom.cc" :show-text-p show-text-p))
 
-(defun test-google-client (&optional show-text-p)
-  (test-https-client-2 "encrypted.google.com" :show-text-p show-text-p))
+(defun test-yahoo-client (&optional show-text-p)
+  (test-https-client-2 "yahoo.com" :show-text-p show-text-p))
 
 (defmacro expecting-no-errors (&body body)
   `(handler-case
@@ -135,17 +135,29 @@ T6MVYory7prWbBaGPKsGw0VgrV9OGbxhbw9EOEYSOgdejvbi9VhgMvEpDYFN7Hnq
      (unless got-error-p
        (error "Did not get expected error."))))
 
-(defun test-verify ()
-  (expecting-no-errors
-    (reload)
-    (test-loom-client)
-    (test-google-client)
-    (setf (ssl-check-verify-p) t))
-  (expecting-no-errors
-    (test-google-client))
-  (expecting-error (ssl-error-verify)
-    (test-loom-client))
-  (install-rayservers-ca-certificate)
-  (expecting-no-errors
-    (test-loom-client)))
-    
+(defun test-verify (&optional quietly)
+  (let ((*standard-output*
+         ;; test-https-client-2 prints the certificate names
+         (if quietly (make-broadcast-stream) *standard-output*)))
+    (expecting-no-errors
+      (reload)
+      (test-loom-client)
+      (test-yahoo-client)
+      (setf (ssl-check-verify-p) t))
+    ;; The Mac appears to have no way to get rid of the default CA certificates
+    ;; #+darwin-host is only true in Clozure Common Lisp running on a Mac,
+    ;; So this test will fail in SBCL on a Mac
+    #-darwin-host
+    (expecting-error (ssl-error-verify)
+      (test-yahoo-client))
+    #+darwin-host
+    (expecting-no-errors
+      (test-yahoo-client))
+    (expecting-error (ssl-error-verify)
+      (test-loom-client))
+    (expecting-no-errors
+      (install-rayservers-ca-certificate)
+      (test-loom-client))
+    (expecting-no-errors
+      (ssl-set-global-default-verify-paths)
+      (test-yahoo-client))))

streams.lisp

@@ -258,6 +258,7 @@
   "PATHNAMES is a list of pathnames to PEM files containing server and CA certificates.
 Install these certificates to use for verifying on all SSL connections.
 After RELOAD, you need to call this again."
+  (ensure-initialized)
   (dolist (path pathnames)
     (let ((namestring (namestring (truename path))))
       (cffi:with-foreign-strings ((cafile namestring))
@@ -267,6 +268,13 @@ After RELOAD, you need to call this again."
                         (cffi:null-pointer)))
           (error "ssl-ctx-load-verify-locations failed."))))))
 
+(defun ssl-set-global-default-verify-paths ()
+  "Load the system default verification certificates.
+After RELOAD, you need to call this again."
+  (ensure-initialized)
+  (unless (eql 1 (ssl-ctx-set-default-verify-paths *ssl-global-context*))
+    (error "ssl-ctx-set-default-verify-paths failed.")))
+
 (defun ssl-check-verify-p ()
   "Return true if SSL connections will error if the certificate doesn't verify."
   (and *ssl-check-verify-p* (not (eq *ssl-check-verify-p* :unspecified))))