From c2fd5031e08e2f0b2e82c2f29235693866be51be Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Sat, 14 Sep 2013 21:18:13 +0200
Subject: [PATCH] io.sockets.secure, io.sockets.secure.openssl: improved host
name verification that takes into account a certificates subject alternative
names.
---
.../secure/openssl/openssl-docs.factor | 21 +++++++++++++++
.../secure/openssl/openssl-tests.factor | 4 +++
.../io/sockets/secure/openssl/openssl.factor | 26 ++++++++++++-------
basis/io/sockets/secure/secure-docs.factor | 4 +--
basis/io/sockets/secure/secure.factor | 6 ++---
5 files changed, 47 insertions(+), 14 deletions(-)
create mode 100644 basis/io/sockets/secure/openssl/openssl-docs.factor
create mode 100644 basis/io/sockets/secure/openssl/openssl-tests.factor
diff --git a/basis/io/sockets/secure/openssl/openssl-docs.factor b/basis/io/sockets/secure/openssl/openssl-docs.factor
new file mode 100644
index 0000000000..bc66781b62
--- /dev/null
+++ b/basis/io/sockets/secure/openssl/openssl-docs.factor
@@ -0,0 +1,21 @@
+USING: help.markup help.syntax ;
+IN: io.sockets.secure.openssl
+
+
+HELP: subject-name
+{ $values { "certificate" "an SSL peer certificate" } }
+{ $description "The subject name of a certificate." } ;
+
+HELP: subject-names-match?
+{ $values { "host" "a host name" } { "subject" "a subject name" } }
+{ $description "True if the host name matches the subject name." }
+{ $examples
+ { $code
+ "\"www.google.se\" \"*.google.se\" subject-names-match?"
+ "t"
+ }
+} ;
+
+HELP: alternative-dns-names
+{ $values { "certificate" "an SSL peer certificate" } }
+{ $description "Alternative subject names for the certificate." } ;
diff --git a/basis/io/sockets/secure/openssl/openssl-tests.factor b/basis/io/sockets/secure/openssl/openssl-tests.factor
new file mode 100644
index 0000000000..d39a787c72
--- /dev/null
+++ b/basis/io/sockets/secure/openssl/openssl-tests.factor
@@ -0,0 +1,4 @@
+USING: accessors http.client kernel tools.test ;
+IN: io.sockets.secure.openssl.tests
+
+[ 200 ] [ "https://www.google.se" http-get drop code>> ] unit-test
diff --git a/basis/io/sockets/secure/openssl/openssl.factor b/basis/io/sockets/secure/openssl/openssl.factor
index a0eae9e717..a1891cdad9 100644
--- a/basis/io/sockets/secure/openssl/openssl.factor
+++ b/basis/io/sockets/secure/openssl/openssl.factor
@@ -1,11 +1,11 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays kernel sequences namespaces math
+USING: accessors byte-arrays classes.struct kernel sequences namespaces math
math.order combinators init alien alien.c-types alien.data
alien.strings libc continuations destructors summary splitting
assocs random math.parser locals unicode.case openssl
openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames
-io.encodings.8-bit.latin1 io.timeouts io.sockets.secure ;
+io.encodings.8-bit.latin1 io.encodings.utf8 io.timeouts io.sockets.secure ;
IN: io.sockets.secure.openssl
GENERIC: ssl-method ( symbol -- method )
@@ -175,25 +175,33 @@ M: ssl-handle dispose*
[ 256 X509_NAME_get_text_by_NID ] keep
swap -1 = [ drop f ] [ latin1 alien>string ] if ;
-: common-name ( certificate -- host )
+: subject-name ( certificate -- host )
X509_get_subject_name x509name>string ;
: issuer-name ( certificate -- issuer )
X509_get_issuer_name x509name>string ;
-: common-names-match? ( expected actual -- ? )
+: name-stack>seq ( name-stack -- seq )
+ dup sk_num iota [ sk_value GENERAL_NAME_st memory>struct ] with map ;
+
+: alternative-dns-names ( certificate -- dns-names )
+ NID_subject_alt_name f f X509_get_ext_d2i [ name-stack>seq ] [ { } ] if*
+ [ type>> GEN_DNS = ] filter
+ [ d>> dNSName>> data>> utf8 alien>string ] map ;
+
+: subject-names-match? ( host subject -- ? )
[ >lower ] bi@ "*." ?head [ tail? ] [ = ] if ;
-: check-common-name ( host ssl-handle -- )
- SSL_get_peer_certificate common-name
- 2dup common-names-match?
- [ 2drop ] [ common-name-verify-error ] if ;
+: check-subject-name ( host ssl-handle -- )
+ SSL_get_peer_certificate [ alternative-dns-names ] [ subject-name ] bi
+ suffix 2dup [ subject-names-match? ] with filter empty?
+ [ subject-name-verify-error ] [ 2drop ] if ;
M: openssl check-certificate ( host ssl -- )
current-secure-context config>> verify>> [
handle>>
[ nip check-verify-result ]
- [ check-common-name ]
+ [ check-subject-name ]
2bi
] [ 2drop ] if ;
diff --git a/basis/io/sockets/secure/secure-docs.factor b/basis/io/sockets/secure/secure-docs.factor
index 139e036241..82624a3f53 100644
--- a/basis/io/sockets/secure/secure-docs.factor
+++ b/basis/io/sockets/secure/secure-docs.factor
@@ -126,8 +126,8 @@ HELP: premature-close
HELP: certificate-verify-error
{ $error-description "Thrown if certificate verification failed. The " { $snippet "result" } " slot contains an object identifying the low-level error that occurred." } ;
-HELP: common-name-verify-error
-{ $error-description "Thrown during certificate verification if the host name on the certificate does not match the host name the socket was connected to. This indicates a potential man-in-the-middle attack. The " { $slot "expected" } " and " { $slot "got" } " slots contain the mismatched host names." } ;
+HELP: subject-name-verify-error
+{ $error-description "Thrown during certificate verification if the subject names on the certificate does not match the host name the socket was connected to. This indicates a potential man-in-the-middle attack. The " { $slot "expected" } " and " { $slot "got" } " slots contain the mismatched host names." } ;
HELP: upgrade-on-non-socket
{ $error-description "Thrown if " { $link send-secure-handshake } " or " { $link accept-secure-handshake } " is called with the " { $link input-stream } " and " { $link output-stream } " variables not set to a socket. This error can also indicate that the connection has already been upgraded to a secure connection." } ;
diff --git a/basis/io/sockets/secure/secure.factor b/basis/io/sockets/secure/secure.factor
index c0d0598adb..fdee739070 100644
--- a/basis/io/sockets/secure/secure.factor
+++ b/basis/io/sockets/secure/secure.factor
@@ -77,10 +77,10 @@ ERROR: certificate-verify-error result ;
M: certificate-verify-error summary
drop "Certificate verification failed" ;
-ERROR: common-name-verify-error expected got ;
+ERROR: subject-name-verify-error expected got ;
-M: common-name-verify-error summary
- drop "Common name verification failed" ;
+M: subject-name-verify-error summary
+ drop "Subject name verification failed" ;
ERROR: upgrade-on-non-socket ;