io.sockets.secure.openssl: Fix subject-name-match? for wildcard domains.

Also remove duplicate names before checking.
db4
Doug Coleman 2016-03-12 20:18:19 -08:00
parent b0d62bcdc3
commit df3f58ae61
2 changed files with 26 additions and 10 deletions

View File

@ -14,3 +14,8 @@ IN: io.sockets.secure.openssl.tests
[ "test" 33 <ssl-handle> handle>> check-subject-name ] [ "test" 33 <ssl-handle> handle>> check-subject-name ]
[ certificate-missing-error? ] must-fail-with [ certificate-missing-error? ] must-fail-with
{ t } [ "badssl.com" "*.badssl.com" subject-names-match? ] unit-test
{ t } [ "www.badssl.com" "*.badssl.com" subject-names-match? ] unit-test
{ f } [ "foo.bar.badssl.com" "*.badssl.com" subject-names-match? ] unit-test
{ f } [ ".com" "*.badssl.com" subject-names-match? ] unit-test

View File

@ -1,13 +1,13 @@
! 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 alien alien.c-types alien.data alien.strings USING: accessors alien alien.c-types alien.data alien.strings
assocs byte-arrays classes.struct combinators destructors fry io assocs byte-arrays classes.struct combinators
io.backend io.binary io.buffers io.encodings.8-bit.latin1 combinators.short-circuit destructors fry io io.backend
io.encodings.utf8 io.files io.pathnames io.ports io.sockets io.binary io.buffers io.encodings.8-bit.latin1 io.encodings.utf8
io.sockets.secure io.timeouts kernel libc locals math io.files io.pathnames io.ports io.sockets io.sockets.secure
math.functions math.order math.parser memoize namespaces openssl io.timeouts kernel libc locals math math.functions math.order
openssl.libcrypto openssl.libssl random sequences splitting math.parser memoize namespaces openssl openssl.libcrypto
unicode.case ; openssl.libssl random sequences sets splitting unicode.case ;
IN: io.sockets.secure.openssl IN: io.sockets.secure.openssl
GENERIC: ssl-method ( symbol -- method ) GENERIC: ssl-method ( symbol -- method )
@ -346,12 +346,23 @@ M: ssl-handle dispose*
[ type>> GEN_DNS = ] filter [ type>> GEN_DNS = ] filter
[ d>> dNSName>> data>> utf8 alien>string ] map ; [ d>> dNSName>> data>> utf8 alien>string ] map ;
: subject-names-match? ( host subject -- ? ) ! *.foo.com matches: foo.com, www.foo.com, a.foo.com
[ >lower ] bi@ "*." ?head [ tail? ] [ = ] if ; ! *.bar.foo.com matches: bar.foo.com, www.bar.foo.com, b.bar.foo.com
: subject-names-match? ( name pattern -- ? )
[ >lower ] bi@
"*." ?head [
{
[ tail? ]
[ [ [ CHAR: . = ] count ] bi@ - 1 <= ]
} 2&&
] [
=
] if ;
: check-subject-name ( host ssl-handle -- ) : check-subject-name ( host ssl-handle -- )
SSL_get_peer_certificate [ SSL_get_peer_certificate [
[ alternative-dns-names ] [ subject-name ] bi suffix [ alternative-dns-names ]
[ subject-name ] bi suffix members
2dup [ subject-names-match? ] with any? 2dup [ subject-names-match? ] with any?
[ 2drop ] [ subject-name-verify-error ] if [ 2drop ] [ subject-name-verify-error ] if
] [ certificate-missing-error ] if* ; ] [ certificate-missing-error ] if* ;