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

io.sockets.secure.openssl: libssl error is opaque, check that cert files 

exist in Factor beforehand so we can get a nicer error message.
Add missing USE: and neaten up the list.
db4
Doug Coleman 2013-11-16 15:59:31 -08:00
parent 3cab340527
commit 4bcb356ba8
2 changed files with 18 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
basis/io/sockets/secure/openssl/openssl-tests.factor
View File

@ -1,13 +1,6 @@
USING: USING: accessors alien http.client io.sockets io.sockets.private
accessors io.sockets.secure.openssl kernel openssl.libcrypto openssl.libssl
alien sequences tools.test urls unix.ffi ;
http.client
io.sockets io.sockets.private io.sockets.secure.openssl
kernel
openssl.libcrypto openssl.libssl
sequences
tools.test
urls ;
IN: io.sockets.secure.openssl.tests IN: io.sockets.secure.openssl.tests
: new-ssl ( -- ssl ) : new-ssl ( -- ssl )

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

@ -5,7 +5,8 @@ assocs byte-arrays classes.struct combinators destructors
io.backend io.encodings.8-bit.latin1 io.encodings.utf8 io.backend io.encodings.8-bit.latin1 io.encodings.utf8
io.pathnames io.sockets.secure kernel libc locals math io.pathnames io.sockets.secure kernel libc locals math
math.order math.parser namespaces openssl openssl.libcrypto math.order math.parser namespaces openssl openssl.libcrypto
openssl.libssl random sequences splitting unicode.case ; openssl.libssl random sequences splitting unicode.case
io.files ;
IN: io.sockets.secure.openssl IN: io.sockets.secure.openssl
GENERIC: ssl-method ( symbol -- method ) GENERIC: ssl-method ( symbol -- method )
@ -23,9 +24,17 @@ TUPLE: openssl-context < secure-context aliens sessions ;
[ 32 random-bits >hex dup length SSL_CTX_set_session_id_context ssl-error ] [ 32 random-bits >hex dup length SSL_CTX_set_session_id_context ssl-error ]
bi ; bi ;
ERROR: file-expected path ;
: ensure-exists ( path -- path )
dup exists? [ file-expected ] unless ; inline
: ssl-file-path ( path -- path' )
absolute-path ensure-exists ;
: load-certificate-chain ( ctx -- ) : load-certificate-chain ( ctx -- )
dup config>> key-file>> [ dup config>> key-file>> [
[ handle>> ] [ config>> key-file>> absolute-path ] bi [ handle>> ] [ config>> key-file>> ssl-file-path ] bi
SSL_CTX_use_certificate_chain_file SSL_CTX_use_certificate_chain_file
ssl-error ssl-error
] [ drop ] if ; ] [ drop ] if ;
@ -55,7 +64,8 @@ TUPLE: openssl-context < secure-context aliens sessions ;
: use-private-key-file ( ctx -- ) : use-private-key-file ( ctx -- )
dup config>> key-file>> [ dup config>> key-file>> [
[ handle>> ] [ config>> key-file>> absolute-path ] bi [ handle>> ]
[ config>> key-file>> ssl-file-path ] bi
SSL_FILETYPE_PEM SSL_CTX_use_PrivateKey_file SSL_FILETYPE_PEM SSL_CTX_use_PrivateKey_file
ssl-error ssl-error
] [ drop ] if ; ] [ drop ] if ;
@ -65,8 +75,8 @@ TUPLE: openssl-context < secure-context aliens sessions ;
[ handle>> ] [ handle>> ]
[ [
config>> config>>
[ ca-file>> dup [ absolute-path ] when ] [ ca-file>> dup [ ssl-file-path ] when ]
[ ca-path>> dup [ absolute-path ] when ] bi [ ca-path>> dup [ ssl-file-path ] when ] bi
] bi ] bi
SSL_CTX_load_verify_locations SSL_CTX_load_verify_locations
] [ handle>> SSL_CTX_set_default_verify_paths ] if ssl-error ; ] [ handle>> SSL_CTX_set_default_verify_paths ] if ssl-error ;