B4J Question [WORK AROUND] - detection of "silent timeouts" in http jobs

[JackKirk]

This is a follow on thread to:

https://www.b4x.com/android/forum/t...job-has-timed-out-when-i-use-wait-for.142809/

The problem I have been getting is that very occasionally I get a http job that never seems to complete - I'm guessing it timeouts, but does not give any indication of having done so.

I have come up with a work around, which I have tested, which involves some small changes to HttpJob.bas and HttpUtils2Service.bas.

I have bracketed my changes with ['<<jk] comments.

HttpJob.bas

'Class module
Sub Class_Globals
    Public JobName As String
    Public Success As Boolean
    Public Username, Password As String
    Public ErrorMessage As String
    Private target As Object
#if B4A or B4J
    #if HU2_PUBLIC
    Public taskId As String
    Public Out As OutputStream
    #else
    Private taskId As String
    #end if
    Private req As OkHttpRequest
    Public Response As OkHttpResponse
#Else
#if HU2_PUBLIC
    Public req As HttpRequest
#else
    Private req As HttpRequest
#end if
    Public Response As HttpResponse
#End If
    Public Tag As Object
    Type MultipartFileData (Dir As String, FileName As String, KeyName As String, ContentType As String)
#If B4J AND UI
    Private fx As JFX
#End If
    Private Const InvalidURL As String = "https://invalid-url/"
    Public DefaultScheme As String = "https"

'<<jk
#If B4J
    'It seems that occasionally a natural time out (req.Timeout)
    'does not work - this is part of an override
 
    Private Time_out_override As Timer
    Private Time_out_taskid As Int
 
#End If
'<<jk
 
End Sub


'Initializes the Job.
'Name - The job's name. Note that the name doesn't need to be unique.
'TargetModule - The activity or service that will handle the JobDone event.
Public Sub Initialize (Name As String, TargetModule As Object)
    JobName = Name
    target = TargetModule
End Sub

Private Sub AddScheme (Link As String) As String
    If DefaultScheme = "" Or Link.Contains(":") Then Return Link
    Return DefaultScheme & "://" & Link
End Sub

'Sends a POST request with the given data as the post data.
Public Sub PostString(Link As String, Text As String)
    PostBytes(Link, Text.GetBytes("UTF8"))
End Sub

'Sends a POST request with the given data as the post data
Public Sub PostBytes(Link As String, Data() As Byte)
    Try
        Link = AddScheme(Link)
        req.InitializePost2(Link, Data)
    Catch
        Log($"Invalid link: ${Link}"$)
        req.InitializePost2(InvalidURL, Data)
    End Try
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
End Sub

'Sends a PUT request with the given text as the post data.
Public Sub PutString(Link As String, Text As String)
    PutBytes(Link, Text.GetBytes("UTF8"))
End Sub

'Sends a PUT request with the given string as the post data
Public Sub PutBytes(Link As String, Data() As Byte)
    Try
        Link = AddScheme(Link)
        req.InitializePut2(Link, Data)
    Catch
        Log($"Invalid link: ${Link}"$)
        req.InitializePut2(InvalidURL, Data)
    End Try
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
End Sub

'Sends a PATCH request with the given string as the request payload.
Public Sub PatchString(Link As String, Text As String)
    PatchBytes(Link, Text.GetBytes("UTF8"))
End Sub

'Sends a PATCH request with the given data as the request payload.
Public Sub PatchBytes(Link As String, Data() As Byte)
    Link = AddScheme(Link)
#If B4i
    req.InitializeGet(Link)
    Dim no As NativeObject = req
    no = no.GetField("object")
    no.RunMethod("setHTTPMethod:", Array("PATCH"))
    no.RunMethod("setHTTPBody:", Array(no.ArrayToNSData(Data)))
#Else
    Try
        req.InitializePatch2(Link, Data)
    Catch
        Log($"Invalid link: ${Link}"$)
        req.InitializePatch2(InvalidURL, Data)
    End Try

#End If
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
End Sub


'Sends a HEAD request.
Public Sub Head(Link As String)
    Try
        Link = AddScheme(Link)
        req.InitializeHead(Link)
    Catch
        Log($"Invalid link: ${Link}"$)
        req.InitializeHead(InvalidURL)
    End Try
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
End Sub

'Sends a multipart POST request.
'NameValues - A map with the keys and values. Pass Null if not needed.
'Files - List of MultipartFileData items. Pass Null if not needed.
Public Sub PostMultipart(Link As String, NameValues As Map, Files As List)
    Dim boundary As String = "---------------------------1461124740692"
    Dim stream As OutputStream
    stream.InitializeToBytesArray(0)
    Dim b() As Byte
    Dim eol As String = Chr(13) & Chr(10)
    Dim empty As Boolean = True
    If NameValues <> Null And NameValues.IsInitialized Then
        For Each key As String In NameValues.Keys
            Dim value As String = NameValues.Get(key)
            empty = MultipartStartSection (stream, empty)
            Dim s As String = _
$"--${boundary}
Content-Disposition: form-data; name="${key}"

${value}"$
            b = s.Replace(CRLF, eol).GetBytes("UTF8")
            stream.WriteBytes(b, 0, b.Length)
        Next
    End If
    If Files <> Null And Files.IsInitialized Then
        For Each fd As MultipartFileData In Files
            empty = MultipartStartSection (stream, empty)
            Dim s As String = _
$"--${boundary}
Content-Disposition: form-data; name="${fd.KeyName}"; filename="${fd.FileName}"
Content-Type: ${fd.ContentType}

"$
            b = s.Replace(CRLF, eol).GetBytes("UTF8")
            stream.WriteBytes(b, 0, b.Length)
            Dim in As InputStream = File.OpenInput(fd.Dir, fd.FileName)
            File.Copy2(in, stream)
        Next
    End If
    empty = MultipartStartSection (stream, empty)
    s = _
$"--${boundary}--
"$
    b = s.Replace(CRLF, eol).GetBytes("UTF8")
    stream.WriteBytes(b, 0, b.Length)
    PostBytes(Link, stream.ToBytesArray)
    req.SetContentType("multipart/form-data; boundary=" & boundary)
    req.SetContentEncoding("UTF8")
End Sub

Private Sub MultipartStartSection (stream As OutputStream, empty As Boolean) As Boolean
    If empty = False Then
        stream.WriteBytes(Array As Byte(13, 10), 0, 2)
    Else
        empty = False
    End If
    Return empty
End Sub

'Sends a POST request with the given file as the post data.
'This method doesn't work with assets files.
Public Sub PostFile(Link As String, Dir As String, FileName As String)
    Link = AddScheme(Link)
#if B4i
    req.InitializePost(Link, Dir, FileName)
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
#Else
    Dim length As Int
    If Dir = File.DirAssets Then
        Log("Cannot send files from the assets folder.")
        Return
    End If
    length = File.Size(Dir, FileName)
    Dim In As InputStream
    In = File.OpenInput(Dir, FileName)
    If length < 1000000 Then '1mb
        'There are advantages for sending the file as bytes array. It allows the Http library to resend the data
        'if it failed in the first time.
        Dim out As OutputStream
        out.InitializeToBytesArray(length)
        File.Copy2(In, out)
        PostBytes(Link, out.ToBytesArray)
    Else
        req.InitializePost(Link, In, length)
        CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
    End If
#End If
End Sub
'Submits a HTTP GET request.
'Consider using Download2 if the parameters should be escaped.
Public Sub Download(Link As String)
    Try
        Link = AddScheme(Link)
        req.InitializeGet(Link)
    Catch
        Log($"Invalid link: ${Link}"$)
        req.InitializeGet(InvalidURL)
    End Try
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
End Sub

'Submits a HTTP GET request.
'Encodes illegal parameter characters.
'<code>Example:
'job.Download2("http://www.example.com", _
'    Array As String("key1", "value1", "key2", "value2"))</code>
Public Sub Download2(Link As String, Parameters() As String)
    Try
        Link = AddScheme(Link)
        req.InitializeGet(escapeLink(Link, Parameters))
    Catch
        Log($"Invalid link: ${Link}"$)
        req.InitializeGet(escapeLink(InvalidURL, Parameters))
    End Try
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
End Sub

Private Sub escapeLink(Link As String, Parameters() As String) As String
    Dim sb As StringBuilder
    sb.Initialize
    sb.Append(Link)
    If Parameters.Length > 0 Then sb.Append("?")
    Dim su As StringUtils
    For i = 0 To Parameters.Length - 1 Step 2
        If i > 0 Then sb.Append("&")
        sb.Append(su.EncodeUrl(Parameters(i), "UTF8")).Append("=")
        sb.Append(su.EncodeUrl(Parameters(i + 1), "UTF8"))
    Next
    Return sb.ToString
End Sub


Public Sub Delete(Link As String)
    Try
        Link = AddScheme(Link)
        req.InitializeDelete(Link)
    Catch
        Log($"Invalid link: ${Link}"$)
        req.InitializeDelete(InvalidURL)
    End Try
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
End Sub

Public Sub Delete2(Link As String, Parameters() As String)
    Try
        Link = AddScheme(Link)
        req.InitializeDelete(escapeLink(Link, Parameters))
    Catch
        Log($"Invalid link: ${Link}"$)
        req.InitializeDelete(escapeLink(InvalidURL, Parameters))
    End Try
    CallSubDelayed2(HttpUtils2Service, "SubmitJob", Me)
End Sub

'Should be called to free resources held by this job.
Public Sub Release
#If B4A or B4J

'<<jk
    If File.Exists(HttpUtils2Service.TempFolder, taskId) Then
'<<jk

    File.Delete(HttpUtils2Service.TempFolder, taskId)

'<<jk
    End If
'<<jk

#End If
End Sub

'Returns the response as a string encoded with UTF8.
Public Sub GetString As String
    Return GetString2("UTF8")
End Sub

'Returns the response as a string.
Public Sub GetString2(Encoding As String) As String
#if B4i
    Return Response.GetString2(Encoding)
#else
    Dim tr As TextReader
    tr.Initialize2(File.OpenInput(HttpUtils2Service.TempFolder, taskId), Encoding)
    Dim res As String = tr.ReadAll
    tr.Close
    Return res
#End If
End Sub

#If B4J Or B4A
'Called by the service to get the request
Public Sub GetRequest As OkHttpRequest
    Return req
End Sub

'Called by the service when job completes
Public Sub Complete (id As Int)
    taskId = id
 
'<<jk
#If B4J
    'It seems that occasionally a natural time out (req.Timeout)
    'does not work - this is part of an override

    'If override time out timer is disabled...
    If Not(Time_out_override.Enabled) Then

        'Event_time_out_override_Tick must have fired before
        'any normal Complete has occurred - and this call to
        'Complete must be some sort of belated response
 
        'Quit
        Return
 
    End If
 
    'If got to here a normal Complete has occurred or
    'Event_timeout_override_Tick has fired forcing a
    'Complete with an override time out error
 
    'Disable override time out timer
    Time_out_override.Enabled = False
 
#End If
'<<jk
 
    CallSubDelayed2(target, "JobDone", Me)
End Sub

#If B4J AND UI
'Returns the response as a bitmap
Public Sub GetBitmap As Image
    Dim b As Image
    b = fx.LoadImage(HttpUtils2Service.TempFolder, taskId)
    Return b
End Sub

#Else If B4A
'Returns the response as a bitmap
Public Sub GetBitmap As Bitmap
    Dim b As Bitmap
    b = LoadBitmap(HttpUtils2Service.TempFolder, taskId)
    Return b
End Sub
'Returns the response as a bitmap loaded with LoadBitmapSample.
'<b>It is recommended to use GetBitmapResize instead.</b>
Public Sub GetBitmapSample(Width As Int, Height As Int) As Bitmap
    Return LoadBitmapSample(HttpUtils2Service.TempFolder, taskId, Width, Height)
End Sub
'Returns the response as a bitmap loaded LoadBitmapResize.
Public Sub GetBitmapResize(Width As Int, Height As Int, KeepAspectRatio As Boolean) As Bitmap
    Return LoadBitmapResize(HttpUtils2Service.TempFolder, taskId, Width, Height, KeepAspectRatio)
End Sub
#End If

'Returns the response input stream.
Public Sub GetInputStream As InputStream
    Dim In As InputStream
    In = File.OpenInput(HttpUtils2Service.TempFolder, taskId)
    Return In
End Sub
#Else If B4i
'Called by the service to get the request
Public Sub GetRequest As HttpRequest
    Return req
End Sub

'Called by the service when job completes
Public Sub Complete (res1 As HttpResponse)
    Response = res1
    CallSub2(target, "Job" & "Done", Me)
End Sub
    'Returns the response as a bitmap
Public Sub GetBitmap As Bitmap
    Dim b As Bitmap
    b.Initialize2(Response.GetInputStream)
    Return b
End Sub

'Returns the response as a bitmap loaded LoadBitmapResize.
Public Sub GetBitmapResize(Width As Int, Height As Int, KeepAspectRatio As Boolean) As Bitmap
    Return GetBitmap.Resize(Width, Height, KeepAspectRatio)
End Sub

'Returns the response input stream.
Public Sub GetInputStream As InputStream
    Return Response.GetInputStream
End Sub
#End If

'<<jk
#If B4J
    'It seems that occasionally a natural time out (req.Timeout)
    'does not work - this is part of an override

Public Sub Start_override_timer (id As Int)
 
    'Save the task ID in case we have to do an override time out
    Time_out_taskid = id
 
    'Set up override time out timer to fire 1 sec after natural
    'time out should occur
    Time_out_override.Initialize("Event_time_out_override", req.Timeout + DateTime.TicksPerSecond)
    Time_out_override.Enabled = True
 
End Sub

'This timer will fire if natural time out has failed to fire
Private Sub Event_time_out_override_Tick

    'Set up completion of job with a override time out error
    Success = False
    ErrorMessage = "Time out override"
 
    'Force completion
    Complete(Time_out_taskid)
 
End Sub

#End If
'<<jk

HttpUtils2Service

'Service module
Sub Process_Globals
#if HU2_PUBLIC
    #if B4A or B4J
        Public hc As OkHttpClient
    #else
        Public hc As HttpClient
    #end if
    Public TaskIdToJob As Map
#else
    #if B4A or B4J
        Private hc As OkHttpClient
    #else
        Private hc As HttpClient
    #end if
    Private TaskIdToJob As Map
#End If
    Public TempFolder As String
#if B4J and SERVER
    Private atomicTaskCounter As AtomicInteger
#else
    Private taskCounter As Int
#End If
End Sub

Sub Service_Create
#if B4A
    TempFolder = File.DirInternalCache
    Try
        File.WriteString(TempFolder, "~test.test", "test")
        File.Delete(TempFolder, "~test.test")
    Catch
        Log(LastException)
        Log("Switching to File.DirInternal")
        TempFolder = File.DirInternal
    End Try
#Else If B4J
    TempFolder = File.DirTemp
#End If
    If hc.IsInitialized = False Then
#if HU2_ACCEPTALL
        Log("(Http client initialized with accept all option.)")
        hc.InitializeAcceptAll("hc")
#else
        hc.Initialize("hc")
#End If
    End If
#if B4J and SERVER
    Log("OkHttpUtils2 - server mode!")
    atomicTaskCounter.Initialize
    TaskIdToJob = Main.srvr.CreateThreadSafeMap
#else
    TaskIdToJob.Initialize
#End If
End Sub
#If B4A
Sub Service_Start (StartingIntent As Intent)
    Service.StopAutomaticForeground
End Sub

Sub Service_Destroy

End Sub
#End If

Public Sub SubmitJob(job As HttpJob)
    If TaskIdToJob.IsInitialized = False Then Service_Create
    #if B4J and SERVER
    Dim TaskId As Int = atomicTaskCounter.Increment
    #else
    taskCounter = taskCounter + 1
    Dim TaskId As Int = taskCounter
    #End If
 
'<<jk
#If B4J
    'It seems that occasionally a natural time out (req.Timeout)
    'does not work - this is part of an override
 
    'Tell job to start it's time out override timer
    job.Start_override_timer(TaskId)
 
#End If
'<<jk
 
    TaskIdToJob.Put(TaskId, job)
    If job.Username <> "" And job.Password <> "" Then
        hc.ExecuteCredentials(job.GetRequest, TaskId, job.Username, job.Password)
    Else
        hc.Execute(job.GetRequest, TaskId)
    End If
End Sub

#if B4A or B4J
Sub hc_ResponseSuccess (Response As OkHttpResponse, TaskId As Int)
    Dim job As HttpJob = TaskIdToJob.Get(TaskId)
    If job = Null Then
        Log("HttpUtils2Service (hc_ResponseSuccess): job completed multiple times - " & TaskId)
        Return
    End If
    job.Response = Response
    Dim out As OutputStream = File.OpenOutput(TempFolder, TaskId, False)
    #if HU2_PUBLIC
    job.Out = out
    #end if
    Response.GetAsynchronously("response", out , _
        True, TaskId)
End Sub

Private Sub Response_StreamFinish (Success As Boolean, TaskId As Int)
    If Success Then
        CompleteJob(TaskId, Success, "")
    Else
        CompleteJob(TaskId, Success, LastException.Message)
    End If
End Sub

Sub hc_ResponseError (Response As OkHttpResponse, Reason As String, StatusCode As Int, TaskId As Int)
    Response.Release
    Dim job As HttpJob = TaskIdToJob.Get(TaskId)
    If job = Null Then
        Log("HttpUtils2Service (hc_ResponseError): job completed multiple times - " & TaskId)
        Return
    End If
    job.Response = Response
    If Response.ErrorResponse <> "" Then
        CompleteJob(TaskId, False, Response.ErrorResponse)
    Else
        CompleteJob(TaskId, False, Reason)
    End If
End Sub
#Else
Sub hc_ResponseError (Response As HttpResponse, Reason As String, StatusCode As Int, TaskId As Int)
    Try
        Dim j As String = Response.GetString
        If j <> "" Then Reason = j
    Catch
        Reason = "(Error decoding response)"
    End Try
    CompleteJob(TaskId, False, Reason, Response)
End Sub

Sub hc_ResponseSuccess (Response As HttpResponse, TaskId As Int)
    CompleteJob(TaskId, True, "", Response)
End Sub
#End If

#If B4A or B4J
Sub CompleteJob(TaskId As Int, success As Boolean, errorMessage As String)
#Else
Sub CompleteJob(TaskId As Int, success As Boolean, errorMessage As String, res As HttpResponse)
#End If
    Dim job As HttpJob = TaskIdToJob.Get(TaskId)
    If job = Null Then
        Log("HttpUtils2Service: job completed multiple times - " & TaskId)
        Return
    End If
    TaskIdToJob.Remove(TaskId)
    job.Success = success
    job.ErrorMessage = errorMessage
#if B4A or B4J
    job.Complete(TaskId)
#Else
    job.Complete(res)
#End If
End Sub

Note my mods are only with respect to B4J - which is where I am seeing the problem.

One other thing I have found is that once a B4J HttpJob fails in this way all subsequent HttpJobs in the same instance of the app will also fail.

To handle this I have modified my B4J apps so that when a HttpJob fails in this fashion, with the app detecting:

Job.ErrorMessage = "Time out override"

the app self destructs with an ExitApplication statement - all my apps are monitored by the RestartOnCrash Windows applet so they are then automatically relaunched.

I could not find a more elegant way to do this - in B4J the HttpUtils2Service.bas is not actually a service - it is a code module which defines some variables (I suspect [Private hc As OkHttpClient]) that can't be flushed/restarted.

If there is a better way to do this in B4J then please tell me.

Happy coding...

 

[JackKirk]

I have incorporated the code in post #1 into all my B4J apps that run htttp jobs to interface to AWS services such as S3.

And added the ExitApplication stuff when a

Job.ErrorMessage = "Time out override"

is detected.

It finally fired in 1 app! - took about 6 weeks - as previously noted it is fairly rare.

And everything worked as wanted - the app self destructed and RestartOnCrash Windows applet relaunched it.