Added socket timeout setting of 3 seconds, works on win32, needs unixy testing.

1 files changed, 45 insertions, 0 deletions

diff --git a/network.F90 b/network.F90
index fc8b410..381dc0f 100644
--- a/network.F90
+++ b/network.F90
@@ -30,6 +30,8 @@ implicit none
     
     integer(kind=c_int), parameter::SOCK_STREAM = 1
     
+    integer, parameter::socket_timeout_ms    = 3000
+    
 #ifdef WINDOWS
     integer, parameter::hostent_int_kind = c_short
 #else
@@ -63,6 +65,13 @@ implicit none
         integer(kind=c_int64_t)::h_addr6
     end type 
     
+#ifndef WINDOWS
+    type, bind(c) :: timeval
+        integer(kind=c_long)::seconds
+        integer(kind=c_long)::useconds
+    end type
+#endif
+    
     integer(kind=c_size_t), parameter::sockaddr_size = 56
     
     interface
@@ -121,8 +130,44 @@ implicit none
     
         integer::socket
         integer, intent(in)::domain, stype, protocol
+        integer::ignored
+        
+#ifdef WINDOWS
+        integer(kind=c_int32_t), target::timeout
+        integer(kind=c_int), parameter::timeout_size=c_int32_t
+#else
+        type(timeval), target::timeout
+        integer(kind=c_int), parameter::timeout_size=2*c_long
+#endif
         
+
+        ! Set up a timeout on the socket that's sensible
+        interface
+            function setsockopt(s, level, optname, optval, optlen) bind(c, name="setsockopt")
+            use iso_c_binding
+            integer(kind=c_int)::setsockopt
+            integer(kind=c_int), value::s
+            integer(kind=c_int), value::level, optname, optlen
+            type(c_ptr), value::optval
+            end function
+        end interface
+
+#ifdef WINDOWS
+        integer, parameter::SOL_SOCKET  = 65535
+        integer, parameter::SO_RCVTIMEO = 4102
+        timeout = socket_timeout_ms
+#else
+        integer, parameter::SOL_SOCKET  = 1
+        integer, parameter::SO_RCVTIMEO = 20
+        timeout%useconds = 0
+        timeout%seconds = socket_timeout_ms/1000
+#endif        
+
         socket = socket_c(int(domain, c_int), int(stype, c_int), int(protocol, c_int))
+
+        ! Timeout call
+        ignored = setsockopt(socket, SOL_SOCKET, SO_RCVTIMEO, c_loc(timeout), c_int32_t) 
+        
         
     end function socket