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 ;
: >secure ( addrspec -- addrspec' )
>insecure [ dup secure? [ <secure> ] unless ] map ;
>insecure [ dup secure? [ f <secure> ] unless ] map ;
: configurable-addrspecs ( addrspecs -- addrspecs' )
[ 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: secure connect-addr addrspec>> connect-addr <secure> ;
M: secure connect-addr addrspec>> connect-addr f <secure> ;
M: local connect-addr ;

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

@ -171,11 +171,16 @@ SYMBOL: default-secure-context
swap >>file
] with-destructors ;
: <ssl-socket> ( winsock -- ssl )
[
socket-handle BIO_NOCLOSE BIO_new_socket dup ssl-error
] keep <ssl-handle>
[ handle>> swap dup SSL_set_bio ] keep ;
:: <ssl-socket> ( winsock hostname -- ssl )
winsock socket-handle BIO_NOCLOSE BIO_new_socket dup ssl-error :> bio
winsock <ssl-handle> :> handle
handle handle>> :> native-handle
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
: syscall-error ( r -- event )
@ -330,7 +335,7 @@ M: openssl check-certificate ( host ssl -- )
: make-input/output-secure ( input output -- )
dup handle>> non-ssl-socket? [ upgrade-on-non-socket ] unless
[ <ssl-socket> ] change-handle
[ f <ssl-socket> ] change-handle
handle>> >>handle drop ;
: (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
HELP: secure-socket-timeout
@ -74,7 +74,7 @@ HELP: secure
{ $class-description "The class of secure socket addresses." } ;
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> } "." } ;
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
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

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

@ -44,7 +44,9 @@ HOOK: <secure-context> secure-socket-backend ( config -- context )
with-disposal
] with-scope ; inline
TUPLE: secure { addrspec read-only } ;
TUPLE: secure
{ addrspec read-only }
{ hostname read-only } ;
C: <secure> secure
@ -53,7 +55,8 @@ M: secure present addrspec>> present " (secure)" append ;
CONSULT: inet secure addrspec>> ;
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 -- )

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

@ -12,7 +12,7 @@ io.sockets.secure.debug ;
:: 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
accept [
quot call
@ -23,7 +23,7 @@ io.sockets.secure.debug ;
: client-test ( -- string )
<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 ;
{ } [ [ class-of name>> write ] server-test ] unit-test
@ -55,7 +55,7 @@ io.sockets.secure.debug ;
[
<secure-config> [
"localhost" "port" get ?promise <inet> <secure> ascii
"localhost" "port" get ?promise <inet> f <secure> ascii
<client> drop dispose
] with-secure-context
] [ certificate-verify-error? ] must-fail-with
@ -95,7 +95,7 @@ io.sockets.secure.debug ;
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
accept drop &dispose dup stream-read1 drop
] 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
accept drop &dispose 1 minutes sleep
] with-disposal
@ -126,7 +126,7 @@ io.sockets.secure.debug ;
[
1 seconds secure-socket-timeout [
<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
] with-secure-context
] with-variable
@ -140,7 +140,7 @@ io.sockets.secure.debug ;
[
[
"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-destructors
] "Silly client" spawn drop
@ -150,7 +150,7 @@ io.sockets.secure.debug ;
[
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
accept drop &dispose
] 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: secure ((client)) ( addrspec -- handle )
addrspec>> ((client)) <ssl-socket> ;
M: secure ((client)) ( secure -- handle )
[ 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) ;
@ -28,7 +28,8 @@ M: secure (server) addrspec>> (server) ;
M: secure (accept)
[
addrspec>> (accept) [ |dispose <ssl-socket> ] dip
[ hostname>> ] [ addrspec>> ] bi (accept)
[ |dispose <ssl-socket> ] dip
] with-destructors ;
: 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 )
[ 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 -- )
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_write ( SSL* ssl, void* buf, int num )
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 )
@ -468,6 +467,10 @@ FUNCTION: void SSL_CTX_set_tmp_rsa_callback ( SSL_CTX* ctx, void* rsa )
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_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.
! 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
UNION: abstract-inet inet inet4 inet6 ;

8
basis/urls/urls.factor
View File

@ -172,7 +172,7 @@ PRIVATE>
<PRIVATE
GENERIC: >secure-addr ( addrspec -- addrspec' )
GENERIC# >secure-addr 1 ( addrspec host -- addrspec' )
PRIVATE>
@ -182,8 +182,10 @@ PRIVATE>
[ port>> ]
[ protocol>> protocol-port ]
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 )
[ host>> >>host ] [ port>> >>port ] bi ;

2
extra/imap/imap.factor
View File

@ -108,7 +108,7 @@ PRIVATE>
! Constructor
: <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.
dup [ "\\*" read-response drop ] with-stream* ;