Function HTTP_Services(@Service, @Params) /*********************************************************************************************************************** This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written permission from SRP Computer Solutions, Inc. Name : 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. 07/11/20 dmb [SRPFW-313] Fix bug in the AddBannedIP service to contactenate the IP using @VM rather than @FM. 07/22/20 dmb Update the AddBannedIP service to check first to see if the IP is whitelisted. If so, then don't add the IP to the banned list. 07/23/20 dmb [SRPFW-313] Fix bug in the IsIPWhitelisted and IsIPBanned services that would consider an IP to be in the list if the IP characters are exactly the same as in the list but the list IPs have additional characters. 07/26/20 dmb [SRPFW-313] Add the GetWhitelistedIPsType service. 07/26/20 dmb [SRPFW-313] Update the IPIsPermitted service to support the new Whitelisted IP type value. 07/26/20 dmb [SRPFW-313] Add the IsIPPermitted service as a synonym to the IPIsPermitted service. This name conforms to the IsIPWhitelisted and IsIPBanned service names. 10/28/21 dmb Update the SetRequestHeaderFields service to first check to see if the field begins with "HTTP_" before stripping it out. This allows for support of OECGI 4.0.2.0. 10/28/21 dmb Update the DecodePercentString service to use SRP_Decode(String, 'URL') instead of successive Swap statements. This fixes a problem where subsequent swaps are unaware of legitmate % characters and attempts to swap them again. 12/22/21 dmb Update the CreateLogFile and SetOECGIRequest services to use the official ADDITIONAL_VALUES_STRING$ equate. ***********************************************************************************************************************/ #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' Equ OnlyAllowWhitelistedIPs$ to 1 Equ AlwaysAllowWhitelistedIPs$ to 2 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: _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__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 If AppID _EQC 'SYSPROG' then SysObjKey = '$HTTP_' : HTTPService : '_SERVICES' end else SysObjKey = '$HTTP_' : HTTPService : '_SERVICES' : '*' : @APPID end IsHTTPService = (Index(HTTPServiceList@, SysObjKey, 1) GT 0) Until IsHTTPService Next AppCnt If Not(IsHTTPService) then For AppCnt = 1 to NumApps AppID = @APPID If AppID _EQC 'SYSPROG' then SysObjKey = '$HTTP_' : HTTPService : '_SERVICES' end else SysObjKey = '$HTTP_' : HTTPService : '_SERVICES' : '*' : @APPID 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 If AppID _EQC 'SYSPROG' then SysObjKey = '$' : HTTPService end else SysObjKey = '$' : HTTPService : '*' : @APPID end IsHTTPService = (Index(HTTPServiceList@, SysObjKey, 1) GT 0) Until IsHTTPService Next AppCnt end If Not(IsHTTPService) then For AppCnt = 1 to NumApps AppID = @APPID If AppID _EQC 'SYSPROG' then SysObjKey = '$' : HTTPService end else SysObjKey = '$' : HTTPService : '*' : @APPID 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 : CRLF$ PathInfo = Request LogBody := Fmt('<02> HTTPPathInfo', 'L#30') : ': ' : PathInfo : CRLF$ LogBody := Fmt('<03> HTTPContentType', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<04> HTTPContentLength', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<05> HTTPGatewayInterface', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<06> HTTPHTTPS', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<07> HTTPAccept', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<08> HTTPCookie', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<09> HTTPFrom', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<10> HTTPReferer', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<11> HTTPUserAgent', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<12> HTTPTranslated', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<13> HTTPRemoteAddr', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<14> HTTPRemoteHost', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<15> HTTPRemoteIdent', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<16> HTTPRemoteUser', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<17> HTTPRequestMethod', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<18> HTTPScriptName', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<19> HTTPServerName', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<20> HTTPServerPort', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<21> HTTPServerProtocol', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<22> HTTPServerSoftware', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<23> HTTPServerURL', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<24> HTTPNoURLDecode', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<25> HTTPResponseIsBinary', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<26> HTTPRegistrySettings', 'L#30') : '+ ' : CRLF$ RegistrySettings = Request 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 : CRLF$ LogBody := Fmt('<28> HTTPGetString', 'L#30') : ': ' : Request : CRLF$ LogBody := Fmt('<29> HTTPPostString', 'L#30') : ': ' : HTTP_Services('DecodePercentString', Request) : CRLF$ LogBody := Fmt('<30> HTTPAdditionalValues', 'L#30') : '+ ' : CRLF$ NumAdditionalNames = DCount(AdditionalNames, ',') AdditionalValues = Request 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 : @FM : Request : @FM : HTTP_Services('GetAPIRootURL', False$) : PathInfo : @FM : Request 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, 'STRING') SRP_JSON(hProcObj, 'SETVALUE', 'LineNo', CallStack, '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 ScriptName = Request // 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 = PathInfo Memory_Services('SetValue', 'HTTPQueryString', Request, CacheName$) Memory_Services('SetValue', 'HTTPPathInfo', Request, CacheName$) Memory_Services('SetValue', 'HTTPContentType', Request, CacheName$) Memory_Services('SetValue', 'HTTPContentLength', Request, CacheName$) Memory_Services('SetValue', 'HTTPGatewayInterface', Request, CacheName$) Memory_Services('SetValue', 'HTTPHTTPS', Request, CacheName$) Memory_Services('SetValue', 'HTTPAccept', Request, CacheName$) Memory_Services('SetValue', 'HTTPCookie', Request, CacheName$) Memory_Services('SetValue', 'HTTPFrom', Request, CacheName$) Memory_Services('SetValue', 'HTTPReferer', Request, CacheName$) Memory_Services('SetValue', 'HTTPUserAgent', Request, CacheName$) Memory_Services('SetValue', 'HTTPTranslated', Request, CacheName$) Memory_Services('SetValue', 'HTTPRemoteAddr', Request, CacheName$) Memory_Services('SetValue', 'HTTPRemoteHost', Request, CacheName$) Memory_Services('SetValue', 'HTTPRemoteIdent', Request, CacheName$) Memory_Services('SetValue', 'HTTPRemoteUser', Request, CacheName$) Memory_Services('SetValue', 'HTTPRequestMethod', Request, CacheName$) Memory_Services('SetValue', 'HTTPScriptName', Request, CacheName$) Memory_Services('SetValue', 'HTTPServerName', Request, CacheName$) Memory_Services('SetValue', 'HTTPServerPort', Request, CacheName$) Memory_Services('SetValue', 'HTTPServerProtocol', Request, CacheName$) Memory_Services('SetValue', 'HTTPServerSoftware', Request, CacheName$) Memory_Services('SetValue', 'HTTPServerURL', Request, CacheName$) Memory_Services('SetValue', 'HTTPNoURLDecode', Request, CacheName$) Memory_Services('SetValue', 'HTTPResponseIsBinary', Request, CacheName$) Memory_Services('SetValue', 'HTTPRegistrySettings', Request, CacheName$) Memory_Services('SetValue', 'HTTPOECGIVersion', Request, CacheName$) Memory_Services('SetValue', 'HTTPGetString', Request, CacheName$) Memory_Services('SetValue', 'HTTPPostString', Request, CacheName$) Memory_Services('SetValue', 'HTTPAdditionalValues', Request, 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) If Name[1, 5] EQ 'HTTP_' then 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@ = Name RequestHeaderValues@ = 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 : Value with // an extra 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@ : ': ' : RequestHeaderValues@ : 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@ 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 Value = QueryString 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@ = Field QueryValues@ = 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@ 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@ 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@ = Name ResponseHeaderValues@ = 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 : Value with // an extra 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@ : ': ' : ResponseHeaderValues@ : 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@ 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 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 = SRP_Decode(String, 'URL') 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 '%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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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) 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 = IP 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 GE StartingRange) AND (IP LE EndingRange) then IPOption = IP end end end end Next IPelement If IP _EQC IPOption then IPWhitelisted = True$ Until IPWhitelisted EQ True$ Next IPOption end Response = IPWhitelisted end service //---------------------------------------------------------------------------------------------------------------------- // GetWhitelistedIPsType // // Returns the whitelisted IPs type. It pulls this from SYSENV\HTTP_FRAMEWORK_SETUP_WHITELISTED_IPS_TYPE <22>. Type // will either be a 1 (these IPs will only be permitted) or a 2 (these IPs will always be permitted). //---------------------------------------------------------------------------------------------------------------------- Service GetWhitelistedIPsType() SetupRowKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$) WhitelistedIPsType = Database_Services('ReadDataRow', SetupTable$, SetupRowKeyID) If WhitelistedIPsType NE 2 then WhitelistedIPsType = 1 Response = WhitelistedIPsType 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) 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 = IP 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 GE StartingRange) AND (IP LE EndingRange) then IPOption = IP end end end end Next IPelement If IP _EQC IPOption 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 IPWhitelisted = HTTP_Services('IsIPWhitelisted', IP) If IPWhitelisted NE True$ then LocalSetupKeyID = HTTP_Services('GetLocalAppKeyID', SetupRowKeyID$) SetupInfo = Database_Services('ReadDataRow', SetupTable$, LocalSetupKeyID) BannedIPs = SetupInfo BannedIPs<0, -1> = IP SetupInfo = 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 //---------------------------------------------------------------------------------------------------------------------- // 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 Locate IP in BannedIPs using @FM setting Pos then BannedIPs = Delete(BannedIPs, Pos, 0, 0) SetupInfo = 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 IsIPPermitted(IP) Service IPIsPermitted(IP) IsIPPermitted = False$ ; // Assume False for now. WhitelistIPsType = HTTP_Services('GetWhitelistedIPsType') If WhitelistIPsType EQ OnlyAllowWhitelistedIPs$ then // Type is that only whitelisted IPs can be allowed. However, these IPs can still be banned. If HTTP_Services('IsIPBanned', IP) EQ False$ then WhitelistedIPs = HTTP_Services('GetWhitelistedIPs') If WhitelistedIPs EQ '' then IsIPPermitted = True$ end else IsIPPermitted = HTTP_Services('IsIPWhitelisted', IP) end end end else // Type must be that whitelisted IPs will always be allowed. These IPs cannot be banned, even if they appear in // the ban list. IPWhitelisted = HTTP_Services('IsIPWhitelisted', IP) If IPWhitelisted then IsIPPermitted = True$ end else IsIPPermitted = Not(HTTP_Services('IsIPBanned', IP)) end end Response = IsIPPermitted 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 If Len(Priority) then Priority = Priority[-1, 1] If Not(Num(Priority)) then Priority = 1 end else Priority = 10 end ClientOptions = 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 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 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 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 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) 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) 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) 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) 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) 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) 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 If AppID _EQC 'SYSPROG' then SysObjKey = '$' : Resource : '_API' end else SysObjKey = '$' : Resource : '_API' : '*' : @APPID 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[1, 1] EQ '{' then EndpointPattern = '{ResourceID}' end end Case EndpointType EQ 'RESOURCE_ID' CurrentResource = EndpointPattern EndpointPattern = '{ResourceID}' Case EndpointType EQ 'PROPERTY' If EndpointPattern[1, 1] EQ '{' then CurrentResource = EndpointPattern EndpointPattern = '{ResourceID}' end else CurrentResource = EndpointPattern 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 '' 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 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[1, 1] NE '{' then // The previous segment is not a resource ID, so update the sub-resource list. ParentResource = EndpointPattern 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 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[1, 1] EQ '{' then CurrentResource = EndpointPattern 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 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