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

SSL API fleshed out, doesn't work yet

db4
Slava Pestov 2008-05-12 19:23:32 -05:00
parent 1260c1ba51
commit dfb25c3350
5 changed files with 24 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/continuations/continuations-tests.factor
View File

@ -119,3 +119,5 @@ T{ dispose-dummy } "b" set
[ t ] [ "b" get disposed?>> ] unit-test [ t ] [ "b" get disposed?>> ] unit-test
[ ] [ [ return ] with-return ] unit-test [ ] [ [ return ] with-return ] unit-test
[ { } [ ] attempt-all ] [ attempt-all-error? ] must-fail-with

2
extra/http/http.factor
View File

@ -17,6 +17,8 @@ IN: http
: http-port 80 ; inline : http-port 80 ; inline
: https-port 443 ; inline
: url-quotable? ( ch -- ? ) : url-quotable? ( ch -- ? )
#! In a URL, can this character be used without #! In a URL, can this character be used without
#! URL-encoding? #! URL-encoding?

4
extra/io/unix/sockets/secure/secure.factor
View File

@ -12,7 +12,7 @@ IN: io.unix.sockets.secure
! todo: SSL_pending, rehandshake ! todo: SSL_pending, rehandshake
! do we call write twice, wth 0 bytes at the end? ! do we call write twice, wth 0 bytes at the end?
M: ssl handle-fd file>> ; M: ssl-handle handle-fd file>> ;
: syscall-error ( port r -- ) : syscall-error ( port r -- )
ERR_get_error dup zero? [ ERR_get_error dup zero? [
@ -90,6 +90,6 @@ M: ssl ((client)) ( addrspec -- handle )
} case ; } case ;
M: ssl-handle (wait-to-connect) M: ssl-handle (wait-to-connect)
handle>> handle>> ! ssl handle>> ! ssl
SSL_connect SSL_connect
check-connect-response ; check-connect-response ;

2
extra/io/unix/sockets/sockets.factor
View File

@ -41,7 +41,7 @@ M: integer (wait-to-connect)
M: connect-task do-io-task M: connect-task do-io-task
port>> dup handle>> (wait-to-connect) ; port>> dup handle>> (wait-to-connect) ;
M: integer wait-to-connect ( client-out fd -- ) M: object wait-to-connect ( client-out fd -- )
drop drop
[ <connect-task> add-io-task ] with-port-continuation [ <connect-task> add-io-task ] with-port-continuation
pending-error ; pending-error ;

21
extra/openssl/openssl.factor
View File

@ -2,7 +2,7 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays kernel debugger sequences namespaces math USING: accessors byte-arrays kernel debugger sequences namespaces math
math.order combinators init alien alien.c-types alien.strings libc math.order combinators init alien alien.c-types alien.strings libc
continuations destructors continuations destructors debugger inspector
locals unicode.case locals unicode.case
openssl.libcrypto openssl.libssl openssl.libcrypto openssl.libssl
io.nonblocking io.files io.encodings.ascii io.sockets.secure ; io.nonblocking io.files io.encodings.ascii io.sockets.secure ;
@ -117,10 +117,19 @@ M: openssl-context dispose
dup handle>> [ SSL_CTX_free ] when* f >>handle dup handle>> [ SSL_CTX_free ] when* f >>handle
drop ; drop ;
TUPLE: ssl-handle file handle ; TUPLE: ssl-handle file handle disposed ;
ERROR: no-ssl-context ;
M: no-ssl-context summary
drop "SSL operations must be wrapped in calls to with-ssl-context" ;
: current-ssl-context ( -- ctx )
ssl-context get [ no-ssl-context ] unless* ;
: <ssl-handle> ( fd -- ssl ) : <ssl-handle> ( fd -- ssl )
ssl-context get handle>> SSL_new dup ssl-error ssl-handle boa ; current-ssl-context handle>> SSL_new dup ssl-error
f ssl-handle boa ;
: <ssl-socket> ( fd -- ssl ) : <ssl-socket> ( fd -- ssl )
[ BIO_NOCLOSE BIO_new_socket dup ssl-error ] keep [ BIO_NOCLOSE BIO_new_socket dup ssl-error ] keep
@ -130,7 +139,11 @@ TUPLE: ssl-handle file handle ;
M: ssl-handle init-handle drop ; M: ssl-handle init-handle drop ;
M: ssl-handle close-handle M: ssl-handle close-handle
[ file>> close-handle ] [ handle>> SSL_free ] bi ; dup disposed>> [ drop ] [
[ t >>disposed drop ]
[ file>> close-handle ]
[ handle>> SSL_free ] tri
] if ;
ERROR: certificate-verify-error result ; ERROR: certificate-verify-error result ;