properly handle accept returning EAGAIN or EINTR

diff --git a/library/unix/io.factor b/library/unix/io.factor
index 8d06792eef0a570aad1e2880504d1a9f05545f1a..f79f2ed4b75a5d0ec7ec8b9d6bf13745f4501731 100644 (file)
--- a/library/unix/io.factor
+++ b/library/unix/io.factor
@@ -75,8 +75,12 @@ M: port set-timeout ( timeout port -- )
 
 : pending-error ( reader -- ) port-error throw ;
 
-: postpone-error ( reader -- )
-    err_no strerror swap set-port-error ;
+: EAGAIN 35 ;
+: EINTR 4 ;
+
+: postpone-error ( port -- )
+    err_no dup EAGAIN = over EINTR = or
+    [ 2drop ] [ strerror swap set-port-error ] ifte ;
 
 ! Associates a port with a list of continuations waiting on the
 ! port to finish I/O
@@ -116,14 +120,15 @@ GENERIC: task-container ( task -- vector )
     port-cutoff dup 0 = not swap millis < and ;
 
 : handle-fd? ( fdset task -- ? )
-    dup io-task-port timeout?
-    [
+    dup io-task-port timeout? [
         2drop t
     ] [
         io-task-fd swap 2dup bit-nth
         >r f -rot set-bit-nth r>
     ] ifte ;
 
+: debug-out 14 getenv fwrite ;
+
 : handle-fdset ( fdset tasks -- )
     [
         cdr tuck handle-fd? [ handle-fd ] [ drop ] ifte
@@ -212,10 +217,12 @@ C: reader ( handle -- reader )
         drop
     ] ifte  t swap set-reader-ready? ;
 
+: (refill) ( port -- n )
+    >port< tuck dup buffer-end swap buffer-capacity read ;
+
 : refill ( port -- )
     dup buffer-length 0 = [
-        >port<
-        tuck dup buffer-end swap buffer-capacity read
+        (refill)
         dup 0 >= [ swap n>buffer ] [ drop postpone-error ] ifte
     ] [
         drop

diff --git a/library/unix/sockets.factor b/library/unix/sockets.factor
index 10e72128067b0604f16c3996b633cf3f7fe9bfa3..0afa69fdc28bcf3e92cca721e12e45020ac4668b 100644 (file)
--- a/library/unix/sockets.factor
+++ b/library/unix/sockets.factor
@@ -49,12 +49,44 @@ USING: alien generic kernel math unix-internals ;
         dup 0 >= [ drop 1 listen ] [ ( fd n - n) nip ] ifte
     ] with-socket-fd ;
 
+IN: streams
+
+C: client-stream ( host port fd -- stream )
+    [ >r <socket-stream> r> set-delegate ] keep
+    [ set-client-stream-port ] keep
+    [ set-client-stream-host ] keep ;
+
+: <client> ( host port -- stream )
+    #! Connect to a port number on a TCP/IP host.
+    client-socket <socket-stream> ;
+
+TUPLE: server client ;
+
+C: server ( port -- server )
+    #! Starts listening for TCP connections on localhost:port.
+    [ >r server-socket 0 <port> r> set-delegate ] keep ;
+
+IN: io-internals
+USE: unix-internals
+
 TUPLE: accept-task ;
 
 C: accept-task ( port -- task )
     [ >r <io-task> r> set-delegate ] keep ;
 
-M: accept-task do-io-task ( task -- ? ) drop t ;
+: init-socket ( fd -- ) SOL_SOCKET SO_OOBINLINE sockopt ;
+
+: do-accept ( port sockaddr fd -- )
+    [
+        init-socket
+        dup sockaddr-in-addr inet-ntoa
+        swap sockaddr-in-port ntohs
+    ] keep <client-stream> swap set-server-client ;
+
+M: accept-task do-io-task ( task -- ? )
+    io-task-port <sockaddr-in>
+    over port-handle over "sockaddr-in" c-size <int> accept
+    dup 0 >= [ do-accept t ] [ 2drop postpone-error f ] ifte ;
 
 M: accept-task task-container drop read-tasks get ;
 
@@ -69,12 +101,6 @@ M: accept-task task-container drop read-tasks get ;
                       HEX: ff bitand unparse %
     ] make-string ;
 
-: do-accept ( fd -- fd host port )
-    <sockaddr-in>
-    [ "sockaddr-in" c-size <int> accept dup io-error ] keep
-    dup sockaddr-in-addr inet-ntoa
-    swap sockaddr-in-port ntohs ;
-
 : <socket-stream> ( fd -- stream )
     dup f <fd-stream> ;
 
@@ -83,23 +109,6 @@ M: accept-task task-container drop read-tasks get ;
 
 IN: streams
 
-C: client-stream ( fd host port -- stream )
-    [ set-client-stream-port ] keep
-    [ set-client-stream-host ] keep
-    [
-        >r
-        dup SOL_SOCKET SO_OOBINLINE sockopt
-        <socket-stream> r> set-delegate
-    ] keep ;
-
-: <client> ( host port -- stream )
-    #! Connect to a port number on a TCP/IP host.
-    client-socket <socket-stream> ;
-
-: <server> ( port -- server )
-    #! Starts listening for TCP connections on localhost:port.
-    server-socket 0 <port> ;
-
 : accept ( server -- client )
     #! Wait for a client connection.
-    dup wait-to-accept port-handle do-accept <client-stream> ;
+    dup wait-to-accept server-client ;