diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index b34d4b20ad..549362ad0c 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -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 ; - -: ( read-handle write-handle -- input-port output-port ) - [ - [ |dispose ] - [ |dispose ] bi* - ] with-destructors ; diff --git a/extra/io/sockets/sockets.factor b/extra/io/sockets/sockets.factor index 93185f50f6..c5dbded093 100755 --- a/extra/io/sockets/sockets.factor +++ b/extra/io/sockets/sockets.factor @@ -161,6 +161,11 @@ GENERIC: (get-remote-address) ( handle remote -- sockaddr ) : get-remote-address ( handle local -- remote ) [ (get-remote-address) ] keep parse-sockaddr ; +: ( handle -- input-port output-port ) + [ + [ |dispose ] [ |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 [ |dispose ] bi@ dup r> + >r [ |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 + ] keep encoding>> swap ; TUPLE: datagram-port < port addr ; diff --git a/extra/io/unix/backend/backend.factor b/extra/io/unix/backend/backend.factor index eecb0daf8f..2a85beac02 100755 --- a/extra/io/unix/backend/backend.factor +++ b/extra/io/unix/backend/backend.factor @@ -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,10 +17,12 @@ 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). - [ F_SETFL O_NONBLOCK fcntl drop ] - [ F_SETFD FD_CLOEXEC fcntl drop ] - [ f fd boa ] - tri ; + fd new + swap + [ F_SETFL O_NONBLOCK fcntl drop ] + [ F_SETFD FD_CLOEXEC fcntl drop ] + [ >>fd ] + tri ; M: fd dispose* [ cancel-operation ] [ fd>> close-file ] bi ; @@ -98,15 +99,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 ) diff --git a/extra/io/unix/sockets/secure/secure-tests.factor b/extra/io/unix/sockets/secure/secure-tests.factor index 0df3c3d96b..a93a30379c 100644 --- a/extra/io/unix/sockets/secure/secure-tests.factor +++ b/extra/io/unix/sockets/secure/secure-tests.factor @@ -118,10 +118,12 @@ concurrency.promises byte-arrays locals calendar io.timeouts ; ] unit-test [ - [ - "127.0.0.1" "port" get ?promise - ascii drop 1 seconds over set-timeout dispose - ] with-secure-context + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" "port" get ?promise + ascii 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 [ - [ - "127.0.0.1" 0 ascii [ - dup addr>> addrspec>> port>> "port" get fulfill - accept drop 1 seconds over set-timeout dispose - ] with-disposal - ] with-test-context + 1 seconds secure-socket-timeout [ + [ + "127.0.0.1" 0 ascii [ + dup addr>> addrspec>> port>> "port" get fulfill + accept drop dispose + ] with-disposal + ] with-test-context + ] with-variable ] [ io-timeout? ] must-fail-with diff --git a/extra/io/unix/sockets/secure/secure.factor b/extra/io/unix/sockets/secure/secure.factor index 4a99164acb..70e015ec8e 100755 --- a/extra/io/unix/sockets/secure/secure.factor +++ b/extra/io/unix/sockets/secure/secure.factor @@ -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 ; diff --git a/extra/openssl/openssl.factor b/extra/openssl/openssl.factor index bf00d64020..80274cdac5 100755 --- a/extra/openssl/openssl.factor +++ b/extra/openssl/openssl.factor @@ -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 + default-secure-context set-global + current-secure-context + ] when + ] unless* ; : ( 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*