io.sockets.secure, io.sockets.secure.openssl: improved host name verification that takes into account a certificates subject alternative names.

db4
Björn Lindqvist 2013-09-14 21:18:13 +02:00 committed by John Benediktsson
parent 98355daba1
commit c2fd5031e0
5 changed files with 47 additions and 14 deletions

View File

@ -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." } ;

View File

@ -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

View File

@ -1,11 +1,11 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI. ! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license. ! 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 math.order combinators init alien alien.c-types alien.data
alien.strings libc continuations destructors summary splitting alien.strings libc continuations destructors summary splitting
assocs random math.parser locals unicode.case openssl assocs random math.parser locals unicode.case openssl
openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames 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 IN: io.sockets.secure.openssl
GENERIC: ssl-method ( symbol -- method ) GENERIC: ssl-method ( symbol -- method )
@ -175,25 +175,33 @@ M: ssl-handle dispose*
[ 256 X509_NAME_get_text_by_NID ] keep [ 256 X509_NAME_get_text_by_NID ] keep
swap -1 = [ drop f ] [ latin1 alien>string ] if ; swap -1 = [ drop f ] [ latin1 alien>string ] if ;
: common-name ( certificate -- host ) : subject-name ( certificate -- host )
X509_get_subject_name x509name>string ; X509_get_subject_name x509name>string ;
: issuer-name ( certificate -- issuer ) : issuer-name ( certificate -- issuer )
X509_get_issuer_name x509name>string ; 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 ; [ >lower ] bi@ "*." ?head [ tail? ] [ = ] if ;
: check-common-name ( host ssl-handle -- ) : check-subject-name ( host ssl-handle -- )
SSL_get_peer_certificate common-name SSL_get_peer_certificate [ alternative-dns-names ] [ subject-name ] bi
2dup common-names-match? suffix 2dup [ subject-names-match? ] with filter empty?
[ 2drop ] [ common-name-verify-error ] if ; [ subject-name-verify-error ] [ 2drop ] if ;
M: openssl check-certificate ( host ssl -- ) M: openssl check-certificate ( host ssl -- )
current-secure-context config>> verify>> [ current-secure-context config>> verify>> [
handle>> handle>>
[ nip check-verify-result ] [ nip check-verify-result ]
[ check-common-name ] [ check-subject-name ]
2bi 2bi
] [ 2drop ] if ; ] [ 2drop ] if ;

View File

@ -126,8 +126,8 @@ HELP: premature-close
HELP: certificate-verify-error 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." } ; { $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 HELP: subject-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." } ; { $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 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." } ; { $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." } ;

View File

@ -77,10 +77,10 @@ ERROR: certificate-verify-error result ;
M: certificate-verify-error summary M: certificate-verify-error summary
drop "Certificate verification failed" ; drop "Certificate verification failed" ;
ERROR: common-name-verify-error expected got ; ERROR: subject-name-verify-error expected got ;
M: common-name-verify-error summary M: subject-name-verify-error summary
drop "Common name verification failed" ; drop "Subject name verification failed" ;
ERROR: upgrade-on-non-socket ; ERROR: upgrade-on-non-socket ;