Changeset 37358 in project

Timestamp:

03/11/19 17:56:43 (23 months ago)

Author:

wasamasa

Message:

Drop SSLv2/v3 support

File:

• release/5/openssl/trunk/openssl.scm (modified) (6 diffs)

release/5/openssl/trunk/openssl.scm

@@ -178 +178 @@
            "return(ctx);\n")
           (case protocol
-            ((sslv2-or-v3)
-             (if server
-                 ((foreign-lambda c-pointer "SSLv23_server_method"))
-                 ((foreign-lambda c-pointer "SSLv23_client_method"))))
-            ((sslv3)
-             (if server
-                 ((foreign-lambda c-pointer "SSLv3_server_method"))
-                 ((foreign-lambda c-pointer "SSLv3_client_method"))))
+            ((sslv2-or-v3 sslv3)
+             (abort
+              (make-composite-condition
+               (make-property-condition
+                'exn
+                'message "obsolete SSL connection protocol"
+                'location 'ssl-ctx-new
+                'arguments (list protocol))
+               (make-property-condition
+                'type))))
             ((tls tlsv1)
              (if server
@@ -597 +599 @@
   (context ssl-unwrap-client-context))
 
-(define (ssl-make-client-context #!optional (protocol 'sslv2-or-v3))
+(define (ssl-make-client-context #!optional (protocol 'tls))
   (ssl-wrap-client-context (ssl-ctx-new protocol #f)))
 
@@ -606 +608 @@
 
 ;; connect to SSL server
-(define (ssl-connect hostname #!optional port (ctx 'sslv2-or-v3) sni-name)
+(define (ssl-connect hostname #!optional port (ctx 'tls) sni-name)
   (let* ((ctx
           (if (ssl-client-context? ctx)
@@ -665 +667 @@
                     tcp-read-timeout tcp-write-timeout)))))
 
-(define (ssl-listen port #!optional (backlog 4) (hostname #f) (protocol 'sslv2-or-v3))
+(define (ssl-listen port #!optional (backlog 4) (hostname #f) (protocol 'tls))
   (ssl-wrap-listener
    (ssl-ctx-new protocol #t)
@@ -796 +798 @@
                (ssl-unwrap-context obj))
              1)
-      (ssl-abort 'ssl-load-verify-root-certificates! #f pathname dirname)))
+      (ssl-abort 'ssl-load-verify-root-certificates! #f pathname dirname))
     (unless (eq?
              ((foreign-lambda
@@ -802 +804 @@
               (ssl-unwrap-context obj) pathname dirname)
              1)
-      (ssl-abort 'ssl-load-verify-root-certificates! #f pathname dirname)))
+      (ssl-abort 'ssl-load-verify-root-certificates! #f pathname dirname))))
 
 ;; load suggested root certificates into SSL context