3104 lines
160 KiB
Plaintext
3104 lines
160 KiB
Plaintext
Function SRP_EDITOR_TEMP_HTTP_SERVICES_FRAMEWORKS(@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 : HTTP_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
|
|
|
|
History : (Date, Initials, Notes)
|
|
02/16/15 dmb [SRPFW-82] Original programmer.
|
|
04/07/15 dmb [SRPFW-82] Add CRLF$ equate.
|
|
07/20/15 dmb [SRPFW-82] Optimize SetRequestHeaderFields by removing the call to GetHTTPAdditionalValues
|
|
out of the loop.
|
|
11/01/15 dmb [SRPFW-86] Fix reference to '<' to '>' in DecodePercentString service when swapping '>'
|
|
(Thanks Anton).
|
|
02/23/16 dmb [SRPFW-106] Add GetVersion service.
|
|
02/25/16 dmb [SRPFW-108] Add GetHomeURL, GetAPIRoolURL, GetCapturePath, GetEnableAuthenticationFlag, and
|
|
GetRealmValue services.
|
|
03/09/16 dmb [SRPFW-110] Update the GetResponseStatus service to use the
|
|
SYSENV\SRP_HTTP_FRAMEWORK_HTTP_STATUS_CODES to use the default phrase if one is not
|
|
provided.
|
|
03/09/16 dmb [SRPFW-110] Update the GetResponse service to use the GetResponseStatus service to populate
|
|
the response body if there is no body already generated by a service.
|
|
03/09/16 dmb [SRPFW-111] Add GetEntryPointService service.
|
|
03/09/16 dmb [SRPFW-112] Add GetFullEndpointURL service.
|
|
03/09/16 dmb [SRPFW-112] Update argument signatures for the RunHTTPService to be simpler and more
|
|
intuitive.
|
|
03/16/16 dmb [SRPFW-113] Update the GetFullEndpointURL service so end points that are also the same as
|
|
the API URL do not display a "/" at the end.
|
|
03/17/16 dmb [SRPFW-113] Update the SetResponseHeaderField service so Access-Control-Allow-Headers is
|
|
added to the list of header fields that use ", " rather than ";" to delimit multiple values.
|
|
03/24/16 dmb [SRPFW-116] Add GetFlushCacheFlag service.
|
|
03/24/16 dmb [SRPFW-117] Update the ClearSettings service to call the GetFlushCacheFlag service and use
|
|
this flag to determine if a Flush and GarbageCollect statement should be called.
|
|
03/27/16 dmb [SRPFW-123] Add GetBestContentNegotiation service.
|
|
09/30/16 dmb [SRPFW-127] Fix DecodePercentString to convert %09, %0A, and %0D properly.
|
|
11/08/16 dmb Retrofit the entire service to use Enhanced BASIC+.
|
|
11/08/16 dmb Update the SetQueryField service to only require the Name argument to be populated.
|
|
02/21/17 dmb [SRPFW-152] Add SetHTTP value services to correspond with the existing GetHTTP value
|
|
services.
|
|
02/27/17 dmb [SRPFW-125] Add the GetAbortedService service.
|
|
03/03/17 dmb [SRPFW-154] Add the SetSessionID, GetSessionID, SetOECGIProcErr, GetOECGIProcErr, and
|
|
CreateLogFile services.
|
|
03/03/17 dmb [SRPFW-154] Add SessionID@ and ProcErr@ to the named common and to the list of variables
|
|
cleared in the ClearSettings service.
|
|
03/04/17 dmb [SRPFW-154] Add the GetEnableLoggingFlag service.
|
|
03/04/17 dmb [SRPFW-154] Update CreateLogFile service to use the GetEnableLoggingFlag service.
|
|
03/04/17 dmb [SRPFW-154] Update the SetRequestHeaderFields service to rely upon the
|
|
GetHTTPRegistrySettings service rather than the SRP_Registry function to identify the
|
|
AdditionalValues that were passed in through the OECGI Request array. This eliminates
|
|
dependency upon the name of the OECGI executable.
|
|
03/07/17 dmb [SRPFW-155] Add the GetDebuggerSetting and GetDebuggerService services.
|
|
07/01/17 dmb [SRPFW-184] Additional refactoring.
|
|
07/07/17 dmb [SRPFW-154] Add the GetLogErrorsOnlyFlag service. Update the CreateLogFile to support this
|
|
service.
|
|
09/22/17 dmb [SRPFW-193] Update the GetEntryPointService service to support fully qualified web service
|
|
routine names.
|
|
10/22/18 dmb [SRPFW-253] Add the GetWhitelistedIPs and IPIsPermitted services.
|
|
10/31/18 dmb [SRPFW-255] Replace Xlate with ReadDataRow for all services referencing SetupTable$
|
|
10/31/18 dmb [SRPFW-255] Update GetHomeURL service to automatically prepend HTTP or HTTPS based on the
|
|
request if this is not already specified in the user defined Home URL setting.
|
|
11/01/18 dmb [SRPFW-255] Update GetNonAuthenticatedURLs service to automatically prepend the API URL if
|
|
this is not already specified in the user defined setting.
|
|
11/01/18 dmb [SRPFW-255] Add the GetEnableHTTPBasicAuthenticationFlag service.
|
|
11/01/18 dmb [SRPFW-255] Add the GetNewPasswordTimeToLive service.
|
|
11/01/18 dmb [SRPFW-255] Add the GetOldPasswordTimeToLive service.
|
|
11/01/18 dmb [SRPFW-256] Add the GetInvalidPasswordLimit service.
|
|
11/01/18 dmb [SRPFW-256] Add the GetContainmentAction service.
|
|
11/01/18 dmb [SRPFW-256] Add the GetServerEnabled service.
|
|
11/01/18 dmb [SRPFW-256] Add the SetServerEnabled service.
|
|
11/09/18 dmb [SRPFW-256] Add the GetTotalInvalidPasswordAttempts service.
|
|
11/09/18 dmb [SRPFW-256] Add the SetTotalInvalidPasswordAttempts service.
|
|
11/18/18 dmb [SRPFW-257] Add the RunWebAPI service.
|
|
11/18/18 dmb [SRPFW-257] Add the GetAPICallProcedure service.
|
|
11/19/18 dmb [SRPFW-257] Add the GetWebAPI service.
|
|
11/18/18 dmb [SRPFW-257] Update the RunWebAPI service to use the GetWebAPI service.
|
|
11/19/18 dmb [SRPFW-257] Add the UpdateWebAPIs service.
|
|
11/20/18 dmb [SRPFW-257] Add support to store SYSENV records keyed to the local application.
|
|
11/22/18 dmb [SRPFW-253] Update the IPIsPermitted service to support wildcard and IP range values.
|
|
12/02/18 dmb [SRPFW-257] Convert GetLocalAppKeyID gosub lable to a service so Web APIs can call it.
|
|
12/02/18 dmb [SRPFW-257] Add the SetResponseError service.
|
|
12/06/18 dmb [SRPFW-257] Add a call to the LoremIpsum service when building a new API using the
|
|
UpdateWebAPIs service.
|
|
12/10/18 dmb [SRPFW-257] Update RunWebAPI service to support sub-resources.
|
|
12/11/18 dmb [SRPFW-257] Remove training '/' character if one exists in the GetFullEndpointURL service.
|
|
12/12/18 dmb [SRPFW-257] Add GetStatus log type.
|
|
12/24/18 dmb [SRPFW-257] Refactor RunWebAPI so resource IDs are identified better.
|
|
02/03/19 dmb [SRPFW-257] Update GetFullEndpointURL service to append query params.
|
|
04/18/19 dmb [SRPFW-271] UpdateDecodePercentString service to support conversion of left quotation mark
|
|
(i.e., %E2%80%9C).
|
|
04/22/19 dmb [SRPFW-271] Add call to Utility_DotNet in the CreateLogFile service so that Response logs
|
|
can provide UTC formatted date/time stamps for the request.
|
|
05/24/19 dmb Update all GetHTTPValue services to support a DecodePercentString flag that will be used to
|
|
automatically call the DecodePercentString service before returning the HTTP value.
|
|
05/31/19 dmb [SRPFW-276] Update the SetResponseError service to use "detail" instead of "Detail".
|
|
06/24/19 dmb [SRPFW-276] Remove larges blocks of code from the RunWebAPI service and convert these into
|
|
new services: GetEndpoint, IsValidEndpoint, SetSupportedEndpoints, and GetEndpointPattern.
|
|
06/24/19 dmb [SRPFW-276] Update the CreateLogFile service to confirm if the endpoint resource should be
|
|
excluded from being logged.
|
|
06/24/19 dmb [SRPFW-276] Update the GetHomeURL service to use the GetHTTPServerName service first and
|
|
then rely upon the HTTP_FRAMEWORK_SETUP_HOME_URL$ value.
|
|
07/16/19 dmb [SRPFW-277] Deprecate local IsValidEndpoint service. Update RunWebAPI service to use the
|
|
IsValidEndpoint service from the HTTP_Resource_Manager_Services module.
|
|
07/16/19 dmb [SRPFW-277] Update the CreateLogFile service to use the new GetResourceProperty service to
|
|
determine if logging is excluded for the current endpoint.
|
|
07/16/19 dmb [SRPFW-277] Deprecate the GetEndpointPattern service since it is no longer a dependency with
|
|
any other services.
|
|
07/16/19 dmb [SRPFW-277] Deprecate the SetSupportedEndpoints service since it is no longer a dependency
|
|
with any other services.
|
|
07/17/19 dmb [SRPFW-277] Update the UpdateWebAPIs service to use the GetResourceProperty service to get
|
|
the supported HTTP methods and also to use the GetResourceSignature service to build the
|
|
list of API signatures.
|
|
07/18/19 dmb [SRPFW-277] Update the CreateLogFile service to parse the Get_Status error better.
|
|
08/10/19 dmb [SRPFW-278] Update the CreateLogFile service to create/append a log index in addition to a
|
|
detail log file. This will be used by the HTTP Logs utility to quickly populate several
|
|
logs.
|
|
09/22/19 dmb [SRPFW-278] Fix VNAV in UpdateWebAPIs service. The APIProcedureName variable was unassigned
|
|
in some conditions.
|
|
09/23/19 dmb [SRPFW-278] Update the CreateLogFile service to support the new Remote Address / Execute
|
|
Time column. Fix minor bug that appended a '/' when the endpoint was the same as the API
|
|
Root.
|
|
09/24/19 dmb [SRPFW-278] Update the UpdateWebAPIs service to support the creation of a local copy of a
|
|
Web API that exists in an inherited application.
|
|
09/24/19 dmb [SRPFW-278] Update the URLRequiresAuthentication service to support exact matching endpoints
|
|
and wildcard endpoints.
|
|
09/25/19 dmb [SRPFW-278] Update the GetResponse and SetResponseBody services to auto-detect PNG, JPG, and
|
|
GIF data formats.
|
|
12/09/19 dmb [SRPFW-296] Update all calls to Memory_Services to use a specific cache name.
|
|
12/16/19 dmb [SRPFW-296] Update the CreateLogFile service to fix a VNAV bug when GetStatus logs are
|
|
created. Clean up the log row and the log body.
|
|
01/18/20 dmb [SRPFW-296] Update the CreateLogFile service by replacing Utility_DotNet('TIMEZONE') with
|
|
the SRP_DateTime service (SRP Utilities 2.1) to avoid localization problems and potential
|
|
502 Bad Gateway errors.
|
|
01/23/20 dmb [SRPFW-296] Update the RunWebAPI service to support the HEAD method if the GET method is
|
|
also supported.
|
|
01/23/20 dmb [SRPFW-296] Update the UpdateWebAPIs service to add a HEAD API if there is a GET API.
|
|
02/08/20 dmb [SRPFW-309] Update the SetResponseHeaderField service so the Append flag creates multiple
|
|
Set-Cookie headers rather than folding them.
|
|
02/09/20 dmb [SRPFW-309] Add SetCookie service to make it easier to build a Set-Cookie response header.
|
|
02/12/20 dmb [SRPFW-311] Update the SetResponseError service to correct a typo. It was calling the
|
|
SetErrorResponse service.
|
|
03/04/20 dmb [SRPFW-311] Update the GetResponseHeaderFields service to check the HTTPScriptName value
|
|
and use LF$ instead of CRLF$ as the delimiter when OECGI is not the .EXE version.
|
|
04/22/20 dmb [SRPFW-313] Update the SetCookie service to use Max-Age instead of MaxAge.
|
|
04/22/20 dmb [SRPFW-313] Update the SetCookie service to assume any internal datetime value being passed
|
|
in is in local time. Use the ToUTC service to convert to UTC/GMT time.
|
|
05/22/20 dmb [SRPFW-313] Update the SetCookie service to always append an equal sign (=) to the cookie's
|
|
name, even if the value is empty. Otherwise, the correct cookie won't get referenced if the
|
|
intent is to clear the value.
|
|
05/22/20 dmb [SRPFW-313] Update the GetNonAuthenticatedURLs service to use the new
|
|
HTTP_FRAMEWORK_SETUP_NON_AUTHENTICATED_PATHS$ equate.
|
|
06/15/20 dmb [SRPFW-313] Rename GetNonAuthenticatedURLs service to GetNonAuthenticatedPaths and update
|
|
the URLRequiresAuthentication service to call the new service name.
|
|
06/15/20 dmb [SRPFW-313] Update the URLRequiresAuthentication service to support query param validations.
|
|
06/30/20 dmb [SRPFW-313] Add the IsIPWhitelisted, GetBannedIPs, and IsIPBanned services.
|
|
06/30/20 dmb [SRPFW-313] Update the IPIsPermitted service to call the IsIPWhitelisted and IsIPBanned
|
|
services to determine result.
|
|
07/08/20 dmb [SRPFW-313] Add the AddBannedIP and RemoveBannedIP services.
|
|
|
|
***********************************************************************************************************************/
|
|
|
|
#pragma precomp SRP_PreCompiler
|
|
|
|
$insert LOGICAL
|
|
$insert HTTP_INSERTS
|
|
$insert HTTP_FRAMEWORK_SETUP_EQUATES
|
|
$insert INET_EQUATES
|
|
$insert INET_HEADERS
|
|
$insert REPOSERRORS
|
|
|
|
Equ CRLF$ to \0D0A\
|
|
Equ LF$ to \0A\
|
|
Equ CacheName$ to 'SRPHTTPFramework'
|
|
|
|
Common /HTTPServices/ WebAPIList@, HTTPServiceList@, Request@, ProcErr@, RequestHeaderFields@, RequestHeaderValues@, ResponseHeaderFields@, ResponseHeaderValues@, ResponseStatusCode@, ResponseStatusPhrase@, ResponseBody@, ResponseBodyIsBinary@, SelfURL@, QueryFields@, QueryValues@, SessionID@, LogCounter@
|
|
|
|
Declare function Memory_Services, Error_Services, Database_Services, Get_Property, RetStack, SRP_Array, Repository
|
|
Declare function RTI_OS_Directory, SRP_Stopwatch, SRP_Registry, SRP_Sort_Array, SRP_Rotate_Array, GetCurrentProcessId
|
|
Declare function HTTP_Resource_Services, HTTP_Resource_Manager_Services, Logging_Services, SRP_Path, SRP_DateTime
|
|
Declare function SRP_Num
|
|
Declare subroutine Memory_Services, Error_Services, SRP_Stopwatch, Database_Services, Send_Message, Repository
|
|
Declare subroutine HTTP_Resource_Services, HTTP_Resource_Manager_Services, Logging_Services
|
|
|
|
// Clear any error conditions.
|
|
Error_Services('Clear')
|
|
|
|
GoToService else
|
|
HTTP_Services('SetResponseError', '', '', 404, Service : ' is not a valid service request within the HTTP services 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',
|
|
Options CONTENTNEGOTIATIONFIELDS = 'Accept', 'Accept-Charset', 'Accept-Encoding', 'Accept-Language'
|
|
Options LOGTYPES = 'Request', 'Response', 'Aborted', 'Debugger'
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Services
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// RunWebAPI
|
|
//
|
|
// Method - The HTTP method for the URL endpoint being requested. - [Optional]
|
|
// Endpoint - The URL endpoint (not including the Home or API Root) being requested. - [Optional]
|
|
//
|
|
// Calls the web API procedure for the resource associated to the URL endpoint being requested. Note, when this service
|
|
// is called normally the arguments are empty. They only exist for testing a web API without having to run from an
|
|
// actual HTTP request.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service RunWebAPI(Method, Endpoint)
|
|
|
|
// The Method and Endpoint arguments will normally be empty, but they might be populated for testing purposes. If
|
|
// empty, just get their values from the appropriate services.
|
|
If Endpoint EQ '' then Endpoint = HTTP_Services('GetEndpoint')
|
|
If Method EQ '' then Method = HTTP_Services('GetHTTPRequestMethod')
|
|
|
|
ValidMethod = True$ ; // Assume the method is valid for now.
|
|
ValidQuery = True$ ; // Assume the method is valid for now.
|
|
ValidEndpoint = HTTP_Resource_Manager_Services('IsValidEndpoint', Endpoint)
|
|
If ValidEndpoint then
|
|
FullEndpointURL = HTTP_Services('GetFullEndpointURL') ; // Used for any SetErrorResponse services if needed.
|
|
Resource = HTTP_Resource_Manager_Services('GetResourceProperty', Endpoint, 'RESOURCE')
|
|
GetString = HTTP_Services('GetHTTPGetString')
|
|
If GetString NE '' then
|
|
// Endpoint contains at least one query param. Note, if the supported query param is a "*", this means
|
|
// any query param is valid.
|
|
ResourceQueryParams = HTTP_Resource_Manager_Services('GetResourceProperty', Endpoint, 'QUERY_PARAMS')
|
|
If ResourceQueryParams NE '*' then
|
|
Convert @Upper_Case to @Lower_Case in ResourceQueryParams
|
|
Convert '&' to @FM in GetString
|
|
Convert '=' to @VM in GetString
|
|
GetString = SRP_Array('Rotate', GetString)
|
|
QueryParams = GetString<1>
|
|
Convert @Upper_Case to @Lower_Case in QueryParams
|
|
For Each QueryParam in QueryParams using @VM
|
|
Locate QueryParam in ResourceQueryParams using ',' setting cPos else ValidQuery = False$
|
|
While ValidQuery EQ True$
|
|
Next QueryParam
|
|
end
|
|
end
|
|
// If the query params are valid, check to see if the HTTP method is valid.
|
|
If ValidQuery EQ True$ then
|
|
ResourceMethods = HTTP_Resource_Manager_Services('GetResourceProperty', Endpoint, 'METHODS')
|
|
Locate 'GET' in ResourceMethods using ',' setting cPos then
|
|
// Whenever the GET method is supported then the HEAD method should also be supported.
|
|
ResourceMethods := ',HEAD'
|
|
end
|
|
ResourceMethods := ',OPTIONS' ; // Always support the OPTIONS method
|
|
If ResourceMethods[1, 1] EQ ',' then ResourceMethods = ResourceMethods[2, 999]
|
|
Locate Method in ResourceMethods using ',' setting cPos else
|
|
ValidMethod = False$
|
|
end
|
|
end
|
|
end
|
|
|
|
// Resolve the endpoint with the appropriate HTTP response.
|
|
Begin Case
|
|
Case (ValidEndpoint EQ True$) AND (ValidMethod EQ True$) AND (ValidQuery EQ True$)
|
|
// Valid endpoint and method. Call the API if it exists or create a default response if it doesn't.
|
|
// Note: It is critical that the web API routine be named in this format: <Resource>_API
|
|
If Method EQ 'OPTIONS' then
|
|
// All OPTIONS methods are handled the same way.
|
|
HTTP_Services('SetResponseHeaderField', 'Access-Control-Allow-Headers', 'authorization', True$)
|
|
HTTP_Services('SetResponseHeaderField', 'Access-Control-Allow-Headers', 'x-authorization', True$)
|
|
HTTP_Services('SetResponseHeaderField', 'Access-Control-Max-Age', 1728000)
|
|
If ResourceMethods NE '' then
|
|
For Each ResourceMethod in ResourceMethods using ','
|
|
HTTP_Services('SetResponseHeaderField', 'Allow', ResourceMethod, True$)
|
|
Next ResourceMethod
|
|
end
|
|
end else
|
|
WebAPI = HTTP_Services('GetWebAPI', Resource)
|
|
If WebAPI NE '' then
|
|
// Call the Web API as indicated.
|
|
APISignature = HTTP_Resource_Manager_Services('GetResourceSignature', Endpoint, Method)
|
|
Call @WebAPI(APISignature)
|
|
end else
|
|
// This resource doesn't have an API routine created yet. Returns a default response.
|
|
HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but the web API module has not yet been created.')
|
|
end
|
|
end
|
|
|
|
Case ValidMethod EQ False$
|
|
// Endpoint is valid, but the method is not.
|
|
HTTP_Services('SetResponseError', '', '', 405, '', FullEndpointURL)
|
|
If ResourceMethods NE '' then
|
|
For Each ResourceMethod in ResourceMethods using ','
|
|
HTTP_Services('SetResponseHeaderField', 'Allow', ResourceMethod, True$)
|
|
Next ResourceMethod
|
|
end
|
|
|
|
Case ValidQuery EQ False$
|
|
// Endpoint is valid, but one of the query params is not.
|
|
HTTP_Services('SetResponseError', '', '', 404, QueryParam : ' is not valid for this web API endpoint.', FullEndpointURL)
|
|
|
|
Case Otherwise$
|
|
// Must be an invalid endpoint.
|
|
HTTP_Services('SetResponseError', '', '', 404, 'This is not a valid web API endpoint.', FullEndpointURL)
|
|
End Case
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// RunHTTPService
|
|
//
|
|
// HTTPService - The HTTP (or web) service to call. - [Required]
|
|
// RemainingURL - This is the remaining portion of the URL that has not yet been processed by previous services.
|
|
//
|
|
// Calls the indicated HTTP web service routine.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service RunHTTPService(HTTPService, RemainingURL)
|
|
|
|
If Len(HTTPService) then
|
|
Convert @Lower_Case to @Upper_Case in HTTPService
|
|
|
|
// Note: It is critical that web service routine be named in this format: HTTP_<HTTPService>_SERVICES
|
|
IsHTTPService = False$ ; // Assume the web service does not exist for now.
|
|
NumApps = Count(@APPID, @FM) + (@APPID NE '')
|
|
For AppCnt = 1 to NumApps
|
|
AppID = @APPID<AppCnt>
|
|
If AppID _EQC 'SYSPROG' then
|
|
SysObjKey = '$HTTP_' : HTTPService : '_SERVICES'
|
|
end else
|
|
SysObjKey = '$HTTP_' : HTTPService : '_SERVICES' : '*' : @APPID<AppCnt>
|
|
end
|
|
IsHTTPService = (Index(HTTPServiceList@, SysObjKey, 1) GT 0)
|
|
Until IsHTTPService
|
|
Next AppCnt
|
|
|
|
If Not(IsHTTPService) then
|
|
For AppCnt = 1 to NumApps
|
|
AppID = @APPID<AppCnt>
|
|
If AppID _EQC 'SYSPROG' then
|
|
SysObjKey = '$HTTP_' : HTTPService : '_SERVICES'
|
|
end else
|
|
SysObjKey = '$HTTP_' : HTTPService : '_SERVICES' : '*' : @APPID<AppCnt>
|
|
end
|
|
IsHTTPService = (Xlate('SYSOBJ', SysObjKey, 0, 'X') GT '')
|
|
Until IsHTTPService
|
|
Next AppCnt
|
|
If (IsHTTPService) then
|
|
If Len(HTTPServiceList@) then HTTPServiceList@ := @FM
|
|
HTTPServiceList@ := SysObjKey
|
|
end
|
|
end
|
|
|
|
If Not(IsHTTPService) then
|
|
For AppCnt = 1 to NumApps
|
|
AppID = @APPID<AppCnt>
|
|
If AppID _EQC 'SYSPROG' then
|
|
SysObjKey = '$' : HTTPService
|
|
end else
|
|
SysObjKey = '$' : HTTPService : '*' : @APPID<AppCnt>
|
|
end
|
|
IsHTTPService = (Index(HTTPServiceList@, SysObjKey, 1) GT 0)
|
|
Until IsHTTPService
|
|
Next AppCnt
|
|
end
|
|
|
|
If Not(IsHTTPService) then
|
|
For AppCnt = 1 to NumApps
|
|
AppID = @APPID<AppCnt>
|
|
If AppID _EQC 'SYSPROG' then
|
|
SysObjKey = '$' : HTTPService
|
|
end else
|
|
SysObjKey = '$' : HTTPService : '*' : @APPID<AppCnt>
|
|
end
|
|
IsHTTPService = (Xlate('SYSOBJ', SysObjKey, 0, 'X') GT '')
|
|
Until IsHTTPService
|
|
Next AppCnt
|
|
If (IsHTTPService) then
|
|
If Len(HTTPServiceList@) then HTTPServiceList@ := @FM
|
|
HTTPServiceList@ := SysObjKey
|
|
end
|
|
end
|
|
|
|
If IsHTTPService then
|
|
// Call the HTTP service as indicated.
|
|
HTTPRoutine = 'HTTP_' : HTTPService : '_SERVICES'
|
|
Call @HTTPRoutine(RemainingURL)
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 404, HTTPService : ' is not a valid web service.')
|
|
end
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetSelfURL
|
|
//
|
|
// SelfURL - The self URL relevant to the current service. - [Required]
|
|
//
|
|
// Sets the self URL for the current service. The self URL is the URL that identifies itself. It is typically returned
|
|
// in responses to serve as a self-referencing ID apart from other URLs that might be returned which direct the caller
|
|
// to other services.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetSelfURL(SelfURL)
|
|
|
|
If Len(SelfURL) then
|
|
SelfURL@ = SelfURL
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 400, 'SelfURL argument was missing a value in the ' : Service : '.')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetSelfURL
|
|
//
|
|
// Returns the self URL for the current service.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetSelfURL()
|
|
|
|
Response = SelfURL@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetSessionID
|
|
//
|
|
// Creates and sets a unique Session ID for the current HTTP Request/Response. This is used to stamp various logs.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetSessionID()
|
|
|
|
ProcessID = GetCurrentProcessId()
|
|
SessionID@ = Oconv(Date(), 'DJS-') : '_' : Oconv(Time(), 'MTS-') : '_' : ProcessID
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetSessionID
|
|
//
|
|
// Returns the unique Session ID for the current HTTP Request/Response. This is used to stamp various logs.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetSessionID()
|
|
|
|
If SessionID@ EQ '' then
|
|
// For some reason, the SetSessionID service has not been called. This could occur if a process that is not
|
|
// called within the normal SRP HTTP Framework stack (e.g., an INET process) calls this service. Go ahead
|
|
// and call the service now so the GetSessionID can be used.
|
|
HTTP_Services('SetSessionID')
|
|
end
|
|
Response = SessionID@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// CreateLogFile
|
|
//
|
|
// LogType - The type of log to be written. This can be user-defined. - [Required]
|
|
// Data - Information used to create the log body. Some log types ignore this. - [Optional]
|
|
//
|
|
// Creates a log file in the designated capture path.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service CreateLogFile(LogType=LOGTYPES, Data)
|
|
|
|
EnableLogging = HTTP_Services('GetEnableLoggingFlag')
|
|
LogErrorsOnly = HTTP_Services('GetLogErrorsOnlyFlag')
|
|
Endpoint = HTTP_Services('GetEndpoint')
|
|
ExcludeLogging = Http_Resource_Manager_Services('GetResourceProperty', Endpoint, 'EXCLUDE_LOGGING')
|
|
|
|
If (LogType NE '') AND (EnableLogging EQ True$) AND (ExcludeLogging NE True$) then
|
|
CapturePath = HTTP_Services('GetCapturePath')
|
|
If RTI_OS_Directory('EXISTS', CapturePath) EQ True$ then
|
|
// Prepare the log body based on the log type.
|
|
LogBody = ''
|
|
LogRow = ''
|
|
Begin Case
|
|
Case (LogType _EQC 'Request') AND (LogErrorsOnly EQ False$)
|
|
Request = HTTP_Services('GetOECGIRequest')
|
|
ProcErr = HTTP_Services('GetOECGIProcErr')
|
|
// If ProcErr is populated, treat this as an error scenario. Otherwise, treat this is a normal HTTP
|
|
// Request.
|
|
If ProcErr NE '' then
|
|
LogBody = 'ProcErr Argument' : CRLF$
|
|
LogBody := Str('-', 80) : CRLF$
|
|
LogBody := ProcErr
|
|
end else
|
|
* Swap @FM with CRLF$ in LogBody
|
|
LogBody = 'Request Argument' : CRLF$
|
|
LogBody := Str('-', 80) : CRLF$
|
|
LogBody := Fmt('<01> HTTPQueryString', 'L#30') : ': ' : Request<QUERY_STRING$> : CRLF$
|
|
PathInfo = Request<PATH_INFO$>
|
|
LogBody := Fmt('<02> HTTPPathInfo', 'L#30') : ': ' : PathInfo : CRLF$
|
|
LogBody := Fmt('<03> HTTPContentType', 'L#30') : ': ' : Request<CONTENT_TYPE$> : CRLF$
|
|
LogBody := Fmt('<04> HTTPContentLength', 'L#30') : ': ' : Request<CONTENT_LENGTH$> : CRLF$
|
|
LogBody := Fmt('<05> HTTPGatewayInterface', 'L#30') : ': ' : Request<GATEWAY_INTERFACE$> : CRLF$
|
|
LogBody := Fmt('<06> HTTPHTTPS', 'L#30') : ': ' : Request<HTTPS$> : CRLF$
|
|
LogBody := Fmt('<07> HTTPAccept', 'L#30') : ': ' : Request<HTTP_ACCEPT$> : CRLF$
|
|
LogBody := Fmt('<08> HTTPCookie', 'L#30') : ': ' : Request<HTTP_COOKIE$> : CRLF$
|
|
LogBody := Fmt('<09> HTTPFrom', 'L#30') : ': ' : Request<HTTP_FROM$> : CRLF$
|
|
LogBody := Fmt('<10> HTTPReferer', 'L#30') : ': ' : Request<HTTP_REFERER$> : CRLF$
|
|
LogBody := Fmt('<11> HTTPUserAgent', 'L#30') : ': ' : Request<HTTP_USER_AGENT$> : CRLF$
|
|
LogBody := Fmt('<12> HTTPTranslated', 'L#30') : ': ' : Request<PATH_TRANSLATED$> : CRLF$
|
|
LogBody := Fmt('<13> HTTPRemoteAddr', 'L#30') : ': ' : Request<REMOTE_ADDR$> : CRLF$
|
|
LogBody := Fmt('<14> HTTPRemoteHost', 'L#30') : ': ' : Request<REMOTE_HOST$> : CRLF$
|
|
LogBody := Fmt('<15> HTTPRemoteIdent', 'L#30') : ': ' : Request<REMOTE_IDENT$> : CRLF$
|
|
LogBody := Fmt('<16> HTTPRemoteUser', 'L#30') : ': ' : Request<REMOTE_USER$> : CRLF$
|
|
LogBody := Fmt('<17> HTTPRequestMethod', 'L#30') : ': ' : Request<REQUEST_METHOD$> : CRLF$
|
|
LogBody := Fmt('<18> HTTPScriptName', 'L#30') : ': ' : Request<SCRIPT_NAME$> : CRLF$
|
|
LogBody := Fmt('<19> HTTPServerName', 'L#30') : ': ' : Request<SERVER_NAME$> : CRLF$
|
|
LogBody := Fmt('<20> HTTPServerPort', 'L#30') : ': ' : Request<SERVER_PORT$> : CRLF$
|
|
LogBody := Fmt('<21> HTTPServerProtocol', 'L#30') : ': ' : Request<SERVER_PROTOCOL$> : CRLF$
|
|
LogBody := Fmt('<22> HTTPServerSoftware', 'L#30') : ': ' : Request<SERVER_SOFTWARE$> : CRLF$
|
|
LogBody := Fmt('<23> HTTPServerURL', 'L#30') : ': ' : Request<SERVER_URL$> : CRLF$
|
|
LogBody := Fmt('<24> HTTPNoURLDecode', 'L#30') : ': ' : Request<NOURLDECODE$> : CRLF$
|
|
LogBody := Fmt('<25> HTTPResponseIsBinary', 'L#30') : ': ' : Request<RESPONSE_IS_BINARY$> : CRLF$
|
|
LogBody := Fmt('<26> HTTPRegistrySettings', 'L#30') : '+ ' : CRLF$
|
|
RegistrySettings = Request<REGISTRY_SETTINGS$>
|
|
NumRegistrySettings = DCount(RegistrySettings, '&')
|
|
AdditionalNames = '' ; // Initialize the AdditionalValues registry setting. Update as required.
|
|
For RegistryCnt = 1 to NumRegistrySettings
|
|
RegistrySetting = Field(RegistrySettings, '&', RegistryCnt, 1)
|
|
Name = RegistrySetting[1, '=']
|
|
Value = RegistrySetting[Col2() + 1, 999]
|
|
If Name _EQC 'AdditionalValues' then
|
|
Value = HTTP_Services('DecodePercentString', Value)
|
|
AdditionalNames = Value
|
|
end
|
|
LogBody := Space(5) : Fmt(Name, 'L#25') : ': ' : Value : CRLF$
|
|
Next RegistryCnt
|
|
LogBody := Fmt('<27> HTTPOECGIVersion', 'L#30') : ': ' : Request<OECGI_VERSION$> : CRLF$
|
|
LogBody := Fmt('<28> HTTPGetString', 'L#30') : ': ' : Request<GET_STRING$> : CRLF$
|
|
LogBody := Fmt('<29> HTTPPostString', 'L#30') : ': ' : HTTP_Services('DecodePercentString', Request<POST_STRING$>) : CRLF$
|
|
LogBody := Fmt('<30> HTTPAdditionalValues', 'L#30') : '+ ' : CRLF$
|
|
NumAdditionalNames = DCount(AdditionalNames, ',')
|
|
AdditionalValues = Request<ADDITIONAL_VALUES$>
|
|
For NameCnt = 1 to NumAdditionalNames
|
|
Name = Field(AdditionalNames, ',', NameCnt, 1)
|
|
Name = Name[6, 99] ; // Remove the "HTTP_" prefix the Registry requires.
|
|
Convert '_' to ' ' in Name
|
|
Name = NameCap(Name) ; // Apply casing to make it prettier to read.
|
|
Convert ' ' to '-' in Name
|
|
LogBody := Space(5) : Fmt(Name, 'L#25') : ': ' : AdditionalValues<0, NameCnt> : CRLF$
|
|
Next NameCnt
|
|
LogBody[-2, 2] = '' ; // Remove the last CR/LF.
|
|
If PathInfo NE '' then
|
|
If PathInfo[1, 1] NE '/' then PathInfo = '/' : PathInfo
|
|
end
|
|
LogRow = Request<REQUEST_METHOD$> : @FM : Request<SERVER_NAME$> : @FM : HTTP_Services('GetAPIRootURL', False$) : PathInfo : @FM : Request<REMOTE_ADDR$>
|
|
end
|
|
|
|
Case LogType _EQC 'Response'
|
|
// The HTTP Response is assumed to be in the Data argument.
|
|
If Not(LogErrorsOnly) OR (LogErrorsOnly AND ((ResponseStatusCode@[1, 1] EQ 4) OR (ResponseStatusCode@[1, 1] EQ 5))) then
|
|
TimeToExecute = SRP_Stopwatch('GetBenchmark', 'WebAPI')
|
|
HTTPFrameworkVer = HTTP_Services('GetVersion')
|
|
Swap CRLF$ with ' - ' in HTTPFrameworkVer
|
|
LogBody := 'HTTP Framework : ' : 'v' : HTTPFrameworkVer : CRLF$
|
|
LogBody := 'Time to Execute : ' : TimeToExecute : CRLF$
|
|
LogBody := 'Request Date/Time: ' : SRP_DateTime('Format', SRP_DateTime('Now', True$), "DDD, DD MMM YYYY hh:mm:ss 'GMT'") : CRLF$
|
|
LogBody := 'Request Method : ' : HTTP_Services('GetHTTPRequestMethod') : CRLF$
|
|
LogBody := 'Request URL : ' : HTTP_Services('GetFullEndpointURL')[1, 'F?'] : CRLF$
|
|
AuthorizationB64 = HTTP_Services('GetRequestHeaderField', 'Authorization')
|
|
If Len(AuthorizationB64) else AuthorizationB64 = HTTP_Services('GetRequestHeaderField', 'X-Authorization')
|
|
If Len(AuthorizationB64) then
|
|
Authorization = AuthorizationB64[1, ' '] : ' ' : SRP_Decode(AuthorizationB64[Col2() + 1, 999], 'BASE64')
|
|
LogBody := 'Authorization : ' : Authorization : CRLF$
|
|
end else
|
|
LogBody := 'Authorization : None' : CRLF$
|
|
end
|
|
QueryParams = Http_Services('GetHTTPGetString')
|
|
If QueryParams NE '' then
|
|
LogBody := 'Query Params : ' : QueryParams : CRLF$
|
|
end
|
|
Status = Get_Status(StatusCode)
|
|
If Status GT 0 then
|
|
LogBody := 'Get_Status() : ' : Status : ' - ' : StatusCode : CRLF$
|
|
end
|
|
LogBody := Str('-', 80) : CRLF$
|
|
LogBody := Data
|
|
ResponseStatus = HTTP_Services('GetResponseStatus')
|
|
StatusCode = ResponseStatus[1, ' ']
|
|
StatusPhrase = Trim(ResponseStatus[Col2() + 1, 999])
|
|
LogRow = '' : @FM : StatusCode : @FM : StatusPhrase : @FM : TimeToExecute
|
|
end
|
|
|
|
Case LogType _EQC 'Aborted'
|
|
// Data should contain the contents of the ProcErr argument that came in through the controller.
|
|
LogBody = 'ProcErr Argument' : CRLF$
|
|
LogBody := Str('-', 80) : CRLF$
|
|
LogBody := Data
|
|
ErrorCode = Data[1, ':']
|
|
ErrorDesc = Trim(Data[Col2() + 1, 999])
|
|
LogRow = '' : @FM : ErrorCode : @FM : ErrorDesc : @FM
|
|
|
|
Case LogType _EQC 'Debugger'
|
|
SPStatus = Data[1, @RM]
|
|
SPStatCode = Data[Col2() + 1, @RM]
|
|
Curr_Program = Data[Col2() + 1, @RM]
|
|
CallDepth = Data[Col2() + 1, @RM]
|
|
LineNo = Data[Col2() + 1, @RM]
|
|
CallStack = Data[Col2() + 1, @RM]
|
|
If SRP_JSON(hDebuggerObj, 'NEW', 'OBJECT') then
|
|
SRP_JSON(hDebuggerObj, 'SETVALUE', 'SPStatus', SPStatus)
|
|
|
|
OSRead RevError from 'REVERROR.DAT' then
|
|
StartPos = Index(RevError, SPStatCode<2>, 1)
|
|
SPStatDesc = RevError[StartPos, \0D\]
|
|
Swap '%1%' with SPStatCode<3> in SPStatDesc
|
|
Swap '%2%' with SPStatCode<4> in SPStatDesc
|
|
end else
|
|
SPStatDesc = SPStatCode
|
|
Swap @FM with ', ' in SPStatDesc
|
|
end
|
|
SRP_JSON(hDebuggerObj, 'SETVALUE', 'SPStatCode', SPStatDesc)
|
|
SRP_JSON(hDebuggerObj, 'SETVALUE', 'Curr_Program', Curr_Program)
|
|
SRP_JSON(hDebuggerObj, 'SETVALUE', 'CallDepth', CallDepth)
|
|
SRP_JSON(hDebuggerObj, 'SETVALUE', 'LineNo', LineNo)
|
|
If SRP_JSON(hCallStackArray, 'NEW', 'ARRAY') then
|
|
ProcCount = DCount(CallStack, @FM)
|
|
For ProcNum = 1 to ProcCount
|
|
If SRP_JSON(hProcObj, 'NEW', 'OBJECT') then
|
|
SRP_JSON(hProcObj, 'SETVALUE', 'ProcName', CallStack<ProcNum, 1>, 'STRING')
|
|
SRP_JSON(hProcObj, 'SETVALUE', 'LineNo', CallStack<ProcNum, 2>, 'NUMBER')
|
|
SRP_JSON(hCallStackArray, 'ADD', hProcObj)
|
|
SRP_JSON(hProcObj, 'RELEASE')
|
|
end
|
|
Next ProcNum
|
|
SRP_JSON(hDebuggerObj, 'SET', 'CallStack', hCallStackArray)
|
|
SRP_JSON(hCallStackArray, 'RELEASE')
|
|
end
|
|
LogBody = SRP_JSON(hDebuggerObj, 'STRINGIFY', 'STYLED')
|
|
SRP_JSON(hDebuggerObj, 'RELEASE')
|
|
end
|
|
ErrorCode = SPStatCode[1, ':']
|
|
ErrorDesc = Trim(SPStatCode[Col2() + 1, 999])
|
|
LogRow = '' : @FM : ErrorCode : @FM : ErrorDesc : @FM
|
|
|
|
Case LogType _EQC 'GetStatus'
|
|
LogRow = '' : @FM : Data : @FM
|
|
Status = Get_Status(StatusCode)
|
|
If Status GT 0 then
|
|
LogBody := 'Get_Status() : ' : StatusCode<1, 1> : ' - ' : StatusCode<1, 2> : CRLF$
|
|
end
|
|
LogBody := Str('-', 80) : CRLF$
|
|
LogBody := Data
|
|
LogRow = '' : @FM : StatusCode<1, 1> : @FM : Trim(StatusCode<1, 2>) : @FM
|
|
|
|
Case Otherwise$
|
|
LogBody := Data
|
|
End Case
|
|
|
|
If LogBody NE '' then
|
|
// Create the log file name and write the log and append the log index.
|
|
SessionID = HTTP_Services('GetSessionID')
|
|
If LogCounter@ EQ '' then LogCounter@ = 0
|
|
LogCounter@ += 1
|
|
LogFileName = SessionID : '_' : Fmt(LogCounter@, 'R(0)#6') : '_' : LogType : '.log'
|
|
OSWrite LogBody to CapturePath : '\' : LogFileName
|
|
If LogRow NE '' then
|
|
LogDate = Iconv(LogFileName[1, '_'], 'DJS')
|
|
LogTime = Iconv(LogFileName[Col2() + 1, '_'], 'MT')
|
|
ProcessID = LogFileName[Col2() + 1, '_']
|
|
Sequence = LogFileName[Col2() + 1, '_']
|
|
objLog = Logging_Services('NewLog', CapturePath, SessionID[1, '_'] : '_Index.log', \0D0A\, \09\, '', '', False$, False$)
|
|
LogRow = LogDate : @FM : LogTime : @FM : ProcessID : @FM : Sequence : @FM : LogType : @FM : LogRow : @FM : 'View...' : @FM : CapturePath : '\' : LogFileName
|
|
Logging_Services('AppendLog', objLog, LogRow, @RM, @FM, True$)
|
|
end
|
|
end
|
|
end
|
|
end
|
|
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetOECGIRequest
|
|
//
|
|
// Request - The @FM delimited array containing the HTTP request that OECGI passes in. - [Required]
|
|
//
|
|
// Sets the HTTP request that the OECGI creates to memory so it can be retrieved by later routines. This avoids the need
|
|
// to pass this around into various routines.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetOECGIRequest(Request)
|
|
|
|
If Len(Request) then
|
|
PathInfo = Request<PATH_INFO$>
|
|
ScriptName = Request<SCRIPT_NAME$>
|
|
// Some web servers, like Microsoft IIS, include the Script Name URL in the Path Info. The SRP HTTP Framework works
|
|
// under the assumption that Script Name and Path Info combined are the full path. So, in or to correct this, a
|
|
// check is made to see if Script Name is included in Path Info and, if so, have it removed.
|
|
LenScriptName = Len(ScriptName)
|
|
If PathInfo[1, LenScriptName] _EQC ScriptName then
|
|
PathInfo = PathInfo[LenScriptName + 1, 999]
|
|
end
|
|
If PathInfo[1, 1] EQ '/' then PathInfo[1, 1] = ''
|
|
Request<PATH_INFO$> = PathInfo
|
|
|
|
Memory_Services('SetValue', 'HTTPQueryString', Request<QUERY_STRING$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPPathInfo', Request<PATH_INFO$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPContentType', Request<CONTENT_TYPE$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPContentLength', Request<CONTENT_LENGTH$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPGatewayInterface', Request<GATEWAY_INTERFACE$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPHTTPS', Request<HTTPS$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPAccept', Request<HTTP_ACCEPT$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPCookie', Request<HTTP_COOKIE$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPFrom', Request<HTTP_FROM$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPReferer', Request<HTTP_REFERER$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPUserAgent', Request<HTTP_USER_AGENT$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPTranslated', Request<PATH_TRANSLATED$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPRemoteAddr', Request<REMOTE_ADDR$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPRemoteHost', Request<REMOTE_HOST$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPRemoteIdent', Request<REMOTE_IDENT$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPRemoteUser', Request<REMOTE_USER$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPRequestMethod', Request<REQUEST_METHOD$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPScriptName', Request<SCRIPT_NAME$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPServerName', Request<SERVER_NAME$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPServerPort', Request<SERVER_PORT$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPServerProtocol', Request<SERVER_PROTOCOL$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPServerSoftware', Request<SERVER_SOFTWARE$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPServerURL', Request<SERVER_URL$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPNoURLDecode', Request<NOURLDECODE$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPResponseIsBinary', Request<RESPONSE_IS_BINARY$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPRegistrySettings', Request<REGISTRY_SETTINGS$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPOECGIVersion', Request<OECGI_VERSION$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPGetString', Request<GET_STRING$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPPostString', Request<POST_STRING$>, CacheName$)
|
|
Memory_Services('SetValue', 'HTTPAdditionalValues', Request<ADDITIONAL_VALUES$>, CacheName$)
|
|
|
|
Request@ = Request
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetOECGIRequest
|
|
//
|
|
// Returns the original HTTP request that the OECGI creates.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetOECGIRequest()
|
|
|
|
Response = Request@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetOECGIProcErr
|
|
//
|
|
// ProcErr - The text of the procedural error. - [Required]
|
|
//
|
|
// Sets the HTTP ProcErr that the OECGI creates to memory so it can be retrieved by later routines. This avoids the need
|
|
// to pass this around into various routines.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetOECGIProcErr(ProcErr)
|
|
|
|
If ProcErr NE '' then
|
|
ProcErr@ = ProcErr
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetOECGIProcErr
|
|
//
|
|
// Returns the original HTTP ProcErr that the OECGI creates.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetOECGIProcErr()
|
|
|
|
Response = ProcErr@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetHTTPValue
|
|
//
|
|
// Sets a specific HTTP request value. This is normally set within the SetOECGIRequest service and done directly using
|
|
// Memory_Services for efficiency, but some APIs might need to override an HTTP request value.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetHTTPQueryString(HTTPValue)
|
|
Service SetHTTPPathInfo(HTTPValue)
|
|
Service SetHTTPContentType(HTTPValue)
|
|
Service SetHTTPContentLength(HTTPValue)
|
|
Service SetHTTPGatewayInterface(HTTPValue)
|
|
Service SetHTTPHTTPS(HTTPValue)
|
|
Service SetHTTPAccept(HTTPValue)
|
|
Service SetHTTPCookie(HTTPValue)
|
|
Service SetHTTPFrom(HTTPValue)
|
|
Service SetHTTPReferer(HTTPValue)
|
|
Service SetHTTPUserAgent(HTTPValue)
|
|
Service SetHTTPTranslated(HTTPValue)
|
|
Service SetHTTPRemoteAddr(HTTPValue)
|
|
Service SetHTTPRemoteHost(HTTPValue)
|
|
Service SetHTTPRemoteIdent(HTTPValue)
|
|
Service SetHTTPRemoteUser(HTTPValue)
|
|
Service SetHTTPRequestMethod(HTTPValue)
|
|
Service SetHTTPScriptName(HTTPValue)
|
|
Service SetHTTPServerName(HTTPValue)
|
|
Service SetHTTPServerPort(HTTPValue)
|
|
Service SetHTTPServerProtocol(HTTPValue)
|
|
Service SetHTTPServerSoftware(HTTPValue)
|
|
Service SetHTTPServerURL(HTTPValue)
|
|
Service SetHTTPNoURLDecode(HTTPValue)
|
|
Service SetHTTPResponseIsBinary(HTTPValue)
|
|
Service SetHTTPRegistrySettings(HTTPValue)
|
|
Service SetHTTPOECGIVersion(HTTPValue)
|
|
Service SetHTTPGetString(HTTPValue)
|
|
Service SetHTTPPostString(HTTPValue)
|
|
Service SetHTTPAdditionalValues(HTTPValue)
|
|
|
|
HTTPKey = Service[4, 99]
|
|
Memory_Services('SetValue', HTTPKey, HTTPValue, CacheName$)
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetHTTPValue
|
|
//
|
|
// Returns a specific HTTP request value. This is normally set within the SetOECGIRequest service. This service is not
|
|
// called directly as other services normally are. It is a generic service that various 'GetHTTPxxxx' services will
|
|
// call. This is why the meta data doesn't include GetHTTPValue but one or more specific GetHTTPxxxx options.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetHTTPQueryString(DecodePercentString)
|
|
Service GetHTTPPathInfo(DecodePercentString)
|
|
Service GetHTTPContentType(DecodePercentString)
|
|
Service GetHTTPContentLength(DecodePercentString)
|
|
Service GetHTTPGatewayInterface(DecodePercentString)
|
|
Service GetHTTPHTTPS(DecodePercentString)
|
|
Service GetHTTPAccept(DecodePercentString)
|
|
Service GetHTTPCookie(DecodePercentString)
|
|
Service GetHTTPFrom(DecodePercentString)
|
|
Service GetHTTPReferer(DecodePercentString)
|
|
Service GetHTTPUserAgent(DecodePercentString)
|
|
Service GetHTTPTranslated(DecodePercentString)
|
|
Service GetHTTPRemoteAddr(DecodePercentString)
|
|
Service GetHTTPRemoteHost(DecodePercentString)
|
|
Service GetHTTPRemoteIdent(DecodePercentString)
|
|
Service GetHTTPRemoteUser(DecodePercentString)
|
|
Service GetHTTPRequestMethod(DecodePercentString)
|
|
Service GetHTTPScriptName(DecodePercentString)
|
|
Service GetHTTPServerName(DecodePercentString)
|
|
Service GetHTTPServerPort(DecodePercentString)
|
|
Service GetHTTPServerProtocol(DecodePercentString)
|
|
Service GetHTTPServerSoftware(DecodePercentString)
|
|
Service GetHTTPServerURL(DecodePercentString)
|
|
Service GetHTTPNoURLDecode(DecodePercentString)
|
|
Service GetHTTPResponseIsBinary(DecodePercentString)
|
|
Service GetHTTPRegistrySettings(DecodePercentString)
|
|
Service GetHTTPOECGIVersion(DecodePercentString)
|
|
Service GetHTTPGetString(DecodePercentString)
|
|
Service GetHTTPPostString(DecodePercentString)
|
|
Service GetHTTPAdditionalValues(DecodePercentString)
|
|
|
|
HTTPKey = Service[4, 99]
|
|
HTTPValue = Memory_Services('GetValue', HTTPKey, '', '', CacheName$)
|
|
|
|
If DecodePercentString EQ True$ then
|
|
HTTPValue = HTTP_Services('DecodePercentString', HTTPValue)
|
|
end
|
|
|
|
Response = HTTPValue
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetRequestHeaderFields
|
|
//
|
|
// Sets all of the Request Header Fields based on the content of the HTTP request that the OECGI creates. This assumes
|
|
// the SetOECGIRequest service has already been called so that the Request array is in memory.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetRequestHeaderFields()
|
|
|
|
// These are the standard header fields that Revelation has pre-defined to be included in the OECGI request array.
|
|
HTTP_Services('SetRequestHeaderField', 'Accept', HTTP_Services('GetHTTPAccept'))
|
|
HTTP_Services('SetRequestHeaderField', 'Content-Length', HTTP_Services('GetHTTPContentLength'))
|
|
HTTP_Services('SetRequestHeaderField', 'Content-Type', HTTP_Services('GetHTTPContentType'))
|
|
HTTP_Services('SetRequestHeaderField', 'Cookie', HTTP_Services('GetHTTPCookie'))
|
|
HTTP_Services('SetRequestHeaderField', 'From', HTTP_Services('GetHTTPFrom'))
|
|
HTTP_Services('SetRequestHeaderField', 'Referer', HTTP_Services('GetHTTPReferer'))
|
|
HTTP_Services('SetRequestHeaderField', 'User-Agent', HTTP_Services('GetHTTPUserAgent'))
|
|
|
|
// Other header fields can be retrieved but they have to be defined in the OECGI registry key under
|
|
// "AdditionalValues". This is a comma delimited string of names but these names have to be converted in order
|
|
// to be valid header names.
|
|
RegistrySettings = HTTP_Services('GetHTTPRegistrySettings')
|
|
NumRegistrySettings = DCount(RegistrySettings, '&')
|
|
AdditionalNames = '' ; // Initialize the AdditionalValues registry setting. Update as required.
|
|
For RegistryCnt = 1 to NumRegistrySettings
|
|
RegistrySetting = Field(RegistrySettings, '&', RegistryCnt, 1)
|
|
Name = RegistrySetting[1, '=']
|
|
If Name _EQC 'AdditionalValues' then
|
|
AdditionalNames = RegistrySetting[Col2() + 1, 999]
|
|
AdditionalNames = HTTP_Services('DecodePercentString', AdditionalNames)
|
|
end
|
|
Until Name _EQC 'AdditionalValues'
|
|
Next RegistryCnt
|
|
NumAdditionalNames = Count(AdditionalNames, ',') + (AdditionalNames NE '')
|
|
AdditionalValues = HTTP_Services('GetHTTPAdditionalValues')
|
|
For NameCnt = 1 to NumAdditionalNames
|
|
If Len(AdditionalValues<0, NameCnt>) then
|
|
Name = Field(AdditionalNames, ',', NameCnt, 1)
|
|
Name = Name[6, 99] ; // Remove the "HTTP_" prefix the Registry requires.
|
|
Convert '_' to ' ' in Name
|
|
Name = NameCap(Name) ; // Apply casing to make it prettier to read.
|
|
Convert ' ' to '-' in Name
|
|
HTTP_Services('SetRequestHeaderField', Name, AdditionalValues<0, NameCnt>)
|
|
end
|
|
Next NameCnt
|
|
|
|
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. This can then be retrieved with a
|
|
// GetRequestHeaderField service call so that server processing can operate accordingly.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetRequestHeaderField(Name, Value)
|
|
|
|
If Len(Name) AND Len(Value) 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. These are formatted as Name : <space> Value <crlf> with
|
|
// an extra <crlf> appended after the last field/value pair.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetRequestHeaderFields()
|
|
|
|
HeaderFieldBlock = ''
|
|
|
|
If Len(RequestHeaderFields@) then
|
|
NumFields = Count(RequestHeaderFields@, @FM) + (RequestHeaderFields@ NE '')
|
|
For FieldCnt = 1 to NumFields
|
|
HeaderFieldBlock := RequestHeaderFields@<FieldCnt> : ': ' : RequestHeaderValues@<FieldCnt> : CRLF$
|
|
Next FieldCnt
|
|
HeaderFieldBlock := CRLF$
|
|
end else
|
|
Error_Services('Add', 'There are no response header fields set')
|
|
end
|
|
|
|
Response = HeaderFieldBlock
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetRequestHeaderField
|
|
//
|
|
// Name - Header Field Name to get. - [Required]
|
|
//
|
|
// Returns the value previously set for the indicated Request Header Field. The Name argument is case-insensitive but
|
|
// if the indicated Request Header Field has not been set then an error condition will be set.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
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
|
|
HTTP_Services('SetResponseError', '', '', 400, 'The Name argument is missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
Response = Value
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetQueryFields
|
|
//
|
|
// Sets all of the Query Fields based on the content of the HTTP request that the OECGI creates. This assumes the
|
|
// SetOECGIRequest service has already been called so that the Request array is in memory.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetQueryFields()
|
|
|
|
QueryString = HTTP_Services('GetHTTPGetString')
|
|
If Len(QueryString) then
|
|
Swap '&' with @FM in QueryString
|
|
Swap '=' with @VM in QueryString
|
|
NumFields = Count(QueryString, @FM) + 1
|
|
For FieldCnt = 1 to NumFields
|
|
Field = QueryString<FieldCnt, 1>
|
|
Value = QueryString<FieldCnt, 2>
|
|
HTTP_Services('SetQueryField', Field, Value)
|
|
Next FieldCnt
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetQueryField
|
|
//
|
|
// Field - Query field to set. - [Required]
|
|
// Value - Value for the Query field. This will be Trimmed to enforce proper formatting. - [Optional]
|
|
//
|
|
// Sets the indicated Query field with the indicated value. This can then be retrieved with a GetQueryField service call
|
|
// so that server processing can operate accordingly.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetQueryField(Field, Value)
|
|
|
|
If Field NE '' then
|
|
Locate Field in QueryFields@ using @FM setting fPos else
|
|
fPos = Count(QueryFields@, @FM) + (QueryFields@ NE '') + 1
|
|
end
|
|
Value = HTTP_Services('DecodePercentString', Value)
|
|
QueryFields@<fPos> = Field
|
|
QueryValues@<fPos> = Trim(Value)
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 400, 'The Field or Value argument is missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetQueryField
|
|
//
|
|
// Field - Query Field to get. - [Required]
|
|
//
|
|
// Returns the value previously set for the indicated Query Field. If then indicated Query Field has not been set then
|
|
// then an error condition will be set.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetQueryField(Field)
|
|
|
|
Value = ''
|
|
|
|
If Len(Field) then
|
|
Locate Field in QueryFields@ using @FM setting fPos then
|
|
Value = QueryValues@<fPos>
|
|
end else
|
|
Error_Services('Add', Field : ' is not a query field in the request.')
|
|
end
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 400, 'The Field 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]
|
|
// Append - Flag that determines if values can be appended to a list. By default this is false and all values will
|
|
// replace existing values. - [Optional]
|
|
//
|
|
// Sets the indicated Response Header Field with the indicated value. This can then be retrieved with a
|
|
// GetRequestHeaderField service call so that server processing can operate accordingly.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetResponseHeaderField(Name=RESPONSEHEADERNAMES, Value, Append=BOOLEAN)
|
|
|
|
If (Append NE True$) AND (Append NE False$) then Append = False$
|
|
If Len(Append) else Append = False$
|
|
|
|
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
|
|
If (Name NE 'Set-Cookie') OR ((Name EQ 'Set-Cookie') AND (Append EQ False$)) then
|
|
Locate SearchName in SearchFields using @FM setting fPos else
|
|
fPos = Count(ResponseHeaderFields@, @FM) + (ResponseHeaderFields@ NE '') + 1
|
|
end
|
|
end else
|
|
fPos = DCount(ResponseHeaderFields@, @FM) + 1
|
|
end
|
|
HeaderValues = ResponseHeaderValues@<fPos>
|
|
If Append then
|
|
// Append the value to an existing list (if one exists). Otherwise, just set the value.
|
|
If Len(HeaderValues) then
|
|
If Index(HeaderValues, Trim(Value), 1) else
|
|
// Only append if it does not already appear in the list.
|
|
If Name _EQC 'Allow' OR Name _EQC 'Access-Control-Allow-Headers' then
|
|
// Some headers are separated by a comma and space. Others use a semi-colon.
|
|
HeaderValues := ', ' : Trim(Value)
|
|
end else
|
|
HeaderValues := ';' : Trim(Value)
|
|
end
|
|
end
|
|
end else
|
|
HeaderValues = Trim(Value)
|
|
end
|
|
end else
|
|
// Set the value. This could replace an existing value.
|
|
HeaderValues = Trim(Value)
|
|
end
|
|
ResponseHeaderFields@<fPos> = Name
|
|
ResponseHeaderValues@<fPos> = HeaderValues
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 400, 'The Name or Value argument is missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetCookie
|
|
//
|
|
// Name - Name of the cookie. - [Required]
|
|
// Value - Value for the cookie. If empty, only the Name will be sent. - [Optional]
|
|
// Expires - Date the cookie should expire. Should use RFC1123 formatting. For example:
|
|
// "Sun, 06 Nov 1994 08:49:37 GMT"
|
|
// If a number is passed in, the system will assume this is an an internal date or datetime and attempt
|
|
// to convert it to RFC1123 formatting. - [Optional]
|
|
// MaxAge - Number of seconds that the cookie should remain alive. - [Optional]
|
|
// Domain - Hosts to which the cookie will be sent. For example, "examples.com", "www.examples.com", or
|
|
// "examples.org" - [Optional]
|
|
// Path - Scope of the cookie. For example, "/api/reports" or "/api/users". - [Optional]
|
|
// Secure - Boolean flag to indicate that the "Secure" attribute should be included. - [Optional]
|
|
// HttpOnly - Boolean flag to indicate that the "HttpOnly" attribute should be included. - [Optional]
|
|
// Extension - Any other content to include in the cookie. May or may not be name/value paired. - [Optional]
|
|
//
|
|
// Adds a Set-Cookie header to the response using the indicated Name. The cookie's value and optional attributes will
|
|
// automatically be included as indicated by each argument.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetCookie(Name, Value, Expires, MaxAge, Domain, Path, Secure=BOOLEAN, HttpOnly=BOOLEAN, Extension)
|
|
|
|
If Name NE '' then
|
|
Value = Name : '=' : Value
|
|
If Expires NE '' then
|
|
If Num(Expires) then
|
|
// Assume time is local time. Convert it to UTC/GMT time.
|
|
Expires = SRP_DateTime('ToUTC', Expires)
|
|
// Convert the internal date or datetime to RFC1123 formatting.
|
|
Expires = SRP_DateTime('Format', Expires, "DDD, DD MMM YYYY hh:mm:ss 'GMT'")
|
|
end
|
|
Value := '; Expires=' : Expires
|
|
end
|
|
If SRP_Num(MaxAge) then
|
|
Value := '; Max-Age=' : MaxAge
|
|
end
|
|
If Domain NE '' then
|
|
Value := '; Domain=' : Domain
|
|
end
|
|
If Path NE '' then
|
|
Value := '; Path=' : Path
|
|
end
|
|
If Secure EQ True$ then
|
|
Value := '; Secure'
|
|
end
|
|
If HttpOnly EQ True$ then
|
|
Value := '; HttpOnly'
|
|
end
|
|
If Extension NE '' then
|
|
Value := '; ' : Extension
|
|
end
|
|
// Use the SetResponseHeaderField service with the Append flag set to True$ to create the Set-Cookie header.
|
|
HTTP_Services('SetResponseHeaderField', 'Set-Cookie', Value, True$)
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 400, 'The Name argument is missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetResponseHeaderFields
|
|
//
|
|
// Returns all of the Response Header Field names and values. These are formatted as Name : <space> Value <crlf> with
|
|
// an extra <crlf> appended after the last field/value pair. This also returns the response status since the CGI
|
|
// specification uses the "Status" header field. This will be put into the response before the regular header
|
|
// field/values.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetResponseHeaderFields()
|
|
|
|
ScriptType = HTTP_Services('GetHTTPScriptName')[-3, 3]
|
|
If ScriptType _EQC 'exe' then
|
|
HeaderDelim = CRLF$
|
|
end else
|
|
HeaderDelim = LF$
|
|
end
|
|
|
|
HeaderFieldBlock = 'Status: ' : HTTP_Services('GetResponseStatus') : HeaderDelim
|
|
|
|
If Len(ResponseHeaderFields@) then
|
|
NumFields = Count(ResponseHeaderFields@, @FM) + (ResponseHeaderFields@ NE '')
|
|
For FieldCnt = 1 to NumFields
|
|
HeaderFieldBlock := ResponseHeaderFields@<FieldCnt> : ': ' : ResponseHeaderValues@<FieldCnt> : HeaderDelim
|
|
Next FieldCnt
|
|
HeaderFieldBlock := HeaderDelim
|
|
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]
|
|
//
|
|
// 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)
|
|
|
|
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>
|
|
end else
|
|
Error_Services('Add', Name : ' is not a header field in the response.')
|
|
end
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 400, 'The Name argument is missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
Response = Value
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetResponseStatus
|
|
//
|
|
// Code - HTTP status code to set. - [Required]
|
|
// Phrase - Custom phrase to send with the status code. - [Optional]
|
|
//
|
|
// Sets the HTTP status code to be used in the response. This can be set at any time. If unchanged by other routines
|
|
// this will be the status code used.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetResponseStatus(Code, Phrase)
|
|
|
|
If Code NE '' AND Num(Code) then
|
|
ResponseStatusCode@ = Code
|
|
ResponseStatusPhrase@ = Trim(Phrase)
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 400, 'The Code argument is missing or not valid in the ' : Service : ' service.')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetResponseStatus
|
|
//
|
|
// Gets the current HTTP status code to be used in the response. If this has not yet been set then code 200 (OK) will
|
|
// be used as a default.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetResponseStatus()
|
|
|
|
If ResponseStatusCode@ NE '' then
|
|
Status = ResponseStatusCode@
|
|
end else
|
|
Status = '200'
|
|
end
|
|
|
|
If Len(ResponseStatusPhrase@) then
|
|
Status := ' ' : ResponseStatusPhrase@
|
|
end else
|
|
HTTPStatusCodes = Xlate('SYSENV', 'SRP_HTTP_FRAMEWORK_HTTP_STATUS_CODES', '', 'X')
|
|
Locate Status in HTTPStatusCodes<1> using @VM setting vPos then
|
|
StatusPhrase = HTTPStatusCodes<2, vPos>
|
|
Status := ' ' : StatusPhrase
|
|
end
|
|
end
|
|
|
|
Response = Status
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetResponseBody
|
|
//
|
|
// Body - The full body to send back with the HTTP response - [Required]
|
|
// IsBinary - Flag to determine if the response body is binary data. If empty then the body content will be examined
|
|
// to make an educated guess. - [Optional]
|
|
// ContentType - Value to set for the response header Content-Type. - [Optional]
|
|
//
|
|
// Sets the body content to be returned in the response.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetResponseBody(Body, IsBinary, ContentType)
|
|
|
|
// If there is nothing in the body then make sure IsBinary is set to False.
|
|
If Len(Body) else IsBinary = False$
|
|
|
|
// If the IsBinary flag is anything other than True or False then clear the argument so the body content can be
|
|
// used to make a decision.
|
|
If Index('10', IsBinary, 1) else IsBinary = ''
|
|
|
|
If Len(ContentType) then HTTP_Services('SetResponseHeaderField', 'Content-Type', ContentType)
|
|
|
|
If Len(Body) AND IsBinary EQ '' then
|
|
// There is a body content but the IsBinary flag is empty. Decide what IsBinary should be based on the
|
|
// body content and the Content-Type response header field.
|
|
ContentType = HTTP_Services('GetResponseHeaderField', 'Content-Type')
|
|
If Len(ContentType) else
|
|
Begin Case
|
|
Case Body[1, 1] EQ '{'
|
|
ContentType = 'application/hal+json'
|
|
Case Body[1, 4] EQ '%PDF'
|
|
ContentType = 'application/pdf'
|
|
Case Body[1, 10] EQ \FFD8FFE00010\ : 'JFIF'
|
|
ContentType = 'image/jpg'
|
|
Case Body[1, 4] EQ \89\ : 'PNG'
|
|
ContentType = 'image/png'
|
|
Case Body[1, 5] EQ 'GIF89'
|
|
ContentType = 'image/gif'
|
|
Case Otherwise$
|
|
ContentType = 'text/html'
|
|
End Case
|
|
end
|
|
|
|
Begin Case
|
|
Case IndexC(ContentType, 'text', 1) ; IsBinary = False$
|
|
Case IndexC(ContentType, 'json', 1) ; IsBinary = False$
|
|
Case IndexC(ContentType, 'xml', 1) ; IsBinary = False$
|
|
Case IndexC(ContentType, 'pdf', 1) ; IsBinary = True$
|
|
Case IndexC(ContentType, 'image', 1) ; IsBinary = True$
|
|
Case IndexC(ContentType, 'audio', 1) ; IsBinary = True$
|
|
Case IndexC(ContentType, 'video', 1) ; IsBinary = True$
|
|
Case IndexC(ContentType, 'application', 1) ; IsBinary = True$
|
|
Case Otherwise$ ; IsBinary = False$
|
|
End Case
|
|
end
|
|
|
|
ResponseBody@ = Body
|
|
ResponseBodyIsBinary@ = IsBinary
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetResponseBody
|
|
//
|
|
// Gets the current body to be returned in the response.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetResponseBody()
|
|
|
|
Response = ResponseBody@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetResponseBodyIsBinary
|
|
//
|
|
// Gets the binary flag associated with the current body. This is normally set by the SetResponseBody service at the
|
|
// time the body content is also set.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetResponseBodyIsBinary()
|
|
|
|
Response = ResponseBodyIsBinary@
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetResponse
|
|
//
|
|
// Gets the full response, headers and body, to be returned to the HTTP request. This will build the response as needed
|
|
// by OECGI, especially regarding binary data handling.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetResponse()
|
|
|
|
Response = ''
|
|
|
|
Body = HTTP_Services('GetResponseBody')
|
|
|
|
If Len(Body) EQ 0 then
|
|
// There is no content in the response body. This is typically due to an error condition, but it could also be
|
|
// an oversight by the developer when creating the API. Either way, a standard error response should be provided
|
|
// so the client can consume the response and have some method of interpreting the problem.
|
|
Body = HTTP_Services('GetErrorResponse')
|
|
end
|
|
|
|
BodyIsBinary = HTTP_Services('GetResponseBodyIsBinary')
|
|
|
|
ContentType = HTTP_Services('GetResponseHeaderField', 'Content-Type')
|
|
If Len(ContentType) else
|
|
Begin Case
|
|
Case Body[1, 1] EQ '{'
|
|
ContentType = 'application/hal+json'
|
|
Case Body[1, 4] EQ '%PDF'
|
|
ContentType = 'application/pdf'
|
|
Case Body[1, 10] EQ \FFD8FFE00010\ : 'JFIF'
|
|
ContentType = 'image/jpg'
|
|
Case Body[1, 4] EQ \89\ : 'PNG'
|
|
ContentType = 'image/png'
|
|
Case Body[1, 5] EQ 'GIF89'
|
|
ContentType = 'image/gif'
|
|
Case Otherwise$
|
|
ContentType = 'text/html'
|
|
End Case
|
|
HTTP_Services('SetResponseHeaderField', 'Content-Type', ContentType)
|
|
end
|
|
|
|
HTTP_Services('SetResponseHeaderField', 'Content-Length', GetByteSize(Body))
|
|
|
|
// Get the response status, all response header fields, and the required additional CR/LF.
|
|
Response = HTTP_Services('GetResponseHeaderFields')
|
|
// Now add the response body.
|
|
Response := Body
|
|
|
|
If BodyIsBinary then
|
|
// OECGI uses a special prefix to the response to help return binary content properly.
|
|
Response = HexConv(Response)
|
|
Response = 'OECGI21' : Response
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetResponseError
|
|
//
|
|
// TypeURL - URL to a human-readable document describing the error condition. Default is "about:blank"
|
|
// - [Optional]
|
|
// Title - A brief title for the error condition. Default is the formal phrase associated with the status.
|
|
// - [Optional]
|
|
// Status - The HTTP status code generated for this occurrence of the problem. - [Required]
|
|
// Detail - A human-readable explanation specific to this occurrence of the problem. - [Optional]
|
|
// InstanceURL - URL that resulted in the error condition. - [Optional]
|
|
// PropertyNames - An delimited list of property names being added. - [Optional]
|
|
// PropertyValues - An delimited list of property values associated with the property names. - [Optional]
|
|
//
|
|
// Sets a response error. This follows the RFC 7807 specification (https://tools.ietf.org/html/rfc7807), or the "Problem
|
|
// Details for HTTP APIs". This service is used instead of the SetResponseStatus and SetResponseBody.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetResponseError(TypeURL, Title, Status, Detail, InstanceURL, PropertyNames, PropertyValues)
|
|
|
|
If Status NE '' then
|
|
Convert @VM : @SVM : @TM : @STM : ',' to @FM : @FM : @FM : @FM : @FM in PropertyNames
|
|
Convert @VM : @SVM : @TM : @STM : ',' to @FM : @FM : @FM : @FM : @FM in PropertyValues
|
|
If TypeURL EQ '' then TypeURL = 'about:blank'
|
|
If Title EQ '' then
|
|
HTTPStatusCodes = Xlate('SYSENV', 'SRP_HTTP_FRAMEWORK_HTTP_STATUS_CODES', '', 'X')
|
|
Locate Status in HTTPStatusCodes<1> using @VM setting vPos then
|
|
Title = HTTPStatusCodes<2, vPos>
|
|
end
|
|
end
|
|
objError = HTTP_Resource_Services('GetObjects')
|
|
If TypeURL NE '' then HTTP_Resource_Services('AddProperties', objError, 'type', TypeURL)
|
|
If Title NE '' then HTTP_Resource_Services('AddProperties', objError, 'title', Title)
|
|
HTTP_Resource_Services('AddProperties', objError, 'status', Status, 'Number')
|
|
If Detail NE '' then HTTP_Resource_Services('AddProperties', objError, 'detail', Detail)
|
|
If InstanceURL NE '' then HTTP_Resource_Services('AddProperties', objError, 'instance', InstanceURL)
|
|
If PropertyNames NE '' then
|
|
HTTP_Resource_Services('AddProperties', objError, PropertyNames, PropertyValues)
|
|
end
|
|
// Serialize the object into a JSON string.
|
|
jsonError = HTTP_Resource_Services('GetSerializedResource', objError)
|
|
// Set the response body with the JSON string and set the Content-Type response header.
|
|
HTTP_Services('SetResponseStatus', Status, Title)
|
|
HTTP_Services('SetResponseBody', jsonError, False$, 'application/problem+json')
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', '500', 'HTTP status code was missing in the ' : Service : ' service.', InstanceURL, PropertyNames, PropertyValues)
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetErrorResponse
|
|
//
|
|
// Creates and returns an error response. This is intended to be used when there is no response body to return to the
|
|
// client. This response will contain the current response status and any error information stored using Error_Services.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetErrorResponse()
|
|
|
|
ErrorResponse = ''
|
|
|
|
ResponseStatus = HTTP_Services('GetResponseStatus')
|
|
StatusCode = ResponseStatus[1, 'F ']
|
|
StatusPhrase = ResponseStatus[Col2() + 1, 9999]
|
|
EndpointURL = HTTP_Services('GetFullEndpointURL')[1, 'F?']
|
|
HTTPMethod = HTTP_Services('GetHTTPRequestMethod')
|
|
QueryParams = HTTP_Services('GetHTTPGetString')
|
|
Errors = Error_Services('GetMessages') ; // @FM list of errors.
|
|
|
|
If SRP_JSON(hResponseObj, 'NEW', 'OBJECT') then
|
|
SRP_JSON(hResponseObj, 'SETVALUE', 'status', StatusCode)
|
|
SRP_JSON(hResponseObj, 'SETVALUE', 'phrase', StatusPhrase)
|
|
SRP_JSON(hResponseObj, 'SETVALUE', 'method', HTTPMethod)
|
|
If Len(QueryParams) then
|
|
SRP_JSON(hResponseObj, 'SETVALUE', 'query', QueryParams)
|
|
end
|
|
SRP_JSON(hResponseObj, 'SETVALUE', 'URL', EndpointURL)
|
|
If Len(Errors) then
|
|
// Only create the JSON array of errors if there are any errors to include.
|
|
If SRP_JSON(hErrorArray, 'NEW', 'ARRAY') then
|
|
NumErrors = DCount(Errors, @FM)
|
|
For ErrorCnt = 1 to NumErrors
|
|
Error = Errors<ErrorCnt>
|
|
SRP_JSON(hErrorArray, 'ADDVALUE', Error)
|
|
Next ErrorCnt
|
|
SRP_JSON(hResponseObj, 'SET', 'errors', hErrorArray)
|
|
SRP_JSON(hErrorArray, 'RELEASE')
|
|
end
|
|
end
|
|
ErrorResponse = SRP_JSON(hResponseObj, 'STRINGIFY', 'STYLED')
|
|
SRP_JSON(hResponseObj, 'RELEASE')
|
|
end
|
|
|
|
Response = ErrorResponse
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// DecodePercentString
|
|
//
|
|
// String - The string with percent-encoded characters. - [Required]
|
|
//
|
|
// Decodes the string so that percent-encoded characters are restored to their regular form. This returns the
|
|
// decoded string.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service DecodePercentString(String)
|
|
|
|
DecodedString = ''
|
|
|
|
If Len(String) then
|
|
DecodedString = String
|
|
Swap '>' with '>' in DecodedString
|
|
Swap '<' with '<' in DecodedString
|
|
Swap '&' with '&' in DecodedString
|
|
Swap '"' with '"' in DecodedString
|
|
Swap ''' with "'" in DecodedString
|
|
Swap ''' with "'" in DecodedString
|
|
Swap '%09' with \09\ in DecodedString
|
|
Swap '%0A' with \0A\ in DecodedString
|
|
Swap '%0D' with \0D\ in DecodedString
|
|
Swap '%20' with ' ' in DecodedString
|
|
Swap '%21' with '!' in DecodedString
|
|
Swap '%22' with '"' in DecodedString
|
|
Swap '%23' with '#' in DecodedString
|
|
Swap '%24' with '$' in DecodedString
|
|
Swap '%25' with '%' in DecodedString
|
|
Swap '%26' with '&' in DecodedString
|
|
Swap '%27' with "'" in DecodedString
|
|
Swap '%28' with '(' in DecodedString
|
|
Swap '%29' with ')' in DecodedString
|
|
Swap '%2A' with '*' in DecodedString
|
|
Swap '%2B' with '+' in DecodedString
|
|
Swap '%2C' with ',' in DecodedString
|
|
Swap '%2D' with '-' in DecodedString
|
|
Swap '%2E' with '.' in DecodedString
|
|
Swap '%2F' with '/' in DecodedString
|
|
Swap '%3A' with ':' in DecodedString
|
|
Swap '%3B' with ';' in DecodedString
|
|
Swap '%3C' with '<' in DecodedString
|
|
Swap '%3D' with '=' in DecodedString
|
|
Swap '%3E' with '>' in DecodedString
|
|
Swap '%3F' with '?' in DecodedString
|
|
Swap '%5B' with '[' in DecodedString
|
|
Swap '%5C' with '\' in DecodedString
|
|
Swap '%5D' with ']' in DecodedString
|
|
Swap '%5E' with '^' in DecodedString
|
|
Swap '%5F' with '_' in DecodedString
|
|
Swap '%7B' with '{' in DecodedString
|
|
Swap '%7C' with '|' in DecodedString
|
|
Swap '%7D' with '}' in DecodedString
|
|
Swap '%7E' with '~' in DecodedString
|
|
Swap '%E2%80%9C' with '"' in DecodedString ; // Left quotation mark.
|
|
Swap '%E2%80%9D' with '"' in DecodedString ; // Right quotation mark.
|
|
end else
|
|
Error_Services('Add', 'The String argument was missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
Response = DecodedString
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// ClearSettings
|
|
//
|
|
// Clears all of the global common variables used to track header names, values, and the status settings. This will
|
|
// typically only be called within HTTP_MCP when the response is finished and sent back to the OECGI.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service ClearSettings()
|
|
|
|
// The FreeCommon statement is not used because one of the commons, LogCounter@, needs to keep its value for as long
|
|
// as the same engine is being used to process requests from the EngineServer.
|
|
Request@ = ''
|
|
ProcErr@ = ''
|
|
RequestHeaderFields@ = ''
|
|
RequestHeaderValues@ = ''
|
|
ResponseHeaderFields@ = ''
|
|
ResponseHeaderValues@ = ''
|
|
ResponseStatusCode@ = ''
|
|
ResponseStatusPhrase@ = ''
|
|
ResponseBody@ = ''
|
|
ResponseBodyIsBinary@ = ''
|
|
SelfURL@ = ''
|
|
QueryFields@ = ''
|
|
QueryValues@ = ''
|
|
SessionID@ = ''
|
|
|
|
Memory_Services('ReleaseHashTable', CacheName$)
|
|
|
|
If HTTP_Services('GetFlushCacheFlag') then
|
|
Flush
|
|
GarbageCollect
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetHomeURL
|
|
//
|
|
// Returns the Home URL for the web site. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <1>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetHomeURL()
|
|
|
|
ServiceKeyID = Service
|
|
HomeURL = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If HomeURL EQ '' then
|
|
HomeURL = HTTP_Services('GetHTTPServerName', True$)
|
|
If HomeURL EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
HomeURL = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_HOME_URL$>
|
|
end
|
|
If HomeURL[1, 4] _NEC 'http' then
|
|
If HTTP_Services('GetHTTPHTTPS') _EQC 'on' then
|
|
HomeURL = 'https://' : HomeURL
|
|
end else
|
|
HomeURL = 'http://' : HomeURL
|
|
end
|
|
end
|
|
|
|
Memory_Services('SetValue', ServiceKeyID, HomeURL, CacheName$)
|
|
end
|
|
|
|
Response = HomeURL
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetAPIRootURL
|
|
//
|
|
// FullURL - Boolean flag indicating if the full URL or just the end point should be returned.
|
|
// Default is True. - [Optional]
|
|
//
|
|
// Returns the API Root URL for the web site. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <2>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetAPIRootURL(FullURL=BOOLEAN)
|
|
|
|
If FullURL NE False$ then FullURL = True$
|
|
|
|
ServiceKeyID = Service : '*' : FullURL
|
|
APIRootURL = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If APIRootURL EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
APIEndpoint = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_API_URL$>
|
|
If FullURL then
|
|
HomeURL = HTTP_Services('GetHomeURL')
|
|
APIRootURL = HomeURL : APIEndpoint
|
|
end else
|
|
Transfer APIEndpoint to APIRootURL
|
|
end
|
|
// Make sure the URL does not end with a slash.
|
|
If APIRootURL[-1, 1] EQ '/' then APIRootURL[-1, 1] = ''
|
|
Convert @Upper_Case to @Lower_Case in APIRootURL ; // Conver to all lower case since it is case-insensitive anyway.
|
|
Memory_Services('SetValue', ServiceKeyID, APIRootURL, CacheName$)
|
|
end
|
|
|
|
Response = APIRootURL
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetCapturePath
|
|
//
|
|
// Returns the capture path for the request and response content. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <3>
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetCapturePath()
|
|
|
|
ServiceKeyID = Service
|
|
CapturePath = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If CapturePath EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
CapturePath = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_CAPTURE_PATH$>
|
|
Memory_Services('SetValue', ServiceKeyID, CapturePath, CacheName$)
|
|
end
|
|
|
|
Response = CapturePath
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetRealmValue
|
|
//
|
|
// Returns the realm value, which is used by the WWW-Authenticate response header. It pulls this from
|
|
// SYSENV\SRP_HTTP_FRAMEWORK_SETUP <5>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetRealmValue()
|
|
|
|
ServiceKeyID = Service
|
|
RealmValue = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If RealmValue EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
RealmValue = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_REALM_VALUE$>
|
|
Memory_Services('SetValue', ServiceKeyID, RealmValue, CacheName$)
|
|
end
|
|
|
|
Response = RealmValue
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetEntryPointService
|
|
//
|
|
// Returns the entry point service name. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <6>. Default is entry_point.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetEntryPointService()
|
|
|
|
ServiceKeyID = Service
|
|
EntryPointService = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If EntryPointService EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
EntryPointService = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_ENTRY_POINT_SERVICE$>
|
|
If EntryPointService EQ '' then EntryPointService = 'ENTRY_POINT'
|
|
If EntryPointService[1, 5] _EQC 'HTTP_' AND EntryPointService[-9, 9] _EQC '_SERVICES' then
|
|
// Entry point service is stored as the fully qualified stored procedure name. Remove the HTTP_ prefix
|
|
// and _SERVICES suffix so this can be called properly by the RunHTTPService service.
|
|
EntryPointService[1, 5] = ''
|
|
EntryPointService[-9, 9] = ''
|
|
end
|
|
Memory_Services('SetValue', ServiceKeyID, EntryPointService, CacheName$)
|
|
end
|
|
|
|
Response = EntryPointService
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetVersion
|
|
//
|
|
// Returns the version of the SRP HTTP Framework being used. The response will be in the following format:
|
|
//
|
|
// x.x.x [RCx]
|
|
// mm.dd.yyyy hh:mmA/P
|
|
//
|
|
// A carriage-return/line-feed character will be used to separate the two pieces of information.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetVersion()
|
|
|
|
Version = Database_Services('ReadDataRow', 'SYSENV', 'SRP_HTTP_FRAMEWORK_VERSION')
|
|
|
|
Swap @FM with CRLF$ in Version
|
|
|
|
Response = Version
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetFullEndpointURL
|
|
//
|
|
// Returns the full URL for the end point. This should correspond with the URL requested by the client.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetFullEndpointURL()
|
|
|
|
ServiceKeyID = Service
|
|
FullEndpointURL = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If FullEndpointURL EQ '' then
|
|
PathInfo = HTTP_Services('GetHTTPPathInfo')
|
|
If PathInfo[-1, 1] EQ '/' then PathInfo[-1, 1] = ''
|
|
If Len(PathInfo) then
|
|
If PathInfo[1, 1] NE '/' then PathInfo = '/' : PathInfo
|
|
end
|
|
FullEndpointURL = HTTP_Services('GetAPIRootURL', True$) : PathInfo
|
|
QueryParams = HTTP_Services('GetHTTPGetString')
|
|
If QueryParams NE '' then
|
|
FullEndpointURL := '?' : QueryParams
|
|
end
|
|
Memory_Services('SetValue', ServiceKeyID, FullEndpointURL, CacheName$)
|
|
end
|
|
|
|
Response = FullEndpointURL
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetFlushCacheFlag
|
|
//
|
|
// Returns the flush cache flag setting. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <7>. This flag should be
|
|
// used to determine if the SRP HTTP Framework should clear all cache and buffers just before returning back to the
|
|
// OECGI. By default, this flag is checked and implemented in the ClearSettings service.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetFlushCacheFlag()
|
|
|
|
ServiceKeyID = Service
|
|
FlushCacheFlag = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If FlushCacheFlag EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
FlushCacheFlag = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_FLUSH_CACHE$>
|
|
Memory_Services('SetValue', ServiceKeyID, FlushCacheFlag, CacheName$)
|
|
end
|
|
|
|
Response = FlushCacheFlag
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetEnableAuthenticationFlag
|
|
//
|
|
// Returns the enable authentication flag setting. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <4>. Note: Only
|
|
// an explicit setting of False (0) will turn this flag off.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetEnableAuthenticationFlag()
|
|
|
|
ServiceKeyID = Service
|
|
EnableAuthenticationFlag = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If EnableAuthenticationFlag EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
EnableAuthenticationFlag = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_ENABLE_AUTHENTICATION$>
|
|
If EnableAuthenticationFlag EQ False$ else EnableAuthenticationFlag = True$
|
|
Memory_Services('SetValue', ServiceKeyID, EnableAuthenticationFlag, CacheName$)
|
|
end
|
|
|
|
Response = EnableAuthenticationFlag
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetEnableHTTPBasicAuthenticationFlag
|
|
//
|
|
// Returns the enable HTTP Basic Authentication flag setting. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <15>.
|
|
// Note: Only an explicit setting of False (0) will turn this flag off.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetEnableHTTPBasicAuthenticationFlag()
|
|
|
|
ServiceKeyID = Service
|
|
EnableHTTPBasicAuthenticationFlag = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If EnableHTTPBasicAuthenticationFlag EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
EnableHTTPBasicAuthenticationFlag = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_ENABLE_HTTP_BASIC_AUTHENTICATION$>
|
|
If EnableHTTPBasicAuthenticationFlag EQ False$ else EnableHTTPBasicAuthenticationFlag = True$
|
|
Memory_Services('SetValue', ServiceKeyID, EnableHTTPBasicAuthenticationFlag, CacheName$)
|
|
end
|
|
|
|
Response = EnableHTTPBasicAuthenticationFlag
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetNewPasswordTimeToLive
|
|
//
|
|
// Returns the length of time (in hours) that new passwords can be valid before needing to be reset. It pulls this from
|
|
// SYSENV\SRP_HTTP_FRAMEWORK_SETUP <16>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetNewPasswordTimeToLive()
|
|
|
|
ServiceKeyID = Service
|
|
TimeToLive = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If TimeToLive EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
TimeToLive = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_NEW_PASSWORD_TIME_TO_LIVE$>
|
|
Memory_Services('SetValue', ServiceKeyID, TimeToLive, CacheName$)
|
|
end
|
|
|
|
Response = TimeToLive
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetOldPasswordTimeToLive
|
|
//
|
|
// Returns the length of time (in hours) that old passwords can be valid. It pulls this from
|
|
// SYSENV\SRP_HTTP_FRAMEWORK_SETUP <17>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetOldPasswordTimeToLive()
|
|
|
|
ServiceKeyID = Service
|
|
TimeToLive = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If TimeToLive EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
TimeToLive = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_OLD_PASSWORD_TIME_TO_LIVE$>
|
|
If TimeToLive EQ '' then TimeToLive = 1
|
|
Memory_Services('SetValue', ServiceKeyID, TimeToLive, CacheName$)
|
|
end
|
|
|
|
Response = TimeToLive
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetInvalidPasswordLimit
|
|
//
|
|
// Returns the number of times an invalid password attempt can be made before containment action is taken. It pulls this
|
|
// from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <18>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetInvalidPasswordLimit()
|
|
|
|
ServiceKeyID = Service
|
|
InvalidPasswordLimit = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If InvalidPasswordLimit EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
InvalidPasswordLimit = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_INVALID_PASSWORD_LIMIT$>
|
|
Memory_Services('SetValue', ServiceKeyID, InvalidPasswordLimit, CacheName$)
|
|
end
|
|
|
|
Response = InvalidPasswordLimit
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetContainmentAction
|
|
//
|
|
// Returns the containment action to take if the number of invalid password attempts exceeds the limit. It pulls this
|
|
// from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <19>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetContainmentAction()
|
|
|
|
ServiceKeyID = Service
|
|
ContainmentAction = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If ContainmentAction EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
ContainmentAction = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_CONTAINMENT_ACTION$>
|
|
Memory_Services('SetValue', ServiceKeyID, ContainmentAction, CacheName$)
|
|
end
|
|
|
|
Response = ContainmentAction
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetServerEnabled
|
|
//
|
|
// Sets the enabled status of the server.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetServerEnabled(ServerEnabled=BOOLEAN)
|
|
|
|
If ServerEnabled NE False$ then ServerEnabled = True$
|
|
LocalSetupKeyID = HTTP_Services('GetLocalAppKeyID', 'SRP_HTTP_FRAMEWORK_SERVER_ENABLED')
|
|
Database_Services('WriteDataRow', SetupTable$, LocalSetupKeyID, ServerEnabled, True$, False$, False$)
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetServerEnabled
|
|
//
|
|
// Returns enabled status of the server.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetServerEnabled()
|
|
|
|
LocalSetupKeyID = HTTP_Services('GetLocalAppKeyID', 'SRP_HTTP_FRAMEWORK_SERVER_ENABLED')
|
|
ServerEnabled = Database_Services('ReadDataRow', SetupTable$, LocalSetupKeyID)
|
|
If ServerEnabled NE False$ then ServerEnabled = True$
|
|
|
|
Response = ServerEnabled
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetTotalInvalidPasswordAttempts
|
|
//
|
|
// Sets the total number of invalid password attempts made.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetTotalInvalidPasswordAttempts(Attempts)
|
|
|
|
LocalSetupKeyID = HTTP_Services('GetLocalAppKeyID', 'SRP_HTTP_FRAMEWORK_TOTAL_INVALID_PASSWORD_ATTEMPTS')
|
|
Database_Services('WriteDataRow', SetupTable$, LocalSetupKeyID, Attempts, True$, False$, True$)
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetTotalInvalidPasswordAttempts
|
|
//
|
|
// Returns the total number of invalid password attempts made.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetTotalInvalidPasswordAttempts()
|
|
|
|
LocalSetupKeyID = HTTP_Services('GetLocalAppKeyID', 'SRP_HTTP_FRAMEWORK_TOTAL_INVALID_PASSWORD_ATTEMPTS')
|
|
Attempts = Database_Services('ReadDataRow', SetupTable$, LocalSetupKeyID)
|
|
If (Attempts EQ '') OR Not(Num(Attempts)) then Attempts = 0
|
|
|
|
Response = Attempts
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetNonAuthenticatedPaths
|
|
//
|
|
// Returns the list of non-authenticated URLs. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <8>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetNonAuthenticatedPaths()
|
|
|
|
ServiceKeyID = Service
|
|
NonAuthenticatedPaths = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If NonAuthenticatedPaths EQ '' then
|
|
APIRootURL = HTTP_Services('GetAPIRootURL', True$)
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
NonAuthenticatedPaths = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_NON_AUTHENTICATED_PATHS$>
|
|
Convert @Upper_Case to @Lower_Case in NonAuthenticatedPaths ; // Make the paths are all lower case since these are case-insensitive anyway.
|
|
NonAuthenticatedQueryParams = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_NON_AUTHENTICATED_QUERY_PARAMS$>
|
|
If NonAuthenticatedPaths NE '' then
|
|
Transfer NonAuthenticatedPaths to Paths
|
|
Transfer NonAuthenticatedQueryParams to QueryParams
|
|
For Each Path in Paths using @VM setting vPos
|
|
If Path[1, 4] _NEC 'http' then
|
|
// The should not begin with http/s, but test for it just in case. If it is missing, then prepend
|
|
// the API Root URL so this service will return a fully formed URL path.
|
|
Path = APIRootURL : Path
|
|
end
|
|
QueryParam = QueryParams<0, vPos>
|
|
If QueryParam NE '' then
|
|
// There are associated query params for this path. Append each one to an instance of the path.
|
|
For Each Param in QueryParam using @TM
|
|
NonAuthenticatedPaths := Path : '?' : Param : @FM
|
|
Next Param
|
|
end else
|
|
NonAuthenticatedPaths := Path : @FM
|
|
end
|
|
Next URL
|
|
NonAuthenticatedPaths[-1, 1] = ''
|
|
end
|
|
Memory_Services('SetValue', ServiceKeyID, NonAuthenticatedPaths, CacheName$)
|
|
end
|
|
|
|
Response = NonAuthenticatedPaths
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// URLRequiresAuthentication
|
|
//
|
|
// Returns a Boolean flag whether the indicated URL requires authentication or not.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service URLRequiresAuthentication(URL)
|
|
|
|
Endpoint = URL[1, '?'] ; // Get the URL path up to any query params.
|
|
Convert @Upper_Case to @Lower_Case in Endpoint ; // Make the URL path all lower case since it is case-insensitive anyway.
|
|
QueryParams = URL[Col2() + 1, 999] ; // Get any query params.
|
|
// Convert query params into an @FM/@VM array, rotate the array, and extract only the query param names.
|
|
Convert '&=' to @FM : @VM in QueryParams
|
|
QueryParams = SRP_Array('Rotate', QueryParams)
|
|
QueryParams = QueryParams<1>
|
|
If Endpoint[-1, 1] EQ '/' then Endpoint[-1, 1] = '' ; // Strip off any ending slashes.
|
|
ServiceKeyID = Service : '*' : URL
|
|
URLRequiresAuthentication = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If URLRequiresAuthentication EQ '' then
|
|
URLRequiresAuthentication = True$ ; // Assume True for now.
|
|
NonAuthenticatedPaths = HTTP_Services('GetNonAuthenticatedPaths')
|
|
If QueryParams NE '' then
|
|
// Since the URL includes query params, each endpoint + query param combination must be found in the
|
|
// non-authenticated path list.
|
|
AcceptAllParams = True$ ; // Assume that all query params are non-authenticated for now.
|
|
For Each Param in QueryParams using @VM
|
|
Path = Endpoint : '?' : Param
|
|
If Inlist(NonAuthenticatedPaths, Path, @FM) else AcceptAllParams = False$
|
|
Until AcceptAllParams EQ False$
|
|
Next Param
|
|
If AcceptAllParams then URLRequiresAuthentication = False$
|
|
end else
|
|
// This URL does not include query params. So just verify that the URL matches any path in the list.
|
|
For Each ComparePath in NonAuthenticatedPaths using @FM
|
|
If ComparePath[-1, 1] EQ '*' then
|
|
// This path has a wildcard which means any URL with the same endpoint will not require
|
|
// authentication.
|
|
ComparePath[-1, 1] = '' ; // Strip off the wildcard.
|
|
If ComparePath[-1, 1] EQ '/' then ComparePath[-1, 1] = '' ; // Strip off any ending slashes.
|
|
If IndexC(Endpoint, ComparePath, 1) then URLRequiresAuthentication = False$
|
|
end else
|
|
// This path must be an exact match to the URL being requested.
|
|
If ComparePath[-1, 1] EQ '/' then ComparePath[-1, 1] = '' ; // Strip off any ending slashes.
|
|
If ComparePath EQ Endpoint then URLRequiresAuthentication = False$
|
|
end
|
|
Until URLRequiresAuthentication EQ False$
|
|
Next Path
|
|
end
|
|
end
|
|
|
|
Response = URLRequiresAuthentication
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetWhitelistedIPs
|
|
//
|
|
// Returns the list of whitelisted IPs. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <14>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetWhitelistedIPs()
|
|
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
WhitelistedIPs = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_WHITELISTED_IPS$>
|
|
|
|
Response = WhitelistedIPs
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// IsIPWhitelisted
|
|
//
|
|
// Returns a Boolean flag whether the indicated IP is whitelisted.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service IsIPWhitelisted(IP)
|
|
|
|
IPWhitelisted = False$ ; // Assume False for now.
|
|
WhitelistedIPs = HTTP_Services('GetWhitelistedIPs')
|
|
|
|
If WhitelistedIPs NE '' then
|
|
Convert '.' to @FM in IP ; // Convert IP string to a delimited array so each element of the IP can be inspected.
|
|
For Each IPOption in WhitelistedIPs using @VM
|
|
// Assume each whitelisted IP can have a pattern (i.e., a "*" for wildcard or a dash-delimited range). Create
|
|
// a match IP before comparing the incoming IP.
|
|
Convert '.' to @FM in IPOption
|
|
For Each IPelement in IPOption using @FM setting fPos
|
|
If IPelement EQ '*' then
|
|
// Set the IPoption to match the IP segment of the incoming IP so a match can be made.
|
|
IPOption<fPos> = IP<fPos>
|
|
end else
|
|
If Count(IPelement, '-') EQ 1 then
|
|
// Verify that the incoming segment falls within the range and then set the IPoption to match
|
|
// the incoming IP so a match can be made.
|
|
StartingRange = IPelement[1, 'F-']
|
|
EndingRange = IPelement[Col2() + 1, 'F-']
|
|
If Num(StartingRange) AND Num(EndingRange) then
|
|
If (IP<fPos> GE StartingRange) AND (IP<fPos> LE EndingRange) then
|
|
IPOption<fPos> = IP<fPos>
|
|
end
|
|
end
|
|
end
|
|
end
|
|
Next IPelement
|
|
|
|
If IndexC(IP, IPOption, 1) then IPWhitelisted = True$
|
|
Until IPWhitelisted EQ True$
|
|
Next IPOption
|
|
end
|
|
|
|
Response = IPWhitelisted
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetBannedIPs
|
|
//
|
|
// Returns the list of banned IPs. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <22>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetBannedIPs()
|
|
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
BannedIPs = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_BANNED_IPS$>
|
|
|
|
Response = BannedIPs
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// IsIPBanned
|
|
//
|
|
// Returns a Boolean flag whether the indicated IP is whitelisted.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service IsIPBanned(IP)
|
|
|
|
IPBanned = False$ ; // Assume False for now.
|
|
BannedIPs = HTTP_Services('GetBannedIPs')
|
|
|
|
If BannedIPs NE '' then
|
|
Convert '.' to @FM in IP ; // Convert IP string to a delimited array so each element of the IP can be inspected.
|
|
For Each IPOption in BannedIPs using @VM
|
|
// Assume each whitelisted IP can have a pattern (i.e., a "*" for wildcard or a dash-delimited range). Create
|
|
// a match IP before comparing the incoming IP.
|
|
Convert '.' to @FM in IPOption
|
|
For Each IPelement in IPOption using @FM setting fPos
|
|
If IPelement EQ '*' then
|
|
// Set the IPoption to match the IP segment of the incoming IP so a match can be made.
|
|
IPOption<fPos> = IP<fPos>
|
|
end else
|
|
If Count(IPelement, '-') EQ 1 then
|
|
// Verify that the incoming segment falls within the range and then set the IPoption to match
|
|
// the incoming IP so a match can be made.
|
|
StartingRange = IPelement[1, 'F-']
|
|
EndingRange = IPelement[Col2() + 1, 'F-']
|
|
If Num(StartingRange) AND Num(EndingRange) then
|
|
If (IP<fPos> GE StartingRange) AND (IP<fPos> LE EndingRange) then
|
|
IPOption<fPos> = IP<fPos>
|
|
end
|
|
end
|
|
end
|
|
end
|
|
Next IPelement
|
|
|
|
If IndexC(IP, IPOption, 1) then IPBanned = True$
|
|
Until IPBanned EQ True$
|
|
Next IPOption
|
|
end
|
|
|
|
Response = IPBanned
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// AddBannedIP
|
|
//
|
|
// Adds the indicated IP to the list of banned IPs.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service AddBannedIP(IP)
|
|
|
|
If IP NE '' then
|
|
LocalSetupKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
SetupInfo = Database_Services('ReadDataRow', SetupTable$, LocalSetupKeyID)
|
|
BannedIPs = SetupInfo<HTTP_FRAMEWORK_SETUP_BANNED_IPS$>
|
|
BannedIPs<-1> = IP
|
|
SetupInfo<HTTP_FRAMEWORK_SETUP_BANNED_IPS$> = BannedIPs
|
|
Database_Services('WriteDataRow', SetupTable$, LocalSetupKeyID, SetupInfo, True$, False$, False$)
|
|
end else
|
|
Error_Services('Add', 'The IP argument was missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// RemoveBannedIP
|
|
//
|
|
// Removes the indicated IP to the list of banned IPs.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service RemoveBannedIP(IP)
|
|
|
|
If IP NE '' then
|
|
LocalSetupKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
SetupInfo = Database_Services('ReadDataRow', SetupTable$, LocalSetupKeyID)
|
|
BannedIPs = SetupInfo<HTTP_FRAMEWORK_SETUP_BANNED_IPS$>
|
|
Locate IP in BannedIPs using @FM setting Pos then
|
|
BannedIPs = Delete(BannedIPs, Pos, 0, 0)
|
|
SetupInfo<HTTP_FRAMEWORK_SETUP_BANNED_IPS$> = BannedIPs
|
|
Database_Services('WriteDataRow', SetupTable$, LocalSetupKeyID, SetupInfo, True$, False$, False$)
|
|
end
|
|
end else
|
|
Error_Services('Add', 'The IP argument was missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// IPIsPermitted
|
|
//
|
|
// Returns a Boolean flag whether the indicated IP is permitted or not. Note, an IP is permitted if the whitelist is
|
|
// empty or if it is included in the list of whitelisted IPs.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service IPIsPermitted(IP)
|
|
|
|
IPIsPermitted = False$ ; // Assume False for now.
|
|
|
|
If HTTP_Services('IsIPBanned', IP) EQ False$ then
|
|
WhitelistedIPs = HTTP_Services('GetWhitelistedIPs')
|
|
|
|
If WhitelistedIPs EQ '' then
|
|
IPIsPermitted = True$
|
|
end else
|
|
IPIsPermitted = HTTP_Services('IsIPWhitelisted', IP)
|
|
end
|
|
end
|
|
|
|
Response = IPIsPermitted
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetBestContentNegotiation
|
|
//
|
|
// RequestHeaderField - The request header field containing the acceptable client options. - [Required]
|
|
// ServerOptions - An @FM delimited list of options the server can accommodate. - [Required]
|
|
//
|
|
// Returns the best content negotiation match based on the options the server is able to support and the options the
|
|
// client requested in one of the header request fields that supports content negotiation. This uses standard content
|
|
// negotiation rules wherein the server does its best to accommodate the client based on the order of preference.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetBestContentNegotiation(RequestHeaderField=CONTENTNEGOTIATIONFIELDS, ServerOptions)
|
|
|
|
ServiceKeyID = Service : '*' : SRP_Hash(RequestHeaderField : ServerOptions, 'SHA-1', 'BASE32')
|
|
ContentNegotiation = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If Len(RequestHeaderField) AND Len(ServerOptions) then
|
|
If Len(ContentNegotiation) EQ 0 then
|
|
Convert @Upper_Case to @Lower_Case in ServerOptions
|
|
ClientOptions = HTTP_Services('GetRequestHeaderField', RequestHeaderField)
|
|
Convert @Upper_Case to @Lower_Case in ClientOptions
|
|
Convert ' ' to '' in ClientOptions
|
|
Convert ',' to @FM in ClientOptions
|
|
Convert ';' to @VM in ClientOptions
|
|
NumClientOptions = DCount(ClientOptions, @FM)
|
|
NumServerOptions = DCount(ServerOptions, @FM)
|
|
// The following loop converts the priority value for each content option into an integer so it can be
|
|
// easily sorted. Note: A missing priority means this option is the most preferred.
|
|
For OptionCnt = 1 to NumClientOptions
|
|
Priority = ClientOptions<OptionCnt, 2>
|
|
If Len(Priority) then
|
|
Priority = Priority[-1, 1]
|
|
If Not(Num(Priority)) then Priority = 1
|
|
end else
|
|
Priority = 10
|
|
end
|
|
ClientOptions<OptionCnt, 2> = Priority
|
|
Next NumClientOptions
|
|
// Sort based on the priority value (highest to lowest).
|
|
ClientOptions = SRP_Sort_Array(ClientOptions, 'DR2', True$)
|
|
// Rotate the array so just the content options can be retreived.
|
|
ClientOptions = SRP_Rotate_Array(ClientOptions)<1>
|
|
Convert @VM to @FM in ClientOptions
|
|
// Loop through the client options until the first match is found. If none is found then return an empty
|
|
// string and set the response status to 406 (Not Acceptable).
|
|
FoundContentNegotiation = False$
|
|
For ClientOptionCnt = 1 to NumClientOptions
|
|
Option = ClientOptions<ClientOptionCnt>
|
|
If RequestHeaderField _EQC 'Accept' then
|
|
If Option EQ '*/*' then
|
|
ServerOptionCnt = 1
|
|
FoundContentNegotiation = True$
|
|
end else
|
|
Type = Option[1, '/']
|
|
SubType = Option[Col2() + 1, '/']
|
|
For ServerOptionCnt = 1 to NumServerOptions
|
|
ServerOption = ServerOptions<ServerOptionCnt>
|
|
ServerType = ServerOption[1, '/']
|
|
ServerSubType = ServerOption[Col2() + 1, '/']
|
|
If Type _EQC ServerType then
|
|
If SubType EQ '*' then
|
|
FoundContentNegotiation = True$
|
|
end else
|
|
If SubType _EQC ServerSubType then
|
|
FoundContentNegotiation = True$
|
|
end
|
|
end
|
|
end
|
|
Until FoundContentNegotiation
|
|
Next ServerOptionCnt
|
|
end
|
|
end else
|
|
If Option EQ '*' then
|
|
ServerOptionCnt = 1
|
|
FoundContentNegotiation = True$
|
|
end else
|
|
Type = Option[1, '/']
|
|
For ServerOptionCnt = 1 to NumServerOptions
|
|
ServerType = ServerOptions<ServerOptionCnt>
|
|
If Type _EQC ServerType then
|
|
FoundContentNegotiation = True$
|
|
end
|
|
Until FoundContentNegotiation
|
|
Next ServerOptionCnt
|
|
end
|
|
end
|
|
Until FoundContentNegotiation
|
|
Next ClientOptionCnt
|
|
|
|
If FoundContentNegotiation EQ True$ then
|
|
ContentNegotiation = ServerOptions<ServerOptionCnt>
|
|
Memory_Services('SetValue', ServiceKeyID, ContentNegotiation, CacheName$)
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 406, 'The server cannot provide the client acceptable content.')
|
|
end
|
|
end
|
|
end else
|
|
HTTP_Services('SetResponseError', '', '', 400, 'The RequestHeaderField or ServerOptions argument is missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
Response = ContentNegotiation
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetAbortedService
|
|
//
|
|
// Returns the service handler for aborted HTTP Requests. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <9>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetAbortedService()
|
|
|
|
ServiceKeyID = Service
|
|
AbortedService = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If AbortedService EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
AbortedService = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_ABORTED_SERVICE$>
|
|
Convert @Lower_Case to @Upper_Case IN AbortedService
|
|
Memory_Services('SetValue', ServiceKeyID, AbortedService, CacheName$)
|
|
end
|
|
|
|
Response = AbortedService
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetEnableLoggingFlag
|
|
//
|
|
// Returns the enable logging flag setting. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <10>. Note: Only
|
|
// an explicit setting of False (0) will turn this flag off.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetEnableLoggingFlag()
|
|
|
|
ServiceKeyID = Service
|
|
EnableLoggingFlag = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If EnableLoggingFlag EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
EnableLoggingFlag = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_ENABLE_LOGGING$>
|
|
If EnableLoggingFlag EQ False$ else EnableLoggingFlag = True$
|
|
Memory_Services('SetValue', ServiceKeyID, EnableLoggingFlag, CacheName$)
|
|
end
|
|
|
|
Response = EnableLoggingFlag
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetLogErrorsOnlyFlag
|
|
//
|
|
// Returns the log errors only flag setting. It pulls this from SYSENV\SRP_HTTP_FRAMEWORK_SETUP <13>. Note: Only
|
|
// an explicit setting of False (0) will turn this flag off.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetLogErrorsOnlyFlag()
|
|
|
|
ServiceKeyID = Service
|
|
LogErrorsOnlyFlag = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If LogErrorsOnlyFlag EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
LogErrorsOnlyFlag = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_LOG_ERRORS_ONLY$>
|
|
If LogErrorsOnlyFlag EQ False$ else LogErrorsOnlyFlag = True$
|
|
Memory_Services('SetValue', ServiceKeyID, LogErrorsOnlyFlag, CacheName$)
|
|
end
|
|
|
|
Response = LogErrorsOnlyFlag
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetDebuggerSetting
|
|
//
|
|
// Returns the value that will be passed into the RTI_Debugger_Setting subroutine. It pulls this from
|
|
// SYSENV\SRP_HTTP_FRAMEWORK_SETUP <11>. If no value has been set then a 0 (disabled) is returned as the default.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetDebuggerSetting()
|
|
|
|
ServiceKeyID = Service
|
|
DebuggerSetting = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If DebuggerSetting EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
DebuggerSetting = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_DEBUGGER_SETTING$>
|
|
If DebuggerSetting EQ '' then DebuggerSetting = 0
|
|
Memory_Services('SetValue', ServiceKeyID, DebuggerSetting, CacheName$)
|
|
end
|
|
|
|
Response = DebuggerSetting
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetDebuggerService
|
|
//
|
|
// Returns the service handler for aborted HTTP Requests due to runtime errors. It pulls this from
|
|
// SYSENV\SRP_HTTP_FRAMEWORK_SETUP <12>.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetDebuggerService()
|
|
|
|
ServiceKeyID = Service
|
|
DebuggerService = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If DebuggerService EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
DebuggerService = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_DEBUGGER_INTERCEPT$>
|
|
Convert @Lower_Case to @Upper_Case IN DebuggerService
|
|
Memory_Services('SetValue', ServiceKeyID, DebuggerService, CacheName$)
|
|
end
|
|
|
|
Response = DebuggerService
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetAPICallProcedure
|
|
//
|
|
// Returns the API calling procedure method which is primarily used by HTTP_MCP. It pulls this from
|
|
// SYSENV\SRP_HTTP_FRAMEWORK_SETUP <20>. If no value has been set then "Web API" is returned as the default.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetAPICallProcedure()
|
|
|
|
ServiceKeyID = Service
|
|
APICallProcedure = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If APICallProcedure EQ '' then
|
|
SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$)
|
|
APICallProcedure = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID)<HTTP_FRAMEWORK_SETUP_API_CALL_PROCEDURE$>
|
|
If APICallProcedure EQ '' then APICallProcedure = 'Web API'
|
|
Memory_Services('SetValue', ServiceKeyID, APICallProcedure, CacheName$)
|
|
end
|
|
|
|
Response = APICallProcedure
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetWebAPI
|
|
//
|
|
// Returns the name of the indicated resource's API procedure if it exists. If it does not exist then an empty string
|
|
// will be returned.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetWebAPI(Resource, ReturnRepositoryKeyID)
|
|
|
|
If ReturnRepositoryKeyID NE True$ then ReturnRepositoryKeyID = False$
|
|
|
|
ServiceModule = RetStack()<1>
|
|
ServiceKeyID = ServiceModule : '*' : Service : '*' : Resource : '*' : ReturnRepositoryKeyID
|
|
WebAPI = Memory_Services('GetValue', ServiceKeyID, True$, 10, CacheName$)
|
|
|
|
If WebAPI EQ '' then
|
|
Convert @Lower_Case to @Upper_Case in Resource
|
|
NumApps = Count(@APPID, @FM) + (@APPID NE '')
|
|
For AppCnt = 1 to NumApps
|
|
AppID = @APPID<AppCnt>
|
|
If AppID _EQC 'SYSPROG' then
|
|
SysObjKey = '$' : Resource : '_API'
|
|
end else
|
|
SysObjKey = '$' : Resource : '_API' : '*' : @APPID<AppCnt>
|
|
end
|
|
ObjExists = (Xlate('SYSOBJ', SysObjKey, 0, 'X') GT '')
|
|
Until ObjExists
|
|
Next AppCnt
|
|
|
|
If ObjExists then
|
|
WebAPI = Resource : '_API'
|
|
If ReturnRepositoryKeyID EQ True$ then
|
|
WebAPI = AppID : '*STPROC**' : WebAPI
|
|
end
|
|
end
|
|
Memory_Services('SetValue', ServiceKeyID, WebAPI, CacheName$)
|
|
end
|
|
|
|
Response = WebAPI
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// UpdateWebAPIs
|
|
//
|
|
// Creates or updates exist web API procedures as needed based on the indicated resource list. If at least one new API
|
|
// has been updated, this service will return a True$. Otherwise a False$ will be returned. Note: this will not
|
|
// remove existing API procedures or individual APIs even if the resource is no longer referenced. The MakeLocal
|
|
// argument can indicate if inherited APIs should be made local in order to be updated and compiled successfully.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service UpdateWebAPIs(ResourceList, MakeLocal=BOOLEAN)
|
|
|
|
// Assume no inherited APIs will be made local
|
|
If MakeLocal NE True$ then MakeLocal = False$
|
|
APIsUpdated = False$
|
|
|
|
If ResourceList EQ '' then ResourceList = HTTP_Resource_Manager_Services('GetResourceList')
|
|
|
|
If ResourceList NE '' then
|
|
For Each ResourceItem in ResourceList using @FM setting fPos
|
|
EndpointPattern = ResourceItem<0, 2>
|
|
EndpointName = ResourceItem<0, 3>
|
|
Convert @Upper_Case to @Lower_Case in EndpointPattern
|
|
Convert @Upper_Case to @Lower_Case in EndpointName
|
|
// Strip off the preceding "/", if any, to make the endpoint pattern uniform.
|
|
If EndpointPattern[1, 1] EQ '/' then EndpointPattern = EndpointPattern[2, 999]
|
|
// Temporarily convert "/" to @FM to make it easier to reference the segments.
|
|
Convert '/' to @FM in EndpointPattern
|
|
NumSegments = DCount(EndpointPattern, @FM)
|
|
EndpointType = ResourceItem<0, 5>
|
|
// Set the current resource (if appropriate) and swap out the unique resource ID with
|
|
// a generic "{ResourceID}" placeholder where appropriate.
|
|
Begin Case
|
|
Case (EndpointType EQ 'APIROOT') OR (EndpointType EQ 'RESOURCE')
|
|
If EndpointType EQ 'APIROOT' then
|
|
CurrentResource = 'APIROOT'
|
|
end else
|
|
CurrentResource = EndpointName
|
|
end
|
|
If NumSegments GT 1 then
|
|
If EndpointPattern<NumSegments - 1>[1, 1] EQ '{' then
|
|
EndpointPattern<NumSegments - 1> = '{ResourceID}'
|
|
end
|
|
end
|
|
Case EndpointType EQ 'RESOURCE_ID'
|
|
CurrentResource = EndpointPattern<NumSegments - 1>
|
|
EndpointPattern<NumSegments> = '{ResourceID}'
|
|
Case EndpointType EQ 'PROPERTY'
|
|
If EndpointPattern<NumSegments - 1>[1, 1] EQ '{' then
|
|
CurrentResource = EndpointPattern<NumSegments - 2>
|
|
EndpointPattern<NumSegments - 1> = '{ResourceID}'
|
|
end else
|
|
CurrentResource = EndpointPattern<NumSegments - 1>
|
|
end
|
|
End Case
|
|
|
|
// Restore the "/" in the endpoint. This is now the Key ID to the endpoint that will be stored in
|
|
// memory.
|
|
Convert @FM to '/' in EndpointPattern
|
|
|
|
// Identify the API signatures needed for this endpoint.
|
|
APISignatures = ''
|
|
Methods = HTTP_Resource_Manager_Services('GetResourceProperty', EndpointPattern, 'METHODS')
|
|
If Methods NE '' then
|
|
For Each Method in Methods using ',' setting MethodPos
|
|
APISignatures := HTTP_Resource_Manager_Services('GetResourceSignature', EndpointPattern, Method) : ','
|
|
Next Method
|
|
end
|
|
APISignatures[-1, 1] = ''
|
|
|
|
CurrentResource = Oconv(CurrentResource, 'MCT')
|
|
APIProcedureName = Oconv(CurrentResource, 'MCU') : '_API'
|
|
|
|
// Check to see if the API procedure for the current resource exists. If not, then attempt to create one.
|
|
WebAPI = HTTP_Services('GetWebAPI', CurrentResource, True$)
|
|
If WebAPI EQ '' then
|
|
APISignatureKeyID = HTTP_Services('GetLocalAppKeyID', APISignatureKeyID$)
|
|
APISignature = Database_Services('ReadDataRow', SetupTable$, APISignatureKeyID)
|
|
APICommentBlockKeyID = HTTP_Services('GetLocalAppKeyID', APICommentBlockKeyID$)
|
|
APICommentBlock = Database_Services('ReadDataRow', SetupTable$, APICommentBlockKeyID)
|
|
APIBodyBlockKeyID = HTTP_Services('GetLocalAppKeyID', APIBodyBlockKeyID$)
|
|
APIBody = Database_Services('ReadDataRow', SetupTable$, APIBodyBlockKeyID)
|
|
APIProcedure = APISignature : @FM : APICommentBlock : @FM : APIBody
|
|
Swap '<Resource>' with CurrentResource in APIProcedure
|
|
Swap 'MM/DD/YY' with Oconv(Date(), 'D2/') in APIProcedure
|
|
GoSub CreateNewAPI
|
|
end
|
|
|
|
// Confirm that the API procedure exists along with associated API signatures. Then check to see if any new
|
|
// API signatures need to be added to the API procedure.
|
|
If (WebAPI NE '') AND (APISignatures NE '') then
|
|
// Web API procedure exists. Make sure all API signatures exist.
|
|
WebAPIAppID = WebAPI[1, '*']
|
|
TypeID = WebAPI[Col2() + 1, '*']
|
|
ClassID = WebAPI[Col2() + 1, '*']
|
|
EntityID = WebAPI[Col2() + 1, '*']
|
|
ThisAppID = @AppId<1>
|
|
rv = Set_Status(0)
|
|
APIProcedure = Repository('ACCESS', WebAPI)
|
|
If Get_Status(StatusCode) then
|
|
Error_Services('Add', 'Error accessing the ' : APIProcedureName : ' procedure. Get_Status: ' : StatusCode)
|
|
WebAPI = ''
|
|
end else
|
|
Swap \0D0A\ with @FM in APIProcedure
|
|
CompareAPIProcedure = APIProcedure
|
|
// Strip away excess @FM (lines) from the source code.
|
|
Loop
|
|
Until APIProcedure[-1, 1] NE @FM
|
|
APIProcedure[-1, 1] = ''
|
|
Repeat
|
|
For Each APISignature in APISignatures using ','
|
|
Method = APISignature[-1, 'B.']
|
|
If IndexC(APIProcedure, 'API ' : APISignature, 1) else
|
|
// API signature doesn't exist so append it to the bottom.
|
|
APIProcedure := @FM : @FM : @FM : 'API ' : APISignature : @FM : @FM : " HTTP_Resource_Services('LoremIpsum')" : @FM : @FM : 'end api'
|
|
end
|
|
If Method EQ 'GET' then
|
|
// Make sure the HEAD API is also present.
|
|
Locate 'API ' : APISignature in APIProcedure using @FM setting fPos then
|
|
APISignature[-3, 3] = 'HEAD'
|
|
If IndexC(APIProcedure, 'API ' : APISignature, 1) else
|
|
// The HEAD API signature doesn't exist so insert it before the GET API.
|
|
APIProcedure = Insert(APIProcedure, fPos, 0, 0, 'API ' : APISignature)
|
|
end
|
|
end
|
|
end
|
|
Next APISignature
|
|
If APIProcedure NE CompareAPIProcedure then
|
|
// A change has been made so attempt to update and compile.
|
|
If (WebAPIAppID NE ThisAppID) AND (MakeLocal EQ True$) then
|
|
// The existing WebAPI belongs to an inherited application. The flag to make this local has been set so create a copy of the Web API.
|
|
GoSub CreateNewAPI
|
|
end else
|
|
GoSub UpdateCurrentAPI
|
|
end
|
|
end
|
|
end
|
|
end
|
|
Until Error_Services('HasError') EQ True$
|
|
Next ResourceItem
|
|
end else
|
|
Error_Services('Add', 'The ResourceList argument is missing in the ' : Service : ' service.')
|
|
end
|
|
|
|
Response = APIsUpdated
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetLocalAppKeyID
|
|
//
|
|
// Returns the local application KeyID for the indicated row. If one does not exist, the FRAMEWORKS row will be copied.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetLocalAppKeyID(BaseAppKeyID)
|
|
|
|
LocalAppKeyID = ''
|
|
|
|
RowFound = False$
|
|
LocalAppKeyID = BaseAppKeyID : '*' : @APPID<1>
|
|
NumApps = Count(@APPID, @FM) + (@APPID NE '')
|
|
For AppCnt = 1 to NumApps
|
|
AppID = @APPID<AppCnt>
|
|
If AppID _EQC 'SYSPROG' then
|
|
SetupKeyID = BaseAppKeyID
|
|
end else
|
|
SetupKeyID = BaseAppKeyID : '*' : AppID
|
|
end
|
|
SetupRow = Database_Services('ReadDataRow', SetupTable$, SetupKeyID)
|
|
If SetupRow NE '' then
|
|
RowFound = True$
|
|
If SetupKeyID NE LocalAppKeyID then
|
|
Database_Services('WriteDataRow', SetupTable$, LocalAppKeyID, SetupRow)
|
|
end
|
|
end
|
|
Until RowFound
|
|
Next AppCnt
|
|
|
|
Response = LocalAppKeyID
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetEndpoint
|
|
//
|
|
// Returns the endpoint for the current request. If this is the entry point then "APIROOT" will be returned so the
|
|
// caller knows explicitly what type of endpoint this is.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetEndpoint()
|
|
|
|
Endpoint = HTTP_Services('GetHTTPPathInfo')
|
|
// If the endpoint is still empty, this emplies the API entry point. Assign the value "APIROOT" so that it can be
|
|
// used to map to the appropriate web API procedure.
|
|
If Endpoint EQ '' then Endpoint = 'APIROOT'
|
|
|
|
Response = Endpoint
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// IsValidEndpoint - Deprecated
|
|
//
|
|
// Returns a Boolean flag indicating if the indicated endpoint is valid based on the defined resources. If the Endpoint
|
|
// argument is empty, the GetEndpoint services will be used to identify the endpoint.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service IsValidEndpoint(Endpoint)
|
|
|
|
ValidEndpoint = True$ ; // Assume the endpoint is valid for now.
|
|
If Endpoint EQ '' then Endpoint = HTTP_Services('GetEndpoint')
|
|
|
|
// Create a list of supported web APIs based on the defined endpoints in the setup record.
|
|
HTTP_Services('SetSupportedEndpoints')
|
|
// Get the endpoint pattern for the current endpoint.
|
|
EndpointPattern = HTTP_Services('GetEndpointPattern', Endpoint)
|
|
|
|
If Error_Services('NoError') then
|
|
// The endpoint has been modified into a well-formed pattern. If it did not fail any obvious validation checks,
|
|
// see if there is an actual resource associated with this endpoint and respond accordingly.
|
|
Resource = Memory_Services('GetValue', 'API*' : EndpointPattern : '*RESOURCE', '', '', CacheName$)
|
|
If Resource EQ '' then
|
|
ValidEndpoint = False$
|
|
end
|
|
end
|
|
|
|
Response = ValidEndpoint
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// SetSupportedEndpoints - Deprecated
|
|
//
|
|
// Creates a memory-resident lookup of all the supported endpoints, properties, methods, query params, and logging flag.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service SetSupportedEndpoints()
|
|
|
|
ServiceKeyID = Service
|
|
AlreadySet = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If Not(AlreadySet) then
|
|
// Create a list of supported web APIs based on the defined endpoints in the setup record.
|
|
ResourcesKeyID = HTTP_Services('GetLocalAppKeyID', ResourcesKeyID$)
|
|
ResourceList = Database_Services('ReadDataRow', SetupTable$, ResourcesKeyID)
|
|
// Loop through the resource list to find a matching pattern. Otherwise, this is an invalid endpoint.
|
|
If ResourceList NE '' then
|
|
For Each ResourceItem in ResourceList using @FM setting fPos
|
|
EndpointPattern = ResourceItem<0, 2>
|
|
EndpointName = ResourceItem<0, 3>
|
|
Convert @Upper_Case to @Lower_Case in EndpointPattern
|
|
Convert @Upper_Case to @Lower_Case in EndpointName
|
|
// Strip off the preceding "/", if any, to make the endpoint pattern uniform.
|
|
If EndpointPattern[1, 1] EQ '/' then EndpointPattern = EndpointPattern[2, 999]
|
|
// Temporarily convert "/" to @FM to make it easier to reference the segments.
|
|
Convert '/' to @FM in EndpointPattern
|
|
NumSegments = DCount(EndpointPattern, @FM)
|
|
EndpointType = ResourceItem<0, 5>
|
|
|
|
// Swap out the unique resource ID with a generic "{ResourceID}" placeholder where appropriate.
|
|
NewEndpointPattern = ''
|
|
For Each Segment in EndpointPattern using @FM
|
|
If Segment[1, 1] EQ '{' then Segment = '{ResourceID}'
|
|
NewEndpointPattern := Segment : @FM
|
|
Next Segment
|
|
NewEndpointPattern[-1, 1] = ''
|
|
Transfer NewEndpointPattern to EndpointPattern
|
|
|
|
// For each resource item, identify the current resource, properties, sub-resources, methods, and valid
|
|
// query params.
|
|
Begin Case
|
|
Case (EndpointType EQ 'APIROOT') OR (EndpointType EQ 'RESOURCE')
|
|
If EndpointType EQ 'APIROOT' then
|
|
CurrentResource = EndpointType
|
|
end else
|
|
CurrentResource = EndpointName
|
|
end
|
|
Memory_Services('SetValue', 'API*' : CurrentResource : '*HAS_RESOURCE_ID', False$, CacheName$) ; // Assume no for now.
|
|
Memory_Services('SetValue', 'API*' : CurrentResource : '*PROPERTIES', '', CacheName$) ; // Assume none for now.
|
|
Memory_Services('SetValue', 'API*' : CurrentResource : '*SUB_RESOURCES', '', CacheName$) ; // Assume none for now.
|
|
If NumSegments GT 1 then
|
|
If EndpointPattern<NumSegments - 1>[1, 1] NE '{' then
|
|
// The previous segment is not a resource ID, so update the sub-resource list.
|
|
ParentResource = EndpointPattern<NumSegments - 1>
|
|
SubResources = Memory_Services('GetValue', 'API*' : ParentResource : '*SUB_RESOURCES', '', '', CacheName$)
|
|
SubResources := EndpointName : @FM
|
|
Memory_Services('SetValue', 'API*' : ParentResource : '*SUB_RESOURCES', SubResources, CacheName$)
|
|
end
|
|
end
|
|
Case EndpointType EQ 'RESOURCE_ID'
|
|
CurrentResource = EndpointPattern<NumSegments - 1>
|
|
Memory_Services('SetValue', 'API*' : CurrentResource : '*HAS_RESOURCE_ID', True$, CacheName$)
|
|
Memory_Services('SetValue', 'API*' : CurrentResource : '*{ResourceID}*PROPERTIES', '', CacheName$) ; // Assume none for now.
|
|
Case EndpointType EQ 'PROPERTY'
|
|
If EndpointPattern<NumSegments - 1>[1, 1] EQ '{' then
|
|
CurrentResource = EndpointPattern<NumSegments - 2>
|
|
Properties = Memory_Services('GetValue', 'API*' : CurrentResource : '*{ResourceID}*PROPERTIES', '', '', CacheName$)
|
|
Properties := EndpointName : @FM
|
|
Memory_Services('SetValue', 'API*' : CurrentResource : '*{ResourceID}*PROPERTIES', Properties, CacheName$)
|
|
end else
|
|
CurrentResource = EndpointPattern<NumSegments - 1>
|
|
Properties = Memory_Services('GetValue', 'API*' : CurrentResource : '*PROPERTIES', '', '', CacheName$)
|
|
Properties := EndpointName : @FM
|
|
Memory_Services('SetValue', 'API*' : CurrentResource : '*PROPERTIES', Properties, CacheName$)
|
|
end
|
|
End Case
|
|
// Restore the "/" in the endpoint. This is now the Key ID to the endpoint that will be stored in
|
|
// memory.
|
|
Convert @FM to '/' in EndpointPattern
|
|
Memory_Services('SetValue', 'API*' : EndpointPattern : '*RESOURCE', CurrentResource, CacheName$)
|
|
// Identify the HTTP methods and Query Params that this endpoint supports.
|
|
EndpointElements = ResourceItem<0, 19>
|
|
If EndpointElements NE '' then
|
|
For Each EndpointElement in EndpointElements using @SVM setting svmPos
|
|
ElementName = EndpointElement[1, @TM]
|
|
ElementValue = EndpointElement[Col2() + 1, @TM]
|
|
Begin Case
|
|
Case ElementName _EQC 'METHODS'
|
|
Memory_Services('SetValue', 'API*' : EndpointPattern : '*METHODS', ElementValue, CacheName$)
|
|
Case ElementName _EQC 'QUERY_PARAMS'
|
|
Memory_Services('SetValue', 'API*' : EndpointPattern : '*QUERY_PARAMS', ElementValue, CacheName$)
|
|
Case ElementName _EQC 'EXCLUDE_LOGGING'
|
|
Memory_Services('SetValue', 'API*' : EndpointPattern : '*EXCLUDE_LOGGING', ElementValue, CacheName$)
|
|
End Case
|
|
Next EndpointElement
|
|
end
|
|
Next ResourceItem
|
|
end
|
|
Memory_Services('SetValue', ServiceKeyID, True$, CacheName$)
|
|
end
|
|
|
|
end service
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
// GetEndpointPattern - Deprecated
|
|
//
|
|
// Returns the generic endpoint format for the indicated actual request endpoint. This replaces specific resource IDs
|
|
// with the "{ResourceID}" place holder. If the Endpoint argument is empty, the GetEndpoint services will be used to
|
|
// identify the endpoint.
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
Service GetEndpointPattern(Endpoint)
|
|
|
|
If Endpoint EQ '' then Endpoint = HTTP_Services('GetEndpoint')
|
|
|
|
ServiceKeyID = Service : '*' : Endpoint
|
|
EndpointPattern = Memory_Services('GetValue', ServiceKeyID, '', '', CacheName$)
|
|
|
|
If EndpointPattern EQ '' then
|
|
// Create a list of supported web APIs based on the defined endpoints in the setup record. This might already
|
|
// be done, but the SetSupportedEndpoints tracks this so it won't waste time doing it again.
|
|
HTTP_Services('SetSupportedEndpoints')
|
|
// Attempt to map the actual endpoint with a endpoint pattern to validate the API as well as supported HTTP methods.
|
|
ValidEndpoint = True$ ; // Assume true for now.
|
|
APISignature = '' ; // This will be the actual API passed into the resource API routine if valid.
|
|
For Each Segment in Endpoint using '/' setting SegmentNo
|
|
Convert @Upper_Case to @Lower_Case in Segment
|
|
Begin Case
|
|
Case SegmentNo EQ 1
|
|
// The first segment is always a resource.
|
|
CurrentResource = Segment
|
|
EndpointPattern := Segment : '/'
|
|
APISignature = Segment : '.'
|
|
LastEndpointType = 'RESOURCE'
|
|
Case LastEndpointType EQ 'RESOURCE'
|
|
Properties = Memory_Services('GetValue', 'API*' : CurrentResource : '*PROPERTIES', '', '', CacheName$)
|
|
SubResources = Memory_Services('GetValue', 'API*' : CurrentResource : '*SUB_RESOURCES', '', '', CacheName$)
|
|
Locate Segment in Properties using @FM setting fPos then
|
|
EndpointPattern := Segment : '/'
|
|
APISignature := Segment : '.'
|
|
LastEndpointType = 'PROPERTY'
|
|
end else
|
|
Locate Segment in SubResources using @FM setting fPos then
|
|
CurrentResource = Segment
|
|
EndpointPattern := Segment : '/'
|
|
APISignature = Segment : '.'
|
|
LastEndpointType = 'RESOURCE'
|
|
end else
|
|
If Memory_Services('GetValue', 'API*' : CurrentResource : '*HAS_RESOURCE_ID', '', '', CacheName$) EQ True$ then
|
|
EndpointPattern := '{ResourceID}/'
|
|
APISignature := 'ID.'
|
|
LastEndpointType = 'RESOURCE_ID'
|
|
end else
|
|
ValidEndpoint = False$
|
|
end
|
|
end
|
|
end
|
|
Case LastEndpointType EQ 'RESOURCE_ID'
|
|
EndpointPattern := Segment : '/'
|
|
Properties = Memory_Services('GetValue', 'API*' : CurrentResource : '*{ResourceID}*PROPERTIES', '', '', CacheName$)
|
|
Locate Segment in Properties using @FM setting fPos then
|
|
LastEndpointType = 'PROPERTY'
|
|
APISignature := Segment : '.'
|
|
end else
|
|
CurrentResource = Segment
|
|
APISignature = Segment : '.'
|
|
LastEndpointType = 'RESOURCE'
|
|
end
|
|
Case LastEndpointType EQ 'PROPERTY'
|
|
// There shouldn't be any more segments, so consider this an invalid endpoint.
|
|
ValidEndpoint = False$
|
|
End Case
|
|
While ValidEndpoint EQ True$
|
|
Next Segment
|
|
EndpointPattern[-1, 1] = ''
|
|
Memory_Services('SetValue', ServiceKeyID, EndpointPattern, CacheName$)
|
|
end
|
|
|
|
Response = EndpointPattern
|
|
|
|
end service
|
|
|
|
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
// Internal Gosubs
|
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
//
|
|
// Create a new Web API in the local application.
|
|
//
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
CreateNewAPI:
|
|
|
|
WebAPI = @AppId<1> : '*STPROC**' : APIProcedureName
|
|
rv = Set_Status(0)
|
|
Repository('NEW', WebAPI, '', 1, 1, '', '', '', '', '', APIProcedureName, APIProcedure)
|
|
If Get_Status(StatusCode) then
|
|
Error_Services('Add', 'Error creating the ' : APIProcedureName : ' procedure. Get_Status: ' : StatusCode)
|
|
WebAPI = ''
|
|
end else
|
|
APIsUpdated = True$
|
|
Repository('COMPILE', WebAPI, 1, '', 1)
|
|
If Get_Status(StatusCode) then
|
|
Error_Services('Add', 'Error compiling the ' : APIProcedureName : ' procedure. Get_Status: ' : StatusCode)
|
|
WebAPI = ''
|
|
end
|
|
end
|
|
|
|
return
|
|
|
|
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
//
|
|
// Update a current Web API in the local application.
|
|
//
|
|
//----------------------------------------------------------------------------------------------------------------------
|
|
UpdateCurrentAPI:
|
|
|
|
rv = Set_Status(0)
|
|
Repository('UPDATE', WebAPI, APIProcedure)
|
|
If Get_Status(StatusCode) then
|
|
If (StatusCode<1, 1> EQ REP_APP_INHERIT_MOD_ERR$) AND (MakeLocal EQ True$) then
|
|
APIsUpdated = True$
|
|
end else
|
|
Error_Services('Add', 'Error updating the ' : APIProcedureName : ' procedure. Get_Status: ' : StatusCode<1, 1> : ' - ' : StatusCode<1, 2>)
|
|
WebAPI = ''
|
|
end
|
|
end else
|
|
APIsUpdated = True$
|
|
Repository('COMPILE', WebAPI, 1, '', 1)
|
|
If Get_Status(StatusCode) then
|
|
Error_Services('Add', 'Error compiling the ' : APIProcedureName : ' procedure. Get_Status: ' : StatusCode)
|
|
WebAPI = ''
|
|
end
|
|
end
|
|
|
|
return
|