From 462715e11037739722457e48084a73daa9e5d889 Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
Date: Mon, 2 Jan 2023 11:50:39 -0500
Subject: Added a timeout to read functions such that failures don't occur
 immediately.  Seems to be a culprit in the upload failures.

---
 common/jessl.f90     | 22 +++++++++++++++++++++-
 common/protocol.f90  |  3 ++-
 common/request.f90   |  9 +++++++--
 common/utilities.F90 | 29 +++++++++++++++++++++++++++++
 4 files changed, 59 insertions(+), 4 deletions(-)

diff --git a/common/jessl.f90 b/common/jessl.f90
index 5ad90fd..1974082 100644
--- a/common/jessl.f90
+++ b/common/jessl.f90
@@ -203,19 +203,39 @@ implicit none
 
 contains
 
-    function ssl_read(ssl, buf)
+    ! The timeout is specified in milliseconds, fyi
+    function ssl_read(ssl, buf, timeout)
     use iso_c_binding
+    use utilities, only: sleep_ms
     implicit none
     
         type(c_ptr)::ssl
         character(len=1), dimension(:), intent(out)::buf
+        integer, intent(in), optional::timeout
         integer::ssl_read
         integer::bufsize
         
+        integer(kind=8)::start_time, current_time, count_rate, dt
+        
         character(kind=c_char), dimension(:), allocatable::cbuf
         bufsize = size(buf)
         allocate(cbuf(bufsize))
         
+        if(present(timeout)) then
+        
+            call system_clock(start_time, count_rate=count_rate)
+            current_time = start_time
+            
+            dt = 0
+            
+            do while(ssl_pending(ssl) <= 0 .and. dt < timeout .and. dt >= 0)
+                call sleep_ms(timeout / 10)
+                call system_clock(current_time)
+                dt = ((current_time - start_time)*1000)/count_rate
+            end do
+        
+        end if
+        
         ssl_read = read_c(ssl, cbuf, bufsize)
         buf = cbuf
         
diff --git a/common/protocol.f90 b/common/protocol.f90
index 9fc1171..d1cd18b 100644
--- a/common/protocol.f90
+++ b/common/protocol.f90
@@ -327,7 +327,8 @@ contains
 
                         end do
 
-                        bytes_received = retrieve_characters(conn%ssl, buffer)
+                        ! Use a timeout here because the server has some work to do
+                        bytes_received = retrieve_characters(conn%ssl, buffer, 1500)
                     end do
                     
                 else
diff --git a/common/request.f90 b/common/request.f90
index ce81ae6..91aa67a 100644
--- a/common/request.f90
+++ b/common/request.f90
@@ -287,7 +287,7 @@ contains
         
     end function send_string
     
-    function retrieve_characters(ssl, arr) result(chars_read)
+    function retrieve_characters(ssl, arr, timeout) result(chars_read)
     use iso_c_binding
     use jessl
     implicit none
@@ -295,8 +295,13 @@ contains
         integer::chars_read
         type(c_ptr)::ssl
         character(len=1), dimension(:), intent(inout)::arr
+        integer, intent(in), optional::timeout
 
-        chars_read = ssl_read(ssl, arr)
+        if(present(timeout)) then
+            chars_read = ssl_read(ssl, arr, timeout)
+        else
+            chars_read = ssl_read(ssl, arr, 250)
+        end if
         
     end function retrieve_characters
     
diff --git a/common/utilities.F90 b/common/utilities.F90
index d746e0f..e200def 100644
--- a/common/utilities.F90
+++ b/common/utilities.F90
@@ -603,4 +603,33 @@ contains
         
     end function build_date
     
+    subroutine sleep_ms(ms)
+    use iso_c_binding
+    implicit none
+    
+        integer, intent(in)::ms
+    
+#ifdef WINDOWS
+        
+        interface
+            subroutine sleep_win(x) bind(c, name="Sleep")
+            integer(kind=8), value::x
+            end subroutine sleep_win
+        end interface
+    
+        call sleep_win(int(ms, kind=8))
+        
+#else
+
+        
+        character(len=40)::cl
+        
+        write(cl, *) "sleep ", real(ms)/1000.0
+        
+        call execute_command_line(cl)
+        
+#endif
+    
+    end subroutine sleep_ms
+    
 end module utilities
-- 
cgit v1.2.3