Function HTTPClient_Services(@Service, @Params)
/***********************************************************************************************************************

    This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
    permission from SRP Computer Solutions, Inc.

    Name        :   HTTPClient_Services

    Description :   Handler program for all module related services.

    Notes       :   The generic parameters should contain all the necessary information to process the services. Often
                    this will be information like the data Record and Key ID.

    Parameters  :
        Service         [in] -- Name of the service being requested
        Param1-10   [in/out] -- Additional request parameter holders
        Response       [out] -- Response to be sent back to the Controller (MCP) or requesting procedure

    Metadata    :

    History     :   (Date, Initials, Notes)
        03/28/16    dmb     [SRPFW-120] Original programmer.
        07/01/17    dmb     [SRPFW-184] Refactor using Enhanced BASIC+ syntax.
        05/19/18    dmb     [SRPFW-235] Check for content in the HeaderList variable before calling the For Each loop.
        11/15/18    dmb     [SRPFW-238] Add ClientCertPath argument to the SendHTTPRequest service to support
                            client-side certificates.
        02/28/19    dmb     Change UseXMLHTTP argument to UseClientXMLHTTP in the SendHTTPRequest service to make it
                            easier to interpret.
        02/09/20    dmb     [SRPFW-309] Fix a bug in the SendHTTPRequest service so that request headers are properly
                            parsed. All colons were erroneously being converted to @VM instead of the first colon (which
                            separated the header name from the header value).
        02/09/20    dmb     [SRPFW-309] Update the SetResponseHeaderField service to better support Set-Cookie headers.
                            Allow multiple cookie names to be stored but only store the value of the last cookie name
                            if it is duplicated.
        02/09/20    dmb     [SRPFW-309] Update the GetResponseHeaderField by adding a Delimiter argument so the caller
                            can specify an alternative delimiter for the values being returned.
        02/09/20    dmb     [SRPFW-309] Add GetCookies service to make it easier to view all cookies returned in the
                            response.
        02/09/20    dmb     [SRPFW-309] Add GetCookie service to make it easier to see the entire cookie string of a
                            specified cookie.
        02/10/20    dmb     [SRPFW-309] Update the GetCookie service to include an IgnoreAttributes argument. If this
                            is True$, then only the cookie name and value will be returned.
        12/19/24	djs 	Created LSL version of service module. Added IgnoreCertErrors parameter to SendHttpRequest service.

***********************************************************************************************************************/

#pragma precomp SRP_PreCompiler

$insert LOGICAL
$insert SERVICE_SETUP

Equ     CRLF$           to \0D0A\
// The readyState property will have this value when the request has returned from the server.
// http://msdn.microsoft.com/en-us/library/ms753800(v=vs.85).aspx
Equ     HTTP_COMPLETED$ to 4

Equ SXH_SERVER_CERT_IGNORE_UNKNOWN_CA$        to 256   ; // Unknown certificate authority
Equ SXH_SERVER_CERT_IGNORE_WRONG_USAGE$       to 512   ; // Malformed certificate such as a certificate with no subject name.
Equ SXH_SERVER_CERT_IGNORE_CERT_CN_INVALID$   to 4096  ; // Mismatch between the visited hostname and the certificate name being used on the server.
Equ SXH_SERVER_CERT_IGNORE_CERT_DATE_INVALID$ to 8192  ; // The date in the certificate is invalid or has expired.
Equ SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS$ to 13056 ; // All certificate errors.

Common /HTTPClientServices/ RequestHeaderFields@, RequestHeaderValues@, ResponseHeaderFields@, ResponseHeaderValues@, ResponseStatusCode@, ResponseStatusPhrase@, ResponseBody@, TimeoutDuration@

Declare function    SRP_COM, HTTPClient_Services, GetTickCount, OLECreateInstance, OLEGetProperty, OLECallMethod, OLEStatus
Declare subroutine  SRP_COM, HTTPClient_Services, OLEPutProperty

GoToService else
    Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' module.')
end

Return Response OR ''


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Service Parameter Options
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Options BOOLEAN             = True$, False$
Options RESPONSEHEADERNAMES = 'Access-Control-Allow-Headers', 'Access-Control-Allow-Methods', 'Access-Control-Allow-Origin', 'Allow', 'Content-Encoding', 'Content-Language', 'Content-Length', 'Content-Location', 'Content-Disposition', 'Content-Type', 'Date', 'Expires', 'Last-Modified', 'Link', 'Location', 'Retry-After', 'Server', 'Set-Cookie', 'Transfer-Encoding', 'Vary', 'WWW-Authenticate',


////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
// Services
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

//----------------------------------------------------------------------------------------------------------------------
// SendHTTPRequest
//
// Method           - The HTTP method to submit to the server. - [Required]
// URL              - The URL receiving the HTTP request. - [Required]
// HeaderList       - An @FM/@VM list of request header names and values. - [Optional]
// Body             - The request body to be sent to the server. - [Optional]
// ProxyUser        - Username needed to authenticate against a proxy server. - [Optional]
// ProxyPassword    - Password needed to authenticate against a proxy server. - [Optional]
// UseAsynchronous  - Flag to determine if the HTTP request should be processed asynchronously. Default is True.
//                    - [Optional]
// UseClientXMLHTTP - Flag to determine if client XMLHTTP or server XMLHTTP should be used. Default is server XMLHTTP.
//                    - [Optional]
// ClientCertPath   - Path to a client-side certificate. This is usually in Location\Certificate Store\Subject format.
//                    - [Optional]
//
// Calls the indicated HTTP web service routine.
//----------------------------------------------------------------------------------------------------------------------
Service SendHTTPRequestOLE(Method, URL, HeaderList, Body, ProxyUser, ProxyPassword, UseAsynchronous, UseClientXMLHTTP, ClientCertPath)

    // Defaults.
    If UseAsynchronous  NE False$   then UseAsynchronous    = True$
    If UseClientXMLHTTP NE True$    then UseClientXMLHTTP   = False$

    If (Method NE '') AND (URL NE '') then
        // Make sure all prior response settings are cleared before performing the next HTTP request.
        HTTPClient_Services('ClearResponseSettings')

        // Attempt to get a handle for the best XMLHTTP object.
        objXMLHTTP  = ''
        If UseClientXMLHTTP then
            ServerPrefix    = ''
        end else
            ServerPrefix    = 'Server'
        end
        XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.6.0'
        objXMLHTTP    = OLECreateInstance(XMLHTTPProgID)
        Status        = OLEStatus()
        If Status then
            XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.3.0'
            objXMLHTTP    = OLECreateInstance(XMLHTTPProgID)
            Status        = OLEStatus()
            If Status then
                XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP'
                objXMLHTTP    = OLECreateInstance(XMLHTTPProgID)
                Status        = OLEStatus()
                If Status then
                    Error  = 'Unable to create a handle to the XMLHTTP object in the ' : Service : ' service.'
                    Error := ' OLE Error: ' : Status
                    Error_Services('Add', Error)                    
                end
            end
        end

        If Error_Services('NoError') then
            // Invoke the XMLHTTP object's open method to initialize a request.
            rv     = OLECallMethod(objXMLHTTP, 'open', Method, URL, UseAsynchronous, ProxyUser, ProxyPassword)
            Status = OLEStatus()
            If Status then
                Error   = 'Error calling the open method for the XMLHTTP object in the ' : Service : ' service.'
                Error  := ' OLE Error: ' : Status
                Error_Services('Add', Error)
            end
        end

*        If Error_Services('NoError') then
*            // Set the request header names and values. This will add or update any header fields passed in through this
*            // service with those have may have been previously set using the SetRequestHeaderFields or
*            // SetRequestHeaderField already.
*            If Len(HeaderList) then HTTPClient_Services('SetRequestHeaderFields', HeaderList)
*            // Now get all of the request header fields.
*            HeaderList  = HTTPClient_Services('GetRequestHeaderFields')
*            If Error_Services('NoError') then
*                If HeaderList NE '' then
*                    For Each HeaderPair in HeaderList using @FM
*                        HeaderName  = HeaderPair<0, 1>
*                        HeaderValue = HeaderPair<0, 2>
*                        SRP_COM(objXMLHTTP, 'CALL', 'setRequestHeader', HeaderName, HeaderValue)
*                        If SRP_COM('', 'HASERROR') then
*                            Error   = 'Error setting the setRequestHeader property for the ' : HeaderName : ' field in the XMLHTTP object in the ' : Service : ' service.'
*                            Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
*                            Error_Services('Add', Error)
*                        end
*                    Next HeaderPair
*                end
*            end
*        end

*        If ClientCertPath NE '' then
*            If Error_Services('NoError') then
*                // Invoke the XMLHTTP object's setOption method to invoke a certificate.
*                rv  = SRP_COM(objXMLHTTP, 'CALL', 'setOption', 3, ClientCertPath)
*                If SRP_COM('', 'HASERROR') then
*                    Error   = 'Error calling the setOption method for the XMLHTTP object in the ' : Service : ' service.'
*                    Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
*                    Error_Services('Add', Error)
*                end
*            end
*        end

        If Error_Services('NoError') then
            // Invoke the XMLHTTP object's send method to submit the request to the server.
            rv     = OLECallMethod(objXMLHTTP, 'send', Body)
            Status = OLEStatus()
            If Status then
                Error   = 'Error calling the send method for the XMLHTTP object in the ' : Service : ' service.'
                Error  := ' OLE Error: ' : Status
                Error_Services('Add', Error)
            end
        end

        If Error_Services('NoError') then
            If UseAsynchronous then
                StartTime       = GetTickCount()
                TimeoutDuration = HTTPClient_Services('GetTimeoutDuration')
                TimedOut        = False$
                Loop
                    ReadyState  = OLEGetProperty(objXMLHTTP, 'readyState')
                    CurrentTime = GetTickCount()
                    ElapsedTime = Int((CurrentTime - StartTime) / 1000)
                    TimedOut    = ElapsedTime GE TimeoutDuration
                While (ReadyState NE HTTP_COMPLETED$) AND Not(TimedOut)
                Repeat
            end

            // Check the XMLHTTP object's responseBody property to get the server's response.
            Response  = OLEGetProperty(objXMLHTTP, 'responseBody')
            Response1 = OLEGetProperty(objXMLHTTP, 'responseText')
            Response2 = objXMLHTTP->responseBody
            Response3 = objXMLHTTP->responseText

            Status = OLEStatus()
            If Status then
                Error       = 'Error getting the responseBody property for the XMLHTTP object in the ' : Service : ' service.'
                Error      := ' OLE Error: ' : Status
                Error_Services('Add', Error)
                Response    = ''
            end else
                HTTPClient_Services('SetResponseBody', Response)
            end
        end

        If Error_Services('NoError') then
            // If the request was successful, get the response status code, phrase, and response headers and set them
            // using HTTPClient_Services so the caller can retrieve is desired.
            Code   = OLEGetProperty(objXMLHTTP, 'status')
            Phrase = Trim(OLEGetProperty(objXMLHTTP, 'statusText'))
            HTTPClient_Services('SetResponseStatusCode', Code)
            HTTPClient_Services('SetResponseStatusPhrase', Phrase)

            ResponseHeaders = OLECallMethod(objXMLHTTP, 'getAllResponseHeaders')
            Swap CRLF$ with @FM in ResponseHeaders
            For Each ResponseHeader in ResponseHeaders using @FM
                Name    = ResponseHeader[1, 'F:']
                Value   = Trim(ResponseHeader[Col2() + 1, 9999])
                If (Name NE '') AND (Value NE '') then
                    HTTPClient_Services('SetResponseHeaderField', Name, Value)
                end
            Next ResponseHeader
        end

        // Make sure all prior request settings are cleared so future HTTP request won't be affected.
        Error = Error_Services('GetMessage')        ; // Get any pre-existing errors so they can be preserved.
        HTTPClient_Services('ClearRequestSettings') ; // This will automatically clear the error stack.
        Error_Services('Set', Error)                ; // Restore any errors so the caller can check for them.
    end else
        Error_Services('Add', 'Method or URL argument was missing from the ' : Service : ' service.')
    end

end service


//----------------------------------------------------------------------------------------------------------------------
// SendHTTPRequest
//
// Method           - The HTTP method to submit to the server. - [Required]
// URL              - The URL receiving the HTTP request. - [Required]
// HeaderList       - An @FM/@VM list of request header names and values. - [Optional]
// Body             - The request body to be sent to the server. - [Optional]
// ProxyUser        - Username needed to authenticate against a proxy server. - [Optional]
// ProxyPassword    - Password needed to authenticate against a proxy server. - [Optional]
// UseAsynchronous  - Flag to determine if the HTTP request should be processed asynchronously. Default is True.
//                    - [Optional]
// UseClientXMLHTTP - Flag to determine if client XMLHTTP or server XMLHTTP should be used. Default is server XMLHTTP.
//                    - [Optional]
// ClientCertPath   - Path to a client-side certificate. This is usually in Location\Certificate Store\Subject format.
//                    - [Optional]
//
// Calls the indicated HTTP web service routine.
//----------------------------------------------------------------------------------------------------------------------
Service SendHTTPRequest(Method, URL, HeaderList, Body, ProxyUser, ProxyPassword, UseAsynchronous, UseClientXMLHTTP, ClientCertPath, IgnoreCertErrors)

    // Defaults.
    If UseAsynchronous  NE False$   then UseAsynchronous    = True$
    If UseClientXMLHTTP NE True$    then UseClientXMLHTTP   = False$
    If IgnoreCertErrors NE True$	then IngoreCertErrors = False$

    If (Method NE '') AND (URL NE '') then
        // Make sure all prior response settings are cleared before performing the next HTTP request.
        HTTPClient_Services('ClearResponseSettings')

        // Attempt to get a handle for the best XMLHTTP object.
        objXMLHTTP  = ''
        If UseClientXMLHTTP then
            ServerPrefix    = ''
        end else
            ServerPrefix    = 'Server'
        end
        XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.6.0'
        If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else
            XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.3.0'
            If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else
                XMLHTTPProgID   = 'Msxml2.' : ServerPrefix : 'XMLHTTP'
                If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else
                    Error   = 'Unable to create a handle to the XMLHTTP object in the ' : Service : ' service.'
                    If SRP_COM('', 'HASERROR') then
                        Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
                    end
                    Error_Services('Add', Error)
                end
            end
        end

        If Error_Services('NoError') then
            // Invoke the XMLHTTP object's open method to initialize a request.
            SRP_COM(objXMLHTTP, 'CALL', 'open', Method, URL, UseAsynchronous, ProxyUser, ProxyPassword)
            If SRP_COM('', 'HASERROR') then
                Error   = 'Error calling the open method for the XMLHTTP object in the ' : Service : ' service.'
                Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
                Error_Services('Add', Error)
            end
        end

        If Error_Services('NoError') then
            // Set the request header names and values. This will add or update any header fields passed in through this
            // service with those have may have been previously set using the SetRequestHeaderFields or
            // SetRequestHeaderField already.
            If Len(HeaderList) then HTTPClient_Services('SetRequestHeaderFields', HeaderList)
            // Now get all of the request header fields.
            HeaderList  = HTTPClient_Services('GetRequestHeaderFields')
            If Error_Services('NoError') then
                If HeaderList NE '' then
                    For Each HeaderPair in HeaderList using @FM
                        HeaderName  = HeaderPair<0, 1>
                        HeaderValue = HeaderPair<0, 2>
                        SRP_COM(objXMLHTTP, 'CALL', 'setRequestHeader', HeaderName, HeaderValue)
                        If SRP_COM('', 'HASERROR') then
                            Error   = 'Error setting the setRequestHeader property for the ' : HeaderName : ' field in the XMLHTTP object in the ' : Service : ' service.'
                            Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
                            Error_Services('Add', Error)
                        end
                    Next HeaderPair
                end
            end
        end

        If IgnoreCertErrors then
        	If Error_Services('NoError') then
        		rv = SRP_COM(objXMLHTTP, 'CALL', 'setOption', 2, SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS$)
                If SRP_COM('', 'HASERROR') then
                    Error   = 'Error calling the setOption method for the XMLHTTP object in the ' : Service : ' service.'
                    Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
                    Error_Services('Add', Error)
                end        		
        	end
        end

        If ClientCertPath NE '' then
            If Error_Services('NoError') then
                // Invoke the XMLHTTP object's setOption method to invoke a certificate.
                rv  = SRP_COM(objXMLHTTP, 'CALL', 'setOption', 3, ClientCertPath)
                If SRP_COM('', 'HASERROR') then
                    Error   = 'Error calling the setOption method for the XMLHTTP object in the ' : Service : ' service.'
                    Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
                    Error_Services('Add', Error)
                end
            end
        end
        
        If Error_Services('NoError') then
            // Invoke the XMLHTTP object's send method to submit the request to the server.
            rv  = SRP_COM(objXMLHTTP, 'CALL', 'send', Body)
            If SRP_COM('', 'HASERROR') then
                Error   = 'Error calling the send method for the XMLHTTP object in the ' : Service : ' service.'
                Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
                Error_Services('Add', Error)
            end
        end

        If Error_Services('NoError') then
            If UseAsynchronous then
                StartTime       = GetTickCount()
                TimeoutDuration = HTTPClient_Services('GetTimeoutDuration')
                TimedOut        = False$
                Loop
                    ReadyState  = SRP_COM(objXMLHTTP, 'GET', 'readyState')
                    CurrentTime = GetTickCount()
                    ElapsedTime = Int((CurrentTime - StartTime) / 1000)
                    TimedOut    = ElapsedTime GE TimeoutDuration
                While (ReadyState NE HTTP_COMPLETED$) AND Not(TimedOut)
                Repeat
            end

            // Check the XMLHTTP object's responseBody property to get the server's response.
*            Response    = SRP_COM(objXMLHTTP, 'GET', 'responseBody')
            Response    = SRP_COM(objXMLHTTP, 'GET', 'responseText')

            If SRP_COM('', 'HASERROR') then
                Error       = 'Error getting the responseBody property for the XMLHTTP object in the ' : Service : ' service.'
                Error      := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
                Error_Services('Add', Error)
                Response    = ''
            end else
                HTTPClient_Services('SetResponseBody', Response)
            end
        end

        If Error_Services('NoError') then
            // If the request was successful, get the response status code, phrase, and response headers and set them
            // using HTTPClient_Services so the caller can retrieve is desired.
            Code            = SRP_COM(objXMLHTTP, 'GET', 'status')
            Phrase          = Trim(SRP_COM(objXMLHTTP, 'GET', 'statusText'))
            HTTPClient_Services('SetResponseStatusCode', Code)
            HTTPClient_Services('SetResponseStatusPhrase', Phrase)

            ResponseHeaders = SRP_COM(objXMLHTTP, 'CALL', 'getAllResponseHeaders')
            Swap CRLF$ with @FM in ResponseHeaders
            For Each ResponseHeader in ResponseHeaders using @FM
                Name    = ResponseHeader[1, 'F:']
                Value   = Trim(ResponseHeader[Col2() + 1, 9999])
                If (Name NE '') AND (Value NE '') then
                    HTTPClient_Services('SetResponseHeaderField', Name, Value)
                end
            Next ResponseHeader
        end

        // Release the handle to the XMLHTTP object in case it was created.
        SRP_COM(objXMLHTTP, 'RELEASE')

        // Make sure all prior request settings are cleared so future HTTP request won't be affected.
        Error = Error_Services('GetMessage')        ; // Get any pre-existing errors so they can be preserved.
        HTTPClient_Services('ClearRequestSettings') ; // This will automatically clear the error stack.
        Error_Services('Set', Error)                ; // Restore any errors so the caller can check for them.
    end else
        Error_Services('Add', 'Method or URL argument was missing from the ' : Service : ' service.')
    end

end service


//----------------------------------------------------------------------------------------------------------------------
// SetRequestHeaderFields
//
// HeaderList   - An @FM/@VM list of request header fields and their values. - [Required]
//
// Sets the Request Header Fields as indicated by the HeaderList argument. The HeaderList should not be formatted as a
// list rather than an associated multivalue array. This is easier for the developer to manage in the code that calls
// this service.
//----------------------------------------------------------------------------------------------------------------------
Service SetRequestHeaderFields(HeaderList)

    If HeaderList NE '' then
        For Each HeaderPair in HeaderList using @FM
            HeaderName  = HeaderPair<0, 1>
            HeaderValue = HeaderPair<0, 2>
            HTTPClient_Services('SetRequestHeaderField', HeaderName, HeaderValue)
        Next HeaderPair
    end else
        Error_Services('Add', 'HeaderList argument was missing from the ' : Service : ' service.')
    end

end service


//----------------------------------------------------------------------------------------------------------------------
// SetRequestHeaderField
//
// Name     - Header Field Name to set. - [Required]
// Value    - Value for the header field. This will be Trimmed to enforce proper formatting. - [Required]
//
// Sets the indicated Request Header Field with the indicated value.
//----------------------------------------------------------------------------------------------------------------------
Service SetRequestHeaderField(Name, Value)

    If (Name NE '') AND (Value NE '') then
        SearchName      = Name
        Convert @Lower_Case to @Upper_Case in SearchName
        SearchFields    = RequestHeaderFields@
        Convert @Lower_Case to @Upper_Case in SearchFields
        Locate SearchName in SearchFields using @FM setting fPos else
            fPos = Count(RequestHeaderFields@, @FM) + (RequestHeaderFields@ NE '') + 1
        end
        RequestHeaderFields@<fPos>  = Name
        RequestHeaderValues@<fPos>  = Trim(Value)
    end else
        Error_Services('Add', 'The Name or Value argument is missing in the ' : Service : ' service.')
    end

end service


//----------------------------------------------------------------------------------------------------------------------
// GetRequestHeaderFields
//
// Returns all of the Request Header Field names and values. This returns an @FM/@VM list of names and values.
//----------------------------------------------------------------------------------------------------------------------
Service GetRequestHeaderFields()

    HeaderFieldBlock    = ''

    If RequestHeaderFields@ NE '' then
        NumFields   = Count(RequestHeaderFields@, @FM) + (RequestHeaderFields@ NE '')
        For FieldCnt = 1 to NumFields
            HeaderFieldBlock   := RequestHeaderFields@<FieldCnt> : @VM : RequestHeaderValues@<FieldCnt> : @FM
        Next FieldCnt
        HeaderFieldBlock[-1, 1] = ''
    end

    Response    = HeaderFieldBlock

end service


//----------------------------------------------------------------------------------------------------------------------
// GetRequestHeaderField
//
// Name - Header Field Name to get. - [Required]
//
// Returns the value previously set for the indicated Request Header Field.
//----------------------------------------------------------------------------------------------------------------------
Service GetRequestHeaderField(Name)

    Value       = ''

    If Name NE '' then
        SearchName      = Name
        Convert @Lower_Case to @Upper_Case in SearchName
        SearchFields    = RequestHeaderFields@
        Convert @Lower_Case to @Upper_Case in SearchFields
        Locate SearchName in SearchFields using @FM setting fPos then
            Value   = RequestHeaderValues@<fPos>
        end else
            Error_Services('Add', Name : ' is not a header field in the request.')
        end
    end else
        Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.')
    end

    Response    = Value

end service


//----------------------------------------------------------------------------------------------------------------------
// SetResponseHeaderField
//
// Name     - Header Field Name to set. - [Required]
// Value    - Value for the header field. This will be Trimmed to enforce proper formatting. - [Required]
//
// Sets the indicated Response Header Field with the indicated value.
//----------------------------------------------------------------------------------------------------------------------
Service SetResponseHeaderField(Name, Value)

    If (Name NE '') AND (Value NE '') then
        SearchName      = Name
        Convert @Lower_Case to @Upper_Case in SearchName
        SearchFields    = ResponseHeaderFields@
        Convert @Lower_Case to @Upper_Case in SearchFields
        Locate SearchName in SearchFields using @FM setting fPos else
            fPos = Count(ResponseHeaderFields@, @FM) + (ResponseHeaderFields@ NE '') + 1
        end
        ResponseHeaderFields@<fPos> = Name
        PreviousValue               = ResponseHeaderValues@<fPos>
        If PreviousValue EQ '' then
            ResponseHeaderValues@<fPos> = Trim(Value)
        end else
            If Name EQ 'Set-Cookie' then
                // Unlike other response headers, Set-Cookie can have multiple entries. However, if more than one
                // cookie of a particular name exists then only store the last entry.
                SetCookieFound  = False$
                CookieName      = Value[1, 'F='][1, 'F '][1, 'F;']
                For Each HeaderField in ResponseHeaderFields@ using @FM setting fPos
                    If HeaderField EQ 'Set-Cookie' then
                        SetCookieFound  = True$
                    end
                Until SetCookieFound EQ True$
                Next HeaderField
                If SetCookieFound EQ True$ then
                    // Set-Cookie was found. Check to see if the cookie name has already been added.
                    CookieNameFound = False$
                    CookieValues    = ResponseHeaderValues@<fPos>
                    For Each CookieValue in CookieValues using @VM setting vPos
                        MatchCookieName = CookieValue[1, 'F='][1, 'F '][1, 'F;']
                        If CookieName EQ MatchCookieName then
                            CookieNameFound = True$
                        end
                    Until CookieNameFound EQ True$
                    Next CookieValue
                    If CookieNameFound EQ True$ then
                        // Cookie name already exists. Replace the old value with the new one.
                        ResponseHeaderValues@<fPos, vPos>   = Trim(Value)
                    end else
                        // This is a new cookie name. Append the Set-Cookie value to the list.
                        ResponseHeaderValues@<fPos, -1>     = Trim(Value)
                    end
                end else
                    // No cookies have been set yet.
                    ResponseHeaderValues@<fPos> = Trim(Value)
                end
            end else
                ResponseHeaderValues@<fPos> = PreviousValue : ' ;' : Trim(Value)
            end
        end
    end else
        Error_Services('Add', 'The Name or Value argument is missing in the ' : Service : ' service.')
    end

end service


//----------------------------------------------------------------------------------------------------------------------
// GetResponseHeaderFields
//
// Returns all of the Response Header Field names and values. This returns an @FM/@VM list of names and values.
//----------------------------------------------------------------------------------------------------------------------
Service GetResponseHeaderFields()

    HeaderFieldBlock    = ''

    If ResponseHeaderFields@ NE '' then
        NumFields   = Count(ResponseHeaderFields@, @FM) + (ResponseHeaderFields@ NE '')
        For FieldCnt = 1 to NumFields
            HeaderFieldBlock   := ResponseHeaderFields@<FieldCnt> : @VM : ResponseHeaderValues@<FieldCnt> : @FM
        Next FieldCnt
        HeaderFieldBlock[-1, 1] = ''
    end else
        Error_Services('Add', 'There are no response header fields get.')
    end

    Response    = HeaderFieldBlock

end service


//----------------------------------------------------------------------------------------------------------------------
// GetResponseHeaderField
//
// Name         - Header Field Name to get. - [Required]
// Delimiter    - Delimiter to use for multiple values. Default is '; ' for all header fields except for Set-Cookie.
//                Set-Cookie defaults to @VM. - [Optional]
//
// Returns the value previously set for the indicated Response Header Field. The Name argument is case-insensitive but
// if the indicated Response Header Field has not been set then an error condition will be set.
//----------------------------------------------------------------------------------------------------------------------
Service GetResponseHeaderField(Name=RESPONSEHEADERNAMES, Delimiter)

    Value       = ''

    If Name NE '' then
        SearchName      = Name
        Convert @Lower_Case to @Upper_Case in SearchName
        SearchFields    = ResponseHeaderFields@
        Convert @Lower_Case to @Upper_Case in SearchFields
        Locate SearchName in SearchFields using @FM setting fPos then
            Value   = ResponseHeaderValues@<fPos>
            If Delimiter NE '' then
                If Name EQ 'Set-Cookie' then
                    Convert @VM to Delimiter in Value
                end else
                    Swap '; ' with Delimiter in Value
                end
            end
        end else
            Error_Services('Add', Name : ' is not a header field in the response.')
        end
    end else
        Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.')
    end

    Response    = Value

end service


//----------------------------------------------------------------------------------------------------------------------
// GetCookies
//
// Delimiter    - Delimiter to use for multiple cookies. Default is @FM - [Optional]
//
// Returns all cookie strings from the response headers.
//----------------------------------------------------------------------------------------------------------------------
Service GetCookies(Delimiter)

    If Delimiter EQ '' then Delimiter = @FM

    Cookies     = HTTPClient_Services('GetResponseHeaderField', 'Set-Cookie', Delimiter)

    Response    = Cookies

end service


//----------------------------------------------------------------------------------------------------------------------
// GetCookie
//
// Name				- Name of the cookie to get. - [Required]
// IgnoreAttributes	- Boolean flag to indicate if the cookie's attributes should be removed when returning the cookie.
//					  Default value is False$. - [Optional]
//
// Returns the value for the indicated cookie name.
//----------------------------------------------------------------------------------------------------------------------
Service GetCookie(Name, IgnoreAttributes=BOOLEAN)

	If IgnoreAttributes NE True$ then IgnoreAttributes = False$

	Cookie      = ''

	If Name NE '' then
		CookieNameFound = False$
		Cookies         = HTTPClient_Services('GetCookies')
		For Each CookieString in Cookies using @FM
			MatchCookieName = CookieString[1, 'F='][1, 'F '][1, 'F;']
			If Name EQ MatchCookieName then
				CookieNameFound = True$
			end
		Until CookieNameFound EQ True$
		Next CookieValue
		If CookieNameFound EQ True$ then
			If IgnoreAttributes EQ True$ then
				CookieString	= Trim(CookieString[1, ';'])
			end
			Transfer CookieString to Cookie
		end
	end else
		Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.')
	end

	Response    = Cookie

end service


//----------------------------------------------------------------------------------------------------------------------
// SetResponseStatusCode
//
// Code - HTTP status code to set. - [Required]
//
// Sets the response status code generated by the most recent HTTP request.
//----------------------------------------------------------------------------------------------------------------------
Service SetResponseStatusCode(Code)

    If Code NE '' then
        ResponseStatusCode@     = Code
    end else
        Error_Services('Add', 'The Code argument is missing in the ' : Service : ' service.')
    end

end service


//----------------------------------------------------------------------------------------------------------------------
// GetResponseStatusCode
//
// Gets the response status code generated by the most recent HTTP request.
//----------------------------------------------------------------------------------------------------------------------
Service GetResponseStatusCode()

    Response    = ResponseStatusCode@

end service


//----------------------------------------------------------------------------------------------------------------------
// SetResponseStatusPhrase
//
// Phrase   - HTTP status phrase to set. - [Required]
//
// Sets the response status phrase generated by the most recent HTTP request.
//----------------------------------------------------------------------------------------------------------------------
Service SetResponseStatusPhrase(Phrase)

    If Phrase NE '' then
        ResponseStatusPhrase@   = Phrase
    end else
        Error_Services('Add', 'The Phrase argument is missing in the ' : Service : ' service.')
    end

end service


//----------------------------------------------------------------------------------------------------------------------
// GetResponseStatusPhrase
//
// Gets the response status phrase generated by the most recent HTTP request.
//----------------------------------------------------------------------------------------------------------------------
Service GetResponseStatusPhrase()

    Response    = ResponseStatusPhrase@

end service


//----------------------------------------------------------------------------------------------------------------------
// SetResponseBody
//
// Body - The response body which would have been generated by an XMLHTTP call.
//
// Sets the response body generated by the most recent HTTP request.
//----------------------------------------------------------------------------------------------------------------------
Service SetResponseBody(Body)

    ResponseBody@   = Body

end service


//----------------------------------------------------------------------------------------------------------------------
// GetResponseBody
//
// Gets the response body generated by the most recent HTTP request.
//----------------------------------------------------------------------------------------------------------------------
Service GetResponseBody()

    Response    = ResponseBody@

end service


//----------------------------------------------------------------------------------------------------------------------
// SetTimeoutDuration
//
// TimeoutDuration  - The length of time (in seconds) before an HTTP request will abort.
//
// Sets the timeout duration that will be used before an HTTP request will abort. This is only applicable if the
// request is asynchronous. If the timeout duration is empty, a default setting of 30 minutes (1800 seconds) will be
// set.
//----------------------------------------------------------------------------------------------------------------------
Service SetTimeoutDuration(TimeoutDuration)

    If TimeoutDuration EQ '' then TimeoutDuration = 1800

    TimeoutDuration@    = TimeoutDuration

end service


//----------------------------------------------------------------------------------------------------------------------
// GetTimeoutDuration
//
// Returns the timeout duration that will be used before an HTTP request will abort. This is only applicable if the
// request is asynchronous. If the timeout duration is empty, a default setting of 30 minutes (1800) seconds) will be
// returned.
//----------------------------------------------------------------------------------------------------------------------
Service GetTimeoutDuration()

    If TimeoutDuration@ EQ '' then TimeoutDuration@ = 1800

    Response    = TimeoutDuration@

end service


//----------------------------------------------------------------------------------------------------------------------
// ClearResponseSettings
//
// Clears all of the global common variables used for responses.
//----------------------------------------------------------------------------------------------------------------------
Service ClearResponseSettings()

    ResponseHeaderFields@   = ''
    ResponseHeaderValues@   = ''
    ResponseStatusCode@     = ''
    ResponseStatusPhrase@   = ''
    ResponseBody@           = ''

end service


//----------------------------------------------------------------------------------------------------------------------
// ClearRequestSettings
//
// Clears all of the global common variables used for requests.
//----------------------------------------------------------------------------------------------------------------------
Service ClearRequestSettings()

    RequestHeaderFields@    = ''
    RequestHeaderValues@    = ''
    TimeoutDuration@        = 1800

end service
