I/O timeouts

diff --git a/CHANGES.txt b/CHANGES.txt
index e0a3713809309ccf570826469e043e0023321025..d05aff18f9de975e6139884e9059aec61b4e0798 100644 (file)
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -36,6 +36,9 @@ http://www.jroller.com/page/slava/20050518.
 
 HTTP server now supports virtual hosting.
 
+You can now set timeouts for I/O operations with the set-timeout generic
+word. The HTTP server sets a timeout of 60 seconds for client requests.
+
 Factor 0.74:
 ------------
 

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 81da484fec509a59708887d3e8d6f7eee4fd96d6..ddeeb3d8bc835604f012514bdddccf2246d9381c 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -9,7 +9,6 @@
 - single-stepper and variable access: wrong namespace?\r
 - investigate if COPYING_GEN needs a fix\r
 - faster layout\r
-- add a socket timeout\r
 - keep alive\r
 - sleep word\r
 - redo new compiler backend for PowerPC\r

diff --git a/library/httpd/httpd.factor b/library/httpd/httpd.factor
index 5c7e7d78dac17cdda33656138434a4a2da645fd6..b3d7633c7ac6b446db5c3c220cab4b8fa82378e0 100644 (file)
--- a/library/httpd/httpd.factor
+++ b/library/httpd/httpd.factor
@@ -52,7 +52,7 @@ stdio streams strings threads http sequences ;
 : httpd-client ( socket -- )
     [
         dup log-client [
-            1 stdio get set-timeout
+            60000 stdio get set-timeout
             read-line [ parse-request ] when*
         ] with-stream
     ] try ;

diff --git a/library/io/c-streams.factor b/library/io/c-streams.factor
index 773a538c40cc8330e8bb5d59fbca837f5f38b670..7d4faab85a2e547a28f3ea4ad53944d450f33501 100644 (file)
--- a/library/io/c-streams.factor
+++ b/library/io/c-streams.factor
@@ -52,7 +52,6 @@ TUPLE: client-stream host port ;
 : <client> c-stream-error ;
 : <server> c-stream-error ;
 : accept c-stream-error ;
-: set-timeout c-stream-error ;
 
 : (stream-copy) ( in out -- )
     4096 pick stream-read [

diff --git a/library/io/stream.factor b/library/io/stream.factor
index 1411a098a1e319c25c364728022d6899abfbc4aa..fbed86cf1823039e5320c794e8ad9982dc62ff80 100644 (file)
--- a/library/io/stream.factor
+++ b/library/io/stream.factor
@@ -21,6 +21,7 @@ GENERIC: stream-readln     ( stream -- string )
 GENERIC: stream-read       ( count stream -- string )
 GENERIC: stream-write-attr ( string style stream -- )
 GENERIC: stream-close      ( stream -- )
+GENERIC: set-timeout       ( timeout stream -- )
 
 : stream-read1 ( stream -- char/f )
     1 swap stream-read dup empty? [ drop f ] [ 0 swap nth ] ifte ;
@@ -87,6 +88,11 @@ M: duplex-stream stream-write-attr
 M: duplex-stream stream-close
     duplex-stream-out stream-close ;
 
+M: duplex-stream set-timeout
+    2dup
+    duplex-stream-in set-timeout
+    duplex-stream-out set-timeout ;
+
 ! Reading lines and counting line numbers.
 SYMBOL: line-number
 SYMBOL: parser-stream

diff --git a/library/unix/io.factor b/library/unix/io.factor
index 26c0a626f54d6c4b19e7ddf9dcaf9404af317483..063ad4aba643939dd8b81d28d7567ed0388fb5d8 100644 (file)
--- a/library/unix/io.factor
+++ b/library/unix/io.factor
@@ -17,18 +17,31 @@ USING: namespaces ;
     F_SETFL O_NONBLOCK fcntl io-error ;
 
 ! Common delegate of native stream readers and writers
-TUPLE: port handle buffer error ;
+TUPLE: port handle buffer error timeout cutoff ;
+
+: make-buffer ( n -- buffer/f )
+    dup 0 > [ <buffer> ] [ drop f ] ifte ;
 
 C: port ( handle buffer -- port )
-    [
-        >r dup 0 > [ <buffer> ] [ drop f ] ifte r> set-delegate
-    ] keep
+    [ 0 swap set-port-timeout ] keep
+    [ 0 swap set-port-cutoff ] keep
+    [ >r make-buffer r> set-delegate ] keep
     [ >r dup init-handle r> set-port-handle ] keep ;
 
 M: port stream-close ( port -- )
     dup port-handle close
     delegate [ buffer-free ] when* ;
 
+: touch-port ( port -- )
+    dup port-timeout dup 0 = [
+        2drop
+    ] [
+        millis + swap set-port-cutoff
+    ] ifte ;
+
+M: port set-timeout ( timeout port -- )
+    [ set-port-timeout ] keep touch-port ;
+
 : buffered-port 8192 <port> ;
 
 : >port< dup port-handle swap delegate ;
@@ -53,6 +66,8 @@ GENERIC: io-task-events ( task -- events )
 ! this with the hash-size call.
 SYMBOL: io-tasks
 
+: io-task ( pollfd -- io-task ) pollfd-fd io-tasks get hash ;
+
 : io-task-fd io-task-port port-handle ;
 
 : add-io-task ( callback task -- )
@@ -71,32 +86,42 @@ SYMBOL: io-tasks
         drop swap remove-io-task
     ] ifte ;
 
-: handle-fd ( fd -- quot )
-    io-tasks get hash dup do-io-task [
-        pop-callback
+: handle-fd ( pollfd -- quot )
+    io-task dup do-io-task [
+        dup io-task-port touch-port pop-callback
     ] [
         drop f
     ] ifte ;
 
+: timeout? ( port -- ? )
+    port-cutoff dup 0 = not swap millis < and ;
+
+: handle-fd? ( pollfd -- ? )
+    dup pollfd-revents 0 = not >r
+    io-task io-task-port timeout? r> or ;
+
 : do-io-tasks ( pollfds n -- )
     [
-        dup pick pollfd-nth dup pollfd-revents 0 = [
-            drop
+        dup pick pollfd-nth dup handle-fd? [
+            handle-fd [ call ] when*
         ] [
-            pollfd-fd handle-fd [ call ] when*
+            drop
         ] ifte
     ] repeat drop ;
 
+: io-task# io-tasks get hash-size ;
+
+: io-task-list io-tasks get hash-values ;
+
 : init-pollfd ( task pollfd -- )
     over io-task-fd over set-pollfd-fd
     swap io-task-events swap set-pollfd-events ;
 
 : make-pollfds ( -- pollfds n )
-    io-tasks get dup hash-size [
-        swap >r <pollfd-array> 0 swap r> hash-values [
-            ( n pollfds iotask )
-            pick pick pollfd-nth init-pollfd >r 1 + r>
-        ] each nip
+    io-task# [
+        <pollfd-array> 0 io-task-list [
+            pick pick swap pollfd-nth init-pollfd 1 +
+        ] each drop
     ] keep ;
 
 : io-multiplex ( timeout -- )

diff --git a/library/unix/sockets.factor b/library/unix/sockets.factor
index 6373523f732bded4c24d2bd8ece3a14632737cd0..6321274e563b6a24d9e31d10e859741098ad2ba7 100644 (file)
--- a/library/unix/sockets.factor
+++ b/library/unix/sockets.factor
@@ -103,10 +103,3 @@ C: client-stream ( fd host port -- stream )
 : accept ( server -- client )
     #! Wait for a client connection.
     dup wait-to-accept port-handle do-accept <client-stream> ;
-
-: set-timeout ( timeout client -- )
-    swap 0 make-timeval 2dup
-    >r duplex-stream-out port-handle SOL_SOCKET SO_SNDTIMEO r>
-    timeout-opt
-    >r duplex-stream-in port-handle SOL_SOCKET SO_RCVTIMEO r>
-    timeout-opt ;

diff --git a/library/unix/syscalls.factor b/library/unix/syscalls.factor
index d5c4927b00e1b6b034514a72694396a960ceb3c2..cc4b08aeeba439752e69cd5aac8dcabc1b704945 100644 (file)
--- a/library/unix/syscalls.factor
+++ b/library/unix/syscalls.factor
@@ -97,13 +97,3 @@ END-STRUCT
 
 : ntohs ( n -- n )
     "ushort" "libc" "ntohs" [ "ushort" ] alien-invoke ;
-
-BEGIN-STRUCT: timeval
-    FIELD: long sec
-    FIELD: long usec
-END-STRUCT
-
-: make-timeval ( sec usec -- timeval )
-    <timeval>
-    [ set-timeval-usec ] keep
-    [ set-timeval-sec ] keep ;