ab8f9d3c24
solution tested and ready for deployment updated SRP_Git_Services to handle creating local copies of inherited entities updated HgCV OCAP order trigger to also look for active prove-in orders moved error services common into sysprog to avoid compilation issues
876 lines
41 KiB
Plaintext
876 lines
41 KiB
Plaintext
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
|