Index: openssl.scm
===================================================================
--- openssl.scm	(revision 36801)
+++ openssl.scm	(working copy)
@@ -24,6 +24,8 @@
    ssl-load-private-key!
    ssl-set-verify!
    ssl-load-verify-root-certificates!
+   ssl-load-default-root-certificates!
+   ssl-load-default-root-certificates?
    ssl-load-suggested-certificate-authorities!
    ssl-peer-verified?
    ssl-peer-subject-name ssl-peer-issuer-name
@@ -775,6 +777,16 @@
     " : SSL_VERIFY_NONE), NULL);\n")
    (ssl-unwrap-context obj) v))
 
+;; load system default root certificates into SSL context
+(define (ssl-load-default-root-certificates! obj)
+  (ssl-clear-error)
+  (unless (eq?
+	   ((foreign-lambda
+	     int "SSL_CTX_set_default_verify_paths" c-pointer)
+	    (ssl-unwrap-context obj))
+	   1)
+    (ssl-abort 'ssl-set-default-verify-paths! #f)))
+
 ;; load trusted root certificates into SSL context
 (define (ssl-load-verify-root-certificates! obj pathname #!optional (dirname #f))
   (if pathname (##sys#check-string pathname))
@@ -843,21 +855,23 @@
 
 ;;; wrappers with secure defaults
 
+;; deprecated; unused
 (define ssl-default-certificate-authority-directory
-  (make-parameter
-   (cond-expand
-    (unix "/etc/ssl/certs")
-    (else "certs"))))
+  (make-parameter #f))
 
+(define ssl-load-default-root-certificates?
+  (make-parameter #t))
+
 (define (ssl-make-client-context* #!key (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? #t))
-  (unless (or certificate-authorities certificate-authority-directory)
-    (set! certificate-authority-directory (ssl-default-certificate-authority-directory)))
   (let ((ctx (ssl-make-client-context protocol)))
     (ssl-set-cipher-list! ctx cipher-list)
     (when certificate
       (ssl-load-certificate-chain! ctx certificate)
       (ssl-load-private-key! ctx private-key private-key-type private-key-asn1?))
-    (ssl-load-verify-root-certificates! ctx certificate-authorities certificate-authority-directory)
+    (when ssl-load-default-root-certificates?
+        (ssl-load-default-root-certificates! ctx))
+    (when (or certificate-authorities certificate-authority-directory)
+      (ssl-load-verify-root-certificates! ctx certificate-authorities certificate-authority-directory))
     (ssl-set-verify! ctx verify?)
     ctx))
 
@@ -865,8 +879,6 @@
   (ssl-connect hostname port (apply ssl-make-client-context* args) sni-name))
 
 (define (ssl-listen* #!key hostname (port 0) (backlog 4) (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? #f))
-  (unless (or certificate-authorities certificate-authority-directory)
-    (set! certificate-authority-directory (ssl-default-certificate-authority-directory)))
   (let ((ear (ssl-listen port backlog hostname protocol)))
     (ssl-set-cipher-list! ear cipher-list)
     (ssl-load-certificate-chain! ear certificate)
@@ -873,13 +885,14 @@
     (ssl-load-private-key! ear private-key private-key-type private-key-asn1?)
     (when certificate-authorities
       (ssl-load-suggested-certificate-authorities! ear certificate-authorities))
-    (ssl-load-verify-root-certificates! ear certificate-authorities certificate-authority-directory)
+    (when ssl-load-default-root-certificates?
+        (ssl-load-default-root-certificates! ear))
+    (when (or certificate-authorities certificate-authority-directory)
+      (ssl-load-verify-root-certificates! ear certificate-authorities certificate-authority-directory))
     (ssl-set-verify! ear verify?)
     ear))
 
 (define (ssl-start* server? tcp-in tcp-out #!key (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? (not server?)) sni-name)
-  (unless (or certificate-authorities certificate-authority-directory)
-    (set! certificate-authority-directory (ssl-default-certificate-authority-directory)))
   ;; ssl-wrap-client-context only serves a technical purpose here,
   ;; as the plain context pointer needs to be wrapped somehow.
   (let ((ctx (ssl-wrap-client-context (ssl-ctx-new protocol server?))))
@@ -889,7 +902,10 @@
       (ssl-load-private-key! ctx private-key private-key-type private-key-asn1?))
     (when certificate-authorities
       (ssl-load-suggested-certificate-authorities! ctx certificate-authorities))
-    (ssl-load-verify-root-certificates! ctx certificate-authorities certificate-authority-directory)
+    (when ssl-load-default-root-certificates?
+        (ssl-load-default-root-certificates! ctx))
+    (when (or certificate-authorities certificate-authority-directory)
+      (ssl-load-verify-root-certificates! ctx certificate-authorities certificate-authority-directory))
     (ssl-set-verify! ctx verify?)
     (let* ((fd (net-unwrap-tcp-ports tcp-in tcp-out))
            (ssl (ssl-new (ssl-unwrap-client-context ctx))))
