diff options
author | Jeffrey Armstrong <jeff@approximatrix.com> | 2023-01-02 11:50:39 -0500 |
---|---|---|
committer | Jeffrey Armstrong <jeff@approximatrix.com> | 2023-01-02 11:50:39 -0500 |
commit | 462715e11037739722457e48084a73daa9e5d889 (patch) | |
tree | 0704f69e9c69f7a16ffae74421392aecd145399e | |
parent | 89e74e6c7c8d6d98939a24fa3f77b9caff2dec07 (diff) | |
download | levitating-462715e11037739722457e48084a73daa9e5d889.tar.gz levitating-462715e11037739722457e48084a73daa9e5d889.zip |
Added a timeout to read functions such that failures don't occur immediately. Seems to be a culprit in the upload failures.
-rw-r--r-- | common/jessl.f90 | 22 | ||||
-rw-r--r-- | common/protocol.f90 | 3 | ||||
-rw-r--r-- | common/request.f90 | 9 | ||||
-rw-r--r-- | 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 |