Working on SSL and refactoring related code to make things easier to plug in

core/alien/c-types/c-types.factor

@@ -382,4 +382,6 @@ M: long-long-type box-return ( type -- )
     "double" define-primitive-type
 
     os winnt? cpu x86.64? and "longlong" "long" ? "ptrdiff_t" typedef
+
+    "ulong" "size_t" typedef
 ] with-compilation-unit

core/continuations/continuations.factor

@@ -139,10 +139,16 @@ SYMBOL: thread-error-hook
     over >r compose [ dip rethrow ] curry
     recover r> call ; inline
 
+ERROR: attempt-all-error ;
+
 : attempt-all ( seq quot -- obj )
-    [
+    over empty? [
-        [ [ , f ] compose [ , drop t ] recover ] curry all?
+        attempt-all-error
-    ] { } make peek swap [ rethrow ] when ; inline
+    ] [
+        [
+            [ [ , f ] compose [ , drop t ] recover ] curry all?
+        ] { } make peek swap [ rethrow ] when
+    ] if ; inline
 
 GENERIC: dispose ( object -- )
 

core/debugger/debugger.factor

@@ -298,6 +298,8 @@ M: immutable-slot summary drop "Slot is immutable" ;
 
 M: bad-create summary drop "Bad parameters to create" ;
 
+M: attempt-all-error summary drop "Nothing to attempt" ;
+
 <PRIVATE
 
 : init-debugger ( -- )

extra/db/postgresql/ffi/ffi.factor

@@ -52,7 +52,6 @@ IN: db.postgresql.ffi
 
 : InvalidOid 0 ; inline
 
-TYPEDEF: int size_t
 TYPEDEF: int ConnStatusType
 TYPEDEF: int ExecStatusType 
 TYPEDEF: int PostgresPollingStatusType

extra/destructors/destructors.factor

@@ -1,30 +1,17 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: continuations io.backend io.nonblocking libc kernel
+USING: accessors continuations io.backend io.nonblocking libc
-namespaces sequences system vectors ;
+kernel namespaces sequences system vectors ;
 IN: destructors
 
 SYMBOL: error-destructors
 SYMBOL: always-destructors
 
-TUPLE: destructor object destroyed? ;
-
-M: destructor dispose
-    dup destructor-destroyed? [
-        drop
-    ] [
-        dup destructor-object dispose 
-        t swap set-destructor-destroyed?
-    ] if ;
-
-: <destructor> ( obj -- newobj )
-    f destructor boa ;
-
 : add-error-destructor ( obj -- )
-    <destructor> error-destructors get push ;
+    error-destructors get push ;
 
 : add-always-destructor ( obj -- )
-    <destructor> always-destructors get push ;
+    always-destructors get push ;
 
 : do-always-destructors ( -- )
     always-destructors get <reversed> dispose-each ;
@@ -40,19 +27,28 @@ M: destructor dispose
         [ do-error-destructors ] cleanup
     ] with-scope ; inline
 
+TUPLE: only-once object destroyed ;
+
+M: only-once dispose
+    dup destroyed>> [ drop ] [
+        [ object>> dispose ] [ t >>destroyed drop ] bi
+    ] if ;
+
+: <only-once> f only-once boa ;
+
 ! Memory allocations
 TUPLE: memory-destructor alien ;
 
 C: <memory-destructor> memory-destructor
 
 M: memory-destructor dispose ( obj -- )
-    memory-destructor-alien free ;
+    alien>> free ;
 
 : free-always ( alien -- )
-    <memory-destructor> add-always-destructor ;
+    <memory-destructor> <only-once> add-always-destructor ;
 
 : free-later ( alien -- )
-    <memory-destructor> add-error-destructor ;
+    <memory-destructor> <only-once> add-error-destructor ;
 
 ! Handles
 TUPLE: handle-destructor alien ;
@@ -60,13 +56,13 @@ TUPLE: handle-destructor alien ;
 C: <handle-destructor> handle-destructor
 
 M: handle-destructor dispose ( obj -- )
-    handle-destructor-alien close-handle ;
+    alien>> close-handle ;
 
 : close-always ( handle -- )
-    <handle-destructor> add-always-destructor ;
+    <handle-destructor> <only-once> add-always-destructor ;
 
 : close-later ( handle -- )
-    <handle-destructor> add-error-destructor ;
+    <handle-destructor> <only-once> add-error-destructor ;
 
 ! Sockets
 TUPLE: socket-destructor alien ;
@@ -76,10 +72,10 @@ C: <socket-destructor> socket-destructor
 HOOK: destruct-socket io-backend ( obj -- )
 
 M: socket-destructor dispose ( obj -- )
-    socket-destructor-alien destruct-socket ;
+    alien>> destruct-socket ;
 
 : close-socket-always ( handle -- )
-    <socket-destructor> add-always-destructor ;
+    <socket-destructor> <only-once> add-always-destructor ;
 
 : close-socket-later ( handle -- )
-    <socket-destructor> add-error-destructor ;
+    <socket-destructor> <only-once> add-error-destructor ;

extra/io/launcher/launcher.factor

@@ -165,7 +165,7 @@ M: object run-pipeline-element
                 run-detached
             ]
             [ out>> close-handle ]
-            [ in>> <reader> ]
+            [ in>> <input-port> ]
         } cleave r> <decoder>
     ] with-destructors ;
 
@@ -182,7 +182,7 @@ M: object run-pipeline-element
                 run-detached
             ]
             [ in>> close-handle ]
-            [ out>> <writer> ]
+            [ out>> <output-port> ]
         } cleave r> <encoder>
     ] with-destructors ;
 
@@ -200,7 +200,7 @@ M: object run-pipeline-element
                 run-detached
             ]
             [ [ in>> close-handle ] [ out>> close-handle ] bi* ]
-            [ [ in>> <reader> ] [ out>> <writer> ] bi* ]
+            [ [ in>> <input-port> ] [ out>> <output-port> ] bi* ]
         } 2cleave r> <encoder-duplex>
     ] with-destructors ;
 

extra/io/nonblocking/nonblocking-docs.factor

@@ -11,10 +11,10 @@ $nl
 { $subsection <buffered-port> }
 "Input ports:"
 { $subsection input-port }
-{ $subsection <reader> }
+{ $subsection <input-port> }
 "Output ports:"
 { $subsection output-port }
-{ $subsection <writer> }
+{ $subsection <output-port> }
 "Global native I/O protocol:"
 { $subsection io-backend }
 { $subsection init-io }
@@ -62,12 +62,12 @@ HELP: <buffered-port>
 { $description "Creates a new " { $link port } " using the specified native handle and a default-sized I/O buffer." } 
 $low-level-note ;
 
-HELP: <reader>
+HELP: <input-port>
 { $values { "handle" "a native handle identifying an I/O resource" } { "input-port" "a new " { $link input-port } } }
 { $description "Creates a new " { $link input-port } " using the specified native handle and a default-sized input buffer." } 
 $low-level-note ;
 
-HELP: <writer>
+HELP: <output-port>
 { $values { "handle" "a native handle identifying an I/O resource" } { "output-port" "a new " { $link output-port } } }
 { $description "Creates a new " { $link output-port } " using the specified native handle and a default-sized input buffer." } 
 $low-level-note ;

extra/io/nonblocking/nonblocking.factor

@@ -3,7 +3,8 @@
 USING: math kernel io sequences io.buffers io.timeouts generic
 byte-vectors system io.encodings math.order io.backend
 continuations debugger classes byte-arrays namespaces splitting
-dlists assocs io.encodings.binary inspector accessors ;
+dlists assocs io.encodings.binary inspector accessors
+destructors ;
 IN: io.nonblocking
 
 SYMBOL: default-buffer-size
@@ -29,16 +30,19 @@ GENERIC: close-handle ( handle -- )
 
 TUPLE: input-port < port ;
 
-: <reader> ( handle -- input-port )
+: <input-port> ( handle -- input-port )
     input-port <buffered-port> ;
 
 TUPLE: output-port < port ;
 
-: <writer> ( handle -- output-port )
+: <output-port> ( handle -- output-port )
     output-port <buffered-port> ;
 
-: <reader&writer> ( read-handle write-handle -- input-port output-port )
+: <ports> ( read-handle write-handle -- input-port output-port )
-    swap <reader> [ swap <writer> ] [ ] [ dispose drop ] cleanup ;
+    [
+        [ <input-port> dup add-error-destructor ]
+        [ <output-port> dup add-error-destructor ] bi*
+    ] with-destructors ;
 
 : pending-error ( port -- )
     [ f ] change-error drop [ throw ] when* ;

extra/io/pipes/pipes.factor

@@ -17,16 +17,16 @@ HOOK: (pipe) io-backend ( -- pipe )
     [
         >r (pipe)
         [ add-error-destructor ]
-        [ in>> <reader> ]
+        [ in>> <input-port> ]
-        [ out>> <writer> ]
+        [ out>> <output-port> ]
         tri
         r> <encoder-duplex>
     ] with-destructors ;
 
 <PRIVATE
 
-: ?reader [ <reader> dup add-always-destructor ] [ input-stream get ] if* ;
+: ?reader [ <input-port> dup add-always-destructor ] [ input-stream get ] if* ;
-: ?writer [ <writer> dup add-always-destructor ] [ output-stream get ] if* ;
+: ?writer [ <output-port> dup add-always-destructor ] [ output-stream get ] if* ;
 
 GENERIC: run-pipeline-element ( input-fd output-fd obj -- quot )
 

extra/io/sockets/secure/secure.factor

@@ -1,6 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel symbols namespaces continuations ;
+USING: accessors kernel symbols namespaces continuations
+io.sockets sequences ;
 IN: io.sockets.secure
 
 SYMBOL: ssl-backend
@@ -22,3 +23,16 @@ HOOK: <ssl-context> ssl-backend ( config -- context )
         [ <ssl-context> ] [ [ ssl-context set ] prepose ] bi*
         with-disposal
     ] with-scope ; inline
+
+TUPLE: ssl addrspec ;
+
+C: <ssl> ssl
+
+<PRIVATE
+
+PREDICATE: ssl-inet < ssl addrspec>> inet? ;
+
+M: ssl-inet (client)
+    addrspec>> resolve-client-addr [ <ssl> ] map (client) ;
+
+PRIVATE>

extra/io/sockets/sockets.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: generic kernel io.backend namespaces continuations
 sequences arrays io.encodings io.nonblocking io.streams.duplex
-accessors ;
+accessors destructors ;
 IN: io.sockets
 
 TUPLE: local path ;
@@ -22,11 +22,21 @@ TUPLE: inet host port ;
 
 C: <inet> inet
 
-HOOK: ((client)) io-backend ( addrspec -- client-in client-out )
+GENERIC: wait-to-connect ( client-out handle -- )
+
+GENERIC: ((client)) ( addrspec -- handle )
 
 GENERIC: (client) ( addrspec -- client-in client-out )
-M: array (client) [ ((client)) 2array ] attempt-all first2 ;
+
-M: object (client) ((client)) ;
+M: array (client) [ (client) 2array ] attempt-all first2 ;
+
+M: object (client)
+    [
+        ((client))
+        dup <ports>
+        2dup [ add-error-destructor ] bi@
+        dup dup handle>> wait-to-connect
+    ] with-destructors ;
 
 : <client> ( addrspec encoding -- stream )
     >r (client) r> <encoder-duplex> ;
@@ -42,7 +52,7 @@ HOOK: (server) io-backend ( addrspec -- handle )
 HOOK: (accept) io-backend ( server -- addrspec handle )
 
 : accept ( server -- client addrspec )
-    [ (accept) dup <reader&writer> ] [ encoding>> ] bi
+    [ (accept) dup <ports> ] [ encoding>> ] bi
     <encoder-duplex> swap ;
 
 HOOK: <datagram> io-backend ( addrspec -- datagram )
@@ -55,8 +65,8 @@ HOOK: resolve-host io-backend ( host serv passive? -- seq )
 
 HOOK: host-name io-backend ( -- string )
 
+: resolve-client-addr ( inet -- seq )
+    [ host>> ] [ port>> ] bi f resolve-host ;
+
 M: inet (client)
-    [ host>> ] [ port>> ] bi f resolve-host
+    resolve-client-addr (client) ;
-    [ empty? [ "Host name lookup failed" throw ] when ]
-    [ (client) ]
-    bi ;

extra/io/unix/backend/backend.factor

@@ -11,7 +11,11 @@ IN: io.unix.backend
 ! I/O tasks
 TUPLE: io-task port callbacks ;
 
-: io-task-fd port>> handle>> ;
+GENERIC: handle-fd ( handle -- fd )
+
+M: integer handle-fd ;
+
+: io-task-fd port>> handle>> handle-fd ;
 
 : <io-task> ( port continuation/f class -- task )
     new
@@ -84,9 +88,10 @@ M: integer init-handle ( fd -- )
 M: integer close-handle ( fd -- )
     close ;
 
+TUPLE: unix-io-error error port ;
+
 : report-error ( error port -- )
-    [ "Error on fd " % dup handle>> # ": " % swap % ] "" make
+    tuck unix-io-error boa >>error drop ;
-    >>error drop ;
 
 : ignorable-error? ( n -- ? )
     [ EAGAIN number= ] [ EINTR number= ] bi or ;
@@ -100,7 +105,7 @@ M: integer close-handle ( fd -- )
     dup rot unregister-io-task
     io-task-callbacks [ resume ] each ;
 
-: handle-io-task ( mx task -- )
+: perform-io-task ( mx task -- )
     dup do-io-task [ pop-callbacks ] [ 2drop ] if ;
 
 : handle-timeout ( port mx assoc -- )
@@ -127,25 +132,25 @@ M: unix cancel-io ( port -- )
     [ buffer>> buffer-end ]
     [ buffer>> buffer-capacity ] tri read ;
 
-: refill ( port -- ? )
+GENERIC: refill ( port handle -- ? )
+
+M: integer refill
     #! Return f if there is a recoverable error
+    drop
     dup buffer>> buffer-empty? [
-        dup (refill)  dup 0 >= [
+        dup (refill) dup 0 >= [
             swap buffer>> n>buffer t
         ] [
             drop defer-error
         ] if
-    ] [
+    ] [ drop t ] if ;
-        drop t
-    ] if ;
 
 TUPLE: read-task < input-task ;
 
-: <read-task> ( port continuation -- task )
+: <read-task> ( port continuation -- task ) read-task <io-task> ;
-    read-task <io-task> ;
 
 M: read-task do-io-task
-    io-task-port dup refill
+    port>> dup dup handle>> refill
     [ [ reader-eof ] [ drop ] if ] keep ;
 
 M: unix (wait-to-read)
@@ -153,7 +158,10 @@ M: unix (wait-to-read)
     pending-error ;
 
 ! Writers
-: write-step ( port -- ? )
+GENERIC: drain ( port handle -- ? )
+
+M: integer drain
+    drop
     dup
     [ handle>> ]
     [ buffer>> buffer@ ]
@@ -164,12 +172,11 @@ M: unix (wait-to-read)
 
 TUPLE: write-task < output-task ;
 
-: <write-task> ( port continuation -- task )
+: <write-task> ( port continuation -- task ) write-task <io-task> ;
-    write-task <io-task> ;
 
 M: write-task do-io-task
     io-task-port dup [ buffer>> buffer-empty? ] [ port-error ] bi or
-    [ 0 swap buffer>> buffer-reset t ] [ write-step ] if ;
+    [ 0 swap buffer>> buffer-reset t ] [ dup handle>> drain ] if ;
 
 : add-write-io-task ( port continuation -- )
     over handle>> mx get-global writes>> at*
@@ -186,9 +193,9 @@ M: unix io-multiplex ( ms/f -- )
     mx get-global wait-for-events ;
 
 M: unix (init-stdio) ( -- )
-    0 <reader>
+    0 <input-port>
-    1 <writer>
+    1 <output-port>
-    2 <writer> ;
+    2 <output-port> ;
 
 ! mx io-task for embedding an fd-based mx inside another mx
 TUPLE: mx-port < port mx ;

extra/io/unix/epoll/epoll.factor

@@ -43,10 +43,10 @@ M: epoll-mx unregister-io-task ( task mx -- )
     r> epoll_wait dup multiplexer-error ;
 
 : epoll-read-task ( mx fd -- )
-    over mx-reads at* [ handle-io-task ] [ 2drop ] if ;
+    over mx-reads at* [ perform-io-task ] [ 2drop ] if ;
 
 : epoll-write-task ( mx fd -- )
-    over mx-writes at* [ handle-io-task ] [ 2drop ] if ;
+    over mx-writes at* [ perform-io-task ] [ 2drop ] if ;
 
 : handle-event ( mx kevent -- )
     epoll-event-fd 2dup epoll-read-task epoll-write-task ;

extra/io/unix/files/files.factor

@@ -21,7 +21,7 @@ M: unix cd ( path -- )
     O_RDONLY file-mode open dup io-error ;
 
 M: unix (file-reader) ( path -- stream )
-    open-read <reader> ;
+    open-read <input-port> ;
 
 : write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline
 
@@ -29,7 +29,7 @@ M: unix (file-reader) ( path -- stream )
     write-flags file-mode open dup io-error ;
 
 M: unix (file-writer) ( path -- stream )
-    open-write <writer> ;
+    open-write <output-port> ;
 
 : append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline
 
@@ -38,7 +38,7 @@ M: unix (file-writer) ( path -- stream )
     [ dup 0 SEEK_END lseek io-error ] [ ] [ close ] cleanup ;
 
 M: unix (file-appender) ( path -- stream )
-    open-append <writer> ;
+    open-append <output-port> ;
 
 : touch-mode ( -- n )
     { O_WRONLY O_APPEND O_CREAT O_EXCL } flags ; foldable

extra/io/unix/kqueue/kqueue.factor

@@ -57,10 +57,10 @@ M: kqueue-mx unregister-io-task ( task mx -- )
     dup multiplexer-error ;
 
 :: kevent-read-task ( mx fd kevent -- )
-    mx fd mx reads>> at handle-io-task ;
+    mx fd mx reads>> at perform-io-task ;
 
 :: kevent-write-task ( mx fd kevent -- )
-    mx fd mx writes>> at handle-io-task ;
+    mx fd mx writes>> at perform-io-task ;
 
 :: kevent-proc-task ( mx pid kevent -- )
     pid wait-for-pid

extra/io/unix/select/select.factor

@@ -21,12 +21,12 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
 : clear-nth ( n seq -- ? )
     [ nth ] [ f -rot set-nth ] 2bi ;
 
-: handle-fd ( fd task fdset mx -- )
+: check-fd ( fd task fdset mx -- )
     roll munge rot clear-nth
-    [ swap handle-io-task ] [ 2drop ] if ;
+    [ swap perform-io-task ] [ 2drop ] if ;
 
-: handle-fdset ( tasks fdset mx -- )
+: check-fdset ( tasks fdset mx -- )
-    [ handle-fd ] 2curry assoc-each ;
+    [ check-fd ] 2curry assoc-each ;
 
 : init-fdset ( tasks fdset -- )
     [ >r drop t swap munge r> set-nth ] curry assoc-each ;
@@ -52,5 +52,5 @@ TUPLE: select-mx < mx read-fdset write-fdset ;
 M: select-mx wait-for-events ( ms mx -- )
     swap >r dup init-fdsets r> dup [ make-timeval ] when
     select multiplexer-error
-    dup read-fdset/tasks pick handle-fdset
+    dup read-fdset/tasks pick check-fdset
-    dup write-fdset/tasks rot handle-fdset ;
+    dup write-fdset/tasks rot check-fdset ;

extra/io/unix/sockets/secure/secure.factor

@@ -0,0 +1,95 @@
+! 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
+math.order combinators init alien alien.c-types alien.strings libc
+continuations destructors
+openssl openssl.libcrypto openssl.libssl
+io.files io.nonblocking io.unix.backend io.unix.sockets
+io.encodings.ascii io.buffers io.sockets io.sockets.secure
+unix.ffi ;
+IN: io.unix.sockets.secure
+
+! todo: SSL_pending, rehandshake
+! do we call write twice, wth 0 bytes at the end?
+
+M: ssl handle-fd file>> ;
+
+: syscall-error ( port r -- )
+    ERR_get_error dup zero? [
+        drop
+        {
+            { -1 [ err_no strerror ] }
+            { 0 [ "Premature EOF" ] }
+        } case
+    ] [
+        nip (ssl-error-string)
+    ] if swap report-error ;
+
+: check-response ( port r -- port r n )
+    over handle>> handle>> over SSL_get_error ; inline
+
+! Input ports
+: report-ssl-error ( port r -- )
+    drop ssl-error-string swap report-error ;
+
+: check-read-response ( port r -- ? )
+    check-response
+    {
+        { SSL_ERROR_NONE [ swap buffer>> n>buffer t ] }
+        { SSL_ERROR_ZERO_RETURN [ drop reader-eof t ] }
+        { SSL_ERROR_WANT_READ [ 2drop f ] }
+        { SSL_ERROR_WANT_WRITE [ 2drop f ] } ! XXX
+        { SSL_ERROR_SYSCALL [ syscall-error t ] }
+        { SSL_ERROR_SSL [ report-ssl-error t ] }
+    } case ;
+
+M: ssl-handle refill
+    drop
+    dup buffer>> buffer-empty? [
+        dup
+        [ handle>> handle>> ] ! ssl
+        [ buffer>> buffer-end ] ! buf
+        [ buffer>> buffer-capacity ] tri ! len
+        SSL_read
+        check-read-response
+    ] [ drop t ] if ;
+
+! Output ports
+: check-write-response ( port r -- ? )
+    check-response
+    {
+        { SSL_ERROR_NONE [ swap buffer>> buffer-consume f ] }
+        ! { SSL_ERROR_ZERO_RETURN [ drop reader-eof ] } ! XXX
+        { SSL_ERROR_WANT_READ [ 2drop f ] } ! XXX
+        { SSL_ERROR_WANT_WRITE [ 2drop f ] }
+        { SSL_ERROR_SYSCALL [ syscall-error t ] }
+        { SSL_ERROR_SSL [ report-ssl-error t ] }
+    } case ;
+
+M: ssl-handle drain
+    drop
+    dup
+    [ handle>> handle>> ] ! ssl
+    [ buffer>> buffer@ ] ! buf
+    [ buffer>> buffer-length ] tri ! len
+    SSL_write
+    check-write-response ;
+
+! Client sockets
+M: ssl ((client)) ( addrspec -- handle )
+    [ addrspec>> ((client)) <ssl-socket> ] with-destructors ;
+
+: check-connect-response ( port r -- ? )
+    check-response
+    {
+        { SSL_ERROR_NONE [ 2drop t ] }
+        { SSL_ERROR_WANT_READ [ 2drop f ] } ! XXX
+        { SSL_ERROR_WANT_WRITE [ 2drop f ] } ! XXX
+        { SSL_ERROR_SYSCALL [ syscall-error t ] }
+        { SSL_ERROR_SSL [ report-ssl-error t ] }
+    } case ;
+
+M: ssl-handle (wait-to-connect)
+    handle>> handle>> ! ssl
+    SSL_connect
+    check-connect-response ;

extra/io/unix/sockets/sockets.factor

@@ -5,22 +5,18 @@ namespaces threads sequences byte-arrays io.nonblocking
 io.binary io.unix.backend io.streams.duplex io.sockets.impl
 io.backend io.files io.files.private io.encodings.utf8
 math.parser continuations libc combinators system accessors
-qualified unix.ffi unix ;
+destructors qualified unix.ffi unix ;
 
 EXCLUDE: io => read write close ;
 EXCLUDE: io.sockets => accept ;
 
 IN: io.unix.sockets
 
-: pending-init-error ( port -- )
-    #! We close it here to avoid a resource leak; callers of
-    #! <client> don't set up error handlers until after <client>
-    #! returns (and if they did before, they wouldn't have
-    #! anything to close!)
-    dup port-error dup [ swap dispose throw ] [ 2drop ] if ;
-
 : socket-fd ( domain type -- socket )
-    0 socket dup io-error dup init-handle ;
+    0 socket
+    dup io-error
+    dup close-later
+    dup init-handle ;
 
 : sockopt ( fd level opt -- )
     1 <int> "int" heap-size setsockopt io-error ;
@@ -37,25 +33,24 @@ TUPLE: connect-task < output-task ;
 : <connect-task> ( port continuation -- task )
     connect-task <io-task> ;
 
+GENERIC: (wait-to-connect) ( port handle -- ? )
+
+M: integer (wait-to-connect)
+    f 0 write 0 < [ defer-error ] [ drop t ] if ;
+
 M: connect-task do-io-task
-    port>> dup handle>> f 0 write
+    port>> dup handle>> (wait-to-connect) ;
-    0 < [ defer-error ] [ drop t ] if ;
 
-: wait-to-connect ( port -- )
+M: integer wait-to-connect ( client-out fd -- )
-    [ <connect-task> add-io-task ] with-port-continuation drop ;
+    drop
+    [ <connect-task> add-io-task ] with-port-continuation
+    pending-error ;
 
-M: unix ((client)) ( addrspec -- client-in client-out )
+M: object ((client)) ( addrspec -- fd )
-    dup make-sockaddr/size >r >r
+    [ protocol-family SOCK_STREAM socket-fd ] [ make-sockaddr/size ] bi
-    protocol-family SOCK_STREAM socket-fd
+    [ 2drop ] [ connect ] 3bi
-    dup r> r> connect
+    zero? err_no EINPROGRESS = or
-    zero? err_no EINPROGRESS = or [
+    [ dup init-client-socket ] [ (io-error) ] if ;
-        dup init-client-socket
-        dup <reader&writer>
-        dup wait-to-connect
-        dup pending-init-error
-    ] [
-        dup close (io-error)
-    ] if ;
 
 ! Server sockets - TCP and Unix domain
 : init-server-socket ( fd -- )
@@ -83,15 +78,17 @@ M: accept-task do-io-task
 : wait-to-accept ( server -- )
     [ <accept-task> add-io-task ] with-port-continuation drop ;
 
-: server-fd ( addrspec type -- fd )
+: server-socket-fd ( addrspec type -- fd )
-    >r dup protocol-family r>  socket-fd
+    >r dup protocol-family r> socket-fd
     dup init-server-socket
     dup rot make-sockaddr/size bind
     zero? [ dup close (io-error) ] unless ;
 
 M: unix (server) ( addrspec -- handle )
-    SOCK_STREAM server-fd
+    [
-    dup 10 listen zero? [ dup close (io-error) ] unless ;
+        SOCK_STREAM server-socket-fd
+        dup 10 listen io-error
+    ] with-destructors ;
 
 M: unix (accept) ( server -- addrspec handle )
     #! Wait for a client connection.
@@ -102,7 +99,9 @@ M: unix (accept) ( server -- addrspec handle )
 
 ! Datagram sockets - UDP and Unix domain
 M: unix <datagram>
-    [ SOCK_DGRAM server-fd ] keep <datagram-port> ;
+    [
+        [ SOCK_DGRAM server-socket-fd ] keep <datagram-port>
+    ] with-destructors ;
 
 SYMBOL: receive-buffer
 

extra/io/unix/unix.factor

@@ -1,6 +1,13 @@
-USING: io.unix.backend io.unix.files io.unix.sockets
+USING: system words sequences vocabs.loader ;
-io.unix.launcher io.unix.mmap io.unix.pipes io.timeouts
+
-io.backend combinators namespaces system vocabs.loader
+{
-sequences words init ;
+    "io.unix.backend"
+    "io.unix.files"
+    "io.unix.sockets"
+    "io.unix.sockets.secure"
+    "io.unix.launcher"
+    "io.unix.mmap"
+    "io.unix.pipes"
+} [ require ] each
 
 "io.unix." os word-name append require

extra/io/windows/ce/backend/backend.factor

@@ -46,5 +46,5 @@ M: wince (init-stdio) ( -- )
             1 _getstdfilex _fileno
             2 _getstdfilex _fileno
         ] if [ f <win32-file> ] 3apply
-        rot <reader> -rot [ <writer> ] bi@
+        [ <input-port> ] [ <output-port> ] [ <output-port> ] tri*
     ] with-variable ;

extra/io/windows/ce/sockets/sockets.factor

@@ -32,7 +32,7 @@ M: win32-socket wince-write ( port port-handle -- )
     windows.winsock:winsock-error!=0/f ;
 
 M: wince (client) ( addrspec -- reader writer )
-    do-connect <win32-socket> dup <reader&writer> ;
+    do-connect <win32-socket> dup <ports> ;
 
 M: wince (server) ( addrspec -- handle )
     windows.winsock:SOCK_STREAM server-fd
@@ -52,7 +52,7 @@ M: wince (accept) ( server -- client )
                 [ windows.winsock:winsock-error ] when
             ] keep
         ] keep server-port-addr parse-sockaddr swap
-        <win32-socket> <reader&writer>
+        <win32-socket> <ports>
     ] with-timeout ;
 
 M: wince <datagram> ( addrspec -- datagram )

extra/io/windows/nt/sockets/sockets.factor

@@ -45,12 +45,16 @@ TUPLE: ConnectEx-args port
     "stdcall" alien-indirect drop
     winsock-error-string [ throw ] when* ;
 
-: connect-continuation ( ConnectEx port -- )
+: connect-continuation ( overlapped port -- )
-    >r ConnectEx-args-lpOverlapped* r>
     2dup save-callback
     get-overlapped-result drop ;
 
-M: winnt ((client)) ( addrspec -- client-in client-out )
+M: win32-socket wait-to-connect ( client-out handle -- )
+    [ overlapped>> swap connect-continuation ]
+    [ drop pending-error ]
+    2bi ;
+
+M: object ((client)) ( addrspec -- handle )
     [
         \ ConnectEx-args new
         over make-sockaddr/size pick init-connect
@@ -60,8 +64,7 @@ M: winnt ((client)) ( addrspec -- client-in client-out )
         dup ConnectEx-args-s* INADDR_ANY roll bind-socket
         dup (ConnectEx)
 
-        dup ConnectEx-args-s* <win32-socket> dup <reader&writer>
+        dup [ ConnectEx-args-s* ] [ ConnectEx-args-lpOverlapped* ] bi <win32-socket>
-        >r [ connect-continuation ] keep [ pending-error ] keep r>
     ] with-destructors ;
 
 TUPLE: AcceptEx-args port
@@ -117,7 +120,7 @@ TUPLE: AcceptEx-args port
     [ extract-remote-host ] keep
     ! addrspec AcceptEx
     [ AcceptEx-args-sAcceptSocket* add-completion ] keep
-    AcceptEx-args-sAcceptSocket* <win32-socket> ;
+    [ AcceptEx-args-sAcceptSocket* ] [ AcceptEx-args-lpOverlapped* ] bi <win32-socket> ;
 
 M: winnt (accept) ( server -- addrspec handle )
     [
@@ -135,7 +138,7 @@ M: winnt (server) ( addrspec -- handle )
     [
         SOCK_STREAM server-fd dup listen-on-socket
         dup add-completion
-        <win32-socket>
+        f <win32-socket>
     ] with-destructors ;
 
 M: winnt <datagram> ( addrspec -- datagram )
@@ -143,7 +146,7 @@ M: winnt <datagram> ( addrspec -- datagram )
         [
             SOCK_DGRAM server-fd
             dup add-completion
-            <win32-socket>
+            f <win32-socket>
         ] keep <datagram-port>
     ] with-destructors ;
 

extra/io/windows/windows.factor

@@ -123,13 +123,13 @@ C: <FileArgs> FileArgs
     FileArgs-lpOverlapped ;
 
 M: windows (file-reader) ( path -- stream )
-    open-read <win32-file> <reader> ;
+    open-read <win32-file> <input-port> ;
 
 M: windows (file-writer) ( path -- stream )
-    open-write <win32-file> <writer> ;
+    open-write <win32-file> <output-port> ;
 
 M: windows (file-appender) ( path -- stream )
-    open-append <win32-file> <writer> ;
+    open-append <win32-file> <output-port> ;
 
 M: windows move-file ( from to -- )
     [ normalize-path ] bi@ MoveFile win32-error=0/f ;
@@ -151,10 +151,12 @@ M: windows delete-directory ( path -- )
 
 HOOK: WSASocket-flags io-backend ( -- DWORD )
 
-TUPLE: win32-socket < win32-file ;
+TUPLE: win32-socket < win32-file overlapped ;
 
-: <win32-socket> ( handle -- win32-socket )
+: <win32-socket> ( handle overlapped -- win32-socket )
-    f win32-file boa ;
+    win32-socket new
+        swap >>overlapped
+        swap >>handle ;
 
 : open-socket ( family type -- socket )
     0 f 0 WSASocket-flags WSASocket dup socket-error ;

extra/openssl/openssl.factor

@@ -19,11 +19,14 @@ M: SSLv23 ssl-method drop SSLv23_method ;
 M: SSLv3  ssl-method drop SSLv3_method ;
 M: TLSv1  ssl-method drop TLSv1_method ;
 
-: (ssl-error) ( num -- * )
+: (ssl-error-string) ( n -- string )
-    ERR_get_error ERR_clear_error f ERR_error_string throw ;
+    ERR_clear_error f ERR_error_string ;
+
+: ssl-error-string ( -- string )
+    ERR_get_error ERR_clear_error f ERR_error_string ;
 
 : ssl-error ( obj -- )
-    { f 0 } member? [ (ssl-error) ] when ;
+    { f 0 } member? [ ssl-error-string throw ] when ;
 
 : init-ssl ( -- )
     SSL_library_init ssl-error
@@ -114,14 +117,19 @@ M: openssl-context dispose
     dup handle>> [ SSL_CTX_free ] when* f >>handle
     drop ;
 
-TUPLE: ssl file handle ;
+TUPLE: ssl-handle file handle ;
 
-: <ssl> ( file -- ssl )
+: <ssl-handle> ( fd -- ssl )
-    ssl-context get handle>> SSL_new dup ssl-error ssl boa ;
+    ssl-context get handle>> SSL_new dup ssl-error ssl-handle boa ;
 
-M: ssl init-handle drop ;
+: <ssl-socket> ( fd -- ssl )
+    [ BIO_NOCLOSE BIO_new_socket dup ssl-error ] keep
+    <ssl-handle>
+    [ handle>> swap dup SSL_set_bio ] keep ;
 
-M: ssl close-handle
+M: ssl-handle init-handle drop ;
+
+M: ssl-handle close-handle
     [ file>> close-handle ] [ handle>> SSL_free ] bi ;
 
 ERROR: certificate-verify-error result ;

extra/openssl/unix/unix.factor

@@ -1,11 +0,0 @@
-! 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
-math.order combinators init alien alien.c-types alien.strings libc
-continuations destructors
-locals unicode.case
-openssl.libcrypto openssl.libssl
-io.files io.encodings.ascii io.sockets.secure ;
-IN: openssl.unix
-
-

extra/oracle/liboci/liboci.factor

@@ -124,7 +124,6 @@ TYPEDEF: ushort ub2
 TYPEDEF: short sb2
 TYPEDEF: uint ub4
 TYPEDEF: int sb4
-TYPEDEF: ulong size_t
 
 ! ===============================================
 ! Input data types (ocidfn.h)

extra/unix/unix.factor

@@ -11,7 +11,6 @@ IN: unix
 
 TYPEDEF: uint in_addr_t
 TYPEDEF: uint socklen_t
-TYPEDEF: ulong size_t
 
 : PROT_NONE   0 ; inline
 : PROT_READ   1 ; inline

extra/windows/types/types.factor

@@ -198,7 +198,6 @@ TYPEDEF: void* MSGBOXPARAMSA
 TYPEDEF: void* MSGBOXPARAMSW
 TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
 
-TYPEDEF: int size_t
 TYPEDEF: size_t socklen_t
 
 TYPEDEF: void* WNDPROC