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

io.sockets.secure: new hook variable ssl-certificate-verification-supported? 

t if the backend is able to verify certificates, f
otherwise. Currently certificate validation isn't implemented on Windows
db4
Björn Lindqvist 2013-10-14 14:45:33 +02:00 committed by Doug Coleman
parent b02710e88c
commit 6ed3a09b5d
4 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,5 +1,5 @@
IN: io.sockets.secure.tests IN: io.sockets.secure.tests
USING: accessors kernel io.sockets io.sockets.secure tools.test ; USING: accessors kernel io.sockets io.sockets.secure system tools.test ;
[ "hello" 24 ] [ "hello" 24 <inet> <secure> [ host>> ] [ port>> ] bi ] unit-test [ "hello" 24 ] [ "hello" 24 <inet> <secure> [ host>> ] [ port>> ] bi ] unit-test
@ -10,3 +10,5 @@ USING: accessors kernel io.sockets io.sockets.secure tools.test ;
"password" >>password "password" >>password
[ ] with-secure-context [ ] with-secure-context
] unit-test ] unit-test
[ t ] [ os windows? ssl-certificate-verification-supported? or ] unit-test

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

@ -12,8 +12,10 @@ SYMBOL: secure-socket-timeout
SYMBOL: secure-socket-backend SYMBOL: secure-socket-backend
HOOK: ssl-supported? secure-socket-backend ( -- ? ) HOOK: ssl-supported? secure-socket-backend ( -- ? )
HOOK: ssl-certificate-verification-supported? secure-socket-backend ( -- ? )
M: object ssl-supported? f ; M: object ssl-supported? f ;
M: object ssl-certificate-verification-supported? f ;
SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ; SINGLETONS: SSLv2 SSLv23 SSLv3 TLSv1 ;
@ -30,7 +32,7 @@ ephemeral-key-bits ;
secure-config new secure-config new
SSLv23 >>method SSLv23 >>method
1024 >>ephemeral-key-bits 1024 >>ephemeral-key-bits
t >>verify ; ssl-certificate-verification-supported? >>verify ;
TUPLE: secure-context < disposable config handle ; TUPLE: secure-context < disposable config handle ;
@ -106,5 +108,5 @@ HOOK: accept-secure-handshake secure-socket-backend ( -- )
{ {
{ [ os unix? ] [ "io.sockets.secure.unix" require ] } { [ os unix? ] [ "io.sockets.secure.unix" require ] }
{ [ os windows? ] [ "openssl" require ] } { [ os windows? ] [ "io.sockets.secure.windows" require ] }
} cond } cond

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

@ -12,6 +12,7 @@ FROM: io.ports => shutdown ;
IN: io.sockets.secure.unix IN: io.sockets.secure.unix
M: openssl ssl-supported? t ; M: openssl ssl-supported? t ;
M: openssl ssl-certificate-verification-supported? t ;
M: ssl-handle handle-fd file>> handle-fd ; M: ssl-handle handle-fd file>> handle-fd ;

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

@ -1,17 +1,19 @@
USING: USING:
accessors accessors
alien alien alien.c-types alien.data
combinators combinators
fry fry
io io.sockets.private io.sockets.secure io.sockets.secure.openssl io.sockets.windows io io.sockets.private io.sockets.secure io.sockets.secure.openssl io.sockets.windows
io.timeouts io.timeouts
kernel kernel
openssl openssl.libcrypto openssl.libssl ; openssl openssl.libcrypto openssl.libssl
windows.winsock ;
IN: io.sockets.secure.windows IN: io.sockets.secure.windows
! Most of this vocab is duplicated code from io.sockets.secure.unix so ! Most of this vocab is duplicated code from io.sockets.secure.unix so
! you could probably unify them. ! you could probably unify them.
M: openssl ssl-supported? t ; M: openssl ssl-supported? t ;
M: openssl ssl-certificate-verification-supported? f ;
: <ssl-socket> ( winsock -- ssl ) : <ssl-socket> ( winsock -- ssl )
[ handle>> alien-address BIO_NOCLOSE BIO_new_socket ] keep <ssl-handle> [ handle>> alien-address BIO_NOCLOSE BIO_new_socket ] keep <ssl-handle>
@ -20,6 +22,10 @@ M: openssl ssl-supported? t ;
M: secure ((client)) ( addrspec -- handle ) M: secure ((client)) ( addrspec -- handle )
addrspec>> ((client)) <ssl-socket> ; addrspec>> ((client)) <ssl-socket> ;
M: secure (get-local-address) ( handle remote -- sockaddr )
[ file>> handle>> ] [ addrspec>> empty-sockaddr/size int <ref> ] bi*
[ getsockname socket-error ] 2keep drop ;
: establish-ssl-connection ( client-out remote -- ) : establish-ssl-connection ( client-out remote -- )
make-sockaddr/size <ConnectEx-args> make-sockaddr/size <ConnectEx-args>
swap >>port swap >>port