steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add SNI support to Factor 

Fixes #1527
db4
Benjamin Pollack 2016-03-02 18:29:59 -05:00 committed by John Benediktsson
parent 9c4ed3ddae
commit 62d1425971
12 changed files with 46 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
basis/io/servers/servers.factor
View File

@ -81,7 +81,7 @@ M: array >insecure [ >insecure ] map ;
M: f >insecure ; M: f >insecure ;
: >secure ( addrspec -- addrspec' ) : >secure ( addrspec -- addrspec' )
>insecure [ dup secure? [ <secure> ] unless ] map ; >insecure [ dup secure? [ f <secure> ] unless ] map ;
: configurable-addrspecs ( addrspecs -- addrspecs' ) : configurable-addrspecs ( addrspecs -- addrspecs' )
[ inet6? not ipv6-supported? or ] filter ; [ inet6? not ipv6-supported? or ] filter ;
@ -230,7 +230,7 @@ M: inet4 connect-addr [ "127.0.0.1" ] dip port>> <inet4> ;
M: inet6 connect-addr [ "::1" ] dip port>> <inet6> ; M: inet6 connect-addr [ "::1" ] dip port>> <inet6> ;
M: secure connect-addr addrspec>> connect-addr <secure> ; M: secure connect-addr addrspec>> connect-addr f <secure> ;
M: local connect-addr ; M: local connect-addr ;

17
basis/io/sockets/secure/openssl/openssl.factor
View File

@ -171,11 +171,16 @@ SYMBOL: default-secure-context
swap >>file swap >>file
] with-destructors ; ] with-destructors ;
: <ssl-socket> ( winsock -- ssl ) :: <ssl-socket> ( winsock hostname -- ssl )
[ winsock socket-handle BIO_NOCLOSE BIO_new_socket dup ssl-error :> bio
socket-handle BIO_NOCLOSE BIO_new_socket dup ssl-error winsock <ssl-handle> :> handle
] keep <ssl-handle> handle handle>> :> native-handle
[ handle>> swap dup SSL_set_bio ] keep ; hostname [
utf8 string>alien
native-handle swap SSL_set_tlsext_host_name ssl-error
] when*
native-handle bio bio SSL_set_bio
handle ;
! Error handling ! Error handling
: syscall-error ( r -- event ) : syscall-error ( r -- event )
@ -330,7 +335,7 @@ M: openssl check-certificate ( host ssl -- )
: make-input/output-secure ( input output -- ) : make-input/output-secure ( input output -- )
dup handle>> non-ssl-socket? [ upgrade-on-non-socket ] unless dup handle>> non-ssl-socket? [ upgrade-on-non-socket ] unless
[ <ssl-socket> ] change-handle [ f <ssl-socket> ] change-handle
handle>> >>handle drop ; handle>> >>handle drop ;
: (send-secure-handshake) ( output -- ) : (send-secure-handshake) ( output -- )

4
basis/io/sockets/secure/secure-docs.factor
View File

@ -1,4 +1,4 @@
USING: io help.markup help.syntax calendar quotations io.sockets ; USING: io help.markup help.syntax calendar quotations strings io.sockets ;
IN: io.sockets.secure IN: io.sockets.secure
HELP: secure-socket-timeout HELP: secure-socket-timeout
@ -74,7 +74,7 @@ HELP: secure
{ $class-description "The class of secure socket addresses." } ; { $class-description "The class of secure socket addresses." } ;
HELP: <secure> HELP: <secure>
{ $values { "addrspec" "an address specifier" } { "secure" secure } } { $values { "addrspec" "an address specifier" } { "hostname" { $maybe string } } { "secure" secure } }
{ $description "Creates a new secure socket address, which can then be passed to " { $link <client> } " or " { $link <server> } "." } ; { $description "Creates a new secure socket address, which can then be passed to " { $link <client> } " or " { $link <server> } "." } ;
ARTICLE: "ssl-addresses" "Secure socket addresses" ARTICLE: "ssl-addresses" "Secure socket addresses"

2
basis/io/sockets/secure/secure-tests.factor
View File

@ -2,7 +2,7 @@ IN: io.sockets.secure.tests
USING: accessors io.sockets io.sockets.secure io.sockets.secure.debug USING: accessors io.sockets io.sockets.secure io.sockets.secure.debug
kernel system tools.test ; kernel system tools.test ;
{ "hello" 24 } [ "hello" 24 <inet> <secure> [ host>> ] [ port>> ] bi ] unit-test { "hello" 24 } [ "hello" 24 <inet> "hello" <secure> [ host>> ] [ port>> ] bi ] unit-test
{ } [ { } [
<test-secure-config> [ ] with-secure-context <test-secure-config> [ ] with-secure-context

7
basis/io/sockets/secure/secure.factor
View File

@ -44,7 +44,9 @@ HOOK: <secure-context> secure-socket-backend ( config -- context )
with-disposal with-disposal
] with-scope ; inline ] with-scope ; inline
TUPLE: secure { addrspec read-only } ; TUPLE: secure
{ addrspec read-only }
{ hostname read-only } ;
C: <secure> secure C: <secure> secure
@ -53,7 +55,8 @@ M: secure present addrspec>> present " (secure)" append ;
CONSULT: inet secure addrspec>> ; CONSULT: inet secure addrspec>> ;
M: secure resolve-host ( secure -- seq ) M: secure resolve-host ( secure -- seq )
addrspec>> resolve-host [ <secure> ] map ; [ addrspec>> resolve-host ] [ hostname>> ] bi
[ <secure> ] curry map ;
HOOK: check-certificate secure-socket-backend ( host handle -- ) HOOK: check-certificate secure-socket-backend ( host handle -- )

16
basis/io/sockets/secure/unix/unix-tests.factor
View File

@ -12,7 +12,7 @@ io.sockets.secure.debug ;
:: server-test ( quot -- ) :: server-test ( quot -- )
[ [
[ [
"127.0.0.1" 0 <inet4> <secure> ascii <server> [ "127.0.0.1" 0 <inet4> f <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill dup addr>> addrspec>> port>> "port" get fulfill
accept [ accept [
quot call quot call
@ -23,7 +23,7 @@ io.sockets.secure.debug ;
: client-test ( -- string ) : client-test ( -- string )
<secure-config> [ <secure-config> [
"127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop stream-contents "127.0.0.1" "port" get ?promise <inet4> f <secure> ascii <client> drop stream-contents
] with-secure-context ; ] with-secure-context ;
{ } [ [ class-of name>> write ] server-test ] unit-test { } [ [ class-of name>> write ] server-test ] unit-test
@ -55,7 +55,7 @@ io.sockets.secure.debug ;
[ [
<secure-config> [ <secure-config> [
"localhost" "port" get ?promise <inet> <secure> ascii "localhost" "port" get ?promise <inet> f <secure> ascii
<client> drop dispose <client> drop dispose
] with-secure-context ] with-secure-context
] [ certificate-verify-error? ] must-fail-with ] [ certificate-verify-error? ] must-fail-with
@ -95,7 +95,7 @@ io.sockets.secure.debug ;
1 seconds secure-socket-timeout [ 1 seconds secure-socket-timeout [
[ [
[ [
"127.0.0.1" 0 <inet4> <secure> ascii <server> [ "127.0.0.1" 0 <inet4> f <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill dup addr>> addrspec>> port>> "port" get fulfill
accept drop &dispose dup stream-read1 drop accept drop &dispose dup stream-read1 drop
] with-disposal ] with-disposal
@ -114,7 +114,7 @@ io.sockets.secure.debug ;
[ [
[ [
[ [
"127.0.0.1" 0 <inet4> <secure> ascii <server> [ "127.0.0.1" 0 <inet4> f <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill dup addr>> addrspec>> port>> "port" get fulfill
accept drop &dispose 1 minutes sleep accept drop &dispose 1 minutes sleep
] with-disposal ] with-disposal
@ -126,7 +126,7 @@ io.sockets.secure.debug ;
[ [
1 seconds secure-socket-timeout [ 1 seconds secure-socket-timeout [
<secure-config> [ <secure-config> [
"127.0.0.1" "port" get ?promise <inet4> <secure> "127.0.0.1" "port" get ?promise <inet4> f <secure>
ascii <client> drop dispose ascii <client> drop dispose
] with-secure-context ] with-secure-context
] with-variable ] with-variable
@ -140,7 +140,7 @@ io.sockets.secure.debug ;
[ [
[ [
"127.0.0.1" "port" get ?promise "127.0.0.1" "port" get ?promise
<inet4> <secure> ascii <client> drop &dispose 1 minutes sleep <inet4> f <secure> ascii <client> drop &dispose 1 minutes sleep
] with-test-context ] with-test-context
] with-destructors ] with-destructors
] "Silly client" spawn drop ] "Silly client" spawn drop
@ -150,7 +150,7 @@ io.sockets.secure.debug ;
[ [
1 seconds secure-socket-timeout [ 1 seconds secure-socket-timeout [
[ [
"127.0.0.1" 0 <inet4> <secure> ascii <server> [ "127.0.0.1" 0 <inet4> f <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill dup addr>> addrspec>> port>> "port" get fulfill
accept drop &dispose accept drop &dispose
] with-disposal ] with-disposal

9
basis/io/sockets/secure/unix/unix.factor
View File

@ -14,10 +14,10 @@ M: ssl-handle handle-fd file>> handle-fd ;
M: unix socket-handle fd>> ; M: unix socket-handle fd>> ;
M: secure ((client)) ( addrspec -- handle ) M: secure ((client)) ( secure -- handle )
addrspec>> ((client)) <ssl-socket> ; [ addrspec>> ((client)) ] [ hostname>> ] bi <ssl-socket> ;
M: secure parse-sockaddr addrspec>> parse-sockaddr <secure> ; M: secure parse-sockaddr addrspec>> parse-sockaddr f <secure> ;
M: secure (get-local-address) addrspec>> (get-local-address) ; M: secure (get-local-address) addrspec>> (get-local-address) ;
@ -28,7 +28,8 @@ M: secure (server) addrspec>> (server) ;
M: secure (accept) M: secure (accept)
[ [
addrspec>> (accept) [ |dispose <ssl-socket> ] dip [ hostname>> ] [ addrspec>> ] bi (accept)
[ |dispose <ssl-socket> ] dip
] with-destructors ; ] with-destructors ;
: check-shutdown-response ( handle r -- event ) : check-shutdown-response ( handle r -- event )

2
basis/io/sockets/secure/windows/windows.factor
View File

@ -14,7 +14,7 @@ M: secure ((client)) ( addrspec -- handle )
M: secure (get-local-address) ( handle remote -- sockaddr ) M: secure (get-local-address) ( handle remote -- sockaddr )
[ file>> ] [ addrspec>> ] bi* (get-local-address) ; [ file>> ] [ addrspec>> ] bi* (get-local-address) ;
M: secure parse-sockaddr addrspec>> parse-sockaddr <secure> ; M: secure parse-sockaddr addrspec>> parse-sockaddr f <secure> ;
M:: secure establish-connection ( client-out addrspec -- ) M:: secure establish-connection ( client-out addrspec -- )
client-out handle>> file>> :> socket client-out handle>> file>> :> socket

5
basis/openssl/libssl/libssl.factor
View File

@ -392,7 +392,6 @@ FUNCTION: int SSL_connect ( SSL* ssl )
FUNCTION: int SSL_read ( SSL* ssl, void* buf, int num ) FUNCTION: int SSL_read ( SSL* ssl, void* buf, int num )
FUNCTION: int SSL_write ( SSL* ssl, void* buf, int num ) FUNCTION: int SSL_write ( SSL* ssl, void* buf, int num )
FUNCTION: long SSL_ctrl ( SSL* ssl, int cmd, long larg, void* parg ) FUNCTION: long SSL_ctrl ( SSL* ssl, int cmd, long larg, void* parg )
! FUNCTION: long SSL_callback_ctrl ( SSL* ssl, int cmd, long larg, void* parg )
FUNCTION: int SSL_shutdown ( SSL* ssl ) FUNCTION: int SSL_shutdown ( SSL* ssl )
@ -468,6 +467,10 @@ FUNCTION: void SSL_CTX_set_tmp_rsa_callback ( SSL_CTX* ctx, void* rsa )
FUNCTION: void* BIO_f_ssl ( ) FUNCTION: void* BIO_f_ssl ( )
: SSL_set_tlsext_host_name ( ctx hostname -- n )
[ SSL_CTRL_SET_TLSEXT_HOSTNAME TLSEXT_NAMETYPE_host_name ] dip
SSL_ctrl ;
: SSL_CTX_need_tmp_rsa ( ctx -- n ) : SSL_CTX_need_tmp_rsa ( ctx -- n )
SSL_CTRL_NEED_TMP_RSA 0 f SSL_CTX_ctrl ; SSL_CTRL_NEED_TMP_RSA 0 f SSL_CTX_ctrl ;

2
basis/urls/secure/secure.factor
View File

@ -1,6 +1,6 @@
! Copyright (C) 2008, 2010 Slava Pestov. ! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: urls urls.private io.sockets io.sockets.secure ; USING: kernel urls urls.private io.sockets io.sockets.secure ;
IN: urls.secure IN: urls.secure
UNION: abstract-inet inet inet4 inet6 ; UNION: abstract-inet inet inet4 inet6 ;

8
basis/urls/urls.factor
View File

@ -172,7 +172,7 @@ PRIVATE>
<PRIVATE <PRIVATE
GENERIC: >secure-addr ( addrspec -- addrspec' ) GENERIC# >secure-addr 1 ( addrspec host -- addrspec' )
PRIVATE> PRIVATE>
@ -182,8 +182,10 @@ PRIVATE>
[ port>> ] [ port>> ]
[ protocol>> protocol-port ] [ protocol>> protocol-port ]
tri or <inet> tri or <inet>
] [ protocol>> ] bi ]
secure-protocol? [ >secure-addr ] when ; [ host>> ]
[ protocol>> ] tri
secure-protocol? [ >secure-addr ] [ drop ] if ;
: set-url-addr ( url addr -- url ) : set-url-addr ( url addr -- url )
[ host>> >>host ] [ port>> >>port ] bi ; [ host>> >>host ] [ port>> >>port ] bi ;

2
extra/imap/imap.factor
View File

@ -108,7 +108,7 @@ PRIVATE>
! Constructor ! Constructor
: <imap4ssl> ( host -- imap4 ) : <imap4ssl> ( host -- imap4 )
IMAP4_SSL_PORT <inet> <secure> binary <client> drop IMAP4_SSL_PORT <inet> f <secure> binary <client> drop
! Read the useless welcome message. ! Read the useless welcome message.
dup [ "\\*" read-response drop ] with-stream* ; dup [ "\\*" read-response drop ] with-stream* ;