Implement socket timeouts.

* lib.c (timeout_error_s): New symbol variable.
(obj_init): Intern timeout-error, init new variable.

* lib.h (timeout_error_s): Declared.

* socket.c (sock_timeout, sock_send_timeout,
sock_recv_timeout): New static functions.
(sock_load_init): Register sock-send-timeout and
sock-recv-timeout intrinsics.

* stream.c (stdio_maybe_read_error, stdio_maybe_error):
Convert EAGAIN into timeout_error_s.

* txr.1: Documented.

6 files changed, 80 insertions, 2 deletions

diff --git a/lib.c b/lib.c
index 02861521..dca1b9de 100644
--- a/lib.c
+++ b/lib.c
@@ -98,7 +98,7 @@ val eof_s, eol_s, assert_s, name_s;
 val error_s, type_error_s, internal_error_s;
 val numeric_error_s, range_error_s;
 val query_error_s, file_error_s, process_error_s, syntax_error_s;
-val system_error_s;
+val timeout_error_s, system_error_s;
 val gensym_counter_s;
 
 val nothrow_k, args_k, colon_k, auto_k, fun_k;
@@ -8304,6 +8304,7 @@ static void obj_init(void)
   process_error_s = intern(lit("process-error"), user_package);
   syntax_error_s = intern(lit("syntax-error"), user_package);
   system_error_s = intern(lit("system-error"), user_package);
+  timeout_error_s = intern(lit("timeout-error"), user_package);
   assert_s = intern(lit("assert"), user_package);
   name_s = intern(lit("name"), user_package);
 
diff --git a/lib.h b/lib.h
index 8b2b700d..07506a2b 100644
--- a/lib.h
+++ b/lib.h
@@ -429,7 +429,7 @@ extern val eof_s, eol_s, assert_s, name_s;
 extern val error_s, type_error_s, internal_error_s;
 extern val numeric_error_s, range_error_s;
 extern val query_error_s, file_error_s, process_error_s, syntax_error_s;
-extern val system_error_s;
+extern val system_error_s, timeout_error_s;
 extern val gensym_counter_s;
 
 #define gensym_counter (deref(lookup_var_l(nil, gensym_counter_s)))
diff --git a/socket.c b/socket.c
index d7d49b4c..b114f704 100644
--- a/socket.c
+++ b/socket.c
@@ -814,6 +814,36 @@ static val sock_shutdown(val sock, val how)
   return t;
 }
 
+#if defined SO_SNDTIMEO && defined SO_RCVTIMEO
+static val sock_timeout(val sock, val usec, val name, int which)
+{
+  cnum fd = c_num(stream_fd(sock));
+  cnum u = c_num(usec);
+  struct timeval tv;
+
+  tv.tv_sec = u / 1000000;
+  tv.tv_usec = u % 1000000;
+
+  if (setsockopt(fd, SOL_SOCKET, which, &tv, sizeof tv) != 0)
+    uw_throwf(socket_error_s, lit("~a failed on ~s: ~d/~s"),
+	      name, sock, num(errno),
+	      string_utf8(strerror(errno)), nao);
+
+  return sock;
+}
+
+static val sock_send_timeout(val sock, val usec)
+{
+  return sock_timeout(sock, usec, lit("sock-send-timeout"), SO_SNDTIMEO);
+}
+
+static val sock_recv_timeout(val sock, val usec)
+{
+  return sock_timeout(sock, usec, lit("sock-recv-timeout"), SO_RCVTIMEO);
+}
+#endif
+
+
 val open_sockfd(val fd, val family, val type, val mode_str_in)
 {
   if (type == num_fast(SOCK_DGRAM)) {
@@ -892,6 +922,11 @@ void sock_load_init(void)
   reg_fun(intern(lit("sock-accept"), user_package), func_n2o(sock_accept, 1));
   reg_fun(intern(lit("sock-shutdown"), user_package), func_n2o(sock_shutdown, 1));
 
+#if defined SO_SNDTIMEO && defined SO_RCVTIMEO
+  reg_fun(intern(lit("sock-send-timeout"), user_package), func_n2(sock_send_timeout));
+  reg_fun(intern(lit("sock-recv-timeout"), user_package), func_n2(sock_recv_timeout));
+#endif
+
   fill_stream_ops(&dgram_strm_ops);
   dgram_strm_ops.get_sock_family = dgram_get_sock_family;
   dgram_strm_ops.get_sock_type = dgram_get_sock_type;
diff --git a/stream.c b/stream.c
index b98d7948..60247af7 100644
--- a/stream.c
+++ b/stream.c
@@ -431,6 +431,10 @@ static val stdio_maybe_read_error(val stream)
   if (ferror(h->f)) {
     val err = num(errno);
     h->err = err;
+#ifdef EAGAIN
+    if (errno == EAGAIN)
+      uw_throwf(timeout_error_s, lit("timed out reading ~a"), stream, nao);
+#endif
     uw_throwf(file_error_s, lit("error reading ~a: ~d/~s"),
               stream, err, errno_to_string(err), nao);
   }
@@ -446,6 +450,10 @@ static val stdio_maybe_error(val stream, val action)
   if (h->f == 0)
     uw_throwf(file_error_s, lit("error ~a ~a: file closed"), stream, action, nao);
   h->err = err;
+#ifdef EAGAIN
+  if (errno == EAGAIN)
+    uw_throwf(timeout_error_s, lit("timed out on ~a"), stream, nao);
+#endif
   uw_throwf(file_error_s, lit("error ~a ~a: ~d/~s"),
             stream, action, err, errno_to_string(err), nao);
 }
diff --git a/txr.1 b/txr.1
index 19f1ba54..de3b5103 100644
--- a/txr.1
+++ b/txr.1
@@ -37990,6 +37990,39 @@ Shutting down in the reading direction is potentially abrupt. If it is executed
 before an "end of stream" indication is received from a peer, it results in an
 abortive close.
 
+.coNP Functions @ sock-recv-timeout and @ sock-send-timeout
+.synb
+.mets (sock-recv-timeout < sock << usec )
+.mets (sock-send-timeout < sock << usec )
+.syne
+.desc
+The
+.code sock-recv-timeout
+and
+.code sock-send-timeout
+functions configure, respectively, receive and send timeouts on socket
+.metn sock .
+
+The
+.meta usec
+parameter specifies the value, in microseconds. It must be a
+.code fixnum
+integer.
+
+When a receive timeout is configured on a socket, then an
+exception of type
+.code timeout-error
+is thrown when an input operation waits for at least
+.code usec
+microseconds without receiving input.
+
+Similarly, when a send timeout is configured, then an
+exception of type
+.code timeout-error
+is thrown when an output operation waits for at least
+.code usec
+microseconds for the availability of buffer space in the socket.
+
 .coNP Functions @ str-inaddr and @ str-in6addr
 .synb
 .mets (str-inaddr address <> [ port ])
diff --git a/unwind.c b/unwind.c
index dfc1d812..e7257896 100644
--- a/unwind.c
+++ b/unwind.c
@@ -862,6 +862,7 @@ void uw_init(void)
   uw_register_subtype(file_error_s, error_s);
   uw_register_subtype(process_error_s, error_s);
   uw_register_subtype(system_error_s, error_s);
+  uw_register_subtype(timeout_error_s, error_s);
   uw_register_subtype(assert_s, error_s);
   uw_register_subtype(syntax_error_s, error_s);
 }