SSL context is now implicit

db4
Slava Pestov 2008-05-21 15:54:27 -05:00
parent bf01d85e12
commit f1c8f3c559
6 changed files with 49 additions and 41 deletions

View File

@ -115,7 +115,7 @@ M: output-port dispose*
[
[ handle>> &dispose drop ]
[ port-flush ]
[ [ handle>> shutdown ] with-timeout ]
[ handle>> shutdown ]
tri
] with-destructors ;
@ -129,12 +129,6 @@ M: port cancel-operation handle>> cancel-operation ;
M: port dispose*
[
[ handle>> &dispose drop ]
[ [ handle>> shutdown ] with-timeout ]
[ handle>> shutdown ]
bi
] with-destructors ;
: <ports> ( read-handle write-handle -- input-port output-port )
[
[ <input-port> |dispose ]
[ <output-port> |dispose ] bi*
] with-destructors ;

View File

@ -161,6 +161,11 @@ GENERIC: (get-remote-address) ( handle remote -- sockaddr )
: get-remote-address ( handle local -- remote )
[ (get-remote-address) ] keep parse-sockaddr ;
: <ports> ( handle -- input-port output-port )
[
[ <input-port> |dispose ] [ <output-port> |dispose ] bi
] with-destructors ;
GENERIC: establish-connection ( client-out remote -- )
GENERIC: ((client)) ( remote -- handle )
@ -173,7 +178,7 @@ M: object (client) ( remote -- client-in client-out local )
[
[ ((client)) ] keep
[
>r dup <ports> [ |dispose ] bi@ dup r>
>r <ports> [ |dispose ] bi@ dup r>
establish-connection
]
[ get-local-address ]
@ -210,7 +215,7 @@ GENERIC: (accept) ( server addrspec -- handle sockaddr )
dup addr>>
[ (accept) ] keep
parse-sockaddr swap
dup <ports>
<ports>
] keep encoding>> <encoder-duplex> swap ;
TUPLE: datagram-port < port addr ;

View File

@ -8,7 +8,6 @@ io.encodings.utf8 destructors accessors inspector combinators ;
QUALIFIED: io
IN: io.unix.backend
! I/O tasks
GENERIC: handle-fd ( handle -- fd )
TUPLE: fd fd disposed ;
@ -18,9 +17,11 @@ TUPLE: fd fd disposed ;
#! since on OS X 10.3, this operation fails from init-io
#! when running the Factor.app (presumably because fd 0 and
#! 1 are closed).
fd new
swap
[ F_SETFL O_NONBLOCK fcntl drop ]
[ F_SETFD FD_CLOEXEC fcntl drop ]
[ f fd boa ]
[ >>fd ]
tri ;
M: fd dispose*
@ -99,15 +100,6 @@ M: io-timeout summary drop "I/O operation timed out" ;
! Some general stuff
: file-mode OCT: 0666 ;
: (io-error) ( -- * ) err_no strerror throw ;
: check-errno ( -- )
err_no dup zero? [ drop ] [ strerror throw ] if ;
: check-null ( n -- ) zero? [ (io-error) ] when ;
: io-error ( n -- ) 0 < [ (io-error) ] when ;
! Readers
: (refill) ( port -- n )
[ handle>> ]

View File

@ -118,10 +118,12 @@ concurrency.promises byte-arrays locals calendar io.timeouts ;
] unit-test
[
1 seconds secure-socket-timeout [
<secure-config> [
"127.0.0.1" "port" get ?promise <inet4> <secure>
ascii <client> drop 1 seconds over set-timeout dispose
ascii <client> drop dispose
] with-secure-context
] with-variable
] [ io-timeout? ] must-fail-with
! Server socket shutdown timeout
@ -137,10 +139,12 @@ concurrency.promises byte-arrays locals calendar io.timeouts ;
] unit-test
[
1 seconds secure-socket-timeout [
[
"127.0.0.1" 0 <inet4> <secure> ascii <server> [
dup addr>> addrspec>> port>> "port" get fulfill
accept drop 1 seconds over set-timeout dispose
accept drop dispose
] with-disposal
] with-test-context
] with-variable
] [ io-timeout? ] must-fail-with

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays kernel debugger sequences namespaces math
USING: accessors unix byte-arrays kernel debugger sequences namespaces math
math.order combinators init alien alien.c-types alien.strings libc
continuations destructors
openssl openssl.libcrypto openssl.libssl
@ -15,7 +15,7 @@ M: ssl-handle handle-fd file>> handle-fd ;
ERR_get_error dup zero? [
drop
{
{ -1 [ (io-error) ] }
{ -1 [ err_no ECONNRESET = [ premature-close ] [ (io-error) ] if ] }
{ 0 [ premature-close ] }
} case
] [
@ -157,5 +157,7 @@ M: secure (accept)
dup dup handle>> SSL_shutdown check-shutdown-response
dup [ dupd wait-for-fd (shutdown) ] [ 2drop ] if ;
M: ssl-handle shutdown USE: io.streams.c
dup connected>> [ f >>connected (shutdown) ] [ drop ] if ;
M: ssl-handle shutdown
dup connected>> [
f >>connected [ (shutdown) ] with-timeout
] [ drop ] if ;

View File

@ -159,11 +159,22 @@ ERROR: no-secure-context ;
M: no-secure-context summary
drop "Secure socket operations must be wrapped in calls to with-secure-context" ;
: current-ssl-context ( -- ctx )
secure-context get [ no-secure-context ] unless* ;
SYMBOL: default-secure-context
: context-expired? ( context -- ? )
dup [ handle>> expired? ] [ drop t ] if ;
: current-secure-context ( -- ctx )
secure-context get [
default-secure-context get dup context-expired? [
drop
<secure-config> <secure-context> default-secure-context set-global
current-secure-context
] when
] unless* ;
: <ssl-handle> ( fd -- ssl )
current-ssl-context handle>> SSL_new dup ssl-error
current-secure-context handle>> SSL_new dup ssl-error
f f ssl-handle boa ;
M: ssl-handle dispose*