From 3576c0930cba4449149efe131794d42538ef62f6 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Fri, 4 Mar 2016 09:15:12 -0800
Subject: [PATCH] openssl: Prefer tls1.2. Only use secure ciphers.

---
 .../io/sockets/secure/openssl/openssl.factor  | 13 +++++++++---
 basis/io/sockets/secure/secure.factor         | 20 ++++++++++++++-----
 basis/openssl/libssl/libssl.factor            |  4 ++++
 basis/openssl/openssl.factor                  |  3 +--
 4 files changed, 30 insertions(+), 10 deletions(-)

diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor
index b87e3951c9..711d4dc2c7 100644
--- a/basis/io/sockets/secure/openssl/openssl.factor
+++ b/basis/io/sockets/secure/openssl/openssl.factor
@@ -12,8 +12,9 @@ splitting unicode.case ;
 IN: io.sockets.secure.openssl
 
 GENERIC: ssl-method ( symbol -- method )
-
-M: TLSv1  ssl-method drop TLSv1_method ;
+M: TLSv1 ssl-method drop TLSv1_method ;
+M: TLSv1.1 ssl-method drop TLSv1_1_method ;
+M: TLSv1.2 ssl-method drop TLSv1_2_method ;
 
 TUPLE: openssl-context < secure-context aliens sessions ;
 
@@ -163,12 +164,18 @@ SYMBOL: default-secure-context
 : save-session ( session addrspec -- )
     current-secure-context sessions>> set-at ;
 
+: set-secure-cipher-list-only ( ssl -- ssl )
+    dup handle>>
+    "DES-CBC3-SHA:IDEA-CBC-SHA:AES128-SHA:CAMELLIA128-SHA:AES256-SHA:CAMELLIA256-SHA"
+    SSL_set_cipher_list ssl-error ;
+
 : <ssl-handle> ( fd -- ssl )
     [
         ssl-handle new-disposable |dispose
-        current-secure-context handle>> SSL_new
+        current-secure-context handle>> SSL_new |dispose
         dup ssl-error >>handle
         swap >>file
+        set-secure-cipher-list-only
     ] with-destructors ;
 
 :: <ssl-socket> ( winsock hostname -- ssl )
diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor
index 2ef50a07a1..9536ed7d33 100644
--- a/basis/io/sockets/secure/secure.factor
+++ b/basis/io/sockets/secure/secure.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors calendar combinators delegate destructors io
-io.sockets io.sockets.private kernel namespaces present
-sequences summary system vocabs ;
+USING: accessors alien.libraries calendar combinators delegate
+destructors io io.sockets io.sockets.private kernel memoize
+namespaces present sequences summary system vocabs ;
 IN: io.sockets.secure
 
 SYMBOL: secure-socket-timeout
@@ -17,7 +17,17 @@ HOOK: ssl-certificate-verification-supported? secure-socket-backend ( -- ? )
 M: object ssl-supported? f ;
 M: object ssl-certificate-verification-supported? f ;
 
-SINGLETONS: TLSv1 ;
+SINGLETONS: TLSv1 TLSv1.1 TLSv1.2 ;
+
+ERROR: no-tls-supported ;
+
+MEMO: best-tls-method ( -- class )
+    {
+        { [ "TLSv1_2_method" "libssl" dlsym? ] [ TLSv1.2 ] }
+        { [ "TLSv1_1_method" "libssl" dlsym? ] [ TLSv1.1 ] }
+        { [ "TLSv1_method" "libssl" dlsym? ] [ TLSv1 ] }
+        [ no-tls-supported ]
+    } cond ;
 
 TUPLE: secure-config
 method
@@ -30,7 +40,7 @@ ephemeral-key-bits ;
 
 : <secure-config> ( -- config )
     secure-config new
-        TLSv1 >>method
+        best-tls-method >>method
         1024 >>ephemeral-key-bits
         ssl-certificate-verification-supported? >>verify ;
 
diff --git a/basis/openssl/libssl/libssl.factor b/basis/openssl/libssl/libssl.factor
index e9c101dc6f..18ed03a6aa 100644
--- a/basis/openssl/libssl/libssl.factor
+++ b/basis/openssl/libssl/libssl.factor
@@ -362,6 +362,10 @@ FUNCTION: ssl-method TLSv1_server_method (  )
 
 FUNCTION: ssl-method TLSv1_method (  )
 
+FUNCTION: ssl-method TLSv1_1_method (  )
+
+FUNCTION: ssl-method TLSv1_2_method (  )
+
 ! Creates the context
 FUNCTION: SSL_CTX* SSL_CTX_new ( ssl-method method )
 
diff --git a/basis/openssl/openssl.factor b/basis/openssl/openssl.factor
index 9315e43a39..0e1a396332 100644
--- a/basis/openssl/openssl.factor
+++ b/basis/openssl/openssl.factor
@@ -23,8 +23,7 @@ SINGLETON: openssl
 : init-ssl ( -- )
     SSL_library_init ssl-error
     SSL_load_error_strings
-    OpenSSL_add_all_digests
-    OpenSSL_add_all_ciphers ;
+    OpenSSL_add_all_digests ;
 
 SYMBOL: ssl-initialized?