added frameworks entities

FRAMEWORKS/STPROC/APIROOT_API.txt

@@ -0,0 +1,100 @@
+Function APIRoot_API(@API)
+/***********************************************************************************************************************
+
+    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        :   APIRoot_API
+
+    Description :   API logic for the Apiroot resource.
+
+    Notes       :   All web APIs should include the API_SETUP insert. This will provide several useful variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        FullEndpointURL         - The URL submitted by the client, including query params.
+                        FullEndpointURLNoQuery  - The URL submitted by the client, excluding query params.
+                        ParentURL               - The URL path preceeding the current endpoint.
+                                                  the SelfURL.
+                        CurrentAPI              - The name of this stored procedure.
+
+    Parameters  :
+        API             [in] -- Web API to process. Format is [APIPattern].[HTTPMethod]:
+                                    - APIPattern must follow this structure <Resource>[.ID.[<Property>]]
+                                    - HTTPMethod can be any valid HTTP method, e.g., GET, POST, PUT, DELETE, etc.
+                                Examples:
+                                    - APIROOT.POST
+                                    - APIROOT.ID.PUT
+                                    - APIROOT.ID.firstName.GET
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        11/19/18    dmb     Original programmer.
+        04/09/19    dmb     [SRPFW-271] Update the APIROOT.GET API to verify that the AuthenticatedAccountID has a value
+                            before adding the resetPassword form action.
+        04/29/19    dmb     Update the APIROOT.GET API to verify the sub-resource has at least one HTTP method before
+                            adding it.
+        05/28/19    dmb     [SRPFW-274] Replace all references to AddLinkRelationship with AddLinkRelation.
+        07/16/19    dmb     [SRPFW-277] Retrofit APIROOT.GET API to use the HTTP_Resource_Manager_Services module.
+        01/23/20    dmb     [SRPFW-296] Add matching HEAD APIs for all GET APIs.
+        01/26/20    dmb     [SRPFW-296] Update the APIROOT.GET API so link relations are templated whenever possible.
+        02/13/20    dmb     [SRPFW-311] Fix a minor typo in the APIROOT.GET API.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert API_SETUP
+$insert HTTP_INSERTS
+$insert HTTP_FRAMEWORK_SETUP_EQUATES
+
+Declare function    Database_Services, HTTP_Resource_Manager_Services
+
+GoToAPI else
+    // The specific resource endpoint doesn't have a API handler yet.
+    HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but a web API handler has not yet been created.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Endpoint Handlers
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+API APIROOT.HEAD
+API APIROOT.GET
+
+    objResource     = HTTP_Resource_Services('GetObject')
+    If Error_Services('NoError') then
+        HTTP_Resource_Services('AddLinkRelation', objResource, 'self', FullEndpointURL)
+        RootResources   = HTTP_Resource_Manager_Services('GetResourceChildren', FullEndpointURL, 'RESOURCE')
+        For Each Resource in RootResources using @FM
+            Methods = HTTP_Resource_Manager_Services('GetResourceProperty', Resource, 'METHODS')
+            If Methods NE '' then
+                Name    = HTTP_Resource_Manager_Services('GetResourceProperty', Resource, 'NAME')
+                Title   = HTTP_Resource_Manager_Services('GetResourceProperty', Resource, 'TITLE')
+                HTTP_Resource_Services('AddLinkRelation', objResource, Name, FullEndpointURL : '/' : Resource[-1, 'B/'], Title, True$)
+            end
+        Next Resource
+    end
+
+    If Error_Services('NoError') then
+        AuthenticatedAccountID  = HTTP_Authentication_Services('GetAuthenticatedAccountID')
+        If AuthenticatedAccountID NE '' then
+            HTTP_Resource_Services('AddFormAction', objResource, 'resetPassword', 'PATCH', FullEndpointURL : '/webaccounts/' : AuthenticatedAccountID : '/password', 'Reset Password', 'value', '' : @VM : True$ : @VM : True$)
+        end
+    end
+
+    If Error_Services('NoError') then
+        Services    = HTTP_Resource_Services('GetSerializedResource', objResource)
+        HTTP_Services('SetResponseBody', Services, False$, 'application/hal+json')
+    end else
+        HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+    end
+
+end api

FRAMEWORKS/STPROC/AUDIT_MANAGER.txt

@@ -0,0 +1,210 @@
+Subroutine Audit_Manager(ID, Table, CurrentRecord, OrigRecord, Activity)
+
+/***********************************************************************************************************************
+
+    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        :   Audit_Manager
+
+    Description :   Updates the Audit table to track modifications of a record.
+
+    Notes       :   This process is normally called by the Audit_Manager_MFS. It handles all of the audit trail
+                    management logic.
+
+    Parameters  :
+        AutoSet         [in] -- Allows automatic setting of the SYSTEM_MAINTENANCE record without user intervention.
+        SysFlag        [out] -- Returns True if the flag was set to stop people from logging in. Returns False if people
+                                are still allowed to log into the application.
+
+        ID                  [in] -- ID of the record.
+        Table               [in] -- Table name where the record being audited is stored.
+        CurrentRecord   [in/out] -- Current record as it will be written to disk. If the Activity is "Write" then the
+                                    audit fields will be updated.
+        OrigRecord          [in] -- If called by Audit_Manager_MFS then this is the original record, otherwise this
+                                    represents a marker for special audit tracking.
+        Activity            [in] -- Identifies the audit activity being performed: Read, Write, Delete, or anything else
+                                    if called directly for special audit tracking.
+
+
+
+    History     :   (Date, Initials, Notes)
+        05/19/05    axf     Initial Program (Original Program MFS_Update_History).
+        11/26/07    dmb     Code clean-up and refactoring.
+        04/05/13    dmb     Repalce SECURITY_EQUATES with Memory Services to get login security. - [SRPFW-9]
+
+***********************************************************************************************************************/
+
+$insert APP_INSERTS
+
+Declare Subroutine Msg, Lock_Record
+Declare Function RetStack, Memory_Services
+
+If Assigned(ID)             else ID             = ""
+If Assigned(Table)          else Table          = ""
+If Assigned(CurrentRecord)  else CurrentRecord  = ""
+If Assigned(OrigRecord)     else OrigRecord     = ""
+
+AuditManagerTable = "APP_INFO"
+
+Convert @Lower_Case to @Upper_Case In Table
+AuditTable  = 'AUDIT_' : Table
+Username    = @USERNAME
+
+* Declare function GetNetworkUsername
+* If GetNetworkUsername() EQ "dbakke1" AND Activity _NEC "READ" then debug
+
+Open AuditTable to HistoryCheck then
+    RecordTracker = No$
+    Locked_handle = ""
+    Temp_activity = ""
+    Success = ""
+    Details = ""
+    New = No$
+    TrackActivity = No$
+
+    CallProgName = RetStack()<2>
+
+    Gosub App_Info
+
+    If TrackActivity EQ Yes$ then Gosub Main_Process
+End
+
+Return
+
+App_Info:
+    Fields      = ""
+    Num_fields  = 0
+    Open AuditManagerTable to hAIT then
+        ReadO App_record from hAIT, "AUDIT_MANAGER_SETTINGS" then
+            Locate Table in App_record<1> using @VM setting vPos then
+                Begin Case
+                    Case ID EQ ""
+                        // Do nothing.
+
+                    Case CallProgName[1, 18] NE "AUDIT_MANAGER_MFS*"
+                        // Program is being called directly from a stored procedure.
+                        If App_record<6,vPos> EQ Yes$ Then
+                            If CurrentRecord NE "" Then 
+                                TrackActivity = Yes$                        
+                                RecordTracker = Yes$    ; // Flag to indicate that special audit tracking is ocurring
+                                Marker        = OrigRecord
+                                OrigRecord    = CurrentRecord
+                            End
+                        End
+
+                    Case Activity EQ "Write"
+                        If App_record<3,vPos> EQ Yes$ Then
+                            TrackActivity = Yes$
+                            Locate Table in App_record<1> using @VM setting Position then
+                                StartField = App_record<2, Position>
+                                If StartField Then
+                                    CurrentRecord<StartField> = Username
+                                    CurrentRecord<StartField + 1> = Date()
+                                    CurrentRecord<StartField + 2> = Time()
+                                End
+                            End
+                        End
+
+                    Case Activity EQ "Delete"
+                        If App_record<4,vPos> EQ Yes$ Then TrackActivity = Yes$
+
+                    Case Activity EQ "Read"
+                        If App_record<5,vPos> EQ Yes$ Then TrackActivity = Yes$
+
+                End Case            
+            end else
+*                Msg("|Unable to locate the ":Table:" information|in the Audit Manager Settings.|")
+            end
+        end else
+*            Msg("|Unable to read the Audit Manager Settings Record.|")
+        end
+    end else
+*        Msg("|Unable to open the App_Info Table.|")
+    end
+return
+
+
+Main_Process:
+    Lock_Record(AuditTable, Locked_handle, ID, Lock$, No$, Yes$, Success)
+    If Success then
+        Read AuditTrail from Locked_handle, ID then
+            Num_items = Count(AuditTrail<1>, @VM) + (AuditTrail<1> NE "")
+*            If Len(AuditTrail) GT 250000 then
+*                For DelNumItems = 1 to 100
+*                    For Loop = 1 to 8
+*                        AuditTrail = Delete(AuditTrail, Loop, Num_items, 0)
+*                    Next Loop
+*                    Num_items -= 1
+*                Next DelNumItems
+*            end
+        end else
+            AuditTrail = ""
+            New = Yes$
+        end
+        Current_date = Date()
+        Current_time = Time()
+        Seq = "DR"
+        StationName = @Station
+        MacAddress = ""
+        
+        Locate Current_date in AuditTrail<1> by Seq Using @VM setting Pos else Null
+        AuditTrail<1> = Insert(AuditTrail<1>, 1, Pos, 0, Current_Date)
+        AuditTrail<2> = Insert(AuditTrail<2>, 1, Pos, 0, Current_Time)
+        AuditTrail<3> = Insert(AuditTrail<3>, 1, Pos, 0, Username)
+        AuditTrail<4> = Insert(AuditTrail<4>, 1, Pos, 0, StationName)
+        AuditTrail<5> = Insert(AuditTrail<5>, 1, Pos, 0, MacAddress)
+        AuditTrail<8> = Insert(AuditTrail<8>, 1, Pos, 0, Activity)
+        AuditTrail<9> = "AUDIT TRACKING RECORD"
+        
+        If RecordTracker EQ Yes$ Then
+            // Special audit tracking is occuring. Store the current program
+            // and the special marker in the audit trail entry.
+            AuditTrail<6>  = Insert(AuditTrail<6>, 1, Pos, 0, RetStack()<2>)
+            AuditTrail<7>  = Insert(AuditTrail<7>, 1, Pos, 0, Marker)
+            AuditTrail<10> = "PROGRAM TRACKER"
+        End Else
+            AuditTrail<6>  = Insert(AuditTrail<6>, 1, Pos, 0, "")
+            AuditTrail<7>  = Insert(AuditTrail<7>, 1, Pos, 0, "")
+            AuditTrail<10> = AuditTrail<10>
+        End
+        
+        // Update the Audit Trail record.
+        Write AuditTrail to Locked_handle, ID Then
+            If Activity NE "Read" Then
+                // Only create an audit record if the Activity isn't Read.
+                AuditRecord = OrigRecord
+                If MacAddress EQ "" Then MacAddress = @Station                
+                StoredRecId = ID:"*":MacAddress:"*":Current_Date:"*":Current_Time
+                Write AuditRecord To Locked_handle, StoredRecId Then
+                    Read RecentlyUpdatedList from Locked_handle, "%RECENTLY_UPDATED%" Else
+                        RecentlyUpdatedList = ""
+                    End
+                    Locate ID in RecentlyUpdatedList using @FM setting UpdatePos Then
+                        RecentlyUpdatedList = Delete(RecentlyUpdatedList, UpdatePos, 0, 0)
+                    End
+                    If RecentlyUpdatedList EQ "" then
+                        RecentlyUpdatedList = ID
+                    End Else
+                        RecentlyUpdatedList = ID:@FM:RecentlyUpdatedList
+                        If Count(RecentlyUpdatedList, @FM) GT 499 then
+                            RecentlyUpdatedList = Field(RecentlyUpdatedList, @FM, 1, 500)
+                        end
+                    End
+                    Write RecentlyUpdatedList to Locked_handle, "%RECENTLY_UPDATED%" Else
+*                        Msg("|Unable to Write the record %RECENTLY_UPDATED%|to the ":AuditTable:".|")
+                    End
+                End Else
+*                    Msg("|Unable to Write the record ":StoredRecId:"|to the ":AuditTable:".|")
+                End
+            End
+        End Else
+*            Msg("|Unable to Write the record ":ID:"|to the ":AuditTable:".|")
+        End
+        Lock_Record(AuditTable, Locked_handle, ID, Unlock$)
+    End Else
+*        Msg("|Unable to update ":AuditTable:" log.|")
+    end
+return
+
+

FRAMEWORKS/STPROC/AUDIT_MANAGER_MFS.txt

@@ -0,0 +1,265 @@
+Function Audit_Manager_MFS(Code, BFS, Handle, Name, FMC, Record, Status)
+
+////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////
+//
+// 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       : Audit_Manager_MFS
+//
+// Description: MFS for tracking the audit history of a particular record.
+//
+// Notes:       This routine primarily passes all essential information into the Audit_Manager
+//              stored procedure. This way changes to the core functionality can be made
+//              without having to restart OpenInsight (which is necessary for changes directly
+//              in MFS procedures.)
+//
+//              A check is first made to see if corresponding audit table exists for the
+//              database table that triggered this MFS. Audit tables use a naming convention
+//              of AUDIT_Tablename. therefore, if the CUSTOMERS table is being audited then
+//              there should be an AUDIT_CUSTOMERS table available. Audit features are managed
+//              by the DBW_AUDIT_MANAGER form.
+//
+// Parameters:																					
+//    Code	    [in] -- An integer value indicating the operation to be performed (1 = read a
+//                      record, 4 = delete a record, 11 = open a file, etc.)
+//    BFS		[in] -- The list of MFSs and the BFS name for the current file or volume. This
+//                      is a subvalue mark-delimited array, with the current MFS name as the
+//                      first value in the array, and the BFS name as the last value.
+//    Handle	[in] -- The file handle of the file or media map being accessed.
+//    Name	    [in] -- The name (key) of the record or file being accessed.
+//    FMC		[in] -- Various functions.
+//    Record	[in] -- The entire record (for record-oriented functions) or a newly-created
+//                      handle (for "get handle" functions).
+//    Status	[in] -- A return code indicating the success or failure of an operation.
+//
+// History (Date, Initials, Notes)																
+//    01/04/00   pcs   Original programmer
+//    01/20/00   pcs   CLEARFILE requires the Arev table name to be removed before processing
+//    05/20/05   axf   Process will now also track the accessing of records.
+//    11/26/07   dmb   Code clean-up. No functional changes were made.
+//
+////////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////
+
+$insert APP_INSERTS
+$INSERT FILE.SYSTEM.EQUATES
+$INSERT FSERRORS_HDR
+
+Declare Subroutine Msg, Audit_Manager
+
+ON CODE GOSUB READ.RECORD,READO.RECORD,WRITE.RECORD,DELETE.RECORD,LOCK.RECORD,UNLOCK.RECORD,SELECT,READNEXT,CLEARSELECT,CLEARFILE,OPEN.FILE,CREATE.FILE,RENAME.FILE,MOVE.FILE,DELETE.FILE,OPEN.MEDIA,CREATE.MEDIA,READ.MEDIA,WRITE.MEDIA,UNLOCK.ALL,FLUSH,INSTALL,RESERVED,RESERVED,RESERVED,OMNI.SCRIPT,CLOSE.MEDIA,RECORD.COUNT, REMAKE.FILE,CREATE.INDEX,DELETE.INDEX,UPDATE.INDEX,SELECT.INDEX,READNEXT.INDEX
+
+Return
+
+READ.RECORD:
+	// Added Check_Update_History Gosub
+	Activity = "Read"
+	GoSub Check_Update_History
+	GoSub Remove_Arev_Table_Name
+return
+
+READO.RECORD:
+	// Added Check_Update_History Gosub
+	Activity = "Read"
+	GoSub Check_Update_History
+	GoSub Remove_Arev_Table_Name
+return
+
+CREATE.MEDIA:
+	GoSub Call_NextFS
+return
+
+OPEN.MEDIA:
+	GoSub Call_NextFS
+return
+
+READ.MEDIA:
+	GoSub Call_NextFS
+return
+
+WRITE.MEDIA:
+	GoSub Call_NextFS
+return
+
+CLOSE.MEDIA:
+	GoSub Call_NextFS
+return
+
+CLEARFILE:
+	GoSub Remove_Arev_Table_Name
+return
+
+CREATE.FILE:
+	GoSub Call_NextFS
+return
+
+DELETE.FILE:
+	GoSub Call_NextFS
+return
+
+MOVE.FILE:
+	GoSub Call_NextFS
+return
+
+OPEN.FILE:
+	// Attaching Arev Table name to Handle for checking purposes
+	GoSub Call_NextFS
+	If Index(RECORD, @TM, 1) EQ 0 then
+	    RECORD = NAME:@TM:RECORD
+	end
+return
+
+REMAKE.FILE:
+	GoSub Call_NextFS
+return
+
+RENAME.FILE:
+	GoSub Call_NextFS
+return
+
+SELECT:
+	GoSub Remove_Arev_Table_Name
+return
+
+READNEXT:
+	GoSub Remove_Arev_Table_Name
+return
+
+CLEARSELECT:
+	GoSub Remove_Arev_Table_Name
+return
+
+LOCK.RECORD:
+	GoSub Remove_Arev_Table_Name
+return
+
+UNLOCK.RECORD:
+	GoSub Remove_Arev_Table_Name
+return
+
+CREATE.INDEX:
+	GoSub Remove_Arev_Table_Name
+return
+
+UPDATE.INDEX:
+	GoSub Remove_Arev_Table_Name
+return
+
+DELETE.INDEX:
+	GoSub Remove_Arev_Table_Name
+return
+
+SELECT.INDEX:
+	GoSub Remove_Arev_Table_Name
+return
+
+READNEXT.INDEX:
+	GoSub Remove_Arev_Table_Name
+return
+
+RESERVED:
+	GoSub Call_NextFS
+return
+
+OMNI.SCRIPT:
+	GoSub Remove_Arev_Table_Name
+return
+
+RECORD.COUNT:
+	GoSub Remove_Arev_Table_Name
+return
+
+LOCK.SEMAPHORE:
+	GoSub Call_NextFS
+return
+
+UNLOCK.SEMAPHORE:
+	GoSub Call_NextFS
+return
+
+SET.USER.SEMAPHORE:
+	GoSub Call_NextFS
+return
+
+WRITE.RECORD:
+    GoSub Prep_Vars
+    Activity = "Write"
+    GoSub Check_Update_History
+    GoSub Remove_Arev_Table_Name
+return
+
+DELETE.RECORD:
+	Activity = "Delete"
+	GoSub Check_Update_History
+	GoSub Remove_Arev_Table_Name
+return
+
+NEXT_FS:
+	GoSub Call_NextFS
+return
+
+// Install, unlock all and flush are called directly, no need to call next FS.
+INSTALL:
+	STATUS = TRUE$
+return
+
+FLUSH:
+	STATUS = TRUE$
+return
+
+UNLOCK.ALL:
+	STATUS = TRUE$
+return
+
+Prep_Vars:
+    TempUseTable = Field(HANDLE, @TM, 1)
+    UseTable = Field(TempUseTable, "*", 1)
+    UseID = Name
+return
+
+Check_Update_History:
+	Temp_File_Name = Field(HANDLE, @TM, 1)
+	FileName = Field(Temp_File_Name, "*", 1)
+	Real_Handle = Field(HANDLE, @TM, 2)
+	History_table = "AUDIT_":FileName
+	Open History_table to HistoryCheck then
+		GoSub Get_Original_Record
+		Audit_Manager(Name, FileName, Record, OrigRecord, Activity)
+	end
+return
+
+Get_Original_Record:
+	OrigRecord = ""
+	CALL RTP57(READO.RECORD, "RTP57", Real_Handle, NAME, FMC, OrigRecord, Temp_status)
+    // If Temp_status is Null then it is a new record or an error reading.
+return
+
+Call_NextFS:
+	FS = DELETE(BFS, 1, 1, 1)
+	NEXTFS = FS<1, 1, 1>
+	@FILE.ERROR = ""
+	CALL @NEXTFS(CODE, FS, HANDLE, NAME, FMC, RECORD, STATUS)
+return
+
+Remove_Arev_Table_Name:
+* 	FileName = Field(HANDLE, @TM, 1)
+* 	If FileName EQ HANDLE then
+*	    Real_Handle = HANDLE
+* 	end else
+*	    Real_Handle = Field(HANDLE, @TM, 2)
+* 	end
+	FS = DELETE(BFS, 1, 1, 1)
+	NEXTFS = FS<1, 1, 1>
+	@FILE.ERROR = ""
+	
+	If Index(FS, @SVM, 1) GT 0 then
+	    Real_Handle = HANDLE
+ 	end else
+	    Real_Handle = Field(HANDLE, @TM, 2)
+ 	end
+	    
+	CALL @NEXTFS(CODE, FS, Real_Handle, NAME, FMC, RECORD, STATUS)
+return
+

FRAMEWORKS/STPROC/CONTACTS_API.txt

@@ -0,0 +1,284 @@
+Function Contacts_API(@API)
+/***********************************************************************************************************************
+
+    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        :   Contacts_API
+
+    Description :   API logic for the Contacts resource.
+
+    Notes       :   All web APIs should include the API_SETUP insert. This will provide several useful variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        FullEndpointURL         - The URL submitted by the client, including query params.
+                        FullEndpointURLNoQuery  - The URL submitted by the client, excluding query params.
+                        ParentURL               - The URL path preceeding the current endpoint.
+                                                  the SelfURL.
+                        CurrentAPI              - The name of this stored procedure.
+
+    Parameters  :
+        API             [in] -- Web API to process. Format is [APIPattern].[HTTPMethod]:
+                                    - APIPattern must follow this structure <Resource>[.ID.[<Property>]]
+                                    - HTTPMethod can be any valid HTTP method, e.g., GET, POST, PUT, DELETE, etc.
+                                Examples:
+                                    - Contacts.POST
+                                    - Contacts.ID.PUT
+                                    - Contacts.ID.firstName.GET
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        11/17/18    dmb     Original programmer.
+        04/09/19    dmb     [SRPFW-271] Replace FullEndpointURL with FullEndpointURLNoQuery in the GetObjects service
+                            within the Contacts.GET API to avoid query params in the embedded object self URLs.
+        05/28/19    dmb     [SRPFW-274] Replace all references to AddLinkRelationships with AddLinkRelations.
+        05/31/19    dmb     [SRPFW-276] Update contacts.ID.GET API by removing unnecessary call to the GetDatabaseItem
+                            service.
+        01/23/20    dmb     [SRPFW-296] Add matching HEAD APIs for all GET APIs.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert API_SETUP
+$insert HTTP_INSERTS
+$insert CONTACTS_EQUATES
+
+Declare function    Database_Services
+Declare subroutine  RList
+
+GoToAPI else
+    // The specific resource endpoint doesn't have a API handler yet.
+    HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but a web API handler has not yet been created.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Endpoint Handlers
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+API contacts.HEAD
+API contacts.GET
+
+    DisplayColumnNames  = 'first_name' : @FM : 'last_name' : @FM : 'email'
+
+    If HTTP_Services('GetHTTPGetString') NE '' then
+        // This means the URL ends with /contacts?{property}={value}. The client is searching for one or more contacts
+        // that match the query parameters. This is equivalent to doing a filtered RLIST search.
+
+        // Get the query string passed into the URL.
+        GetString   = HTTP_Services('GetHTTPGetString')
+        // Get the name of the property being queried.
+        Property    = GetString[1, 'F=']
+        // Get the value being searched for.
+        Value       = HTTP_Services('GetQueryField', Property)
+        // Get the database columns for the table.
+        ColumnNames = HTTP_Resource_Services('GetColumnNames', 'CONTACTS')
+        ColumnName  = Property
+        Convert @Lower_Case to @Upper_Case in ColumnName
+        // Verify the property matches a valid column in the table.
+        Locate ColumnName in ColumnNames using @FM setting fPos then
+            // Use the GetDatabaseItems service to perform the search and prepare the HAL+JSON response. If a more complex
+            // or optimized solution is needed, then replace the following with custom code.
+            Filter      = 'SELECT CONTACTS WITH ' : ColumnName : ' CONTAINING ' : Quote(Value)
+            // The GetDatabaseItems service will return all database column values unless otherwise specified. Since a query
+            // search might generated several results, it is sometimes best to pass in just those columns that are important
+            // for the query result.
+            Locate ColumnName in DisplayColumnNames using @FM setting fPos else
+                // Make sure the property being searched is included in the columns being returned.
+                DisplayColumnNames := @FM : Property
+            end
+        end else
+            // This is not a valid property, which means the URL does not resolve. Set a 404 error. Add a description if
+            // desired.
+            Error_Services('Add', ColumnName : ' is not a valid column in the CONTACTS table.')
+            HTTP_Services('SetResponseError', '', '', 404, Error_Services('GetMessage'), FullEndpointURL)
+        end
+    end else
+        // This means the URL ends with /contacts. The client is requesting all resources available at this URL.
+        // This is equivalent to performing an unfiltered SELECT statement. Pass in an empty filter.
+        Filter  = ''
+    end
+
+    If Error_Services('NoError') then
+        objResource = HTTP_Resource_Services('GetObject')
+        If Error_Services('NoError') then
+            objContacts = HTTP_Resource_Services('GetObjects', 'CONTACTS', Filter, DisplayColumnNames, '', '', '', '', FullEndpointURLNoQuery)
+            HTTP_Resource_Services('AddEmbeddedResources', objResource, 'contacts', objContacts)
+            // Add _links sub-properties for HAL implementation.
+            Rels    = 'self' : @FM : 'apiEntryPoint'
+            URLs    = FullEndpointURL : @FM : ParentURL
+            HTTP_Resource_Services('AddLinkRelations', objResource, Rels, URLs)
+            If Error_Services('NoError') then
+                // Serialize the object into a JSON string.
+                jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+                // Set the response body with the JSON string and set the Content-Type response header.
+                HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+            end else
+                HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+            end
+        end else
+            HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+        end
+    end
+
+end api
+
+
+API contacts.POST
+
+*    HTTP_Resource_Services('PostDatabaseItem', 'CONTACTS', FullEndpointURL)
+*    Call Push.Session(Hold1, Hold2, Hold3, Hold4, Hold5, Hold6)
+*    Call Pop.Session(Hold1, Hold2, Hold3, Hold4, Hold5, Hold6)
+
+end api
+
+
+API contacts.ID.HEAD
+API contacts.ID.GET
+
+    KeyID           = EndpointSegment
+
+    // Create a new specific contacts resource object using the passed in resource ID to initialize the content.
+    objResource     = HTTP_Resource_Services('GetObject', 'CONTACTS', KeyID, '', '', '', '', '', '', '', '', 1)
+
+    If Error_Services('NoError') then
+        // Add _links sub-properties for HAL implementation.
+        CollectionURL   = ParentURL
+        Names           = 'self,collection'
+        URLs            = FullEndpointURL : ',' : CollectionURL
+        HTTP_Resource_Services('AddLinkRelations', objResource, Names, URLs)
+    end
+
+    If Error_Services('NoError') then
+        // If there is a picture related to this contact, add another _links sub-property for the URL.
+        PictureValue    = SRP_JSON(objResource, 'GetValue', 'picture', '')
+        If PictureValue NE '' then
+            ImageURL    = FullEndpointURL : '/picture'
+            HTTP_Resource_Services('AddLinkRelations', objResource, 'picture', ImageURL)
+        end
+    end
+
+    If Error_Services('NoError') then
+        // Serialize the object into a JSON string.
+        jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+        // Set the response body with the JSON string and set the Content-Type response header.
+        HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+    end else
+        HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+    end
+
+end api
+
+
+API contacts.ID.PATCH
+
+    KeyID   = EndpointSegment
+    HTTP_Resource_Services('PatchDatabaseItem', 'CONTACTS', FullEndpointURL, KeyID)
+
+end api
+
+
+API contacts.ID.PUT
+
+    KeyID   = EndpointSegment
+    HTTP_Resource_Services('PutDatabaseItem', 'CONTACTS', FullEndpointURL, KeyID)
+
+end api
+
+
+API contacts.ID.DELETE
+
+    KeyID   = EndpointSegment
+    HTTP_Resource_Services('DeleteDatabaseItem', 'CONTACTS', KeyID)
+
+end api
+
+
+API contacts.ID.first_name.HEAD
+API contacts.ID.first_name.GET
+
+    KeyID       = ParentSegment
+    objResource = HTTP_Resource_Services('GetObject', 'CONTACTS', KeyID, 'first_name')
+    If Error_Services('NoError') then
+        // Add _links sub-properties for HAL implementation.
+        ResourceURL     = ParentURL
+        Names           = 'self' : @FM : 'resource'
+        URLs            = FullEndpointURL : @FM : ResourceURL
+        HTTP_Resource_Services('AddLinkRelations', objResource, Names, URLs)
+    end
+
+    If Error_Services('NoError') then
+        // Serialize the object into a JSON string.
+        jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+        // Set the response body with the JSON string and set the Content-Type response header.
+        HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+    end else
+        HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+    end
+
+end api
+
+
+API contacts.ID.first_name.PATCH
+
+    KeyID   = ParentSegment
+    HAL     = HTTP_Resource_Services('PatchDatabaseItem', 'CONTACTS', FullEndpointURL, KeyID, 'first_name')
+
+end api
+
+
+API contacts.ID.last_name.HEAD
+API contacts.ID.last_name.GET
+
+    KeyID       = ParentSegment
+    objResource = HTTP_Resource_Services('GetObject', 'CONTACTS', KeyID, 'last_name')
+    If Error_Services('NoError') then
+        // Add _links sub-properties for HAL implementation.
+        ResourceURL     = ParentURL
+        Names           = 'self' : @FM : 'resource'
+        URLs            = FullEndpointURL : @FM : ResourceURL
+        HTTP_Resource_Services('AddLinkRelations', objResource, Names, URLs)
+    end
+
+    If Error_Services('NoError') then
+        // Serialize the object into a JSON string.
+        jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+        // Set the response body with the JSON string and set the Content-Type response header.
+        HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+    end else
+        HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+    end
+
+end api
+
+
+API contacts.ID.last_name.PATCH
+
+    KeyID   = ParentSegment
+    HAL     = HTTP_Resource_Services('PatchDatabaseItem', 'CONTACTS', FullEndpointURL, KeyID, 'last_name')
+
+end api
+
+
+API contacts.ID.first_name.PUT
+
+    KeyID   = ParentSegment
+    HAL     = HTTP_Resource_Services('PatchDatabaseItem', 'CONTACTS', FullEndpointURL, KeyID, 'first_name')
+
+end api
+
+
+API contacts.ID.last_name.PUT
+
+    KeyID   = ParentSegment
+    HAL     = HTTP_Resource_Services('PatchDatabaseItem', 'CONTACTS', FullEndpointURL, KeyID, 'last_name')
+
+end api

FRAMEWORKS/STPROC/ERROR_SERVICES.txt

@@ -0,0 +1,380 @@
+Function Error_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        :   Error_Services
+
+    Description :   Handler program for all error services.
+
+    Notes       :   Application errors should be logged using the Error Services module. There are a few methodological
+                    assumptions built into way errors are managed which are important to understand in order to properly
+                    work with Error Services:
+
+                    - The term 'top' refers to the originating procedure of a call stack and the term 'bottom' refers to
+                      the last routine (or the current routine) within a call stack. Within the OpenInsight Debugger
+                      this will appear backwards since the originating procedure always appears at the bottom of the
+                      list and the current routine appears at the top of the list. We are using this orientation because
+                      it is common to refer to the process of calling other procedures as 'drilling down'.
+
+                    - The reason for defining the orientation of the call stack is because Error_Services allows for
+                      multiple error conditions to be appended to an original error. In most cases this will happen when
+                      a procedure at the bottom of the stack generates an error condition and then returns to its
+                      calling procedure. This higher level procedure can optionally add more information relevant to
+                      itself. This continues as the call stack 'bubbles' its way back to the top to where the
+                      originating procedure is waiting.
+
+                    - Native OpenInsight commands that handle errors (e.g., Set_Status, Set_FSError, Set_EventStatus)
+                      preserve their error state until explicitly cleared. This can hinder the normal execution of code
+                      since subsequent procedures (usually SSPs) will fail if a pre-existing error condition exists.
+                      Our philosophy is that error conditions should automatically be cleared before a new procedure
+                      is executed to avoid this problem. However, the nature of Basic+ does not make this easy to
+                      automate for any given stored procedure. Therefore, if a stored procedure wants to conform to our
+                      philosophy then it should include a call into the 'Clear' service request at the top of the
+                      program. Alternatively this can be done through a common insert (see SERVICE_SETUP for example.)
+
+                    - Service modules will use the SERVICE_SETUP insert and therefore automatically clear out any
+                      error conditions that were set before.
+
+                    - The 'Set' service request is the equivelent to the various forms of setting an error within Basic+
+                      (e.g., Set_Status, Set_FSError, Set_EventStatus). This will clear out any pre-existing error(s)
+                      first (see 'Clear' service request description below). In most cases the 'Add' service request
+                      (see below) should be used since error conditions are intended to be automatically cleared by
+                      service modules or properly managed stored procedures.
+
+                    - The 'Add' service request is similar to the 'Set' service request but it will not clear out any
+                      pre-existing errors. Using 'Add', the error conditions can be stacked allowing the higher level
+                      calling procedures the ability to contribute to the existing error or add additional errors.
+
+                    - The 'Clear' service request will reset all of the error condition flags.
+
+    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)
+        12/28/12    dmb     Original programmer.
+        12/31/12    dmb     Add hooks for various service requests. Add comments in the Notes section to explain the
+                            theory of operation of Error Services.
+        01/01/13    dmb     Add functionality to the Set, Add, GetMessage, and GetMessages service requests.
+        01/02/13    dmb     Remove reference to SERVICES_SETUP and put the Assigned command lines directly into this
+                            code to avoid infinite loop problem.
+        01/05/13    dmb     Added HasError service request.
+        03/13/13    dmb     [SRPFW-9] Added NoError service request.
+        10/01/13    dmb     [SRPFW-18] Replace APP_INSERTS with LOGICAL and declare Error_Services.
+        10/06/13    dmb     [SRPFW-17] Retrofit to use the default FrameWorks system font.
+        03/20/17    fjt	    [SRPFW-160] Conversion to EB+; addition of justification parameter to display.
+        10/09/17    dmb     Add SendRuntimeAlert service to act as a debugger intercept process.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert LOGICAL
+$Insert MSG_EQUATES
+$insert RTI_DEBUG_COMMON
+$insert SRPMail_Inserts
+
+Equ Segoe_UI$ to 'Segoe UI' : @SVM : -12 : @SVM : 400 : @SVM : 0 : @SVM : 0 : @SVM : 0 : @SVM : 0 : @SVM : 34 : @SVM : 0 : @SVM : 3 : @SVM : 2 : @SVM : 1 : @SVM : 0 : @SVM : 0 : @SVM : 0 : @SVM : 0
+
+// Make sure any request parameters which have not been assigned are nulled.
+// Normally these would be referenced in the SERVICES_SETUP insert but there is a call to ERROR_SERVICES in that
+// insert which causes an infinite loop to occur.
+If Assigned(Service)    else Service    = ''
+If Assigned(Error)      else Error      = ''
+If Assigned(Param1)     else Param1     = ''
+If Assigned(Param2)     else Param2     = ''
+If Assigned(Param3)     else Param3     = ''
+If Assigned(Param4)     else Param4     = ''
+If Assigned(Param5)     else Param5     = ''
+If Assigned(Param6)     else Param6     = ''
+If Assigned(Param7)     else Param7     = ''
+If Assigned(Param8)     else Param8     = ''
+If Assigned(Param9)     else Param9     = ''
+If Assigned(Param10)    else Param10    = ''
+If Assigned(Response)   else Response   = ''
+
+AutoDisplayErrors   = False$    ; // Set this to True$ when debugging so all errors will automatically display.
+
+Common /ErrorServices/ ErrorMessages@, ErrorSources@, ErrorCodes@, RetStacks@, Unused5@, Unused6@, Unused7@, Unused8@
+
+Declare function      RetStack, Error_Services, SRPSendMail
+Declare subroutine    Error_Services
+
+GoToService else
+	Error_Services('Set', Service : ' is not a valid service request within the Error services module.')
+end
+
+Return Response else ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// Set
+//
+// Param1 - Error message. Messages should be fairly descriptive.
+//
+// Sets an error to the stack. This will automatically clear any existing error conditions first so this error will
+// be the only one on the stack.
+//----------------------------------------------------------------------------------------------------------------------
+Service Set(ErrorMessage)
+
+    Error_Services('Clear')
+    Error_Services('Add', ErrorMessage)
+
+    If AutoDisplayErrors then Error_Services('DisplayError')
+
+End Service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Add
+//
+// Param1 - Error message. Messages should be fairly descriptive.
+//
+// Adds an error to the stack. This will not clear existing error conditions first. It is intended to allow higher level
+// routines to add more information to an existing error condition or simply to maintain an ongoing error log for some
+// troubleshooting or debugging purposes.
+//----------------------------------------------------------------------------------------------------------------------
+Service Add(ErrorMessage)
+
+    CurStack    = RetStack()
+    AtSelf      = CurStack[1, @FM]              ; // AtSelf should be the name of this routine (e.g., ERROR_SERVICES)
+    Loop
+        CurRoutine  = CurStack[1, @FM]          ; // Get the next routine from the program call stack.
+    Until CurRoutine _NEC AtSelf
+        CurStack    = Delete(CurStack, 1, 0, 0) ; // Remove any self-references from the program call stack.
+    Repeat
+    Convert @FM to @VM in CurStack              ; // Convert the delimiter so it can be added to the global common.
+    
+    If Len(ErrorMessages@) then
+        ErrorMessages@  := @FM : ErrorMessage
+        RetStacks@      := @FM : CurStack
+    end else
+        ErrorMessages@  = ErrorMessage
+        RetStacks@      = CurStack
+    end
+    
+    If AutoDisplayErrors then Error_Services('DisplayError')
+
+End Service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Clear
+//
+// Clears all error conditions and related information.
+//----------------------------------------------------------------------------------------------------------------------
+Service Clear()
+
+    ErrorMessages@  = ''
+    ErrorSources@   = ''
+    ErrorCodes@     = ''
+    RetStacks@      = ''
+
+End Service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetMessage
+//
+// Returns the most current error message.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetMessage()
+
+    Response = ErrorMessages@[-1, 'B' : @FM]
+
+End Service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetMessages
+//
+// Returns the stack of error messages. This will be @FM delimited.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetMessages()
+
+    // Business logic goes here. Data that needs to be returned should be assigned to the Response parameter.
+    Response = ErrorMessages@
+
+End Service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// HasError
+//
+// Returns True if there is an error condition, False if there is no error condition. Caller will still need to use
+// the GetMessage or GetMessages service to determine what the error is. The HasError service allows the caller to
+// embed the Error_Services service call inside of a conditional statement like this:
+//
+// If Error_Services('HasError') then
+//     * An error has occured. Proceed accordingly.
+//     ErrorMessage = Error_Services('GetMessage')
+// end else
+//     * No error has occured.
+// end
+//----------------------------------------------------------------------------------------------------------------------
+Service HasError()
+
+    If Len(ErrorMessages@) then
+        Response = True$
+    end else
+        Response = False$
+    end
+
+End Service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// NoError
+//
+// Returns True if there are no error conditions, False if there is an error condition. This is the opposite of the
+// HasError service and exists for improved readability.
+//----------------------------------------------------------------------------------------------------------------------
+Service NoError()
+
+    If Len(ErrorMessages@) then
+        Response = False$
+    end else
+        Response = True$
+    end
+
+End Service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// DisplayError
+//
+// Displays the current error message to the end user.
+//----------------------------------------------------------------------------------------------------------------------
+Service DisplayError(Justification)
+
+    ErrorMessage = Error_Services('GetMessage')
+    If Len(ErrorMessage) then
+        MsgStruct                   = ''
+        MsgStruct<MTEXT$>           = ErrorMessage
+        MsgStruct<MTYPE$>           = 'BO'
+        MsgStruct<MMODAL$>          = 'W'
+        MsgStruct<MICON$>           = '!'
+        MsgStruct<MCOL$>            = -1
+        MsgStruct<MROW$>            = -1
+        MsgStruct<MJUST$>           = Justification
+        MsgStruct<MCAPTION$>        = 'Error Services'
+        MsgStruct<MFONT$>           = Segoe_UI$
+        Msg(@Window, MsgStruct)
+    end
+
+End Service
+
+
+Service GetSource()
+
+    // Business logic goes here. Data that needs to be returned should be assigned to the Response parameter.
+    Response = '<Service Response>'
+
+End Service
+
+
+Service GetSources()
+
+    // Business logic goes here. Data that needs to be returned should be assigned to the Response parameter.
+    Response = '<Service Response>'
+
+End Service
+
+
+Service GetCode()
+
+    // Business logic goes here. Data that needs to be returned should be assigned to the Response parameter.
+    Response = '<Service Response>'
+
+End Service
+
+
+Service GetCodes()
+
+    // Business logic goes here. Data that needs to be returned should be assigned to the Response parameter.
+    Response = '<Service Response>'
+
+End Service
+
+
+Service GetStackTrace()
+    // Business logic goes here. Data that needs to be returned should be assigned to the Response parameter.
+    Response = '<Service Response>'
+End Service
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////?
+
+//----------------------------------------------------------------------------------------------------------------------
+// SendRuntimeAlert
+//
+// Sends out an email alert when this service is called as a debugger intercept.
+//----------------------------------------------------------------------------------------------------------------------
+SendRuntimeAlert:
+
+    Done            = False$
+    Error           = False$
+    Program         = Curr_Program@
+    MsgSent         = ''
+    
+    If Program EQ '' then Program = 'Error Services'
+
+    ConfigFile      = ''
+    ConfigFile<1>   = SendUsing_Port$
+    ConfigFile<2>   = ''
+    ConfigFile<3>   = ''                        ; // Server port
+    ConfigFile<4>   = ''                        ; // Mail server
+    ConfigFile<5>   = True$                     ; // Authenticate
+    ConfigFile<6>   = ''                        ; // Username
+    ConfigFile<7>   = ''                        ; // Password
+    ConfigFile<8>   = False$                    ; // Use SSL
+
+    Text        = ''
+    Text<-1>    = 'App:     '       : @APPID<1>
+    Text<-1>    = 'Window:  '       : @WINDOW
+    Text<-1>    = 'User:    '       : @USERNAME
+    Text<-1>    = 'Station: '       : @STATION
+    Text<-1>    = ' '
+    Text<-1>    = 'SP Status:    '  : SPStatus@
+    Text<-1>    = 'SP Stat Code: '  : SPStatCode@
+    Text<-1>    = 'Program:      '  : Program
+    Text<-1>    = 'Call Depth:   '  : CallDepth@
+    Text<-1>    = 'Line No:      '  : LineNo@
+    Text<-1>    = ' '
+    Text<-1>    = 'Stack:   '
+    Text<-1>    = CallStack@
+    Convert \00\ TO ',' in Text
+    Swap @VM with ':@VM:' IN Text
+    Swap @FM with Char(13) : Char(10) IN Text
+    Swap @TM with Char(13) : Char(10) IN Text
+
+    SentFrom    = ''
+    SentTo      = ''
+    Message     = ''
+    Message<1>  = '' : Program                          ; // Subject
+    Message<2>  = SentFrom                              ; // From (email address)
+    Message<3>  = SentTo                                ; // Send to (email address)
+    Message<5>  = ''                                    ; // Blind Carbon Copy (email address)
+    Message<6>  = ''                                    ; // Reply To (email address)
+    Message<7>  = 'TEXT'                                ; // Content Type (TEXT or HTML)
+    Message<8>  = Text                                  ; // Content / Body
+    Message<9>  = ''                                    ; // Attachment(s) (path to file name(s))
+
+    MsgSent     = SRPSendMail(Message, ConfigFile)
+
+return

FRAMEWORKS/STPROC/HTTPCLIENT_SERVICES.txt

@@ -0,0 +1,856 @@
+Function HTTPClient_Services(@Service, @Params)
+/***********************************************************************************************************************
+
+    This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written
+    permission from SRP Computer Solutions, Inc.
+
+    Name        :   HTTPClient_Services
+
+    Description :   Handler program for all module related services.
+
+    Notes       :   The generic parameters should contain all the necessary information to process the services. Often
+                    this will be information like the data Record and Key ID.
+
+    Parameters  :
+        Service         [in] -- Name of the service being requested
+        Param1-10   [in/out] -- Additional request parameter holders
+        Response       [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
+
+    Metadata    :
+
+    History     :   (Date, Initials, Notes)
+        03/28/16    dmb     [SRPFW-120] Original programmer.
+        07/01/17    dmb     [SRPFW-184] Refactor using Enhanced BASIC+ syntax.
+        05/19/18    dmb     [SRPFW-235] Check for content in the HeaderList variable before calling the For Each loop.
+        11/15/18    dmb     [SRPFW-238] Add ClientCertPath argument to the SendHTTPRequest service to support
+                            client-side certificates.
+        02/28/19    dmb     Change UseXMLHTTP argument to UseClientXMLHTTP in the SendHTTPRequest service to make it
+                            easier to interpret.
+        02/09/20    dmb     [SRPFW-309] Fix a bug in the SendHTTPRequest service so that request headers are properly
+                            parsed. All colons were erroneously being converted to @VM instead of the first colon (which
+                            separated the header name from the header value).
+        02/09/20    dmb     [SRPFW-309] Update the SetResponseHeaderField service to better support Set-Cookie headers.
+                            Allow multiple cookie names to be stored but only store the value of the last cookie name
+                            if it is duplicated.
+        02/09/20    dmb     [SRPFW-309] Update the GetResponseHeaderField by adding a Delimiter argument so the caller
+                            can specify an alternative delimiter for the values being returned.
+        02/09/20    dmb     [SRPFW-309] Add GetCookies service to make it easier to view all cookies returned in the
+                            response.
+        02/09/20    dmb     [SRPFW-309] Add GetCookie service to make it easier to see the entire cookie string of a
+                            specified cookie.
+        02/10/20    dmb     [SRPFW-309] Update the GetCookie service to include an IgnoreAttributes argument. If this
+                            is True$, then only the cookie name and value will be returned.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert LOGICAL
+$insert SERVICE_SETUP
+
+Equ     CRLF$           to \0D0A\
+// The readyState property will have this value when the request has returned from the server.
+// http://msdn.microsoft.com/en-us/library/ms753800(v=vs.85).aspx
+Equ     HTTP_COMPLETED$ to 4
+
+Common /HTTPClientServices/ RequestHeaderFields@, RequestHeaderValues@, ResponseHeaderFields@, ResponseHeaderValues@, ResponseStatusCode@, ResponseStatusPhrase@, ResponseBody@, TimeoutDuration@
+
+Declare function    SRP_COM, HTTPClient_Services, GetTickCount, OLECreateInstance, OLEGetProperty, OLECallMethod, OLEStatus
+Declare subroutine  SRP_COM, HTTPClient_Services, OLEPutProperty
+
+GoToService else
+    Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' module.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN             = True$, False$
+Options RESPONSEHEADERNAMES = 'Access-Control-Allow-Headers', 'Access-Control-Allow-Methods', 'Access-Control-Allow-Origin', 'Allow', 'Content-Encoding', 'Content-Language', 'Content-Length', 'Content-Location', 'Content-Disposition', 'Content-Type', 'Date', 'Expires', 'Last-Modified', 'Link', 'Location', 'Retry-After', 'Server', 'Set-Cookie', 'Transfer-Encoding', 'Vary', 'WWW-Authenticate',
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// SendHTTPRequest
+//
+// Method           - The HTTP method to submit to the server. - [Required]
+// URL              - The URL receiving the HTTP request. - [Required]
+// HeaderList       - An @FM/@VM list of request header names and values. - [Optional]
+// Body             - The request body to be sent to the server. - [Optional]
+// ProxyUser        - Username needed to authenticate against a proxy server. - [Optional]
+// ProxyPassword    - Password needed to authenticate against a proxy server. - [Optional]
+// UseAsynchronous  - Flag to determine if the HTTP request should be processed asynchronously. Default is True.
+//                    - [Optional]
+// UseClientXMLHTTP - Flag to determine if client XMLHTTP or server XMLHTTP should be used. Default is server XMLHTTP.
+//                    - [Optional]
+// ClientCertPath   - Path to a client-side certificate. This is usually in Location\Certificate Store\Subject format.
+//                    - [Optional]
+//
+// Calls the indicated HTTP web service routine.
+//----------------------------------------------------------------------------------------------------------------------
+Service SendHTTPRequestOLE(Method, URL, HeaderList, Body, ProxyUser, ProxyPassword, UseAsynchronous, UseClientXMLHTTP, ClientCertPath)
+
+    // Defaults.
+    If UseAsynchronous  NE False$   then UseAsynchronous    = True$
+    If UseClientXMLHTTP NE True$    then UseClientXMLHTTP   = False$
+
+    If (Method NE '') AND (URL NE '') then
+        // Make sure all prior response settings are cleared before performing the next HTTP request.
+        HTTPClient_Services('ClearResponseSettings')
+
+        // Attempt to get a handle for the best XMLHTTP object.
+        objXMLHTTP  = ''
+        If UseClientXMLHTTP then
+            ServerPrefix    = ''
+        end else
+            ServerPrefix    = 'Server'
+        end
+        XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.6.0'
+        objXMLHTTP    = OLECreateInstance(XMLHTTPProgID)
+        Status        = OLEStatus()
+        If Status then
+            XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.3.0'
+            objXMLHTTP    = OLECreateInstance(XMLHTTPProgID)
+            Status        = OLEStatus()
+            If Status then
+                XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP'
+                objXMLHTTP    = OLECreateInstance(XMLHTTPProgID)
+                Status        = OLEStatus()
+                If Status then
+                    Error  = 'Unable to create a handle to the XMLHTTP object in the ' : Service : ' service.'
+                    Error := ' OLE Error: ' : Status
+                    Error_Services('Add', Error)                    
+                end
+            end
+        end
+
+        If Error_Services('NoError') then
+            // Invoke the XMLHTTP object's open method to initialize a request.
+            rv     = OLECallMethod(objXMLHTTP, 'open', Method, URL, UseAsynchronous, ProxyUser, ProxyPassword)
+            Status = OLEStatus()
+            If Status then
+                Error   = 'Error calling the open method for the XMLHTTP object in the ' : Service : ' service.'
+                Error  := ' OLE Error: ' : Status
+                Error_Services('Add', Error)
+            end
+        end
+
+*        If Error_Services('NoError') then
+*            // Set the request header names and values. This will add or update any header fields passed in through this
+*            // service with those have may have been previously set using the SetRequestHeaderFields or
+*            // SetRequestHeaderField already.
+*            If Len(HeaderList) then HTTPClient_Services('SetRequestHeaderFields', HeaderList)
+*            // Now get all of the request header fields.
+*            HeaderList  = HTTPClient_Services('GetRequestHeaderFields')
+*            If Error_Services('NoError') then
+*                If HeaderList NE '' then
+*                    For Each HeaderPair in HeaderList using @FM
+*                        HeaderName  = HeaderPair<0, 1>
+*                        HeaderValue = HeaderPair<0, 2>
+*                        SRP_COM(objXMLHTTP, 'CALL', 'setRequestHeader', HeaderName, HeaderValue)
+*                        If SRP_COM('', 'HASERROR') then
+*                            Error   = 'Error setting the setRequestHeader property for the ' : HeaderName : ' field in the XMLHTTP object in the ' : Service : ' service.'
+*                            Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
+*                            Error_Services('Add', Error)
+*                        end
+*                    Next HeaderPair
+*                end
+*            end
+*        end
+
+*        If ClientCertPath NE '' then
+*            If Error_Services('NoError') then
+*                // Invoke the XMLHTTP object's setOption method to invoke a certificate.
+*                rv  = SRP_COM(objXMLHTTP, 'CALL', 'setOption', 3, ClientCertPath)
+*                If SRP_COM('', 'HASERROR') then
+*                    Error   = 'Error calling the setOption method for the XMLHTTP object in the ' : Service : ' service.'
+*                    Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
+*                    Error_Services('Add', Error)
+*                end
+*            end
+*        end
+
+        If Error_Services('NoError') then
+            // Invoke the XMLHTTP object's send method to submit the request to the server.
+            rv     = OLECallMethod(objXMLHTTP, 'send', Body)
+            Status = OLEStatus()
+            If Status then
+                Error   = 'Error calling the send method for the XMLHTTP object in the ' : Service : ' service.'
+                Error  := ' OLE Error: ' : Status
+                Error_Services('Add', Error)
+            end
+        end
+
+        If Error_Services('NoError') then
+            If UseAsynchronous then
+                StartTime       = GetTickCount()
+                TimeoutDuration = HTTPClient_Services('GetTimeoutDuration')
+                TimedOut        = False$
+                Loop
+                    ReadyState  = OLEGetProperty(objXMLHTTP, 'readyState')
+                    CurrentTime = GetTickCount()
+                    ElapsedTime = Int((CurrentTime - StartTime) / 1000)
+                    TimedOut    = ElapsedTime GE TimeoutDuration
+                While (ReadyState NE HTTP_COMPLETED$) AND Not(TimedOut)
+                Repeat
+            end
+
+            // Check the XMLHTTP object's responseBody property to get the server's response.
+            Response  = OLEGetProperty(objXMLHTTP, 'responseBody')
+            Response1 = OLEGetProperty(objXMLHTTP, 'responseText')
+            Response2 = objXMLHTTP->responseBody
+            Response3 = objXMLHTTP->responseText
+
+            Status = OLEStatus()
+            If Status then
+                Error       = 'Error getting the responseBody property for the XMLHTTP object in the ' : Service : ' service.'
+                Error      := ' OLE Error: ' : Status
+                Error_Services('Add', Error)
+                Response    = ''
+            end else
+                HTTPClient_Services('SetResponseBody', Response)
+            end
+        end
+
+        If Error_Services('NoError') then
+            // If the request was successful, get the response status code, phrase, and response headers and set them
+            // using HTTPClient_Services so the caller can retrieve is desired.
+            Code   = OLEGetProperty(objXMLHTTP, 'status')
+            Phrase = Trim(OLEGetProperty(objXMLHTTP, 'statusText'))
+            HTTPClient_Services('SetResponseStatusCode', Code)
+            HTTPClient_Services('SetResponseStatusPhrase', Phrase)
+
+            ResponseHeaders = OLECallMethod(objXMLHTTP, 'getAllResponseHeaders')
+            Swap CRLF$ with @FM in ResponseHeaders
+            For Each ResponseHeader in ResponseHeaders using @FM
+                Name    = ResponseHeader[1, 'F:']
+                Value   = Trim(ResponseHeader[Col2() + 1, 9999])
+                If (Name NE '') AND (Value NE '') then
+                    HTTPClient_Services('SetResponseHeaderField', Name, Value)
+                end
+            Next ResponseHeader
+        end
+
+        // Make sure all prior request settings are cleared so future HTTP request won't be affected.
+        Error = Error_Services('GetMessage')        ; // Get any pre-existing errors so they can be preserved.
+        HTTPClient_Services('ClearRequestSettings') ; // This will automatically clear the error stack.
+        Error_Services('Set', Error)                ; // Restore any errors so the caller can check for them.
+    end else
+        Error_Services('Add', 'Method or URL argument was missing from the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SendHTTPRequest
+//
+// Method           - The HTTP method to submit to the server. - [Required]
+// URL              - The URL receiving the HTTP request. - [Required]
+// HeaderList       - An @FM/@VM list of request header names and values. - [Optional]
+// Body             - The request body to be sent to the server. - [Optional]
+// ProxyUser        - Username needed to authenticate against a proxy server. - [Optional]
+// ProxyPassword    - Password needed to authenticate against a proxy server. - [Optional]
+// UseAsynchronous  - Flag to determine if the HTTP request should be processed asynchronously. Default is True.
+//                    - [Optional]
+// UseClientXMLHTTP - Flag to determine if client XMLHTTP or server XMLHTTP should be used. Default is server XMLHTTP.
+//                    - [Optional]
+// ClientCertPath   - Path to a client-side certificate. This is usually in Location\Certificate Store\Subject format.
+//                    - [Optional]
+//
+// Calls the indicated HTTP web service routine.
+//----------------------------------------------------------------------------------------------------------------------
+Service SendHTTPRequest(Method, URL, HeaderList, Body, ProxyUser, ProxyPassword, UseAsynchronous, UseClientXMLHTTP, ClientCertPath)
+
+    // Defaults.
+    If UseAsynchronous  NE False$   then UseAsynchronous    = True$
+    If UseClientXMLHTTP NE True$    then UseClientXMLHTTP   = False$
+
+    If (Method NE '') AND (URL NE '') then
+        // Make sure all prior response settings are cleared before performing the next HTTP request.
+        HTTPClient_Services('ClearResponseSettings')
+
+        // Attempt to get a handle for the best XMLHTTP object.
+        objXMLHTTP  = ''
+        If UseClientXMLHTTP then
+            ServerPrefix    = ''
+        end else
+            ServerPrefix    = 'Server'
+        end
+        XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.6.0'
+        If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else
+            XMLHTTPProgID = 'Msxml2.' : ServerPrefix : 'XMLHTTP.3.0'
+            If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else
+                XMLHTTPProgID   = 'Msxml2.' : ServerPrefix : 'XMLHTTP'
+                If SRP_COM(objXMLHTTP, 'CREATE', XMLHTTPProgID) else
+                    Error   = 'Unable to create a handle to the XMLHTTP object in the ' : Service : ' service.'
+                    If SRP_COM('', 'HASERROR') then
+                        Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
+                    end
+                    Error_Services('Add', Error)
+                end
+            end
+        end
+
+        If Error_Services('NoError') then
+            // Invoke the XMLHTTP object's open method to initialize a request.
+            SRP_COM(objXMLHTTP, 'CALL', 'open', Method, URL, UseAsynchronous, ProxyUser, ProxyPassword)
+            If SRP_COM('', 'HASERROR') then
+                Error   = 'Error calling the open method for the XMLHTTP object in the ' : Service : ' service.'
+                Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
+                Error_Services('Add', Error)
+            end
+        end
+
+        If Error_Services('NoError') then
+            // Set the request header names and values. This will add or update any header fields passed in through this
+            // service with those have may have been previously set using the SetRequestHeaderFields or
+            // SetRequestHeaderField already.
+            If Len(HeaderList) then HTTPClient_Services('SetRequestHeaderFields', HeaderList)
+            // Now get all of the request header fields.
+            HeaderList  = HTTPClient_Services('GetRequestHeaderFields')
+            If Error_Services('NoError') then
+                If HeaderList NE '' then
+                    For Each HeaderPair in HeaderList using @FM
+                        HeaderName  = HeaderPair<0, 1>
+                        HeaderValue = HeaderPair<0, 2>
+                        SRP_COM(objXMLHTTP, 'CALL', 'setRequestHeader', HeaderName, HeaderValue)
+                        If SRP_COM('', 'HASERROR') then
+                            Error   = 'Error setting the setRequestHeader property for the ' : HeaderName : ' field in the XMLHTTP object in the ' : Service : ' service.'
+                            Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
+                            Error_Services('Add', Error)
+                        end
+                    Next HeaderPair
+                end
+            end
+        end
+
+        If ClientCertPath NE '' then
+            If Error_Services('NoError') then
+                // Invoke the XMLHTTP object's setOption method to invoke a certificate.
+                rv  = SRP_COM(objXMLHTTP, 'CALL', 'setOption', 3, ClientCertPath)
+                If SRP_COM('', 'HASERROR') then
+                    Error   = 'Error calling the setOption method for the XMLHTTP object in the ' : Service : ' service.'
+                    Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
+                    Error_Services('Add', Error)
+                end
+            end
+        end
+
+        If Error_Services('NoError') then
+            // Invoke the XMLHTTP object's send method to submit the request to the server.
+            rv  = SRP_COM(objXMLHTTP, 'CALL', 'send', Body)
+            If SRP_COM('', 'HASERROR') then
+                Error   = 'Error calling the send method for the XMLHTTP object in the ' : Service : ' service.'
+                Error  := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
+                Error_Services('Add', Error)
+            end
+        end
+
+        If Error_Services('NoError') then
+            If UseAsynchronous then
+                StartTime       = GetTickCount()
+                TimeoutDuration = HTTPClient_Services('GetTimeoutDuration')
+                TimedOut        = False$
+                Loop
+                    ReadyState  = SRP_COM(objXMLHTTP, 'GET', 'readyState')
+                    CurrentTime = GetTickCount()
+                    ElapsedTime = Int((CurrentTime - StartTime) / 1000)
+                    TimedOut    = ElapsedTime GE TimeoutDuration
+                While (ReadyState NE HTTP_COMPLETED$) AND Not(TimedOut)
+                Repeat
+            end
+
+            // Check the XMLHTTP object's responseBody property to get the server's response.
+*            Response    = SRP_COM(objXMLHTTP, 'GET', 'responseBody')
+            Response    = SRP_COM(objXMLHTTP, 'GET', 'responseText')
+
+            If SRP_COM('', 'HASERROR') then
+                Error       = 'Error getting the responseBody property for the XMLHTTP object in the ' : Service : ' service.'
+                Error      := ' SRP_COM Error: ' : SRP_COM('', 'ERROR')
+                Error_Services('Add', Error)
+                Response    = ''
+            end else
+                HTTPClient_Services('SetResponseBody', Response)
+            end
+        end
+
+        If Error_Services('NoError') then
+            // If the request was successful, get the response status code, phrase, and response headers and set them
+            // using HTTPClient_Services so the caller can retrieve is desired.
+            Code            = SRP_COM(objXMLHTTP, 'GET', 'status')
+            Phrase          = Trim(SRP_COM(objXMLHTTP, 'GET', 'statusText'))
+            HTTPClient_Services('SetResponseStatusCode', Code)
+            HTTPClient_Services('SetResponseStatusPhrase', Phrase)
+
+            ResponseHeaders = SRP_COM(objXMLHTTP, 'CALL', 'getAllResponseHeaders')
+            Swap CRLF$ with @FM in ResponseHeaders
+            For Each ResponseHeader in ResponseHeaders using @FM
+                Name    = ResponseHeader[1, 'F:']
+                Value   = Trim(ResponseHeader[Col2() + 1, 9999])
+                If (Name NE '') AND (Value NE '') then
+                    HTTPClient_Services('SetResponseHeaderField', Name, Value)
+                end
+            Next ResponseHeader
+        end
+
+        // Release the handle to the XMLHTTP object in case it was created.
+        SRP_COM(objXMLHTTP, 'RELEASE')
+
+        // Make sure all prior request settings are cleared so future HTTP request won't be affected.
+        Error = Error_Services('GetMessage')        ; // Get any pre-existing errors so they can be preserved.
+        HTTPClient_Services('ClearRequestSettings') ; // This will automatically clear the error stack.
+        Error_Services('Set', Error)                ; // Restore any errors so the caller can check for them.
+    end else
+        Error_Services('Add', 'Method or URL argument was missing from the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetRequestHeaderFields
+//
+// HeaderList   - An @FM/@VM list of request header fields and their values. - [Required]
+//
+// Sets the Request Header Fields as indicated by the HeaderList argument. The HeaderList should not be formatted as a
+// list rather than an associated multivalue array. This is easier for the developer to manage in the code that calls
+// this service.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetRequestHeaderFields(HeaderList)
+
+    If HeaderList NE '' then
+        For Each HeaderPair in HeaderList using @FM
+            HeaderName  = HeaderPair<0, 1>
+            HeaderValue = HeaderPair<0, 2>
+            HTTPClient_Services('SetRequestHeaderField', HeaderName, HeaderValue)
+        Next HeaderPair
+    end else
+        Error_Services('Add', 'HeaderList argument was missing from the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetRequestHeaderField
+//
+// Name     - Header Field Name to set. - [Required]
+// Value    - Value for the header field. This will be Trimmed to enforce proper formatting. - [Required]
+//
+// Sets the indicated Request Header Field with the indicated value.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetRequestHeaderField(Name, Value)
+
+    If (Name NE '') AND (Value NE '') then
+        SearchName      = Name
+        Convert @Lower_Case to @Upper_Case in SearchName
+        SearchFields    = RequestHeaderFields@
+        Convert @Lower_Case to @Upper_Case in SearchFields
+        Locate SearchName in SearchFields using @FM setting fPos else
+            fPos = Count(RequestHeaderFields@, @FM) + (RequestHeaderFields@ NE '') + 1
+        end
+        RequestHeaderFields@<fPos>  = Name
+        RequestHeaderValues@<fPos>  = Trim(Value)
+    end else
+        Error_Services('Add', 'The Name or Value argument is missing in the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetRequestHeaderFields
+//
+// Returns all of the Request Header Field names and values. This returns an @FM/@VM list of names and values.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetRequestHeaderFields()
+
+    HeaderFieldBlock    = ''
+
+    If RequestHeaderFields@ NE '' then
+        NumFields   = Count(RequestHeaderFields@, @FM) + (RequestHeaderFields@ NE '')
+        For FieldCnt = 1 to NumFields
+            HeaderFieldBlock   := RequestHeaderFields@<FieldCnt> : @VM : RequestHeaderValues@<FieldCnt> : @FM
+        Next FieldCnt
+        HeaderFieldBlock[-1, 1] = ''
+    end
+
+    Response    = HeaderFieldBlock
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetRequestHeaderField
+//
+// Name - Header Field Name to get. - [Required]
+//
+// Returns the value previously set for the indicated Request Header Field.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetRequestHeaderField(Name)
+
+    Value       = ''
+
+    If Name NE '' then
+        SearchName      = Name
+        Convert @Lower_Case to @Upper_Case in SearchName
+        SearchFields    = RequestHeaderFields@
+        Convert @Lower_Case to @Upper_Case in SearchFields
+        Locate SearchName in SearchFields using @FM setting fPos then
+            Value   = RequestHeaderValues@<fPos>
+        end else
+            Error_Services('Add', Name : ' is not a header field in the request.')
+        end
+    end else
+        Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.')
+    end
+
+    Response    = Value
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetResponseHeaderField
+//
+// Name     - Header Field Name to set. - [Required]
+// Value    - Value for the header field. This will be Trimmed to enforce proper formatting. - [Required]
+//
+// Sets the indicated Response Header Field with the indicated value.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetResponseHeaderField(Name, Value)
+
+    If (Name NE '') AND (Value NE '') then
+        SearchName      = Name
+        Convert @Lower_Case to @Upper_Case in SearchName
+        SearchFields    = ResponseHeaderFields@
+        Convert @Lower_Case to @Upper_Case in SearchFields
+        Locate SearchName in SearchFields using @FM setting fPos else
+            fPos = Count(ResponseHeaderFields@, @FM) + (ResponseHeaderFields@ NE '') + 1
+        end
+        ResponseHeaderFields@<fPos> = Name
+        PreviousValue               = ResponseHeaderValues@<fPos>
+        If PreviousValue EQ '' then
+            ResponseHeaderValues@<fPos> = Trim(Value)
+        end else
+            If Name EQ 'Set-Cookie' then
+                // Unlike other response headers, Set-Cookie can have multiple entries. However, if more than one
+                // cookie of a particular name exists then only store the last entry.
+                SetCookieFound  = False$
+                CookieName      = Value[1, 'F='][1, 'F '][1, 'F;']
+                For Each HeaderField in ResponseHeaderFields@ using @FM setting fPos
+                    If HeaderField EQ 'Set-Cookie' then
+                        SetCookieFound  = True$
+                    end
+                Until SetCookieFound EQ True$
+                Next HeaderField
+                If SetCookieFound EQ True$ then
+                    // Set-Cookie was found. Check to see if the cookie name has already been added.
+                    CookieNameFound = False$
+                    CookieValues    = ResponseHeaderValues@<fPos>
+                    For Each CookieValue in CookieValues using @VM setting vPos
+                        MatchCookieName = CookieValue[1, 'F='][1, 'F '][1, 'F;']
+                        If CookieName EQ MatchCookieName then
+                            CookieNameFound = True$
+                        end
+                    Until CookieNameFound EQ True$
+                    Next CookieValue
+                    If CookieNameFound EQ True$ then
+                        // Cookie name already exists. Replace the old value with the new one.
+                        ResponseHeaderValues@<fPos, vPos>   = Trim(Value)
+                    end else
+                        // This is a new cookie name. Append the Set-Cookie value to the list.
+                        ResponseHeaderValues@<fPos, -1>     = Trim(Value)
+                    end
+                end else
+                    // No cookies have been set yet.
+                    ResponseHeaderValues@<fPos> = Trim(Value)
+                end
+            end else
+                ResponseHeaderValues@<fPos> = PreviousValue : ' ;' : Trim(Value)
+            end
+        end
+    end else
+        Error_Services('Add', 'The Name or Value argument is missing in the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResponseHeaderFields
+//
+// Returns all of the Response Header Field names and values. This returns an @FM/@VM list of names and values.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResponseHeaderFields()
+
+    HeaderFieldBlock    = ''
+
+    If ResponseHeaderFields@ NE '' then
+        NumFields   = Count(ResponseHeaderFields@, @FM) + (ResponseHeaderFields@ NE '')
+        For FieldCnt = 1 to NumFields
+            HeaderFieldBlock   := ResponseHeaderFields@<FieldCnt> : @VM : ResponseHeaderValues@<FieldCnt> : @FM
+        Next FieldCnt
+        HeaderFieldBlock[-1, 1] = ''
+    end else
+        Error_Services('Add', 'There are no response header fields get.')
+    end
+
+    Response    = HeaderFieldBlock
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResponseHeaderField
+//
+// Name         - Header Field Name to get. - [Required]
+// Delimiter    - Delimiter to use for multiple values. Default is '; ' for all header fields except for Set-Cookie.
+//                Set-Cookie defaults to @VM. - [Optional]
+//
+// Returns the value previously set for the indicated Response Header Field. The Name argument is case-insensitive but
+// if the indicated Response Header Field has not been set then an error condition will be set.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResponseHeaderField(Name=RESPONSEHEADERNAMES, Delimiter)
+
+    Value       = ''
+
+    If Name NE '' then
+        SearchName      = Name
+        Convert @Lower_Case to @Upper_Case in SearchName
+        SearchFields    = ResponseHeaderFields@
+        Convert @Lower_Case to @Upper_Case in SearchFields
+        Locate SearchName in SearchFields using @FM setting fPos then
+            Value   = ResponseHeaderValues@<fPos>
+            If Delimiter NE '' then
+                If Name EQ 'Set-Cookie' then
+                    Convert @VM to Delimiter in Value
+                end else
+                    Swap '; ' with Delimiter in Value
+                end
+            end
+        end else
+            Error_Services('Add', Name : ' is not a header field in the response.')
+        end
+    end else
+        Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.')
+    end
+
+    Response    = Value
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetCookies
+//
+// Delimiter    - Delimiter to use for multiple cookies. Default is @FM - [Optional]
+//
+// Returns all cookie strings from the response headers.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetCookies(Delimiter)
+
+    If Delimiter EQ '' then Delimiter = @FM
+
+    Cookies     = HTTPClient_Services('GetResponseHeaderField', 'Set-Cookie', Delimiter)
+
+    Response    = Cookies
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetCookie
+//
+// Name				- Name of the cookie to get. - [Required]
+// IgnoreAttributes	- Boolean flag to indicate if the cookie's attributes should be removed when returning the cookie.
+//					  Default value is False$. - [Optional]
+//
+// Returns the value for the indicated cookie name.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetCookie(Name, IgnoreAttributes=BOOLEAN)
+
+	If IgnoreAttributes NE True$ then IgnoreAttributes = False$
+
+	Cookie      = ''
+
+	If Name NE '' then
+		CookieNameFound = False$
+		Cookies         = HTTPClient_Services('GetCookies')
+		For Each CookieString in Cookies using @FM
+			MatchCookieName = CookieString[1, 'F='][1, 'F '][1, 'F;']
+			If Name EQ MatchCookieName then
+				CookieNameFound = True$
+			end
+		Until CookieNameFound EQ True$
+		Next CookieValue
+		If CookieNameFound EQ True$ then
+			If IgnoreAttributes EQ True$ then
+				CookieString	= Trim(CookieString[1, ';'])
+			end
+			Transfer CookieString to Cookie
+		end
+	end else
+		Error_Services('Add', 'The Name argument is missing in the ' : Service : ' service.')
+	end
+
+	Response    = Cookie
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetResponseStatusCode
+//
+// Code - HTTP status code to set. - [Required]
+//
+// Sets the response status code generated by the most recent HTTP request.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetResponseStatusCode(Code)
+
+    If Code NE '' then
+        ResponseStatusCode@     = Code
+    end else
+        Error_Services('Add', 'The Code argument is missing in the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResponseStatusCode
+//
+// Gets the response status code generated by the most recent HTTP request.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResponseStatusCode()
+
+    Response    = ResponseStatusCode@
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetResponseStatusPhrase
+//
+// Phrase   - HTTP status phrase to set. - [Required]
+//
+// Sets the response status phrase generated by the most recent HTTP request.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetResponseStatusPhrase(Phrase)
+
+    If Phrase NE '' then
+        ResponseStatusPhrase@   = Phrase
+    end else
+        Error_Services('Add', 'The Phrase argument is missing in the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResponseStatusPhrase
+//
+// Gets the response status phrase generated by the most recent HTTP request.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResponseStatusPhrase()
+
+    Response    = ResponseStatusPhrase@
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetResponseBody
+//
+// Body - The response body which would have been generated by an XMLHTTP call.
+//
+// Sets the response body generated by the most recent HTTP request.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetResponseBody(Body)
+
+    ResponseBody@   = Body
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResponseBody
+//
+// Gets the response body generated by the most recent HTTP request.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResponseBody()
+
+    Response    = ResponseBody@
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetTimeoutDuration
+//
+// TimeoutDuration  - The length of time (in seconds) before an HTTP request will abort.
+//
+// Sets the timeout duration that will be used before an HTTP request will abort. This is only applicable if the
+// request is asynchronous. If the timeout duration is empty, a default setting of 30 minutes (1800 seconds) will be
+// set.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetTimeoutDuration(TimeoutDuration)
+
+    If TimeoutDuration EQ '' then TimeoutDuration = 1800
+
+    TimeoutDuration@    = TimeoutDuration
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetTimeoutDuration
+//
+// Returns the timeout duration that will be used before an HTTP request will abort. This is only applicable if the
+// request is asynchronous. If the timeout duration is empty, a default setting of 30 minutes (1800) seconds) will be
+// returned.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetTimeoutDuration()
+
+    If TimeoutDuration@ EQ '' then TimeoutDuration@ = 1800
+
+    Response    = TimeoutDuration@
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ClearResponseSettings
+//
+// Clears all of the global common variables used for responses.
+//----------------------------------------------------------------------------------------------------------------------
+Service ClearResponseSettings()
+
+    ResponseHeaderFields@   = ''
+    ResponseHeaderValues@   = ''
+    ResponseStatusCode@     = ''
+    ResponseStatusPhrase@   = ''
+    ResponseBody@           = ''
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ClearRequestSettings
+//
+// Clears all of the global common variables used for requests.
+//----------------------------------------------------------------------------------------------------------------------
+Service ClearRequestSettings()
+
+    RequestHeaderFields@    = ''
+    RequestHeaderValues@    = ''
+    TimeoutDuration@        = 1800
+
+end service

FRAMEWORKS/STPROC/HTTP_ABORTED_SERVICE.txt

@@ -0,0 +1,38 @@
+Subroutine HTTP_Aborted_Service(ProcErr)
+/***********************************************************************************************************************
+
+    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_Aborted_Service
+
+    Description :   Handler program for the HTTP Aborted service module.
+
+    Notes       :   Service handler for HTTP Requests that get aborted either due to Runtime Errors or Status Errors.
+                    If the Debugger Intercept has been enabled, this handler will only receive Status Error aborts.
+
+    Parameters  :
+        ProcErr         [in] -- The procedural error data being passed in from the OEngineServer. Unless otherwise
+                                changed, the only reason this should be called is if there was a runtime error in one
+                                of the stored procedures that was called by the initial request.
+
+    Metadata    :
+
+    History     :   (Date, Initials, Notes)
+        02/27/17    dmb     Original programmer. - [SRPFW-125]
+        03/04/17    dmb     Replace direct logging with the CreateLogFile service. - [SRPFW-154]
+        12/03/18    dmb     Update to use the SetResponseError service. - [SRPFW-257]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert HTTP_INSERTS
+
+// Generate a log file. Pass in the contents of the ProcErr argument as is.
+HTTP_Services('CreateLogFile', 'Aborted', ProcErr)
+
+HTTP_Services('SetResponseError', '', '', 500, ProcErr, FullEndpointURL)
+
+Return

FRAMEWORKS/STPROC/HTTP_AUTHENTICATION_SERVICES.txt

@@ -0,0 +1,553 @@
+Function HTTP_Authentication_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_Authentication_Services
+
+    Description :   Handler program for all HTTP authentication.
+
+    Notes       :   Authentication techniques will vary depending upon the application so the code in the
+                    AuthenticateRequest service will need to be customized as necessary.
+
+    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/25/15    dmb     [SRPFW-91] Original programmer.
+        06/10/15    dmb     [SRPFW-91] Add checks to make sure Username and Password are populated before attempting to
+                            authenticate against the USERS table. This prevents easy authentication if the USERS table
+                            isn't being managed well.
+        02/25/16    dmb     [SRPFW-108] Add support for the GetEnableAuthenticateFlag service. If disabled, then automatically
+                            authenticate the user.
+        02/25/16    dmb     [SRPFW-108] Add support for the GetRealmValue service. Use this instead of hard-coding the
+                            realm.
+        12/01/16    dmb     Update the AuthenticateRequest service to verify authentication requirements of the current
+                            URL using the URLRequiresAuthentication service.
+        07/01/17    dmb     [SRPFW-184] Refactor using Enhanced BASIC+ syntax.
+        10/22/18    dmb     [SRPFW-253] Add support for checking for whitelisted IPs in the AuthenticateRequest service.
+        10/31/18    dmb     [SRPFW-254] Add GetWebAccountPassword, SetWebAccountPassword, and ValidateWebAccountPassword
+                            services.
+        10/31/18    dmb     [SRPFW-254] Update the AuthenticateRequest service to use the ValidateWebAccountPassword
+                            service rather than relying upon a hardcoded USERS table. 
+        11/01/18    dmb     [SRPFW-256] Update NewPasswordTimeToLive$ equate to use the GetNewPasswordTimeToLive service
+                            rather than the hardcoded value.
+        11/01/18    dmb     [SRPFW-256] Update OldPasswordTimeToLive$ equate to use the GetOldPasswordTimeToLive service
+                            rather than the hardcoded value.
+        11/09/18    dmb     [SRPFW-256] Update ValidateWebAccountPassword service to implement the containment action if
+                            too many failed password attempts have been attempted.
+        11/20/18    dmb     [SRPFW-256] Add GetWebAccountEnabledStatus service. Update the AuthenticateRequest service
+                            to use it before attempting to validate the password.
+        11/21/18    dmb     [SRPFW-257] Add ResetWebAccountPassword service.
+        11/21/18    dmb     [SRPFW-257] Update SetWebAccountPassword service to support a flag that ignores expiration
+                            date.
+        11/23/18    dmb     [SRPFW-257] Add SetAuthenticatedAccountID and GetAuthenticatedAccountID services.
+        12/12/18    dmb     [SRPFW-257] Add SetAuthenticatedPassword and GetAuthenticatedPassword services.
+        06/24/19    dmb     [SRPFW-276] Update the ValidateWebAccountPassword service to reset the invalid password
+                            attempt counter for an account if a valid password is passed in.
+        12/09/19    dmb     [SRPFW-296] Update all calls to Memory_Services to use a specific cache name.
+        06/30/20    dmb     [SRPFW-313] Update the AuthenticateRequest service to return a 403 status code rather than
+                            a 511 status code if the IP making the request is not permitted.
+        07/27/20    dmb     [SRPFW-313] Replace references to the IPIsPermitted service with the IsIPPermitted service.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert SERVICE_SETUP
+$insert HTTP_INSERTS
+
+Equ SecondsPerHour$                 to 60 * 60                                                      ; // 60 minutes * 60 seconds = 3600
+Equ SecondsPerDay$                  to 24 * SecondsPerHour$                                         ; // 24 hours * 60 minutes * 60 seconds = 86400
+Equ NewPasswordTimeToLive$          to HTTP_Services('GetNewPasswordTimeToLive') * SecondsPerHour$  ; // Convert hours to seconds
+Equ OldPasswordTimeToLive$          to HTTP_Services('GetOldPasswordTimeToLive') * SecondsPerHour$  ; // Convert hours to seconds
+Equ CacheName$                      to 'SRPHTTPFramework'
+
+Declare function    Database_Services, RTI_CreateGUID
+Declare subroutine  Database_Services
+
+GoToService else
+    Error_Services('Add', Service : ' is not a valid service request within the HTTP Authentication services module.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN                     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// AuthenticateRequest
+//
+// Returns a boolean value indicating the success of the authentication attempt. Default method is built around
+// HTTP Basic Authentication.
+//----------------------------------------------------------------------------------------------------------------------
+Service AuthenticateRequest()
+
+    // All response headers that need to be set, regardless of authentication, should be handled here.
+    //  1. Access-Control-Allow-Origin must always be returned for CORS purposes.
+    HTTP_Services('SetResponseHeaderField', 'Access-Control-Allow-Origin', '*')
+
+    EnableAuthentication        = HTTP_Services('GetEnableAuthenticationFlag')
+    FullEndPointURL             = HTTP_Services('GetFullEndPointURL')
+    URLRequiresAuthentication   = HTTP_Services('URLRequiresAuthentication', FullEndPointURL)
+
+    // Set the default status code and phrase if authentication fails.
+    StatusCode      = 401
+    StatusPhrase    = ''
+
+    If EnableAuthentication AND URLRequiresAuthentication then
+        HTTPMethod      = HTTP_Services('GetHTTPRequestMethod')
+        HTTPRemoteAddr  = HTTP_Services('GetHTTPRemoteAddr')
+
+        // Verify that the client IP is permitted. If there are no whitelisted IPs, then all IPs are permitted.
+        IsIPPermitted = HTTP_Services('IsIPPermitted', HTTPRemoteAddr)
+        If IsIPPermitted EQ True$ then
+            If HTTPMethod _EQC 'OPTIONS' then
+                // OPTIONS methods are never authenticated. Allow the user to be provisionally authenticated since the method
+                // will remains as OPTIONS throughout the entire API.
+                UserAuthenticated   = True$
+            end else
+                // Assume the user is not authenticated until otherwise proven.
+                UserAuthenticated   = False$
+
+                // The follow code provides a skeleton for support HTTP Basic authorization. This is a REST friendly
+                // authentication protocol and is documented in the core HTTP specification. Because REST does not preserve the
+                // state, all requests are authenticated regardless of previous authentication successes. HTTP Basic should
+                // only be used if https:// is being used. Otherwise, the credentials are being passed through as plain text.
+
+
+                // HTTP Basic uses the Authorization request header. However, the Authorization request header field does not
+                // always work with web server products when being passed to a third-party service. So, if the standard header
+                // returns nothing then check the custom X-Authorization request header.
+                AuthorizationB64    = HTTP_Services('GetRequestHeaderField', 'Authorization')
+                If AuthorizationB64 EQ '' then AuthorizationB64 = HTTP_Services('GetRequestHeaderField', 'X-Authorization')
+
+                If AuthorizationB64 NE '' then
+                    // All HTTP Basic credentials should be Base64 encoded (in addition to encrypted via https://). Decode
+                    // the credentials.
+                    Authorization   = SRP_Decode(AuthorizationB64[7, 999], 'BASE64')
+
+                    // HTTP Basic credentials are always colon (:) delimited. Typically this will come through as
+                    // Username:Password, but there could be other formats if the application requires it. For instance, for
+                    // applications supporting multiple customers wherein each customer has their own group of users, the
+                    // format could look like this CustomerID/Username:Password. This provides, in a sense, a three-part
+                    // identifier. The following parsing logic would need to be adjusted as needed.
+                    Username        = Authorization[1, ':']
+                    Password        = Authorization[Col2() + 1, 999]
+                    EnabledStatus   = HTTP_Authentication_Services('GetWebAccountEnabledStatus', Username)
+                    If EnabledStatus EQ True$ then
+                        // Only authenticate if a username and password is provided. This prevents authenticating in the event
+                        // the USERS row is missing a password or the USERS table has a blank row.
+                        If (Username NE '') AND (Password NE '') then
+                            // Below is where you would place your logic to validate the username, password, and any other credentials
+                            // that were passed in. This code uses the default HTTP Framework WEB_ACCOUNTS table.
+
+                            UserAuthenticated   = HTTP_Authentication_Services('ValidateWebAccountPassword', Username, Password, False$)
+
+                            // A successful login should set the WWW-Authenticate response header field with the appropriate value. The
+                            // credentials are stored in memory so they can be retrieved by other services as needed.
+                            If UserAuthenticated then
+                                UserAuthenticated   = True$
+                                HTTP_Authentication_Services('SetAuthenticatedAccountID', Username)
+                                HTTP_Authentication_Services('SetAuthenticatedPassword', Password)
+                                // The realm attribute is a part of the HTTP authentication specification and is used to help identify all
+                                // resources that belong to the same authentication. Typically this will be the same value for all requests
+                                // within the same application. The branded name or OpenInsight name of the application would be a good
+                                // example to use here.
+                                Realm               = HTTP_Services('GetRealmValue')
+                                HTTP_Services('SetResponseHeaderField', 'WWW-Authenticate', 'xBasic realm="' : Realm : '"')
+                            end
+                        end
+                    end else
+                        // IP address making the request is not permitted. Do not authenticate the user.
+                        StatusCode          = 403
+                        StatusPhrase        = 'Account ' : Username : ' is disabled.'
+                        UserAuthenticated   = False$
+                    end
+                end
+            end
+        end else
+            // IP address making the request is not permitted. Do not authenticate the user.
+            StatusCode        = 403
+            StatusPhrase      = HTTPRemoteAddr : ' is not a permitted IP address.'
+            UserAuthenticated = False$
+        end
+    end else
+        // Force the user to be authenticated since authentication is not enabled.
+        UserAuthenticated = True$
+    end
+
+    // Non-authenticated requests should have a 401 status code returned.
+    If Not(UserAuthenticated) then
+        HTTP_Services('SetResponseError', '', '', StatusCode, StatusPhrase, FullEndpointURL)
+    end
+
+    Response    = UserAuthenticated
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// CleanUp
+//
+// Runs any clean up processes as needed to prepare the engine for the next request.
+//----------------------------------------------------------------------------------------------------------------------
+Service CleanUp()
+
+    // This service is called from HTTP_MCP before sending the response back to the caller. Any application specific
+    // logic that stores data in memory or attaches customer specific database tables should be properly closed out
+    // to avoid subsequent requests from having innappropriate access.
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetWebAccountEnabledStatus
+//
+// Gets the enabled status for the indicated web account.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetWebAccountEnabledStatus(AccountID)
+
+    EnabledStatus   = ''
+
+    If AccountID NE '' then
+        WebAccountRow   = Database_Services('ReadDataRow', 'WEB_ACCOUNTS', AccountID)
+        If Error_Services('NoError') then
+            @DICT   = Database_Services('GetTableHandle', 'DICT.WEB_ACCOUNTS')
+            @ID     = AccountID
+            @RECORD = WebAccountRow
+            EnabledStatus   = {ACCOUNT_ENABLED}
+            If EnabledStatus NE True$ then EnabledStatus = False$   ; // Always default to disabled unless explicitly enabled.
+        end
+    end else
+        Error_Services('Add', 'AccountID argument was missing in the ' : Service : ' service.')
+    end
+
+    Response    = EnabledStatus
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetWebAccountPassword
+//
+// Gets the current password for the indicated web account. If the CreateIfNew flag is set to True$, a new password will
+// be generated if no password currently exists. This new password will be added to the web account.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetWebAccountPassword(AccountID, CreateIfNew)
+
+    Password    = ''
+
+    If CreateIfNew NE True$ then CreateIfNew = False$
+
+    If AccountID NE '' then
+        WebAccountRow   = Database_Services('ReadDataRow', 'WEB_ACCOUNTS', AccountID)
+        If Error_Services('NoError') then
+            @DICT   = Database_Services('GetTableHandle', 'DICT.WEB_ACCOUNTS')
+            @ID     = AccountID
+            @RECORD = WebAccountRow
+            Begin Case
+                Case ({CURRENT_PASSWORD} EQ '') AND (CreateIfNew EQ True$)
+                    Password    = HTTP_Authentication_Services('ResetWebAccountPassword', AccountID, CurrentPassword)
+
+                Case ({CURRENT_PASSWORD} EQ '') AND (CreateIfNew EQ False$)
+                    Error_Services('Add', 'No password exists for Account ID ' : AccountID)
+
+                Case Otherwise$
+                    Password    = {CURRENT_PASSWORD}
+
+            End Case
+        end
+    end else
+        Error_Services('Add', 'AccountID argument was missing in the ' : Service : ' service.')
+    end
+
+    Response    = Password
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ResetWebAccountPassword
+//
+// Resets the current password (or creates a new one) for the indicated web account. This new password will be added to
+// the web account.
+//----------------------------------------------------------------------------------------------------------------------
+Service ResetWebAccountPassword(AccountID, CurrentPassword)
+
+    Password    = ''
+
+    If AccountID NE '' then
+        WebAccountRow   = Database_Services('ReadDataRow', 'WEB_ACCOUNTS', AccountID)
+        If Error_Services('NoError') then
+            @DICT   = Database_Services('GetTableHandle', 'DICT.WEB_ACCOUNTS')
+            @ID     = AccountID
+            @RECORD = WebAccountRow
+            // Password is based on a random GUID and then encoded as Base64.
+            Password    = RTI_CreateGUID('B')
+            HTTP_Authentication_Services('SetWebAccountPassword', AccountID, CurrentPassword, Password, True$)
+            If Error_Services('HasError') then Password = ''
+        end
+    end else
+        Error_Services('Add', 'AccountID argument was missing in the ' : Service : ' service.')
+    end
+
+    Response    = Password
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ValidateWebAccountPassword
+//
+// Validates the password for the indicated web account. If the CurrentOnly argument is set to True$, then only the
+// current password associated with the web account will be validated. Otherwise, the old password will also be valided
+// using the expiration date and time associated.
+//----------------------------------------------------------------------------------------------------------------------
+Service ValidateWebAccountPassword(AccountID, Password, CurrentOnly)
+
+    Valid           = False$    ; // Assume False$ for now.
+    ErrorMessage    = ''
+
+    If CurrentOnly NE True$ then CurrentOnly = False$
+
+    If (AccountID NE '') AND (Password NE '') then
+        WebAccountRow   = Database_Services('ReadDataRow', 'WEB_ACCOUNTS', AccountID)
+        If Error_Services('NoError') then
+            @DICT       = Database_Services('GetTableHandle', 'DICT.WEB_ACCOUNTS')
+            @ID         = AccountID
+            @RECORD     = WebAccountRow
+            ThisSeconds = Date() * SecondsPerDay$ + Time()
+            Begin Case
+                Case Password EQ {CURRENT_PASSWORD}
+                    ExpireSeconds   = {CURRENT_PASSWORD_EXPIRE_DATE} * SecondsPerDay$ + {CURRENT_PASSWORD_EXPIRE_TIME}
+                    If ThisSeconds LE ExpireSeconds then
+                        Valid           = True$
+                    end else
+                        ErrorMessage    = 'Password is expired. A new one needs to be requested.'
+                    end
+
+                Case (Password EQ {OLD_PASSWORD}) AND (CurrentOnly EQ False$)
+                    ExpireSeconds   = {OLD_PASSWORD_EXPIRE_DATE} * SecondsPerDay$ + {OLD_PASSWORD_EXPIRE_TIME}
+                    If ThisSeconds LE ExpireSeconds then
+                        Valid           = True$
+                    end else
+                        ErrorMessage    = 'Password is expired. A new one needs to be requested.'
+                    end
+
+                Case Otherwise$
+                    ErrorMessage    = 'Password is invalid.'
+
+            End Case
+
+            If ErrorMessage EQ '' then
+                // Reset the number of invalid password attempts for the account.
+                {INVALID_PASSWORD_ATTEMPTS} = 0
+                Database_Services('WriteDataRow', 'WEB_ACCOUNTS', @ID, @RECORD, True$, False$, True$)
+            end else
+                // Update the total invalid password attempts for this server.
+                Attempts                    = HTTP_Services('GetTotalInvalidPasswordAttempts')
+                Attempts                   += 1
+                HTTP_Services('SetTotalInvalidPasswordAttempts', Attempts)
+                // Update the total invalid password attempts for this account.
+                InvalidPasswordAttempts     = {INVALID_PASSWORD_ATTEMPTS} + 1
+                {INVALID_PASSWORD_ATTEMPTS} = InvalidPasswordAttempts
+                Database_Services('WriteDataRow', 'WEB_ACCOUNTS', @ID, @RECORD, True$, False$, True$)
+                InvalidPasswordLimit        = HTTP_Services('GetInvalidPasswordLimit')
+                If InvalidPasswordAttempts GE InvalidPasswordLimit then
+                    ContainmentAction   = HTTP_Services('GetContainmentAction')
+                    Begin Case
+                        Case ContainmentAction _EQC 'Disable Server'
+                            HTTP_Services('SetServerEnabled', False$)
+                        Case ContainmentAction _EQC 'Quarantine Account'
+                            {ACCOUNT_ENABLED}   = False$
+                            WebAccountRow       = @RECORD
+                            Database_Services('WriteDataRow', 'WEB_ACCOUNTS', AccountID, WebAccountRow, True$, False$, True$)
+                    End Case
+                    ActionDetails       = ''
+                    ActionDetails<1>    = Fmt('Containment Action:', 'L#35') : ContainmentAction
+                    ActionDetails<2>    = Fmt('Invalid Password Limit:', 'L#35') : InvalidPasswordLimit
+                    ActionDetails<3>    = Fmt('Total Invalid Password Attempts:', 'L#35') : Attempts
+                    ActionDetails<4>    = Fmt('Account ID:', 'L#35') : AccountID
+                    ActionDetails<5>    = Fmt('Total Account Invalid Attempts:', 'L#35') : InvalidPasswordAttempts
+                    HTTP_Authentication_Services('ContainmentActionNotification', ActionDetails)
+                end
+                Error_Services('Add', ErrorMessage)
+            end
+        end
+    end else
+        Error_Services('Add', 'AccountID or Password argument was missing in the ' : Service : ' service.')
+    end
+
+    Response    = Valid
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetWebAccountPassword
+//
+// Sets a new password for the indicated web account. If no current password already exists, then the new password will
+// be added to the web account automatically. Otherwise, the current password will be verified before allowing a new
+// password to be set.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetWebAccountPassword(AccountID, CurrentPassword, NewPassword, OverrideExpireDate)
+
+    If OverrideExpireDate NE True$ then OverrideExpireDate = False$
+
+    If (AccountID NE '') AND (NewPassword NE '') then
+        WebAccountRow   = Database_Services('ReadDataRow', 'WEB_ACCOUNTS', AccountID)
+        If Error_Services('NoError') then
+            @DICT   = Database_Services('GetTableHandle', 'DICT.WEB_ACCOUNTS')
+            @ID     = AccountID
+            @RECORD = WebAccountRow
+            If {CURRENT_PASSWORD} EQ '' then
+                // This is a new password for this web account. Accept the new password.
+                CreateDate      = Date()
+                CreateTime      = Time()
+                CreateSeconds   = CreateDate * SecondsPerDay$ + CreateTime
+                ExpireSeconds   = CreateSeconds + NewPasswordTimeToLive$
+                ExpireDate      = Int(ExpireSeconds / SecondsPerDay$)
+                ExpireTime      = Mod(ExpireSeconds, SecondsPerDay$)
+                {CURRENT_PASSWORD}              = NewPassword
+                {CURRENT_PASSWORD_CREATE_DATE}  = CreateDate
+                {CURRENT_PASSWORD_CREATE_TIME}  = CreateTime
+                {CURRENT_PASSWORD_EXPIRE_DATE}  = ExpireDate
+                {CURRENT_PASSWORD_EXPIRE_TIME}  = ExpireTime
+                WebAccountRow   = @RECORD
+                Database_Services('WriteDataRow', 'WEB_ACCOUNTS', AccountID, WebAccountRow, True$, False$, True$)
+            end else
+                // A current password already exists.
+                Valid   = HTTP_Authentication_Services('ValidateWebAccountPassword', AccountID, CurrentPassword, True$) OR (OverrideExpireDate EQ True$)
+                If Valid EQ True$ then
+                    Begin Case
+                        Case CurrentPassword EQ NewPassword
+                            // New password must be different than the current password.
+                            Error_Services('Add', 'New password must be different than the current password.')
+
+                        Case Otherwise$
+                            // Current password is valid and new password is different.
+
+                            // Make the current password the old passowrd. Reset the expiration date and time as
+                            // needed.
+                            CurrentPassword                 = {CURRENT_PASSWORD}
+                            CurrentPasswordCreateDate       = {CURRENT_PASSWORD_CREATE_DATE}
+                            CurrentPasswordCreateTime       = {CURRENT_PASSWORD_CREATE_TIME}
+                            {OLD_PASSWORD}                  = CurrentPassword
+                            {OLD_PASSWORD_CREATE_DATE}      = CurrentPasswordCreateDate
+                            {OLD_PASSWORD_CREATE_TIME}      = CurrentPasswordCreateTime
+                            ThisSeconds                     = Date() * SecondsPerDay$ + Time()
+                            ExpireSeconds                   = ThisSeconds + OldPasswordTimeToLive$
+                            ExpireDate                      = Int(ExpireSeconds / SecondsPerDay$)
+                            ExpireTime                      = Mod(ExpireSeconds, SecondsPerDay$)
+                            {OLD_PASSWORD_EXPIRE_DATE}      = ExpireDate
+                            {OLD_PASSWORD_EXPIRE_TIME}      = ExpireTime
+
+                            // Set the new password information.
+                            CreateDate                      = Date()
+                            CreateTime                      = Time()
+                            CreateSeconds                   = CreateDate * SecondsPerDay$ + CreateTime
+                            ExpireSeconds                   = CreateSeconds + NewPasswordTimeToLive$
+                            ExpireDate                      = Int(ExpireSeconds / SecondsPerDay$)
+                            ExpireTime                      = Mod(ExpireSeconds, SecondsPerDay$)
+                            {CURRENT_PASSWORD}              = NewPassword
+                            {CURRENT_PASSWORD_CREATE_DATE}  = CreateDate
+                            {CURRENT_PASSWORD_CREATE_TIME}  = CreateTime
+                            {CURRENT_PASSWORD_EXPIRE_DATE}  = ExpireDate
+                            {CURRENT_PASSWORD_EXPIRE_TIME}  = ExpireTime
+                            WebAccountRow   = @RECORD
+                            Database_Services('WriteDataRow', 'WEB_ACCOUNTS', AccountID, WebAccountRow, True$, False$, True$)
+                    End Case
+                end
+            end
+        end
+    end else
+        Error_Services('Add', 'AccountID or NewPassword argument was missing in the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetAuthenticatedAccountID
+//
+// Sets the account ID that was successfully authenticated for this request.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetAuthenticatedAccountID(AccountID)
+
+    If AccountID NE '' then
+        Memory_Services('SetValue', ServiceModule : '*AuthenticatedAccountID', AccountID, CacheName$)
+    end
+    
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetAuthenticatedAccountID
+//
+// Gets the successfully authenticated account ID for this request.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetAuthenticatedAccountID()
+
+    AccountID   = Memory_Services('GetValue', ServiceModule : '*AuthenticatedAccountID', '', '', CacheName$)
+
+    Response    = AccountID
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetAuthenticatedPassword
+//
+// Sets the password that was successfully authenticated for this request.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetAuthenticatedPassword(Password)
+
+    If Password NE '' then
+        Memory_Services('SetValue', ServiceModule : '*AuthenticatedPassword', Password, CacheName$)
+    end
+    
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetAuthenticatedPassword
+//
+// Gets the successfully authenticated password for this request.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetAuthenticatedPassword()
+
+    Password    = Memory_Services('GetValue', ServiceModule : '*AuthenticatedPassword', '', '', CacheName$)
+
+    Response    = Password
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ContainmentActionNotification
+//
+// Handles notification protocols when a containment breach has occured. This handler is mostly a placeholder for
+// developers to add their own custom protocol action.
+//----------------------------------------------------------------------------------------------------------------------
+Service ContainmentActionNotification(ActionDetails)
+
+end service
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+

FRAMEWORKS/STPROC/HTTP_CONTACTS_SERVICES.txt

@@ -0,0 +1,535 @@
+Function HTTP_Contacts_Services(RemainingURL)
+/***********************************************************************************************************************
+
+    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_Contacts_Services
+
+    Description :   Handler program for the HTTP Contacts service module.
+
+    Notes       :   In the comments below, the term "resource" will be used. In most cases this is synonymous with a
+                    database row, but the web (and especially REST) abstracts all information being returned simply as a
+                    "resource". This provides developers more flexibility in their web API designs. For instance, a
+                    resource can be a combination of various different database rows and other data (like images,
+                    documents, etc.)
+
+                    In this sample service, the "contact" resource will closely map to a sample CONTACTS database table.
+                    This is meant to provide the OpenInsight web API developer an easy way to create a web-based CRUD
+                    API that can also be extended as needed. Locking is performed on the resource at the database row
+                    level using the Lock statement, but this is only done just prior to the Write statement since HTTP
+                    is a stateless protocol. While some attempts to wait for the lock to be available could be added,
+                    this is normally discouraged since this could cause the HTTP request to take too long to finish.
+
+                    All HTTP web services should include the HTTP_SERVICE_SETUP insert. This will provide several useful
+                    variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        SelfURL                 - The URL path representing the current service.
+                        FullEndPointURL         - The URL submitted by the client. This can be the same or longer than
+                                                  the SelfURL.
+                        NextSegment             - The URL segment immediately following the SelfURL (if any). This
+                                                  could contain the name of the next service or it could contain the
+                                                  Item ID for the current service (aka resource).
+                        CurrentServiceHandler   - The name of this stored procedure.
+
+    Parameters  :
+        RemainingURL    [in] -- The remaining portion of the URL that follows the URL that launched this current
+                                service. This information is used in the HTTP_SERVICE_SETUP insert to populate other
+                                useful variables (see Notes above).
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        04/17/15    dmb     Original programmer. - [SRPFW-96]
+        03/09/16    dmb     Refactor to use the updated RunHTTPService service. - [SRPFW-112]
+        07/01/17    dmb     Refactor using Enhanced BASIC+ syntax. - [SRPFW-184]
+        07/07/17    dmb     Add support for PUT and PATCH so this routine can serve as a more complete CRUD example.
+                            - [SRPFW-187]
+        07/08/17    dmb     Remove checks for query parameters from the main router and make this a function of the
+                            GET method/URL handler. - [SRPFW-187]
+        07/19/18    dmb     Fix minor typo in the NextSegment variable in the GetItem method. - [SRPFW-248]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert HTTP_SERVICE_SETUP
+$insert HTTP_INSERTS
+
+// In the comments related to URL examples, words surrounded by "{" and "}" represent the names of values that
+// will appear in the actual URL. Words surrounded by "<" and ">" represent variables that contain values relevant to
+// the actual URL. See the Notes above for a list of the most important variables.
+//
+// For instance, <APIURL>/contacts/{KeyID} could look like https://api.mysite.com/v1/contacts/1000, assuming <APIURL>
+// resolves to "https://api.mysite.com/v1" and {KeyID} resolves to "1000".
+//
+// The type of request being made needs to be determined based on the URL content. There are only a few possibilities
+// that this API will support:
+//
+//   All Resources              = <APIURL>/contacts
+//   Specific Resource          = <APIURL>/contacts/{KeyID}
+//   Specific Resource Property = <APIURL>/contacts/{KeyID}/{property}
+//
+// Also, any URL can end with query parameters like this:
+//
+//   Resource Query             = <APIURL>/contacts?{property}={value}
+//
+// The request will go to the same handler as if the query parameters were missing but that handler itself will
+// determine if the query parameters will be used or ignored. 
+
+// Assume the current HTTP method is valid until proven otherwise.
+ValidMethod     = True$
+// Assume the current web service is valid until provent otherwise.
+ValidService    = True$
+// Assume no HTTP methods are valid until proven otherwise.
+AllowedMethods  = ''
+// A list of all services able to be called from this URL.
+AllowedServices = 'picture'
+
+// Handle the HTTP request as needed.
+Begin Case
+    Case RemainingURL _EQC ''
+        // This means the URL ends with /contacts, which means this is the end point. The HTTP methods roughly function
+        // as follows:
+        //
+        //  POST    - Creates a new resource. Assumes the server will generate the Key ID, which will be returned in the
+        //            HTTP response.
+        //  GET     - The client is requesting a collection of all contacts.
+        AllowedMethods  = 'POST,GET,OPTIONS'
+        Locate HTTPMethod in AllowedMethods using ',' setting MethodPos then
+            On MethodPos GoSub Post, Get, Options
+        end else
+            ValidMethod = False$
+        end
+
+    Case Count(RemainingURL, '/') EQ 0
+        // This means the URL ends with /contacts/{KeyID}. {KeyID} is also known as the resource ID. When a resource is
+        // closely mapped to a database row (as is the case with this Contacts API), this is where the basic CRUD
+        // functionality will be added. The HTTP methods roughly function as follows:
+        //
+        //  PUT     - Creates* a resource using the Key ID contained in the URL. This is equivalent to the Write
+        //            statement in BASIC+. 
+        //  GET     - Reads the resource referenced by the Key ID contained in the URL. This is equivalent to the Read
+        //            statement in BASIC+.
+        //  PUT     - Updates* the resource referenced by the Key ID contained in the URL. This is the exact same
+        //            feature defined above. This should make sense since the Write statement in BASIC+ is used to
+        //            create and update database rows. Note, the PUT method assumes the entire resource is within the
+        //            request body, not just the changes. See the PATCH method below.
+        //  DELETE  - Deletes the source referenced by the Key ID contained in the URL. This is equivalent to the Delete
+        //            statement in BASIC+.
+        //
+        //  * Many people use the POST method for creating (and updating) a resource. However, per the HTTP
+        //    specification, POST is to be used when creating a new resource that does not yet have a resource ID
+        //    (i.e., Key ID). The server determines the Key ID and this is returned to the client for future use.
+        //
+        // PATCH    - Updates specific properties (e.g., data columns) of the resource referenced by the Key ID
+        //            contained in the URL. This is similar in concept to the WriteV statement in BASIC+, although
+        //            multiple changes in the resource can be updated with one PATCH method.
+        AllowedMethods  = 'PUT,GET,DELETE,PATCH,OPTIONS'
+        Locate HTTPMethod in AllowedMethods using ',' setting MethodPos then
+            On MethodPos GoSub PutItem, GetItem, DeleteItem, PatchItem, OptionsItem
+        end else
+            ValidMethod = False$
+        end
+
+    Case Count(RemainingURL, '/') GE 1
+        // This means the URL ends with /contacts/{KeyID}/{property}. A property can be any specific data that is
+        // associated with the resource. It could be a column value, an image, a PDF document, etc. In this case, the
+        // only property supported by this web API is the contact's "picture". The developer can put add code in this
+        // service to update the picture or the developer can create another HTTP service to handle this. Since a
+        // "picture" service might be useful as a property for other types of resources, a call to a dedicated "picture"
+        // HTTP service will be made "as is" so it can handle the request. Calling another HTTP service is similar to
+        // the way one MFS calls another MFS by modifying the FS list. In this case, the NextSegment and RemainingURL
+        // variables will need to be modified.
+        Property    = FullEndPointURL[-1, 'B/']
+        Locate Property in AllowedServices using ',' setting ServicePos then
+            NextSegment     = Property  ; // This allows the RunHTTPService to call HTTP_PICTURE_SERVICES.
+            RemainingURL    = ''        ; // This variable won't be used in the HTTP_PICTURE_SERVICES code, but to keep the
+                                        ; // variables well formed, this should be cleared.
+            HTTP_Services('RunHTTPService', NextSegment, RemainingURL)
+        end else
+            ValidService    = False$
+        end
+
+    Case Otherwise$
+        ValidService    = False$
+End Case
+
+// Resolve any invalid conditions with the HTTP request.
+Begin Case
+    Case Not(ValidService)
+        HTTP_Services('SetResponseStatus', 404, NextSegment : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+
+    Case Not(ValidMethod)
+        HTTP_Services('SetResponseStatus', 405, HTTPMethod : ' is not valid for this service.')
+
+        GoSub SetAllowedMethods
+End Case
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN                     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Web Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// Post
+//
+// Attempts to create a new resource. Creating a new which is a database row follows these guidelines:
+//
+//   - Any unexpected system errors will return a 500 status code (Internal Server Error).
+//   - If no errors occur then a 201 (Created) status code is returned. The Content-Location response header will be
+//     set to the value of the URL that will allow the client to GET the newly created resource.
+//   - If there is an error locking the resource then a 423 status code (Locked) is returned.
+//----------------------------------------------------------------------------------------------------------------------
+Post:
+
+    HTTP_Resource_Services('PostDatabaseItem', 'CONTACTS', SelfURL)
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Get
+//
+// Returns a collection of resources.
+//
+// The easiest way to return a list of resources that are mapped to a database table is to use the GetDatabaseItems
+// service. This is being done in the code below. This URL also supports the passing in of query parameters, which in
+// this case will be used to return those items that match the property/value query.
+//
+// A property can be any specific data that is associated with the resource. It could be a column value, an image, a PDF
+// document, etc. In this case, only properties that match the name of database columns in the CONTACTS table will be
+// supported by this web API. Note, developers can limit the properties (aka columns) to those that are indexed in order
+// to avoid having a request take too long.
+//----------------------------------------------------------------------------------------------------------------------
+Get:
+
+    HAL = ''    ; // Initialize the response.
+
+    If HTTP_Services('GetHTTPGetString') NE '' then
+        // This means the URL ends with /contacts?{property}={value}. The client is searching for one or more contacts
+        // that match the query parameters. This is equivalent to doing a filtered RLIST search.
+
+        // Get the query string passed into the URL.
+        GetString   = HTTP_Services('GetHTTPGetString')
+        // Get the name of the property being queried.
+        Property    = GetString[1, 'F=']
+        // Get the value being searched for.
+        Value       = HTTP_Services('GetQueryField', Property)
+        // Get the database columns for the table.
+        ColumnNames = HTTP_Resource_Services('GetColumnNames', 'CONTACTS')
+        ColumnName  = Property
+        Convert @Lower_Case to @Upper_Case in ColumnName
+        // Verify the property matches a valid column in the table.
+        Locate ColumnName in ColumnNames using @FM setting fPos then
+            // Use the GetDatabaseItems service to perform the search and prepare the HAL+JSON response. If a more complex
+            // or optimized solution is needed, then replace the following with custom code.
+            Filter      = 'SELECT CONTACTS WITH ' : ColumnName : ' CONTAINING ' : Quote(Value)
+            // The GetDatabaseItems service will return all database column values unless otherwise specified. Since a query
+            // search might generated several results, it is sometimes best to pass in just those columns that are important
+            // for the query result.
+            ColumnNames = 'first_name' : @FM : 'last_name' : @FM : 'email'
+            Locate ColumnName in ColumnNames using @FM setting fPos else
+                // Make sure the property being searched is included in the columns being returned.
+                ColumnNames    := @FM : Property
+            end
+            HAL         = HTTP_Resource_Services('GetDatabaseItems', Filter, 'CONTACTS', SelfURL, ColumnNames)        
+        end else
+            // This is not a valid property, which means the URL does not resolve. Set a 404 error. Add a description if
+            // desired.
+            HTTP_Services('SetResponseStatus', 404)
+        end
+
+    end else
+        // This means the URL ends with /contacts. The client is requesting all resources available at this URL.
+        // This is equivalent to performing an unfiltered SELECT statement. The ColumnNames argument for the
+        // GetDatabaseItems service specifies which values should be represented in the JSON response.
+
+        Filter      = ''
+        ColumnNames = 'first_name' : @FM : 'last_name' : @FM : 'email'
+        HAL         = HTTP_Resource_Services('GetDatabaseItems', Filter, 'CONTACTS', SelfURL, ColumnNames)
+
+    end
+
+    Response    = HAL
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Options
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+Options:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// PutItem
+//
+// Attempts to update the resource. If the resource does not already exist then a new one will be created. Updating a
+// resource which is a database row follows these guidelines:
+//
+//   - Any unexpected system errors will return a 500 status code (Internal Server Error).
+//   - If no errors occur then a 200 (OK) status code is returned if the resource previously existed. Otherwise,
+//     a 201 (Created) status code is returned and the Content-Location response header will be set to the value of the
+//     URL that will allow the client to GET a newly created resource.
+//   - If there is an error locking the resource then a 423 status code (Locked) is returned.
+//----------------------------------------------------------------------------------------------------------------------
+PutItem:
+
+    KeyID   = NextSegment
+
+    HTTP_Resource_Services('PutDatabaseItem', 'CONTACTS', SelfURL : '/' : KeyID, KeyID)
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetItem
+//
+// Returns the specific resource.
+//
+// The easiest way to return a resource that is mapped to a database row is to use the GetDatabaseItem service. This
+// is being done in the code below. However, to demonstrate how then basic functionality can be extended, there is
+// additional code below that will show how to add the Contact resource's image URL to the JSON response.
+//----------------------------------------------------------------------------------------------------------------------
+GetItem:
+
+    KeyID   = NextSegment
+
+    // Calling this service alone would be sufficient to return a HAL+JSON representation of the specified contact.
+    HAL     = HTTP_Resource_Services('GetDatabaseItem', 'CONTACTS', SelfURL : '/' : KeyID, KeyID)
+
+    // Since the Contact resource can also have an image, the following code will generate a valid URL for this image
+    // in case the client wants to retrieve it. The URL will then be added to the HAL+JSON response so this comes
+    // back as a single representation of the resource.
+    If HAL NE '' then
+        // Make the JSON content an object so the SRP_JSON API can work with it.
+        ParseResponse   = SRP_JSON(HALRootObj, 'PARSE', HAL)
+        If ParseResponse EQ '' then
+            // The CONTACTS table has a PICTURE data column. This stores the physical path to the image, but this is
+            // not useful to the HTTP client. Create a URL that will allow the client to retrieve the image.
+            PictureValue    = SRP_JSON(HALRootObj, 'GETVALUE', 'picture', '')
+            If PictureValue NE '' then
+                If SRP_JSON(PictureObj, 'NEW', 'OBJECT') then
+                    // Create the URL and add it to the JSON object.
+                    ImageURL    = SelfURL : '/' : KeyID : '/picture'
+                    SRP_JSON(PictureObj, 'SETVALUE', 'href', ImageURL)
+                    SRP_JSON(PictureObj, 'SETVALUE', 'name', 'picture-' : KeyID)
+                    SRP_JSON(HALRootObj, 'SET', 'picture', PictureObj)
+                    HAL         = SRP_JSON(HALRootObj, 'STRINGIFY', 'STYLED')
+                    // Set the HTTP response body with the final HAL+JSON results.
+                    HTTP_Services('SetResponseBody', HAL, False$, 'application/hal+json')
+                    SRP_JSON(PictureObj, 'RELEASE')
+                end
+            end
+            SRP_JSON(HALRootObj, 'RELEASE')
+        end
+    end
+
+    Response    = HAL
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// DeleteItem
+//
+// Attempts to delete the resource. Deleting a resource which is a database row follows these guidelines:
+//
+//   - Any unexpected system errors will return a 500 status code (Internal Server Error).
+//   - If no errors occur then a 204 (No Content) status code is returned.
+//   - If the resource was already deleted then a 204 (No Content) status code is returned.
+//   - If there is an error locking the resource then a 423 status code (Locked) is returned.
+//----------------------------------------------------------------------------------------------------------------------
+DeleteItem:
+
+    KeyID   = NextSegment
+
+    HTTP_Resource_Services('DeleteDatabaseItem', 'CONTACTS', KeyID)
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// PatchItem
+//
+// Attempts to update the resource. Updating a resource which is a database row follows these guidelines:
+//
+//   - Any unexpected system errors will return a 500 status code (Internal Server Error).
+//   - If no errors occur then a 200 (OK) status code is returned.
+//   - If the resource is new then a 404 (Not Found) status code is returned. PATCH only works with existing resources.
+//   - Only those properties (columns) which are passed in will get updated.
+//   - If there is an error locking the resource then a 423 status code (Locked) is returned.
+//----------------------------------------------------------------------------------------------------------------------
+PatchItem:
+
+    KeyID   = NextSegment
+
+    HTTP_Resource_Services('PatchDatabaseItem', 'CONTACTS', SelfURL : '/' : KeyID, KeyID)
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// OptionsItem
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+OptionsItem:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// PutItemProperty
+//
+// Attempts to update the property of a specific resource.
+//
+// A property can be any specific data that is associated with the resource. It could be a column value, an image, a PDF
+// document, etc. In this case, the only property supported by this web API is the contact's "picture". The developer
+// can put add code here to update the picture or the developer can create another HTTP service to handle this. Since a
+// "picture" service might be useful as a property for other types of resources, a call to a dedicated "picture" HTTP
+// service will be made.
+//
+// Calling another HTTP service is similar to the way one MFS calls another MFS by modifying the FS list. In this case,
+// the NextSegment and RemainingURL variables will need to be modified. At this point in the stack the following
+// API variables look like this:
+//
+//    HTTPMethod        : PUT
+//    SelfURL           : <APIURL>/contacts
+//    NextSegment       : {KeyID}
+//    FullEndPointURL   : <APIURL>/contacts/{KeyID}/{property}
+//
+// The code will need to determine if a supported property has been passed in. If so, then the next HTTP service will
+// need to be called with the appropriate modifications to the variables.
+//----------------------------------------------------------------------------------------------------------------------
+PutItemProperty:
+
+    // Get the name of the property by looking at the last segment in the FullEndPointURL variable. An assumption is
+    // being made that there are no other segments in the URL that follow the property name.
+    Property    = FullEndPointURL[-1, 'B/']
+    Locate Property in AllowedServices using ',' setting ServicePos then
+        // A supported property has been passed in the URL. Modify the NextSegment and RemainingURL variables so the
+        // next HTTP service can be called correctly.
+        NextSegment     = Property  ; // This allows the RunHTTPService to call HTTP_PICTURE_SERVICES.
+        RemainingURL    = ''        ; // This variable won't be used in the HTTP_PICTURE_SERVICES code, but to keep the
+                                    ; // variables well formed, this should be cleared.
+        HTTP_Services('RunHTTPService', NextSegment, RemainingURL)
+    end else
+        // The URL contains an unsupported property. Return a 404 error.
+        HTTP_Services('SetResponseStatus', 404, Property : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+    end
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetItemProperty
+//
+// Returns the property of a specific resource.
+//
+// A property can be any specific data that is associated with the resource. It could be a column value, an image, a PDF
+// document, etc. In this case, the only property supported by this web API is the contact's "picture". The developer
+// can put add code here to return the picture or the developer can create another HTTP service to handle this. Since a
+// "picture" service might be useful as a property for other types of resources, a call to a dedicated "picture" HTTP
+// service will be made.
+//
+// Calling another HTTP service is similar to the way one MFS calls another MFS by modifying the FS list. In this case,
+// the NextSegment and RemainingURL variables will need to be modified. At this point in the stack the following
+// API variables look like this:
+//
+//    HTTPMethod        : GET
+//    SelfURL           : <APIURL>/contacts
+//    NextSegment       : {KeyID}
+//    FullEndPointURL   : <APIURL>/contacts/{KeyID}/{property}
+//
+// The code will need to determine if a supported property has been passed in. If so, then the next HTTP service will
+// need to be called with the appropriate modifications to the variables.
+//----------------------------------------------------------------------------------------------------------------------
+GetItemProperty:
+
+    // Get the name of the property by looking at the last segment in the FullEndPointURL variable. An assumption is
+    // being made that there are no other segments in the URL that follow the property name.
+    Property    = FullEndPointURL[-1, 'B/']
+    If Property _EQC 'picture' then
+        // A supported property has been passed in the URL. Modify the NextSegment and RemainingURL variables so the
+        // next HTTP service can be called correctly.
+        NextSegment     = Property  ; // This allows the RunHTTPService to call HTTP_PICTURE_SERVICES.
+        RemainingURL    = ''        ; // This variable won't be used in the HTTP_PICTURE_SERVICES code, but to keep the
+                                    ; // variables well formed, this should be cleared.
+        HTTP_Services('RunHTTPService', NextSegment, RemainingURL)
+    end else
+        // The URL contains an unsupported property. Return a 404 error.
+        HTTP_Services('SetResponseStatus', 404, Property : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+    end
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// OptionsItemProperty
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+OptionsItemProperty:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetCommonOptionResponseHeaders
+//
+// Sets the response headers that will be common for all OPTIONS methods.
+//----------------------------------------------------------------------------------------------------------------------
+SetCommonOptionResponseHeaders:
+
+    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)
+
+    GoSub SetAllowedMethods
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetAllowedMethods
+//
+// Sets the Allow response header field as appropriate for the requested URL.
+//----------------------------------------------------------------------------------------------------------------------
+SetAllowedMethods:
+
+    If AllowedMethods NE '' then
+        For Each Method in AllowedMethods using ','
+            HTTP_Services('SetResponseHeaderField', 'Allow', Method, True$)
+        Next Method
+    end
+
+return

FRAMEWORKS/STPROC/HTTP_DEBUGGER_SERVICE.txt

@@ -0,0 +1,31 @@
+Subroutine HTTP_Debugger_Service(Void)
+/***********************************************************************************************************************
+
+    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_Debugger_Service
+
+    Description :   Handler program for the HTTP Debugger service module.
+
+    Notes       :   Service handler for HTTP Requests that abort due to a Runtime Error and the Debugger Intercept
+                    has been enabled.
+
+    Parameters  :
+
+    Metadata    :
+
+    History     :   (Date, Initials, Notes)
+        03/07/17    dmb     Original programmer. - [SRPFW-155]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert HTTP_INSERTS
+$insert RTI_DEBUG_COMMON
+
+HTTP_Services('CreateLogFile', 'Debugger', SPStatus@ : @RM : SPStatCode@ : @RM : Curr_Program@ : @RM : CallDepth@ : @RM : LineNo@ : @RM : CallStack@)
+
+Return

FRAMEWORKS/STPROC/HTTP_ENTRY_POINT_SERVICES.txt

@@ -0,0 +1,199 @@
+Function HTTP_Entry_Point_Services(RemainingURL)
+/***********************************************************************************************************************
+
+    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_Entry_Point_Services
+
+    Description :   Handler program for the HTTP Entry Point service module.
+
+    Notes       :   All HTTP web services should include the HTTP_SERVICE_SETUP insert. This will provide several useful
+                    variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        SelfURL                 - The URL path representing the current service.
+                        FullEndPointURL         - The URL submitted by the client. This can be the same or longer than
+                                                  the SelfURL.
+                        NextSegment             - The URL segment immediately following the SelfURL (if any). This
+                                                  could contain the name of the next service or it could contain the
+                                                  Item ID for the current service (aka resource).
+                        CurrentServiceHandler   - The name of this stored procedure.
+
+    Parameters  :
+        RemainingURL    [in] -- The remaining portion of the URL that follows the URL that launched this current
+                                service. This information is used in the HTTP_SERVICE_SETUP insert to populate other
+                                useful variables (see Notes above).
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        02/04/15    dmb     Original programmer. - [SRPFW-92]
+        04/17/15    dmb     Replace the SetHALLinks service with SetHALCollection service for the Get method. -
+                            [SRPFW-92]
+        03/09/16    dmb     Refactor to use the updated RunHTTPService service. - [SRPFW-112]
+        07/01/17    dmb     Refactor using Enhanced BASIC+ syntax. - [SRPFW-184]
+        07/10/17    dmb     Add version to the list of allowed services. - [SRPFW-188]
+        09/13/18    dmb     Add scan as an allowed service. Remove contacts and version.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert HTTP_SERVICE_SETUP
+$insert HTTP_INSERTS
+
+// Assume the current HTTP method is valid until proven otherwise.
+ValidMethod     = True$
+// Assume the current web service is valid until provent otherwise.
+ValidService    = True$
+// Assume no HTTP methods are valid until proven otherwise.
+AllowedMethods  = ''
+// A list of all services able to be called from this URL.
+AllowedServices = 'scan'
+
+// Since all authenticated API requests will start with the Entry Point, any authentication-dependent global response
+// headers should be set here.
+GoSub SetGlobalResponseHeaders
+
+// Handle the HTTP request as needed.
+Begin Case
+    Case RemainingURL _EQC ''
+        // This means the URL matches the <APIURL>, which means this is the entry point. The client is requesting a
+        // collection of services available.
+        AllowedMethods  = 'GET,OPTIONS'
+        Locate HTTPMethod in AllowedMethods using ',' setting MethodPos then
+            On MethodPos GoSub Get, Options
+        end else
+            ValidMethod = False$
+        end
+
+    Case Count(RemainingURL, '/') GE 0
+        // This means the URL ends with /{service}, where <NextSegment> is the name of the service. The client is
+        // requesting a specific web service. If this is an allowed service, just call the service "as is" and let it
+        // handle the request. Calling another HTTP service is similar to the way one MFS calls another MFS by modifying
+        // the FS list. In this case, the NextSegment and RemainingURL variables will need to be modified.
+        Locate NextSegment in AllowedServices using ',' setting ServicePos then
+            RemainingURL    = Field(RemainingURL, '/', 2, 99)
+            HTTP_Services('RunHTTPService', NextSegment, RemainingURL)
+        end else
+            ValidService    = False$
+        end
+
+    Case Otherwise$
+        ValidService    = False$
+End Case
+
+// Resolve any invalid conditions with the HTTP request.
+Begin Case
+    Case Not(ValidService)
+        HTTP_Services('SetResponseStatus', 404, NextSegment : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+
+    Case Not(ValidMethod)
+        HTTP_Services('SetResponseStatus', 405, HTTPMethod : ' is not valid for this service.')
+
+        GoSub SetAllowedMethods
+End Case
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN                     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Web Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// Get
+//
+// Returns the available services.
+//----------------------------------------------------------------------------------------------------------------------
+Get:
+
+    HREFNames           = ''
+    HREFURIs            = ''
+    For Each Service in AllowedServices using ','
+        HREFNames  := service : @FM
+        HREFURIs   := SelfURL : '/' : Service : @FM
+    Next Service
+    HREFNames[-1, 1]    = ''
+    HREFURIs[-1, 1]     = ''
+
+    HTTP_JSON_Services('SetHALCollection', SelfURL, HREFURIs, HREFNames)
+
+    If Error_Services('NoError') then
+        Services    = HTTP_JSON_Services('GetHAL')
+        HTTP_Services('SetResponseBody', Services, False$, 'application/hal+json')
+    end else
+        HTTP_Services('SetResponseStatus', 500, '')
+    end
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Options
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+Options:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetGlobalResponseHeaders
+//
+// Since all authenticated API requests will start with the Entry Point, any authentication-dependent global response
+// headers should be set here.
+//----------------------------------------------------------------------------------------------------------------------
+SetGlobalResponseHeaders:
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetCommonOptionResponseHeaders
+//
+// Sets the response headers that will be common for all OPTIONS methods.
+//----------------------------------------------------------------------------------------------------------------------
+SetCommonOptionResponseHeaders:
+
+    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)
+
+    GoSub SetAllowedMethods
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetAllowedMethods
+//
+// Sets the Allow response header field as appropriate for the requested URL.
+//----------------------------------------------------------------------------------------------------------------------
+SetAllowedMethods:
+
+    If AllowedMethods NE '' then
+        For Each Method in AllowedMethods using ','
+            HTTP_Services('SetResponseHeaderField', 'Allow', Method, True$)
+        Next Method
+    end
+
+return
+

FRAMEWORKS/STPROC/HTTP_JSON_SERVICES.txt

@@ -0,0 +1,909 @@
+Function HTTP_JSON_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_JSON_Services
+
+    Description :   Handler program for all module related services.
+
+    Notes       :   The generic parameters should contain all the necessary information to process the services. Often
+                    this will be information like the data Record and Key ID.
+
+    Parameters  :
+        Service         [in] -- Name of the service being requested
+        Param1-10   [in/out] -- Additional request parameter holders
+        Response       [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
+
+    Metadata    :
+
+    History     :   (Date, Initials, Notes)
+        02/06/15    dmb     Original programmer. - [SRPFW-87]
+        04/17/15    dmb     Added SetHALItem, SetHALCollection, and SetHALCollectionEmbedded services and removed
+                            SetHALLinks, SetHALEmbedded, and GetHALRootObj services. These new services do a better
+                            job of simplifying the creation of specific item and item collection HAL+JSON responses.
+                            The GetHAL service remains but it has been modified to support the new services.
+                            - [SRPFW-87]
+        04/17/15    dmb     Converted /HTTPJSONServices/ labelled common into /HAL/ and /Schema/ labelled commons so
+                            that the FreeCommon statement can be used. - [SRPFW-87]
+        04/19/15    dmb     Update SetHALItem to support multivalue columns. - [SRPFW-87]
+        05/15/15    dmb     Update SetHALCollectionEmbedded to allow responses with no embedded data. - [SRPFW-87]
+        06/09/15    dmb     Restore SetHALLinks service as this does provide a valid response in some cases.
+                            - [SRPFW-87]
+        06/09/15    dmb     Add ItemArrayLabel argument to the GetHAL service so the calling service (usually
+                            HTTP_Resources_Services) can specify the label text to use for the primary HAL array.
+                            If not specified then "item" will be used as the default. - [SRPFW-87]
+        07/01/17    dmb     Refactor using Enhanced BASIC+ syntax. - [SRPFW-184]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert SERVICE_SETUP
+$insert HTTP_INSERTS
+
+Declare function    SRP_Sort_Array
+
+Common /HAL/    HALType@, HALRootObj@, HALRootLinksObj@, HALEmbeddedObj@, HALItemArray@, HALLinksObj@
+Common /Schema/ SchemaRootObj@, SchemaPropertiesObj@, SchemaRequiredArray@
+
+GoToService else
+    Error_Services('Add', Service : ' is not a valid service request within the HTTP Authentication services module.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN                     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetHALItem
+//
+// ItemURL      - The URL to the item itself. - [Required]
+// ColumnNames  - An @FM delimited array of column names (i.e., dictionaries) that will label the column values.
+//              - [Required]
+// ColumnValues - An @FM delimited array of column values (i.e., data) that represents the item resource. These are
+//                associated with the ColumnNames argument. - [Required]
+// DataTypes    - An @FM delimited array of JSON data types for each column value. If empty then SRP_JSON will decide
+//                using its default type matching rules. - [Optional]
+// MVGroupNames - An @FM delimited array of MV group names. These are associated with the ColumnNames argument.
+//              - [Optional]
+//
+// Creates a HAL+JSON object for a specific item. Requires the GetHAL service to return the serialized object.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetHALItem(ItemURL, ColumnNames, ColumnValues, DataTypes, MVGroupNames)
+
+    HALType@        = Service
+
+    If (ItemURL NE '') AND (ColumnNames NE '') AND (ColumnValues NE '') then
+        If MVGroupNames NE '' then
+            // MV group names have been passed in. Sort the arguments by the MV group names so these can be properly
+            // combined into the same JSON object.
+            Arguments       = SRP_Sort_Array(ColumnNames : @RM : ColumnValues : @RM : DataTypes : @RM : MVGroupNames, 'AL4', False$, @RM, @FM)
+            ColumnNames     = Arguments[1, @RM]
+            ColumnValues    = Arguments[Col2() + 1, @RM]
+            DataTypes       = Arguments[Col2() + 1, @RM]
+            MVGroupNames    = Arguments[Col2() + 1, @RM]
+        end
+
+        PrevMVGroupName = ''
+
+        If HALRootObj@ NE '' else
+            // Create the root object.
+            If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else
+                HTTP_Services('SetResponseError', '', '', 500)
+                Error_Services('Add', 'Error creating the HAL root object in the ' : Service : ' service.')
+            end
+        end
+
+        If Error_Services('NoError') then
+            // Create the "_links" object. It will be SET to the root object in the GetHAL service.
+            If SRP_JSON(HALRootLinksObj@, 'NEW', 'OBJECT') then
+
+                // Create the "self" object. It will be SET to the "_links" object when finished.
+                If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
+                    // Create the "href" name/value for the "self" object.
+                    SRP_JSON(hSelfObj, 'SETVALUE', 'href', ItemURL)
+                    // SET the "self" object to the "_links" object and name it.
+                    If SRP_JSON(HALRootLinksObj@, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
+                    SRP_JSON(hSelfObj, 'RELEASE')
+                end else
+                    HTTP_Services('SetResponseError', '', '', 500)
+                end
+
+                // Create the "collection" object. It will be SET to the "_links" object when finished.
+                If SRP_JSON(hCollectionObj, 'NEW', 'OBJECT') then
+                    // Create the "href" name/value for the "collection" object.
+                    CollectionURL = ItemURL
+                    ItemID = CollectionURL[-1, 'B/']
+                    CollectionURL[-1, Neg(Len(ItemID) + 1)] = ''
+                    SRP_JSON(hCollectionObj, 'SETVALUE', 'href', CollectionURL)
+                    // SET the "collection" object to the "_links" object and name it.
+                    If SRP_JSON(HALRootLinksObj@, 'SET', 'collection', hCollectionObj) else HTTP_Services('SetResponseError', '', '', 500)
+                    SRP_JSON(hCollectionObj, 'RELEASE')
+                end else
+                    HTTP_Services('SetResponseError', '', '', 500)
+                end
+
+                // Add the column name/value pairs. These are SETVALUEd to the root object.
+                ColumnNames     = ColumnNames[1, @RM]   ; // Make sure there are no "extra" items being added.
+                ColumnValues    = ColumnValues[1, @RM]  ; // Make sure there are no "extra" items being added.
+                DataTypes       = DataTypes[1, @RM]     ; // Make sure there are no "extra" items being added.
+                MVGroupNames    = MVGroupNames[1, @RM]  ; // Make sure there are no "extra" items being added.
+                NumColumns      = DCount(ColumnNames, @FM)
+                For ColumnCnt = 1 to NumColumns
+                    Name        = ColumnNames<ColumnCnt>
+                    Value       = ColumnValues<ColumnCnt>
+                    Type        = DataTypes<ColumnCnt>
+                    MVGroupName = MVGroupNames<ColumnCnt>
+
+                    If Len(MVGroupName) then
+                        // This column is a part of a MV group. Check to see if this is a new MV group or one that was
+                        // already being used.
+                        If MVGroupName NE PrevMVGroupName then
+                            // A new MV group is being worked on.
+                            If PrevMVGroupName NE '' then
+                                // Create the JSON object for the new MV group.
+                                If SRP_JSON(hMVArray, 'New', 'ARRAY') then
+                                    For MVValueCnt = 1 to MVTotalValues
+                                        If SRP_JSON(hMVObject, 'New', 'Object') then
+                                            For MVColumnCnt = 1 to MVTotalColumns
+                                                SRP_JSON(hMVObject, 'SetValue', MVLabels<MVColumnCnt>, MVArray<MVColumnCnt, MVValueCnt>)
+                                            Next MVColumnCnt
+                                        end
+                                        SRP_JSON(hMVArray, 'Add', hMVObject)
+                                        SRP_JSON(hMVObject, 'Release')
+                                    Next MVValueCnt
+                                    If SRP_JSON(HALRootObj@, 'Set', PrevMVGroupName, hMVArray) else HTTP_Services('SetResponseError', '', '', 500)
+                                    SRP_JSON(hMVArray, 'Release')
+                                end
+                            end
+                            MVLabels        = ''
+                            MVArray         = ''
+                            MVTotalColumns  = 0
+                            MVTotalValues   = 0
+                        end
+                        MVLabels       := Name : @FM
+                        MVArray        := Value : @FM
+                        MVTotalColumns += 1
+                        NumValues       = DCount(Value, @VM)
+                        If NumValues GT MVTotalValues then MVTotalValues = NumValues
+*                        If SRP_JSON(hColumnArray, 'NEW', 'ARRAY') then
+*                            NumValues = Count(Value, @VM) + (Value NE '')
+*                            For ValueCnt = 1 to NumValues
+*                                SRP_JSON(hColumnArray, 'ADDVALUE', Value<0, ValueCnt>)
+*                            Next ValueCnt
+*                            If SRP_JSON(hMVGroupObj@, 'SET', Name, hColumnArray) else HTTP_Services('SetResponseError', '', '', 500)
+*                            SRP_JSON(hColumnArray, 'RELEASE')
+*                        end
+                    end else
+                        If Index(Value, @VM, 1) then
+                            If SRP_JSON(hColumnArray, 'NEW', 'ARRAY') then
+                                NumValues = Count(Value, @VM) + (Value NE '')
+                                For ValueCnt = 1 to NumValues
+                                    SRP_JSON(hColumnArray, 'ADDVALUE', Value<0, ValueCnt>)
+                                Next ValueCnt
+                                If SRP_JSON(HALRootObj@, 'SET', Name, hColumnArray) else HTTP_Services('SetResponseError', '', '', 500)
+                                SRP_JSON(hColumnArray, 'RELEASE')
+                            end
+                        end else
+                            If SRP_JSON(HALRootObj@, 'SETVALUE', Name, Value, Type) else HTTP_Services('SetResponseError', '', '', 500)
+                        end
+                    end
+                    Transfer MVGroupName to PrevMVGroupName
+                Next ColumnCnt
+
+                If PrevMVGroupName NE '' then
+                    // Create the JSON object for the new MV group.
+                    If SRP_JSON(hMVArray, 'New', 'ARRAY') then
+                        For MVValueCnt = 1 to MVTotalValues
+                            If SRP_JSON(hMVObject, 'New', 'Object') then
+                                For MVColumnCnt = 1 to MVTotalColumns
+                                    SRP_JSON(hMVObject, 'SetValue', MVLabels<MVColumnCnt>, MVArray<MVColumnCnt, MVValueCnt>)
+                                Next MVColumnCnt
+                            end
+                            SRP_JSON(hMVArray, 'Add', hMVObject)
+                            SRP_JSON(hMVObject, 'Release')
+                        Next MVValueCnt
+                        If SRP_JSON(HALRootObj@, 'Set', PrevMVGroupName, hMVArray) else HTTP_Services('SetResponseError', '', '', 500)
+                        SRP_JSON(hMVArray, 'Release')
+                    end
+                end
+                SRP_JSON(hMVGroupObj@, 'RELEASE')
+            end else
+                HTTP_Services('SetResponseError', '', '', 500)
+            end
+        end
+    end else
+        // At least one required argument is missing.
+        HTTP_Services('SetResponseError', '', '', 500)
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetHALCollection
+//
+// CollectionURL    - The URL to the collection. - [Required]
+// ItemsURLs        - An @FM delimited array of URLs to each item. - [Required]
+// ItemsTitles      - An @FM delimited array of item titles. These are associated with the ItemsURLs argument -
+//                    [Required]
+//
+// Creates a HAL+JSON object for a collection. Requires the GetHAL service to return the serialized object.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetHALCollection(CollectionURL, ItemsURLs, ItemsTitles)
+
+    HALType@        = Service
+
+    If (CollectionURL NE '') AND (ItemsURLs NE '') AND (ItemsTitles NE '') then
+
+        If HALRootObj@ NE '' else
+            // Create the root object.
+            If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else
+                HTTP_Services('SetResponseError', '', '', 500)
+                Error_Services('Add', 'Error creating the HAL root object in the ' : Service : ' service.')
+            end
+        end
+
+        If Error_Services('NoError') then
+            If Len(HALRootLinksObj@) else
+                // Create the "_links" object. It will be SET to the root object in the GetHAL service.
+                If SRP_JSON(HALRootLinksObj@, 'NEW', 'OBJECT') then
+
+                    // Create the "self" object. It will be SET to the "_links" object when finished.
+                    If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
+                        // Create the "href" name/value for the "self" object.
+                        SRP_JSON(hSelfObj, 'SETVALUE', 'href', CollectionURL)
+                        // SET the "self" object to the "_links" object and name it.
+                        If SRP_JSON(HALRootLinksObj@, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
+                        SRP_JSON(hSelfObj, 'RELEASE')
+                    end else
+                        HTTP_Services('SetResponseError', '', '', 500)
+                    end
+                end else
+                    HTTP_Services('SetResponseError', '', '', 500)
+                end
+            end
+
+            If Len(HALItemArray@) else
+                // Create the "item" array. This will hold the embedded items. It will be SET to the "_links" object
+                // in the GetHAL when service. It is left available now so multiple calls into the SetHALCollection
+                // service can be made in the event items needs to be added at different opportunities.
+                If SRP_JSON(HALItemArray@, 'NEW', 'ARRAY') else
+                    HTTP_Services('SetResponseError', '', '', 500)
+                    Error_Services('Add', 'Error creating the HAL item array in the ' : Service : ' service.')
+                end
+            end
+
+            If Error_Services('NoError') then
+                // ADD items to the "item" array.
+                NumItems = Count(ItemsURLs, @FM) + (ItemsURLs NE '')
+                For ItemCnt = 1 to NumItems
+                    If SRP_JSON(hItemObj, 'NEW', 'OBJECT') then
+                        ItemURL             = Field(ItemsURLs, @FM, ItemCnt, 1)
+                        ItemTitle           = Field(ItemsTitles, @FM, ItemCnt, 1)
+
+                        // Create the "href" name/value for the "item" object.
+                        SRP_JSON(hItemObj, 'SETVALUE', 'href', ItemURL)
+
+                        // Create the "title" name/value for the "item" object.
+                        SRP_JSON(hItemObj, 'SETVALUE', 'title', ItemTitle)
+
+                        // Add this item object to the "item" array.
+                        SRP_JSON(HALItemArray@, 'ADD', hItemObj)
+
+                        // Release the Item object handle.
+                        SRP_JSON(hItemObj, 'RELEASE')
+                    end
+                Next ItemCnt
+            end else
+                HTTP_Services('SetResponseError', '', '', 500)
+            end
+        end
+    end else
+        // At least one required argument is missing.
+        HTTP_Services('SetResponseError', '', '', 500)
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetHALCollectionEmbedded
+//
+// CollectionURL    - The URL to the collection. - [Required]
+// ItemsURLs        - An @RM delimited array of URLs to each item. - [Required]
+// ColumnNames      - An @RM/@FM delimited array of column names (i.e., dictionaries) that will label the column values.
+//                    These are associated with the ItemsURLs argument. - [Required]
+// ColumnValues     - An @RM/@FM delimited array of column values (i.e., data) that represents the item resource. These
+//                    are associated with the ItemsURLs argument. - [Required]
+// DataTypes        - An @RM/@FM delimited array of JSON data types for each column value. If empty then SRP_JSON will
+//                    decide using its default type matching rules. - [Optional]
+// MVGroupNames     - An @RM/@FM delimited array of MV group names. These are associated with the ItemsURLs argument.
+//                    - [Optional]
+//
+// Creates a HAL+JSON object for a collection of embedded items. Requires the GetHAL service to return the serialized
+// object.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetHALCollectionEmbedded(CollectionURL, ItemsURLs, ColumnNames, ColumnValues, DataTypes, MVGroupNames)
+
+    HALType@        = Service
+
+    If CollectionURL NE '' then
+        If HALRootObj@ NE '' else
+            // Create the root object.
+            If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else
+                HTTP_Services('SetResponseError', '', '', 500)
+                Error_Services('Add', 'Error creating the HAL root object in the ' : Service : ' service.')
+            end
+        end
+
+        If Error_Services('NoError') then
+            If HALRootLinksObj@ NE '' else
+                // Create the "_links" object. It will be SET to the root object in the GetHAL service.
+                If SRP_JSON(HALRootLinksObj@, 'NEW', 'OBJECT') then
+
+                    // Create the "self" object. It will be SET to the "_links" object when finished.
+                    If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
+                        // Create the "href" name/value for the "self" object.
+                        SRP_JSON(hSelfObj, 'SETVALUE', 'href', CollectionURL)
+                        // SET the "self" object to the "_links" object and name it.
+                        If SRP_JSON(HALRootLinksObj@, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
+                        SRP_JSON(hSelfObj, 'RELEASE')
+                    end else
+                        HTTP_Services('SetResponseError', '', '', 500)
+                    end
+                end else
+                    HTTP_Services('SetResponseError', '', '', 500)
+                end
+            end
+
+            If HALEmbeddedObj@ NE '' else
+                // Create the "_embedded" object. This will contain the array of items. It will be SET to the root
+                // object in the GetHAL service. It is left available now so multiple calls into the
+                // SetHALCollectionEmbedded service can be made in the event items needs to be added at different
+                // opportunities.
+                If SRP_JSON(HALEmbeddedObj@, 'NEW', 'OBJECT') else
+                    HTTP_Services('SetResponseError', '', '', 500)
+                    Error_Services('Add', 'Error creating the HAL embedded object in the ' : Service : ' service.')
+                end
+            end
+
+            If HALItemArray@ NE '' else
+                // Create the "item" array. This will hold the embedded items. It will be SET to the "_embedded" object
+                // in the GetHAL when service. It is left available now so multiple calls into the
+                // SetHALCollectionEmbedded service can be made in the event items needs to be added at different
+                // opportunities.
+                If SRP_JSON(HALItemArray@, 'NEW', 'ARRAY') else
+                    HTTP_Services('SetResponseError', '', '', 500)
+                    Error_Services('Add', 'Error creating the HAL item array in the ' : Service : ' service.')
+                end
+            end
+
+            If Error_Services('NoError') then
+                // SET items to the "item" array.
+
+                NumItems = Count(ItemsURLs, @RM) + (ItemsURLs NE '')
+                For ItemCnt = 1 to NumItems
+                    If SRP_JSON(hItemObj, 'NEW', 'OBJECT') then
+                        ItemURL             = Field(ItemsURLs, @RM, ItemCnt, 1)
+                        ItemColumnNames     = Field(ColumnNames, @RM, ItemCnt, 1)
+                        ItemColumnValues    = Field(ColumnValues, @RM, ItemCnt, 1)
+                        ItemDataTypes       = Field(DataTypes, @RM, ItemCnt, 1)
+                        ItemMVGroupNames    = Field(MVGroupNames, @RM, ItemCnt, 1)
+
+                        If Len(ItemMVGroupNames) then
+                            // MV group names have been passed in. Sort the arguments by the MV group names so these can be properly
+                            // combined into the same JSON object.
+                            Arguments           = SRP_Sort_Array(ItemColumnNames : @RM : ItemColumnValues : @RM : ItemDataTypes : @RM : ItemMVGroupNames, 'AL4', False$, @RM, @FM)
+                            ItemColumnNames     = Arguments[1, @RM]
+                            ItemColumnValues    = Arguments[Col2() + 1, @RM]
+                            ItemDataTypes       = Arguments[Col2() + 1, @RM]
+                            ItemMVGroupNames    = Arguments[Col2() + 1, @RM]
+                        end
+
+                        PrevMVGroupName = ''
+
+                        If SRP_JSON(hLinksObj, 'NEW', 'OBJECT') then
+                            // Create the "self" object. It will be SET to the "_links" object when finished.
+                            If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
+                                // Create the "href" name/value for the "self" object.
+                                SRP_JSON(hSelfObj, 'SETVALUE', 'href', ItemURL)
+                                // SET the "self" object to the "_links" object and name it.
+                                If SRP_JSON(hLinksObj, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
+                                SRP_JSON(hSelfObj, 'RELEASE')
+                            end else
+                                HTTP_Services('SetResponseError', '', '', 500)
+                            end
+
+                            // SET the "_links" object to the root object and name it.
+                            If SRP_JSON(hItemObj, 'SET', '_links', hLinksObj) else HTTP_Services('SetResponseError', '', '', 500)
+
+                            // Release the "links" object handle.
+                            SRP_JSON(hLinksObj, 'RELEASE')
+                        end else
+                            HTTP_Services('SetResponseError', '', '', 500)
+                        end
+
+                        NumColumns = Count(ItemColumnNames, @FM) + (ItemColumnNames NE '')
+                        For ColumnCnt = 1 to NumColumns
+                            Name        = ItemColumnNames<ColumnCnt>
+                            Value       = ItemColumnValues<ColumnCnt>
+                            Type        = ItemDataTypes<ColumnCnt>
+                            MVGroupName = ItemMVGroupNames<ColumnCnt>
+
+                            If Len(MVGroupName) then
+                                // This column is a part of a MV group. Check to see if this is a new MV group or one that was
+                                // already being used.
+                                If MVGroupName NE PrevMVGroupName then
+                                    // A new MV group is being worked on.
+                                    If Len(PrevMVGroupName) then
+                                        // There was a previous MV group started, then SET this to the MV group object.
+                                        If SRP_JSON(hItemObj, 'SET', PrevMVGroupName, hMVGroupObj@) else HTTP_Services('SetResponseError', '', '', 500)
+                                        SRP_JSON(hMVGroupObj@, 'RELEASE')
+                                    end
+                                    // Create the JSON object for the new MV group.
+                                    If SRP_JSON(hMVGroupObj@, 'NEW', 'OBJECT') else HTTP_Services('SetResponseError', '', '', 500)
+                                end
+                                If SRP_JSON(hColumnArray, 'NEW', 'ARRAY') then
+                                    NumValues = Count(Value, @VM) + (Value NE '')
+                                    For ValueCnt = 1 to NumValues
+                                        SRP_JSON(hColumnArray, 'ADDVALUE', Value<0, ValueCnt>)
+                                    Next ValueCnt
+                                    If SRP_JSON(hMVGroupObj@, 'SET', Name, hColumnArray) else HTTP_Services('SetResponseError', '', '', 500)
+                                    SRP_JSON(hColumnArray, 'RELEASE')
+                                end
+                            end else
+                                If Index(Value, @VM, 1) then
+                                    If SRP_JSON(hColumnArray, 'NEW', 'ARRAY') then
+                                        NumValues = Count(Value, @VM) + (Value NE '')
+                                        For ValueCnt = 1 to NumValues
+                                            SRP_JSON(hColumnArray, 'ADDVALUE', Value<0, ValueCnt>)
+                                        Next ValueCnt
+                                        If SRP_JSON(hItemObj, 'SET', Name, hColumnArray) else HTTP_Services('SetResponseError', '', '', 500)
+                                        SRP_JSON(hColumnArray, 'RELEASE')
+                                    end
+                                end else
+                                    If SRP_JSON(hItemObj, 'SETVALUE', Name, Value, Type) else HTTP_Services('SetResponseError', '', '', 500)
+                                end
+                            end
+                            Transfer MVGroupName to PrevMVGroupName
+                        Next ColumnCnt
+
+                        If Len(PrevMVGroupName) then
+                            // There was a previous MV group started, then SET this to the MV group object.
+                            If SRP_JSON(hItemObj, 'SET', PrevMVGroupName, hMVGroupObj@) else HTTP_Services('SetResponseError', '', '', 500)
+                            SRP_JSON(hMVGroupObj@, 'RELEASE')
+                        end
+
+                        // Add this item object to the "item" array.
+                        SRP_JSON(HALItemArray@, 'ADD', hItemObj)
+
+                        // Release the Item object handle.
+                        SRP_JSON(hItemObj, 'RELEASE')
+                    end
+                Next ItemCnt
+            end else
+                HTTP_Services('SetResponseError', '', '', 500)
+            end
+        end else
+            HTTP_Services('SetResponseError', '', '', 500)
+        end
+    end else
+        // At least one required argument is missing.
+        HTTP_Services('SetResponseError', '', '', 500)
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetHALLinks
+//
+// SelfURI      - The URI to the self object. - [Required]
+// HREFNames    - An @FM delimited array of HREF names to add to the "links" object. - [Optional]
+// HREFURIs     - An @FM delimited array of HREF URIs to add to the "links" objects. These are associated with the
+//                HREFNames argument. - [Optional]
+// ChildNames   - An @FM delimited array of names for objects to add to the "links" object. - [Optional]
+// hChildren    - An @FM delimited array of objects handles to add to the "links" object. These are associated with
+//                the ChildNames argument.
+// Names        - An @FM delimited array of names to add to the "links" object. - [Optional]
+// Values       - An @FM delimited array of values to add to the "links" object. These are associated with the Names
+//                argument. -[Optional]
+//
+// Creates a HAL style "links" object.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetHALLinks(SelfURI, HREFNames, HREFURIs, ChildNames, hChildren, Names, Values)
+
+    HALType@    = Service
+
+    If SelfURI NE '' then
+
+        If HALRootObj@ NE '' else
+            // Create the root object.
+            If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else
+                HTTP_Services('SetResponseError', '', '', 500)
+                Error_Services('Add', 'Error creating the HAL root object in the ' : Service : ' service.')
+            end
+        end
+
+        If Error_Services('NoError') then
+
+            If HALRootLinksObj@ NE '' else
+                // Create the "_links" object. It will be SET to the root object in the GetHAL service.
+                If SRP_JSON(HALRootLinksObj@, 'NEW', 'OBJECT') then
+
+                    // Create the "self" object. It will be SET to the "_links" object when finished.
+                    If SRP_JSON(hSelfObj, 'NEW', 'OBJECT') then
+                        // Create the "href" name/value for the "self" object.
+                        SRP_JSON(hSelfObj, 'SETVALUE', 'href', SelfURI)
+                        // SET the "self" object to the "_links" object and name it.
+                        If SRP_JSON(HALRootLinksObj@, 'SET', 'self', hSelfObj) else HTTP_Services('SetResponseError', '', '', 500)
+                        SRP_JSON(hSelfObj, 'RELEASE')
+                    end else
+                        HTTP_Services('SetResponseError', '', '', 500)
+                    end
+                end else
+                    HTTP_Services('SetResponseError', '', '', 500)
+                end
+            end
+
+            // Create any "href" objects that are requested. These will be SET to the "_links" object when finished.
+            If HREFNames NE '' then
+                NumHREFs    = Count(HREFNames, @FM) + (HREFNames NE '')
+                For HREFCnt = 1 to NumHREFs
+                    HREFName    = HREFNames<HREFCnt>
+                    HREFURI     = HREFURIs<HREFCnt>
+                    // Create the "href" object. It will be SET to the "_links" object when finished.
+                    If SRP_JSON(hHREFObj, 'NEW', 'OBJECT') then
+                        // Create the "href" name/value for the "href" object.
+                        SRP_JSON(hHREFObj, 'SETVALUE', 'href', HREFURI)
+                        // SET the "href" object to the "_links" object and name it.
+                        If SRP_JSON(HALRootLinksObj@, 'SET', HREFName, hHREFObj) then else HTTP_Services('SetResponseError', '', '', 500)
+                        SRP_JSON(hHREFObj, 'RELEASE')
+                    end else
+                        HTTP_Services('SetResponseError', '', '', 500)
+                    end
+                Next HREFCnt
+            end
+
+            // Add any chile name/object pairs that have been passed into this service. This are SET to the "links"
+            // object.
+            If ChildNames NE '' then
+                NumChildren = Count(ChildNames, @FM) + (ChildNames NE '')
+                For ChildCnt = 1 to NumChildren
+                    ChildName   = ChildNames<ChildCnt>
+                    hChild      = hChildren<ChildCnt>
+                    If SRP_JSON(HALRootLinksObj@, 'SET', ChildName, hChild) else HTTP_Services('SetResponseError', '', '', 500)
+                While Error_Services('NoError')
+                Next ChildCnt
+            end
+
+            // Add any name/value pairs that have been passed into this service. These are SETVALUEd to the "links"
+            // object.
+            If Names NE '' then
+                NumNames    = Count(Names, @FM) + (Names NE '')
+                For NameCnt = 1 to NumNames
+                    Name    = Names<NameCnt>
+                    Value   = Values<NameCnt>
+                    If SRP_JSON(HALRootLinksObj@, 'SETVALUE', Name, Value) else HTTP_Services('SetResponseError', '', '', 500)
+                While Error_Services('NoError')
+                Next NameCnt
+            end
+        end else
+            HTTP_Services('SetResponseError', '', '', 500)
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 500)
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetHALEmbedded
+//
+// Returns the handle to a root JSON object.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetHALEmbedded()
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetHALRootObj
+//
+// Returns the handle to a root JSON object. If it does not already exist it will be created.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetHALRootObj()
+
+    If HALRootObj@ NE '' else
+        // Create the root object.
+        If SRP_JSON(HALRootObj@, 'NEW', 'OBJECT') else HTTP_Services('SetResponseError', '', '', 500)
+    end
+
+    Response    = HALRootObj@
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetHAL
+//
+// Returns the serialized JSON object for the current HAL response. If no HAL object has been defined then this will
+// return an empty string and a 500 status code will be set. All HAL objects and arrays will be released in this
+// service.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetHAL(ItemArrayLabel)
+
+    HAL             = ''
+
+    If (HALType@ NE '') AND (HALRootObj@ NE '') AND (HALRootLinksObj@ NE '') then
+        // Check the HAL Type (i.e., Collection or CollectionEmbedded) and perform any final association of
+        // objects and arrays. Release any objects and arrays.
+        Begin Case
+            Case HALType@ _EQC 'SetHALCollectionEmbedded'
+                If Len(HALEmbeddedObj@) AND Len(HALItemArray@) then
+                    If Len(ItemArrayLabel) else ItemArrayLabel = 'item'
+                    If SRP_JSON(HALEmbeddedObj@, 'SET', ItemArrayLabel, HALItemArray@) else HTTP_Services('SetResponseError', '', '', 500)
+                    If SRP_JSON(HALRootObj@, 'SET', '_embedded', HALEmbeddedObj@) else HTTP_Services('SetResponseError', '', '', 500)
+                end
+                SRP_JSON(HALEmbeddedObj@, 'RELEASE')
+                SRP_JSON(HALItemArray@, 'RELEASE')
+
+            Case HALType@ _EQC 'SetHALCollection'
+                If Len(HALItemArray@) then
+                    If Len(ItemArrayLabel) else ItemArrayLabel = 'item'
+                    If SRP_JSON(HALRootLinksObj@, 'SET', ItemArrayLabel, HALItemArray@) else HTTP_Services('SetResponseError', '', '', 500)
+                end
+                SRP_JSON(HALItemArray@, 'RELEASE')
+        End Case
+
+        // Set the "_links" object to the root. This occurs for all HAL types.
+        If SRP_JSON(HALRootObj@, 'SET', '_links', HALRootLinksObj@) else HTTP_Services('SetResponseError', '', '', 500)
+        SRP_JSON(HALRootLinksObj@, 'RELEASE')
+
+        // Serialize the HAL object. Use STYLED for human readability or FAST for optimum performance and smaller payload.
+*        HAL = SRP_JSON(HALRootObj@, 'STRINGIFY', 'STYLED')
+        HAL = SRP_JSON(HALRootObj@, 'STRINGIFY', 'FAST')
+        SRP_JSON(HALRootObj@, 'RELEASE')
+    end
+
+    // Clear all HAL common variables.
+    FreeCommon 'HAL'
+
+    Response    = HAL
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetSchemaRootObj
+//
+// Returns the handle to a root Schema object. If it does not already exist it will be created with the standard
+// "$schema" value already added.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetSchemaRootObj()
+
+    If SchemaRootObj@ NE '' else
+        // Create the root object.
+        If SRP_JSON(SchemaRootObj@, 'NEW', 'OBJECT') then
+            If SRP_JSON(SchemaRootObj@, 'SETVALUE', '$schema', 'http://json-schema.org/draft-04/schema#') else HTTP_Services('SetResponseError', '', '', 500)
+        end else
+            HTTP_Services('SetResponseError', '', '', 500)
+        end
+    end
+
+    Response    = SchemaRootObj@
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetSchemaMeta
+//
+// Title        - The title for the schema. - [Optional]
+// Description  - A description for the schema. - [Optional]
+// Type         - The JSON type for the schema. The default value is "object". - [Optional]
+//
+// Sets the meta data associated to the schema object.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetSchemaMeta(Title, Description, Type)
+
+    // Check for the root object. If none exists then create one and use it.
+    If Len(SchemaRootObj@) else SchemaRootObj@ = HTTP_JSON_Services('GetSchemaRootObj')
+
+    If Error_Services('NoError') then
+        If Type NE '' else Type = 'object'
+
+        If Title NE '' then
+            If SRP_JSON(SchemaRootObj@, 'SETVALUE', 'title', Title) else HTTP_Services('SetResponseError', '', '', 500)
+        end
+
+        If Description NE '' then
+            If SRP_JSON(SchemaRootObj@, 'SETVALUE', 'description', Description, 'STRING') else HTTP_Services('SetResponseError', '', '', 500)
+        end
+
+        If Type NE '' then
+            If SRP_JSON(SchemaRootObj@, 'SETVALUE', 'type', Type, 'STRING') else HTTP_Services('SetResponseError', '', '', 500)
+        end
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetSchemaProperty
+//
+// Name     - The name of the member of this property. - [Required]
+// Title    - The title for this property. - [Optional]
+// Type     - The data type for this property. - [Optional]
+// Format   - The display format for this property. - [Optional]
+// EnumList - A list of options that are to be used for this property. - [Optional]
+// Required - Flag to indicate if this property is required. Default is false. - [Optional]
+//
+// Sets a property to the schema. There can be more than one property so this service will add another property to the
+// list if it already exists.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetSchemaProperty(Name, Title, Type, Format, EnumList, Required)
+
+    // Check for properties object handle. If none, create an object and use it.
+    If SchemaPropertiesObj@ NE '' else
+        SRP_JSON(SchemaPropertiesObj@, 'NEW', 'OBJECT')
+    end
+
+    If SchemaPropertiesObj@ NE '' then
+        If Name NE '' then
+            If SRP_JSON(hNameObj, 'NEW', 'OBJECT') then
+                // Add the Title member to the Name object.
+                If Title NE '' then
+                    If SRP_JSON(hNameObj, 'SETVALUE', 'title', Title) else HTTP_Services('SetResponseError', '', '', 500)
+                end
+                // Add the Type member to the Name object.
+                If Type NE '' then
+                    If SRP_JSON(hNameObj, 'SETVALUE', 'type', Type) else HTTP_Services('SetResponseError', '', '', 500)
+                end
+                // Add the Format member to the Name object.
+                If Format NE '' then
+                    If SRP_JSON(hNameObj, 'SETVALUE', 'format', Format) else HTTP_Services('SetResponseError', '', '', 500)
+                end
+                // Add the EnumList array to the Name object.
+                If EnumList NE '' then
+                    If SRP_JSON(hEnumAry, 'NEW', 'ARRAY') then
+                        NumItems = Count(EnumList, @FM) + (EnumList NE '')
+                        For ItemCnt = 1 to NumItems
+                            If SRP_JSON(hEnumAry, 'ADDVALUE', EnumList<ItemCnt>) else HTTP_Services('SetResponseError', '', '', 500)
+                        Next ItemCnt
+                        If SRP_JSON(hNameObj, 'SET', 'enum', hEnumAry) else HTTP_Services('SetResponseError', '', '', 500)
+                        SRP_JSON(hEnumAry, 'RELEASE')
+                    end else
+                        // Unable to create the Enum array.
+                        HTTP_Services('SetResponseError', '', '', 500)
+                    end
+                end
+                SRP_JSON(SchemaPropertiesObj@, 'SET', Name, hNameObj)
+                SRP_JSON(hNameObj, 'RELEASE')
+                If Required then
+                    // Add members to the Required object.
+                    If Len(SchemaRequiredArray@) else
+                        SRP_JSON(SchemaRequiredArray@, 'NEW', 'ARRAY')
+                    end
+                    If Len(SchemaRequiredArray@) then
+                        SRP_JSON(SchemaRequiredArray@, 'ADDVALUE', Name, 'STRING')
+                    end
+                end
+            end else
+                // Unable to create the Name object.
+                HTTP_Services('SetResponseError', '', '', 500)
+            end
+        end else
+            // Name argument is missing.
+            HTTP_Services('SetResponseError', '', '', 500)
+        end
+    end else
+        // Unable to create the Schema Properties object.
+        HTTP_Services('SetResponseError', '', '', 500)
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetSchema
+//
+// Returns the serialized JSON object for the current schema. If no schema object has been defined then this will return
+// an empty string and a 500 status code will be set. All schema objects and arrays will be released in this service.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetSchema()
+
+    Schema      = ''
+
+    If SchemaRootObj@ NE '' then
+        SRP_JSON(SchemaRootObj@, 'SET', 'properties', SchemaPropertiesObj@)
+        SRP_JSON(SchemaRootObj@, 'SET', 'required', SchemaRequiredArray@)
+        Schema  = SRP_JSON(SchemaRootObj@, 'STRINGIFY', 'FAST')
+        SRP_JSON(SchemaRequiredArray@, 'RELEASE')   ; SchemaRequiredArray@  = ''
+        SRP_JSON(SchemaPropertiesObj@, 'RELEASE')   ; SchemaPropertiesObj@  = ''
+        SRP_JSON(SchemaRootObj@, 'RELEASE')         ; SchemaRootObj@        = ''
+    end else
+        HTTP_Services('SetResponseError', '', '', 500)
+    end
+
+    Response    = Schema
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetURLFromID
+//
+// ID that needs to be converted to a URL format. - [Required]
+//
+// Returns a URL segment for the ID passed into the service. This creates a "slug" style URL so that it will be search
+// friendly, human readable, and an RESTful.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetURLFromID(ID)
+    
+    URL = ID
+
+    // Convert all non-friendly URL characters into dashes.
+    Convert @Upper_Case to @Lower_Case in URL
+    Convert '!@#$%^&*()+=|<>?,./\"' : "'" to '' in URL
+    Convert '_' to '' in URL
+    URL = Trim(URL)
+    Convert ' ' to '-' in URL
+
+    Response    = URL
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetIDFromURL
+//
+// URL that needs to be converted to an ID. Note, this is not a complete URL path. This should ordinarily be the end
+//          point of a URL. - [Required]
+// A delimited array of IDs that can be used to validate the converted ID. Any MV delimiter can be used. If there is no
+//          match found then the ID will match the URL. - [Optional]
+//
+// Returns the ID based on the URL passed into the service. This service attempts to reverse engineer the URL.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetIDFromURL(URL, Array, Table)
+
+    ID      = URL
+
+    FoundID = False$
+
+    If Array NE '' then
+        Convert @STM to @FM in Array
+        Convert @TM  to @FM in Array
+        Convert @SVM to @FM in Array
+        Convert @VM  to @FM in Array
+        Convert @RM  to @FM in Array
+        NumElements = Count(Array, @FM) + (Array NE '')
+        For ElementCnt = 1 to NumElements
+            MatchID = HTTP_JSON_Services('GetURLFromID', Array<ElementCnt>)
+            If ID _EQC MatchID then
+                ID      = Array<ElementCnt>
+                FoundID = True$
+            end
+        Until FoundID
+        Next ElementCnt
+    end
+
+    If Not(FoundID) then Error_Services('Add', 'Unable to match the ID based on the provided URL')
+
+    Response    = ID
+
+end service

FRAMEWORKS/STPROC/HTTP_MCP.txt

@@ -0,0 +1,195 @@
+Function HTTP_MCP(Request, ProcErr)
+/***********************************************************************************************************************
+
+    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_MCP (HTTP Master Controller Program)
+
+    Description :   HTTP Controller program for the application.
+
+    Notes       :   In an MVC framework this is the 'Controller' routine that accepts HTTP requests nad routes them to
+                    the core Master Controller Program (MCP). HTTP_MCP is written as a replacement to the
+                    RUN_OECGI_REQUEST listner. It is intended to be a cleaner listener designed to allow REST style
+                    API calls and better control over request and response handling. Since it is a listner, it should
+                    be only modified when core functionality needs to be added or modified. Application specific
+                    changes should be kept within one or more of the called services.
+
+    Parameters  :
+        Request     [in] -- The request array which includes the HTTP request and OECGI provided information.
+        ProcErr     [in] -- Contains error messages in the event of a prior crash (such as a runtime error). The
+                            specified listener is automatically called in these situations with the ProcErr argument
+                            populated. Therefore, a check for data in this argument needs to occur immediately so that
+                            the error can be properly managed and returned to the caller in a suitable format. For
+                            RUN_OECGI_REQUEST applications, INET_ABORTED would normally be called to handle this.
+        Response   [out] -- HTTP response to send back to the OECGI.
+
+    History     :   (Date, Initials, Notes)
+        02/06/15    dmb     [SRPFW-90] Original programmer. Copied from INET_MCP but refactored for REST API requests.
+        04/14/15    dmb     [SRPFW-90] Add missing '\' in the path for debug files to be written to.
+        02/23/16    dmb     [SRPFW-103] Move the request/response capture path defintion into the
+                            SYSENV\SRP_HTTP_FRAMEWORK_SETUP record.
+        02/25/16    dmb     [SRPFW-108] Replace Xlate with GetCapturePath service.
+        03/09/16    dmb     [SRPFW-111] Call GetEntryPointService before calling RunHTTPService.
+        03/09/16    dmb     [SRPFW-112] Remove HTTP_SERVICE_SETUP insert.
+        03/09/16    dmb     [SRPFW-112] Call GetHTTPPathInfo before calling RunHTTPService.
+        05/17/16    dmb     [SRPFW-125] Add support for ProcErr. Create a generic error response.
+        10/01/16    dmb     [SRPFW-128] Add code to track API execution time using SRP_Stopwatch. Display the time in
+                            the Response log that is written into the debug folder.
+        02/18/17    dmb     [SRPFW-151] Report the decoded Authorization data in the Response log.
+        02/27/17    dmb     [SRPFW-125] Add support for the GetProcErrService service. If missing, the default ProcErr
+                            process logic will continue to work.
+        03/03/17    dmb     [SRPFW-154] Replace direct logging with the CreateLogFile service.
+        03/08/17    dmb     [SRPFW-155] Add support for setting the debugger mode and intercept.
+        07/01/17    dmb     [SRPFW-184] Refactor using Enhanced BASIC+ syntax.
+        11/01/18    dmb     [SRPFW-256] Add support for the GetServerEnabled service. Set status to 503 is server is not
+                            enabled.
+        11/18/18    dmb     [SRPFW-257] Add support for the GetAPICallProcedure service. Use the RunWebAPI or
+                            RunHTTPService service as appropriate.
+        12/12/18    dmb     [SRPFW-257] If Get_Status returns an error, produce a GetStatus log and then use the
+                            SetResponseError service so the client gets a detailed response.
+        12/16/19    dmb     [SRPFW-296] Update code that calls the CreateLogFile service for Get_Status conditions so
+                            that the status detail is better formatted. Also, clear the error condition to prevent
+                            the OECGI from making a ProcErr call.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert LOGICAL
+$insert HTTP_INSERTS
+$insert INET_EQUATES
+$insert INET_HEADERS
+$insert Msg_Equates
+
+Equ     CRLF$ to \0D0A\
+
+Declare subroutine  SRP_Stopwatch, Set_Status, RTI_Set_Debugger
+Declare function    SRP_Stopwatch, RTI_OS_Directory
+
+If Assigned(Request)    else Request = ''
+If Assigned(ProcErr)    else ProcErr = ''
+If ProcErr NE '' then
+    // Runtime errors produce two copies of the error description in the ProcErr argument. Just divide in half to get
+    // one copy.
+    If ProcErr[1, Len(ProcErr) / 2] EQ ProcErr[Len(ProcErr) / 2 + 1, Len(ProcErr) / 2] then
+        ProcErr = ProcErr[1, Len(ProcErr) / 2]
+    end
+end
+
+// Start timing the overall API.
+SRP_Stopwatch('Reset')
+SRP_Stopwatch('Start', 'WebAPI')
+
+// Set the mode for the debugger and identify the debugger intercept service if applicable.
+DebuggerSetting = HTTP_Services('GetDebuggerSetting')
+If DebuggerSetting EQ 2 then
+    DebuggerService = HTTP_Services('GetDebuggerService')
+end else
+    DebuggerService = ''
+end
+RTI_Set_Debugger(DebuggerSetting, DebuggerService)
+
+// Use HTTP_Services to store the HTTP request as provided by the OECGI and also to retreive the relevant request
+// information that will be used below.
+HTTP_Services('SetSessionID')
+HTTP_Services('SetOECGIRequest', Request)
+HTTP_Services('SetOECGIProcErr', ProcErr)
+HTTP_Services('SetRequestHeaderFields')
+HTTP_Services('SetQueryFields')
+
+// Create the HTTP Request log file.
+HTTP_Services('CreateLogFile', 'Request')
+
+If ProcErr NE '' then
+    // An unexpected error occurred with the most recent request. The nature of the error (usually a runtime error) will
+    // be contained in the ProcErr argument. Generate a response so the caller will receive a well formatted reply.
+    AbortedService  = HTTP_Services('GetAbortedService')
+
+    If AbortedService NE '' then
+        // There is a procedural error service designated to handle this condition. Allow it to process the error and
+        // generate the response.
+        Call @AbortedService(ProcErr)
+    end else
+        // There is no procedural error service so process this using default logic.
+        Swap \00\ with \0D0A\   in ProcErr
+        Swap @FM with \0D0A\    in ProcErr
+        Swap @VM with \0D0A\    in ProcErr
+        Swap @SVM with \0D0A\   in ProcErr
+
+        // The ProcErr always contains two copies of the error description so just divide in half to get one copy.
+        If ProcErr[1, Len(ProcErr) / 2] EQ ProcErr[Len(ProcErr) / 2 + 1, Len(ProcErr) / 2] then
+            ProcErr = ProcErr[1, Len(ProcErr) / 2]
+        end
+
+        HTTP_Services('SetResponseError', '', '', 500, ProcErr, FullEndpointURL)
+    end
+end else
+    ServerEnabled   = HTTP_Services('GetServerEnabled')
+    // Check to see if the server is still enabled.
+    If ServerEnabled then
+        // Authenticate the request using HTTP Authentication Services. If the user is not validated then the appropriate
+        // response status and headers will be set. If no authentication is required then the AuthenticateRequest service
+        // should set the UserAuthenticated response to True as a default.
+        //
+        // This service is also where global response headers are set, regardless of whether the user is authenticated.
+        //
+        // Note: Even if authentication is disabled via the SRP_HTTP_FRAMEWORK_SETUP configuration record, the
+        // AuthenticateRequest should still be called. It will inspect the flag and set the response accordingly.
+        UserAuthenticated = HTTP_Authentication_Services('AuthenticateRequest')
+
+        If UserAuthenticated then
+            // Call the API based on the type of calling procedure specified in the setup.
+            APICallProcedure    = HTTP_Services('GetAPICallProcedure')
+            If APICallProcedure EQ 'Web API' then
+                HTTP_Services('RunWebAPI')                
+            end else
+                EntryPointService   = HTTP_Services('GetEntryPointService')
+                RemainingURL        = HTTP_Services('GetHTTPPathInfo')
+                HTTP_Services('RunHTTPService', EntryPointService, RemainingURL)
+            end
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 503, 'Server is temporarily disabled.')
+    end
+end
+
+// Get the full response to send back to the requesting client.
+Response    = HTTP_Services('GetResponse')
+
+// Stop timing the overall API.
+SRP_Stopwatch('Stop', 'WebAPI')
+TimeToExecute   = SRP_Stopwatch('GetBenchmark', 'WebAPI')
+
+// Check the status before logging and returning the HTTP Response. If there is a status error then the Response
+// variable should be cleared and no log generated. The OEngineServer will resubmit a request with the error detail
+// the the ProcErr service will handle and log this.
+If Get_Status() EQ 0 then
+    HTTP_Services('CreateLogFile', 'Response', Response)
+end else
+    StatusCode  = ''
+    Status      = Get_Status(StatusCode)
+    HTTP_Services('SetResponseError', '', '', 500, 'Get_Status Error', FullEndpointURL, 'Status' : @FM : 'StatusCode', Status : @FM : StatusCode<1, 1> : ' - ' : StatusCode<1, 2>)
+    Response    = HTTP_Services('GetResponse')
+    HTTP_Services('CreateLogFile', 'GetStatus', Response)
+    Set_Status(0)
+end
+
+// Engage the debugger if requested.
+If HTTP_Services('GetRequestHeaderField', 'Debug') then Debug
+
+// Clear all saved values that were set in this session to avoid subsequent requests to a running engine from getting
+// invalid data.
+HTTP_Services('ClearSettings')
+
+// Clean up processes, as needed, that were set in this session to avoid subsequent requests to a running engine from
+// getting invalid data.
+HTTP_Authentication_Services('CleanUp')
+
+// Clear any possible internal OpenInsight errors so everything will process normally. Note, traditional INET does not
+// clear this flag automatically. This is how INET_ABORTED gets called if there is an SSP error. The SRP HTTP Framework
+// clears this flag by default because the developer can still trap Get_Status() in the relevant web service code and
+// create a custom HTTP response. Thus, the ProcErr service will only be called if there is a runtime error condition.
+* Set_Status(0)
+
+Return Response

FRAMEWORKS/STPROC/HTTP_PICTURE_SERVICES.txt

@@ -0,0 +1,252 @@
+Function HTTP_Picture_Services(RemainingURL)
+/***********************************************************************************************************************
+
+    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_Picture_Services
+
+    Description :   Handler program for the HTTP Picture service module.
+
+    Notes       :   All HTTP web services should include the HTTP_SERVICE_SETUP insert. This will provide several useful
+                    variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        SelfURL                 - The URL path representing the current service.
+                        FullEndPointURL         - The URL submitted by the client. This can be the same or longer than
+                                                  the SelfURL.
+                        NextSegment             - The URL segment immediately following the SelfURL (if any). This
+                                                  could contain the name of the next service or it could contain the
+                                                  Item ID for the current service (aka resource).
+                        CurrentServiceHandler   - The name of this stored procedure.
+
+    Parameters  :
+        RemainingURL    [in] -- The remaining portion of the URL that follows the URL that launched this current
+                                service. This information is used in the HTTP_SERVICE_SETUP insert to populate other
+                                useful variables (see Notes above).
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        03/27/16    dmb     Original programmer. - [SRPFW-96]
+        07/06/17    dmb     Refactor using Enhanced BASIC+ syntax. - [SRPFW-184]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert HTTP_SERVICE_SETUP
+$insert HTTP_INSERTS
+$insert CONTACTS_EQUATES
+
+// Assume the current HTTP method is valid until proven otherwise.
+ValidMethod     = True$
+// Assume the current web service is valid until provent otherwise.
+ValidService    = True$
+// Assume no HTTP methods are valid until proven otherwise.
+AllowedMethods  = ''
+// A list of all services able to be called from this URL.
+AllowedServices = ''
+
+PictureFolder   = '\WebAppData\ContactPictures\'
+
+// Handle the HTTP request as needed.
+Begin Case
+    Case RemainingURL _EQC ''
+        // This means the URL ends with /contacts/{KeyID}/picture, which means this is the end point.
+        AllowedMethods  = 'PUT,GET,OPTIONS'
+        Locate HTTPMethod in AllowedMethods using ',' setting MethodPos then
+            On MethodPos GoSub Put, Get, Options
+        end else
+            ValidMethod = False$
+        end
+
+    Case Otherwise$
+        ValidService    = False$
+End Case
+
+// Resolve any invalid conditions with the HTTP request.
+Begin Case
+    Case Not(ValidService)
+        HTTP_Services('SetResponseStatus', 404, NextSegment : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+
+    Case Not(ValidMethod)
+        HTTP_Services('SetResponseStatus', 405, HTTPMethod : ' is not valid for this service.')
+
+        GoSub SetAllowedMethods
+End Case
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN                     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Web Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// Put
+//
+// Attempts to update the picture resource at this URL end point.
+//----------------------------------------------------------------------------------------------------------------------
+Put:
+
+    NumSegments     = DCount(SelfURL, '/')
+    KeyID           = Field(SelfURL, '/', NumSegments - 1, 1)
+    TableName       = 'CONTACTS'
+
+    Open TableName to hTable then
+        Lock hTable, KeyID then
+            ResponseStatus  = 200       ; // Updating an existing resource.
+            Read DataRow from hTable, KeyID else
+                DataRow         = ''
+                ResponseStatus  = 201   ; // Creating a new resource.
+            end
+
+            // A URI scheme of the Base64 encoded image will be in the Data variable.
+            HTTPPostString  = HTTP_Services('GetHTTPPostString')
+            HTTPPostString  = HTTP_Services('DecodePercentString', HTTPPostString)
+            Scheme = HTTPPostString[1, 'F:']
+            If Scheme _EQC 'data' then
+                MediaType   = HTTPPostString[Col2() + 1, 'F;']                  ; // Should be "image/png" or "image/jpg"
+                Encoding    = HTTPPostString[Col2() + 1, 'F,']                  ; // Should be "base64"
+                EncodedData = HTTPPostString[Col2() + 1, Len(HTTPPostString)]   ; // Should be the actual Base64 encoded content.
+                DecodedData = SRP_Decode(EncodedData, 'BASE64')
+                FileType    = MediaType[-1, 'B/']
+                FileName    = KeyID : '.' : FileType
+                FilePath    = Drive() : PictureFolder : FileName
+                Status()    = 0
+                OSWrite DecodedData to FilePath
+                StatusCode = Status()
+                If StatusCode then
+                    Begin Case
+                        Case StatusCode EQ 1    ; Error = 'Bad OS filename. Code: ' : StatusCode
+                        Case StatusCode EQ 2    ; Error = 'Access denied by operating system. Code: ' : StatusCode
+                        Case StatusCode EQ 3    ; Error = 'Disk or directory full. Code: ' : StatusCode
+                        Case StatusCode EQ 4    ; Error = 'File does not exist. Code: ' : StatusCode
+                        Case StatusCode EQ 5    ; Error = 'Unknown error. Code: ' : StatusCode
+                        Case StatusCode EQ 6    ; Error = 'Attempt to write to read-only file. Code: ' : StatusCode
+                        Case Otherwise$         ; Error = 'Unknown error. Code: ' : StatusCode
+                    End Case
+                    HTTP_Services('SetResponseStatus', '501', Error)
+                end else
+                    DataRow<CONTACTS_PICTURE$>  = PictureFolder : FileName
+                    Write DataRow to hTable, KeyID then
+                        HTTP_Services('SetResponseStatus', ResponseStatus)
+                        HTTP_Services('SetResponseHeaderField', 'Content-Location', SelfURL)
+                    end else
+                        HTTP_Services('SetResponseStatus', 500, 'Error writing ' : KeyID : ' to the ' : TableName : ' table.')
+                    end
+                end
+            end else
+                HTTP_Services('SetResponseStatus', '415')
+            end
+            Unlock hTable, KeyID else Null
+        end else
+            HTTP_Services('SetResponseStatus', 423, KeyID : ' is currently locked.')
+        end
+    end else
+        HTTP_Services('SetResponseStatus', 500, 'Error opening the ' : TableName : ' table.')
+    end
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Get
+//
+// Attempts to return the picture resource from this URL end point.
+//----------------------------------------------------------------------------------------------------------------------
+Get:
+
+    // Get the picture's physical file path from the CONTACT database row.
+    NumSegments     = DCount(SelfURL, '/')
+    KeyID           = Field(SelfURL, '/', NumSegments - 1, 1)
+    PicturePath     = Drive() : HTTP_Resource_Services('GetColumnValues', 'CONTACTS', 'picture', KeyID)
+
+    If PicturePath NE '' then
+        // Verify the picture actually exists.
+        If Dir(PicturePath) NE '' then
+            // Get the image extension.
+            ImageExt    = PicturePath[-1, 'B.']
+            If ImageExt _EQC 'jpg' then ImageExt = 'jpeg'
+            // Get the best content type that matches the client's and server's ability.
+            ContentType = HTTP_Services('GetBestContentNegotiation', 'Accept', 'text/plain' : @FM : 'image/' : ImageExt)
+            If ContentType NE '' then
+                OSRead PictureBinary from PicturePath then
+                    Begin Case
+                        Case ContentType _EQC 'text/plain'
+                            PictureBody = SRP_Encode(PictureBinary, 'BASE64')
+                            PictureBody = 'data:' : 'image/' : ImageExt : ';base64,' : PictureBody
+                            HTTP_Services('SetResponseHeaderField', 'Content-Encoding', 'base64')
+                            HTTP_Services('SetResponseBody', PictureBody, False$, 'text/plain')
+
+                        Case ContentType[1, 6] _EQC 'image/'
+                            HTTP_Services('SetResponseBody', PictureBinary, True$, ContentType)
+
+                    End Case
+                end
+            end
+        end else
+            HTTP_Services('SetResponseStatus', '404', 'Picture for contact ' : KeyID : ' does not exist.')
+        end
+    end else
+        HTTP_Services('SetResponseStatus', '404', 'Picture for contact ' : KeyID : ' does not exist.')
+    end
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Options
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+Options:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetCommonOptionResponseHeaders
+//
+// Sets the response headers that will be common for all OPTIONS methods.
+//----------------------------------------------------------------------------------------------------------------------
+SetCommonOptionResponseHeaders:
+
+    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)
+
+    GoSub SetAllowedMethods
+
+return
+//----------------------------------------------------------------------------------------------------------------------
+// SetAllowedMethods
+//
+// Sets the Allow response header field as appropriate for the requested URL.
+//----------------------------------------------------------------------------------------------------------------------
+SetAllowedMethods:
+
+    If AllowedMethods NE '' then
+        For Each Method in AllowedMethods using ','
+            HTTP_Services('SetResponseHeaderField', 'Allow', Method, True$)
+        Next Method
+    end
+
+return

FRAMEWORKS/STPROC/HTTP_RESOURCE_MANAGER_SERVICES.txt

@@ -0,0 +1,582 @@
+Function HTTP_Resource_Manager_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_Resource_Manager_Services
+
+    Description :   Handler program for all module related services.
+
+    Notes       :   The generic parameters should contain all the necessary information to process the services. Often
+                    this will be information like the data Record and Key ID.
+
+    Parameters  :
+        Service         [in] -- Name of the service being requested
+        Param1-10   [in/out] -- Additional request parameter holders
+        Response       [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
+
+    Metadata    :
+
+    History     :   (Date, Initials, Notes)
+        07/12/19    dmb     [SRPFW-277] Original programmer.
+        07/13/19    dmb     [SRPFW-277] Added various services so that the NDW_HTTP_FRAMEWORKS_SERVICES commuter as well
+                            as additional tools can get or set various resource meta data.
+        07/15/19    dmb     [SRPFW-277] Added the GetEndpointResourceKeyID service.
+        07/16/19    dmb     [SRPFW-277] Added the GetResourceSignature service.
+        07/16/19    dmb     [SRPFW-277] Update GetResourceProperty service to support the RESOURCE property.
+        07/16/19    dmb     [SRPFW-277] Replaced harcoded cache duration with the CacheTTL$ equate.
+        07/16/19    dmb     [SRPFW-277] Rename the IsResource service to IsValidEndpoint.
+        07/17/19    dmb     [SRPFW-277] Update the SetResource service to refresh the GetResource cache better.
+        07/24/19    dmb     [SRPFW-278] Fix bug in the GetEndpointResourceKeyID service so that matching the URLEndpoint
+                            works better.
+        09/25/19    dmb     [SRPFW-278] Fix bug in the GetResource service that prevented endpoints with a resource ID
+                            from being matched correctly to the currently stored resources endpoints.
+        12/09/19    dmb     [SRPFW-296] Update all calls to Memory_Services to use a specific cache name.
+        01/23/20    dmb     [SRPFW-296] Update the SetResourceProperty and GetResourceSignature services to support the
+                            HEAD method.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert LOGICAL
+$insert HTTP_INSERTS
+$insert SERVICE_SETUP
+$insert INET_EQUATES
+$insert INET_HEADERS
+$insert HTTP_FRAMEWORK_SETUP_EQUATES
+
+Equ CRLF$           to \0D0A\
+Equ CacheTTL$       to 300   ; // Allow cached data to only be fresh for 5 seconds.
+Equ CacheName$      to 'SRPHTTPFramework'
+Equ ValidMethods$   to 'GET,POST,PUT,PATCH,DELETE,HEAD'
+
+Declare function    HTTP_Resource_Manager_Services, HTTP_Resource_Services, Database_Services, Memory_Services, SRP_Array
+Declare subroutine  HTTP_Resource_Manager_Services, HTTP_Resource_Services, Database_Services, Memory_Services
+
+GoToService else
+    HTTP_Services('SetResponseError', '', '', 404, Service : ' is not a valid service request within the HTTP Resource Manager services module.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN     = True$, False$
+Options CLASSES     = 'APIROOT', 'RESOURCE', 'RESOURCE_ID', 'PROPERTY'
+Options PROPERTIES  = 'CLASS', 'DESCRIPTION', 'EXCLUDE_LOGGING', 'METHODS', 'NAME', 'RESOURCE', 'TITLE', 'QUERY_PARAMS'
+Options CHILDREN    = 'ALL', 'RESOURCE', 'RESOURCE_ID', 'PROPERTY'
+Options METHODS     = 'GET', 'POST', 'PUT', 'PATCH', 'DELETE', 'HEAD'
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResourceProperty
+//
+// URLEndpoint  - URL endpoint for the resource. If empty, the APIROOT resource will be returned. - [Optional]
+// PropertyName - Name of the property whose value is being queried. - [Required]
+//
+// Returns the value of the indicated resource property for the indicated URL endpoint.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResourceProperty(URLEndpoint, PropertyName=PROPERTIES)
+
+    PropertyValue   = ''
+
+    If PropertyName NE '' then
+        Resource        = HTTP_Resource_Manager_Services('GetResource', URLEndpoint)
+        If Error_Services('NoError') then
+            PropertyNames   = Resource<1>
+            Locate PropertyName in PropertyNames using @VM setting PropertyPos then
+                PropertyValue   = Resource<2, PropertyPos>
+            end
+            Begin Case
+                Case PropertyName EQ 'EXCLUDE_LOGGING'
+                    // This property defaults to false unless true.
+                    If PropertyValue NE True$ then PropertyValue = False$
+                Case PropertyName EQ 'RESOURCE' AND PropertyValue = ''
+                    // Unless the system has forced this property to store a value, it should be derived from the
+                    // resource signature.
+                    Signature       = HTTP_Resource_Manager_Services('GetResourceSignature', URLEndpoint)
+                    PropertyValue   = Signature[1, '.']
+            End Case
+        end
+    end else
+        Error_Services('Add', 'PropertyName argument was missing in the ' : Service : ' service.')
+    end
+
+    Response        = PropertyValue
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetResourceProperty
+//
+// URLEndpoint      - URL endpoint for the resource. If empty, the APIROOT resource will be returned. - [Optional]
+// PropertyName     - Name of the property whose value is being set. - [Required]
+// PropertyValue    - Value of the property being updated. Depending upon the property, this might clear the value or
+//                    set a default value. - [Optional]
+//
+// Sets (or updates) the value of the indicated resource property for the indicated URL endpoint.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetResourceProperty(URLEndpoint, PropertyName=PROPERTIES, PropertyValue)
+
+    If PropertyName NE '' then
+        Resource        = HTTP_Resource_Manager_Services('GetResource', URLEndpoint)
+        If Error_Services('NoError') then
+            PropertyNames   = Resource<1>
+            Begin Case
+                Case PropertyName EQ 'METHODS'
+                    // Make sure only valid HTTP methods are set.
+                    Transfer PropertyValue to Methods
+                    For Each Method in Methods using ',' setting cPos
+                        Locate Method in ValidMethods$ using ',' setting MethodPos then
+                            PropertyValue  := Method : ','
+                        end
+                    Next Method
+                    PropertyValue[-1, 1]    = ''
+                Case PropertyName EQ 'EXCLUDE_LOGGING'
+                    // This property defaults to false unless true.
+                    If PropertyValue NE True$ then PropertyValue = False$
+                Case PropertyName EQ 'CLASS'
+                    // Make sure only a valid resource class is set.
+                    Locate PropertyValue in 'RESOURCE,RESOURCE_ID,PROPERTY' using ',' setting ClassPos else
+                        PropertyValue   = 'RESOURCE'
+                    end
+            End Case
+            Locate PropertyName in PropertyNames using @VM setting PropertyPos else
+                Resource<1, PropertyPos>    = PropertyName
+            end
+            Resource<2, PropertyPos>    = PropertyValue
+            HTTP_Resource_Manager_Services('SetResource', URLEndpoint, Resource)
+        end
+    end else
+        Error_Services('Add', 'PropertyName argument was missing in the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResourceChildren
+//
+// URLEndpoint  - URL endpoint for the resource. If empty, the APIROOT resource will be returned. - [Optional]
+// ChildType    - Type of child resource being queried. If empty or ALL then all children are returned. - [Optional]
+//
+// Returns an @FM delimited list of URL endpoints matching the indicated child type that are children to the indicated
+// URL endpoint.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResourceChildren(URLEndpoint, ChildType=CHILDREN)
+
+    Children    = ''
+
+    ResourceList    = HTTP_Resource_Manager_Services('GetResourceList')
+    If Error_Services('NoError') then
+        // Loop through the resource list to find resource children.
+        If ResourceList NE '' then
+            Locate ChildType in 'ALL,RESOURCE,RESOURCE_ID,PROPERTY' using ',' setting ChildPos else
+                ChildType   = 'ALL'
+            end
+            ThisEndpointKeyID   = HTTP_Resource_Manager_Services('GetEndpointResourceKeyID', URLEndpoint)
+            ThisLevel           = DCount(ThisEndpoint, '/')
+            For Each ResourceItem in ResourceList using @FM
+                Endpoint        = ResourceItem<0, 2>
+                EndpointLevel   = DCount(Endpoint, '/')
+                If EndpointLevel EQ 2 then
+                    EndpointParent  = 'APIROOT'
+                end else
+                    EndpointParent  = Field(Endpoint, '/', 1, EndpointLevel - 1)
+                end
+                If EndpointParent _EQC ThisEndpointKeyID then
+                    EndpointType        = ResourceItem<0, 5>
+                    If (EndpointType EQ ChildType) OR (ChildType EQ 'ALL') then
+                        Children    := Endpoint : @FM
+                    end
+                end
+            Next ResourceItem
+        end
+    end
+    Children[-1, 1]  = ''
+
+    Response    = Children
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResourceSignature
+//
+// URLEndpoint  - URL endpoint for the resource. If empty, the APIROOT resource will be returned. - [Optional]
+// Method       - HTTP method for the signature. This must be a valid method but it can also be empty. If empty,
+//                the signature returned will simply omit the method. - [Optional]
+//
+// Returns the API calling signature for the indicated URL endpoint. This is used by the RunWebAPI service (a member of
+// HTTP_Services) when calling the Web API module.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResourceSignature(URLEndpoint, Method=METHODS)
+
+    Signature           = ''
+
+    URLEndpointKeyID    = HTTP_Resource_Manager_Services('GetEndpointResourceKeyID', URLEndpoint)
+
+    // Validate the HTTP method.
+    Locate Method in ValidMethods$ using ',' setting MethodPos else
+        Method  = ''
+    end
+
+    If URLEndpointKeyID EQ 'APIROOT' then
+        Signature   = 'APIROOT.'
+    end else
+        ThisLevel   = DCount(URLEndpointKeyID, '/')
+        For LevelCnt = 2 to ThisLevel
+            Class   = HTTP_Resource_Manager_Services('GetResourceProperty', Field(URLEndpointKeyID, '/', 1, LevelCnt), 'CLASS')
+            Begin Case
+                Case Class EQ 'RESOURCE'
+                    // A resource starts a new signature.
+                    Signature   = Field(URLEndpointKeyID, '/', LevelCnt, 1) : '.'
+                Case Class EQ 'RESOURCE_ID'
+                    Signature  := 'ID.'
+                Case Otherwise$
+                    Signature  := Field(URLEndpointKeyID, '/', LevelCnt, 1) : '.'
+            End Case
+        Next LevelCnt
+    end
+
+    If Method NE '' then
+        Signature          := Method
+    end else
+        Signature[-1, 1]    = ''
+    end
+
+    Response    = Signature
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetEndpointResourceKeyID
+//
+// URLEndpoint  - URL endpoint to be validated. If empty, the APIROOT resource will be returned. - [Optional]
+// AllowNew     - Boolean flag indicating if a URL endpoint can be returned if new. Default is false. - [Optional]
+//
+// Returns the resource Key ID for the indicated URL endpoint. If AllowNew is true, a URL endpoint will be returned that
+// best matches the available endpoints but it will not be cached.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetEndpointResourceKeyID(URLEndpoint, AllowNew)
+
+    ServiceKeyID       := '*' : URLEndpoint
+    ResourceKeyID       = Memory_Services('GetValue', ServiceKeyID, True$, CacheTTL$, CacheName$)
+    ResourceKeyIDFound  = True$ ; // Assume true for now.
+
+    If AllowNew NE True$ then AllowNew = False$
+    IsNew   = False$    ; // Assume false for now.
+
+    If ResourceKeyID EQ '' then
+        If (URLEndpoint EQ '') OR (URLEndpoint _EQC 'APIROOT') then
+            ResourceKeyID   = 'APIROOT'
+        end else
+            // Make sure the URL endpoint is well formed. The intent is for the incoming URL endpoint to be forgiving but
+            // internally it needs to match with the exact format of the endpoints used to uniquely identify each resource.
+            Swap 'https' with '' in URLEndpoint
+            Swap 'http' with '' in URLEndpoint
+            HomeURL = HTTP_Services('GetHomeURL')
+            Swap 'https' with '' in HomeURL
+            Swap 'http' with '' in HomeURL
+            APIURL  = HTTP_Services('GetAPIRootURL', False$)
+            If URLEndpoint[-1, 1] EQ '/' then URLEndpoint[-1, 1] = ''
+            // Remove references to the Home or API URLs since these are not used when creating the resource endpoint
+            // identifiers.
+            Swap HomeURL with '' in URLEndpoint
+            Swap APIURL with '' in URLEndpoint
+            If URLEndpoint EQ '' then
+                // An empty URL endpoint implies APIROOT.
+                ResourceKeyID   = 'APIROOT'
+            end else
+                // The URL endpoint needs to be walked one segment at a time to confirm that it matches the pattern of
+                // an existing resource endpoint. Since the true URL endpoint might contains a resource ID, there needs
+                // to be a check to see if the value of a given segment matches a defined resource or resource property
+                // first. If not, then confirm there is a resource ID defined for this segment.
+                ResourceList        = HTTP_Resource_Manager_Services('GetResourceList')
+                ResourceArray       = SRP_Array('Rotate', ResourceList, @FM , @VM)
+                ResourceEndpoints   = ResourceArray<2>
+                ResourceNames       = ResourceArray<3>
+                ResourceClasses     = ResourceArray<5>
+                // Since the stored resource endpoints contain user defined resource IDs, each of these need to be
+                // converted to a generic '{ResourceID}' so simple comparison logic can work.
+                For Each Class in ResourceClasses using @VM setting ClassPos
+                    If Class EQ 'RESOURCE_ID' then
+                        OrigResourceEndpoint            = ResourceEndpoints<0, ClassPos>
+                        ResourceEndpoint                = OrigResourceEndpoint
+                        ResourceName                    = ResourceNames<0, ClassPos>
+                        Swap ResourceName with '{ResourceID}' in ResourceEndpoint
+                        Swap OrigResourceEndpoint with ResourceEndpoint in ResourceEndpoints
+                    end
+                Next Class
+                Convert @Upper_Case to @Lower_Case in ResourceEndpoints
+                Convert @Upper_Case to @Lower_Case in URLEndpoint
+                // Remove any preceding "/" characters so the For Each will work
+                // better.
+                If URLEndpoint[1, 1] EQ '/' then URLEndpoint = URLEndpoint[2, 9999]
+                MatchResourceKeyID  = ''
+                // Walk the URL endpoint provided and check for matches. Build the resource Key ID along the way. If a
+                // given segment is unable to be matched to a defined resource endpoint, end the loop and clear the
+                // resource Key ID.
+                FinalSegment    = False$
+                For Each Segment in URLEndpoint using '/' setting SegmentPos
+                    MatchResourceKeyID := '/' : Segment
+                    Locate MatchResourceKeyID in ResourceEndpoints using @VM setting URLPos then
+                        If Segment[1, 1] EQ '{' then
+                            ResourceKeyID  := '/{resourceid}'
+                        end else
+                            ResourceKeyID  := '/' : Segment
+                        end
+                    end else
+                        MatchResourceKeyID  = Field(MatchResourceKeyID, '/', 1, SegmentPos) : '/{resourceid}'
+                        Locate MatchResourceKeyID in ResourceEndpoints using @VM setting URLPos then
+                            ResourceKeyID      := '/{resourceid}'
+                        end else
+                            If AllowNew EQ True$ then
+                                ResourceKeyID      := '/' : Segment
+                                IsNew               = True$
+                            end else
+                                FinalSegment        = True$
+                            end
+                        end
+                    end
+                While (ResourceKeyIDFound EQ True$) AND (FinalSegment EQ False$)
+                Next Segment
+            end
+        end
+
+        If ResourceKeyIDFound EQ True$ then
+            If IsNew NE True$ then
+                Memory_Services('SetValue', ServiceKeyID, ResourceKeyID, CacheName$)
+            end
+        end else
+            ResourceKeyID = ''
+        end
+    end
+
+    Response        = ResourceKeyID
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResource
+//
+// URLEndpoint  - URL endpoint for the resource. If empty, the APIROOT resource will be returned. - [Optional]
+//
+// Returns an array of resource property names and values for the indicated URL endpoint.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResource(URLEndpoint)
+
+    URLEndpointKeyID    = HTTP_Resource_Manager_Services('GetEndpointResourceKeyID', URLEndpoint)
+    ServiceKeyID       := '*' : URLEndpointKeyID
+    Resource            = Memory_Services('GetValue', ServiceKeyID, True$, CacheTTL$, CacheName$)
+
+    If Resource EQ '' then
+        ResourceList    = HTTP_Resource_Manager_Services('GetResourceList')
+        If Error_Services('NoError') then
+            // The URL endpoint needs to be walked one segment at a time to confirm that it matches the pattern of
+            // an existing resource endpoint. Since the true URL endpoint might contains a resource ID, there needs
+            // to be a check to see if the value of a given segment matches a defined resource or resource property
+            // first. If not, then confirm there is a resource ID defined for this segment.
+            ResourceArray       = SRP_Array('Rotate', ResourceList, @FM , @VM)
+            ResourceEndpoints   = ResourceArray<2>
+            ResourceNames       = ResourceArray<3>
+            ResourceClasses     = ResourceArray<5>
+            // Since the stored resource endpoints contain user defined resource IDs, each of these need to be
+            // converted to a generic '{ResourceID}' so simple comparison logic can work.
+            For Each Class in ResourceClasses using @VM setting ClassPos
+                If Class EQ 'RESOURCE_ID' then
+                    OrigResourceEndpoint            = ResourceEndpoints<0, ClassPos>
+                    ResourceEndpoint                = OrigResourceEndpoint
+                    ResourceName                    = ResourceNames<0, ClassPos>
+                    Swap ResourceName with '{ResourceID}' in ResourceEndpoint
+                    Swap OrigResourceEndpoint with ResourceEndpoint in ResourceEndpoints
+                end
+            Next Class
+            Convert @Upper_Case to @Lower_Case in ResourceEndpoints
+            MatchURLEndpointKeyID   = URLEndpointKeyID
+            Convert @Upper_Case to @Lower_Case in MatchURLEndpointKeyID
+
+            Locate MatchURLEndpointKeyID in ResourceEndpoints using @VM setting ResourcePos then
+                ResourceArray   = ResourceList<ResourcePos>
+                Convert @VM to @FM in ResourceArray
+                NameProperty    = ResourceArray<3>
+                ClassProperty   = ResourceArray<5>
+                OtherProperties = ResourceArray<19>
+                Convert @SVM to @FM in OtherProperties
+                Convert @TM to @VM in OtherProperties
+                ResourceList    = 'NAME' : @VM : NameProperty : @FM : 'CLASS' : @VM : ClassProperty : @FM : OtherProperties
+                Resource        = SRP_Array('Rotate', ResourceList, @FM, @VM)
+                Memory_Services('SetValue', ServiceKeyID, Resource, CacheName$)
+            end
+        end
+    end
+
+    Response        = Resource
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetResource
+//
+// URLEndpoint      - URL endpoint for the resource. If empty, the APIROOT resource will be returned. - [Optional]
+// PropertyArray    - An @FM/@VM delimited array of resource property names and values for the resource. - [Required]
+//
+// Updates the array of resource property names and values for the indicated URL endpoint. Note, this replaces the
+// existing property names and values. Other services should be used to update an existing array and then call this
+// service when the array is updated. The PropertyArray must have at least one property name and value.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetResource(URLEndpoint, PropertyArray)
+
+    If PropertyArray NE '' then
+        URLEndpointKeyID    = HTTP_Resource_Manager_Services('GetEndpointResourceKeyID', URLEndpoint, True$)
+        ResourceList        = HTTP_Resource_Manager_Services('GetResourceList')
+        If Error_Services('NoError') then
+            ResourceArray           = SRP_Array('Rotate', ResourceList, @FM , @VM)
+            MatchURLEndpointKeyID   = URLEndpointKeyID
+            Convert @Upper_Case to @Lower_Case in MatchURLEndpointKeyID
+            ResourceEndpoints       = ResourceArray<2>
+            Convert @Upper_Case to @Lower_Case in ResourceEndpoints
+            Locate MatchURLEndpointKeyID in ResourceEndpoints By 'AL' using @VM setting ResourcePos then
+                // This is an existing resource so update it.
+                Resource    = ResourceList<ResourcePos>
+                Convert @VM to @FM in Resource
+            end else
+                // This is a new resource.
+                ResourceList    = Insert(ResourceList, ResourcePos, 0, 0, '')
+                GoSub GetResourceTemplate
+            end
+            // Update the resource array with the property array data.
+            PropertyNames   = PropertyArray<1>
+            PropertyValues  = PropertyArray<2>
+            Locate 'NAME' in PropertyNames using @VM setting PropertyPos then
+                Name            = PropertyValues<0, PropertyPos>
+                PropertyNames   = Delete(PropertyNames, 0, PropertyPos, 0)
+                PropertyValues  = Delete(PropertyValues, 0, PropertyPos, 0)
+            end else
+                // If no Name is provided, use the final segment of the URL endpoint.
+                Name            = URLEndpointKeyID[-1, 'B/']
+                PropertyArray   = Insert(PropertyArray, 1, 1, 0, 'NAME')
+                PropertyArray   = Insert(PropertyArray, 2, 1, 0, Name)
+            end
+            Locate 'CLASS' in PropertyNames using @VM setting PropertyPos then
+                Class           = PropertyValues<0, PropertyPos>
+                Locate Class in 'RESOURCE,RESOURCE_ID,PROPERTY' using ',' setting ClassPos else
+                    Class                           = 'RESOURCE'
+                    PropertyArray<2, PropertyPos>   = Class
+                end
+                PropertyNames   = Delete(PropertyNames, 0, PropertyPos, 0)
+                PropertyValues  = Delete(PropertyValues, 0, PropertyPos, 0)
+            end else
+                // All resources are required to have a class. If none is specified then set it to 'RESOURCE'.
+                Class           = 'RESOURCE'
+                PropertyArray   = Insert(PropertyArray, 1, 1, 0, 'CLASS')
+                PropertyArray   = Insert(PropertyArray, 2, 1, 0, Class)
+            end
+            Memory_Services('SetValue', ServiceModule : '*GetResource*' : URLEndpointKeyID, PropertyArray, CacheName$)
+            Resource<03>                = Name
+            Resource<05>                = Class
+            OtherProperties             = PropertyNames : @FM : PropertyValues
+            OtherPropertiesList         = SRP_Array('Rotate', OtherProperties, @FM, @VM)
+            Convert @VM to @TM in OtherPropertiesList
+            Convert @FM to @SVM in OtherPropertiesList
+            Resource<19>                = OtherPropertiesList
+            Convert @FM to @VM in Resource
+            ResourceList<ResourcePos>   = Resource
+            ResourcesKeyID              = HTTP_Services('GetLocalAppKeyID', ResourcesKeyID$)
+            Database_Services('WriteDataRow', SetupTable$, ResourcesKeyID, ResourceList, True$, False$, True$)
+        end
+    end else
+        Error_Services('Add', 'PropertyArray was missing from the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// IsValidEndpoint
+//
+// URLEndpoint  - URL endpoint for the resource. If empty, a False value will be returned. - [Required]
+//
+// Returns a Boolean flag indicating if the indicated URL endpoint exists.
+//----------------------------------------------------------------------------------------------------------------------
+Service IsValidEndpoint(URLEndpoint)
+
+    IsValidEndpoint = False$    ; // Assume False for now.
+
+    If URLEndpoint NE '' then
+        URLEndpointKeyID    = HTTP_Resource_Manager_Services('GetEndpointResourceKeyID', URLEndpoint)
+        If URLEndpointKeyID NE '' then IsValidEndpoint = True$
+    end else
+        Error_Services('Add', 'URLEndpoint argument was missing in the ' : Service : ' service.')
+    end
+
+    Response        = IsValidEndpoint
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResourceList
+//
+// Returns the resource list for the current application.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetResourceList()
+
+    ResourceList    = ''
+
+    ResourcesKeyID  = HTTP_Services('GetLocalAppKeyID', ResourcesKeyID$)
+    If Error_Services('NoError') then
+        ResourceList    = Database_Services('ReadDataRow', SetupTable$, ResourcesKeyID, True$, CacheTTL$, False$)
+    end
+
+    Response        = ResourceList
+
+end service
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetResourceTemplate
+//
+// Returns a template for a new resource. Most of this information is needed for the NDW_HTTP_FRAMEWORK_SETUP form's
+// Tree control.
+//----------------------------------------------------------------------------------------------------------------------
+GetResourceTemplate:
+
+    Resource            = ''
+    Resource<01>        = DCount(URLEndpointKeyID, '/')
+    Resource<02>        = URLEndpointKeyID
+    Resource<03>        = URLEndpointKeyID[-1, 'B/']
+    Resource<04>        = 'Text' : @SVM
+    Resource<05>        = ''
+    Resource<06>        = ''
+    Resource<07>        = 'RGB{68, 68, 68}' : @SVM : 'White'
+    Resource<08>        = 'Segoe UI' : @SVM : '-12' : @SVM : '400' : @SVM : '0' : @SVM : '0' : @SVM : '0' : @SVM : '1' : @SVM : '0' : @SVM : '0' : @SVM : '0' : @SVM : '0' : @SVM : '0'
+    Resource<09>        = 'Left' : @SVM : 'Center'
+    Resource<10>        = 'N'
+    Resource<11>        = 'None'
+    Resource<12>        = 1
+    Resource<13>        = 24
+    Resource<14>        = 0
+    Resource<15>        = 1
+    Resource<16>        = 'None'
+    Resource<17>        = 'Left'
+    Resource<18>        = 13 : @SVM : 13
+
+return

FRAMEWORKS/STPROC/HTTP_USERS_SERVICES.txt

@@ -0,0 +1,256 @@
+Function HTTP_Users_Services(RemainingURL)
+/***********************************************************************************************************************
+
+    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_Users_Services
+
+    Description :   Handler program for the HTTP Users service module.
+
+    Notes       :   All HTTP web services should include the HTTP_SERVICE_SETUP insert. This will provide several useful
+                    variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        SelfURL                 - The URL path representing the current service.
+                        FullEndPointURL         - The URL submitted by the client. This can be the same or longer than
+                                                  the SelfURL.
+                        NextSegment             - The URL segment immediately following the SelfURL (if any). This
+                                                  could contain the name of the next service or it could contain the
+                                                  Item ID for the current service (aka resource).
+                        CurrentServiceHandler   - The name of this stored procedure.
+
+    Parameters  :
+        RemainingURL    [in] -- The remaining portion of the URL that follows the URL that launched this current
+                                service. This information is used in the HTTP_SERVICE_SETUP insert to populate other
+                                useful variables (see Notes above).
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        04/17/15    dmb     Original programmer. - [SRPFW-94]
+        05/22/15    dmb     Retrofit using the new template from HTTP_Contacts_Services and relying upon the
+                            HTTP_Resources_Services module. - [SRPFW-94]
+        03/09/16    dmb     Refactor to use the updated RunHTTPService service. - [SRPFW-112]
+        07/01/17    dmb     Refactor using Enhanced BASIC+ syntax. - [SRPFW-184]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert HTTP_SERVICE_SETUP
+$insert HTTP_INSERTS
+
+// Assume the current HTTP method is valid until proven otherwise.
+ValidMethod     = True$
+// Assume the current web service is valid until provent otherwise.
+ValidService    = True$
+// Assume no HTTP methods are valid until proven otherwise.
+AllowedMethods  = ''
+// A list of all services able to be called from this URL.
+AllowedServices = ''
+
+// Some methods are restricted to authorized users only. Get their security level for cross-checking later.
+Username    = Memory_Services('GetValue', 'Username')
+Security    = Xlate('USERS', Username, 'ACCESS_LEVEL', 'X')
+
+// Handle the HTTP request as needed.
+Begin Case
+    Case RemainingURL _EQC ''
+        // This means the URL ends with /users, which means this is the end point. The client is requesting a
+        // collection of all users.
+        AllowedMethods  = 'POST,GET,OPTIONS'
+        Locate HTTPMethod in AllowedMethods using ',' setting MethodPos then
+            On MethodPos GoSub Post, Get, Options
+        end else
+            ValidMethod = False$
+        end
+
+    Case Count(RemainingURL, '/') EQ 0
+        // This means the URL ends with /users/{KeyID}. The client is requesting a specific user item.
+        AllowedMethods  = 'PUT,GET,DELETE,OPTIONS'
+        Locate HTTPMethod in AllowedMethods using ',' setting MethodPos then
+            On MethodPos GoSub PutItem, GetItem, DeleteItem, OptionsItem
+        end else
+            ValidMethod = False$
+        end
+
+    Case Otherwise$
+        ValidService    = False$
+End Case
+
+// Resolve any invalid conditions with the HTTP request.
+Begin Case
+    Case Not(ValidService)
+        HTTP_Services('SetResponseStatus', 404, NextSegment : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+
+    Case Not(ValidMethod)
+        HTTP_Services('SetResponseStatus', 405, HTTPMethod : ' is not valid for this service.')
+
+        GoSub SetAllowedMethods
+End Case
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN                     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Web Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// Post
+//
+// Attempts to create a new user.
+//----------------------------------------------------------------------------------------------------------------------
+Post:
+
+    HTTP_Resource_Services('PostDatabaseItem', 'USERS', SelfURL)
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Get
+//
+// Returns a collection of users. This URL also supports the passing in of query parameters, which in this case will
+// will only support "name" as the query param field.
+//----------------------------------------------------------------------------------------------------------------------
+Get:
+
+    HAL = ''    ; // Initialize the response.
+
+    If HTTP_Services('GetHTTPGetString') NE '' then
+        // This means the URL ends with /users?name={value}.
+
+        NameSearch  = HTTP_Services('GetQueryField', 'name')
+        Filter      = 'SELECT USERS BY USERNAME WITH USERNAME CONTAINING ' : Quote(NameSearch)
+        ColumnNames	= 'first_name' : @FM : 'last_name'
+        HAL         = HTTP_Resource_Services('GetDatabaseItems', Filter, 'USERS', SelfURL, ColumnNames)
+
+    end else
+        // This means the URL ends with /users. The client is requesting all users available at this URL.
+
+        Filter      = ''
+        ColumnNames	= 'first_name' : @FM : 'last_name'
+        HAL         = HTTP_Resource_Services('GetDatabaseItems', Filter, 'USERS', SelfURL, ColumnNames)
+
+    end
+
+    Response    = HAL
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Options
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+Options:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// PutItem
+//
+// Attempts to update a user. If the user does not already exist then a new one will be created.
+//----------------------------------------------------------------------------------------------------------------------
+PutItem:
+
+    KeyID   = NextSegment
+
+    HTTP_Resource_Services('PutDatabaseItem', 'USERS', SelfURL : '/' : KeyID, KeyID)
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetItem
+//
+// Returns the specific user.
+//----------------------------------------------------------------------------------------------------------------------
+GetItem:
+
+    KeyID   = NextSegment
+
+	ColumnNames	= 'first_name' : @FM : 'last_name'
+    HAL     	= HTTP_Resource_Services('GetDatabaseItem', 'USERS', SelfURL : '/' : KeyID, KeyID, ColumnNames)
+
+    Response    = HAL
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// DeleteItem
+//
+// Attempts to delete the user.
+//----------------------------------------------------------------------------------------------------------------------
+DeleteItem:
+
+    KeyID   = NextSegment
+
+    HTTP_Resource_Services('DeleteDatabaseItem', 'USERS', KeyID)
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// OptionsItem
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+OptionsItem:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetCommonOptionResponseHeaders
+//
+// Sets the response headers that will be common for all OPTIONS methods.
+//----------------------------------------------------------------------------------------------------------------------
+SetCommonOptionResponseHeaders:
+
+    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)
+
+    GoSub SetAllowedMethods
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetAllowedMethods
+//
+// Sets the Allow response header field as appropriate for the requested URL.
+//----------------------------------------------------------------------------------------------------------------------
+SetAllowedMethods:
+
+    If AllowedMethods NE '' then
+        For Each Method in AllowedMethods using ','
+            HTTP_Services('SetResponseHeaderField', 'Allow', Method, True$)
+        Next Method
+    end
+
+return

FRAMEWORKS/STPROC/HTTP_VERSION_SERVICES.txt

@@ -0,0 +1,162 @@
+Function HTTP_Version_Services(RemainingURL)
+/***********************************************************************************************************************
+
+    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_Version_Services
+
+    Description :   Handler program for the HTTP Version service module.
+
+    Notes       :   All HTTP web services should include the HTTP_SERVICE_SETUP insert. This will provide several useful
+                    variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        SelfURL                 - The URL path representing the current service.
+                        FullEndPointURL         - The URL submitted by the client. This can be the same or longer than
+                                                  the SelfURL.
+                        NextSegment             - The URL segment immediately following the SelfURL (if any). This
+                                                  could contain the name of the next service or it could contain the
+                                                  Item ID for the current service (aka resource).
+                        CurrentServiceHandler   - The name of this stored procedure.
+
+    Parameters  :
+        RemainingURL    [in] -- The remaining portion of the URL that follows the URL that launched this current
+                                service. This information is used in the HTTP_SERVICE_SETUP insert to populate other
+                                useful variables (see Notes above).
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        07/10/17    dmb     Original programmer. - [SRPFW-188]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert HTTP_SERVICE_SETUP
+$insert HTTP_INSERTS
+
+// Assume the current HTTP method is valid until proven otherwise.
+ValidMethod     = True$
+// Assume the current web service is valid until provent otherwise.
+ValidService    = True$
+// Assume no HTTP methods are valid until proven otherwise.
+AllowedMethods  = ''
+// A list of all services able to be called from this URL.
+AllowedServices = ''
+
+// Handle the HTTP request as needed.
+Begin Case
+    Case RemainingURL _EQC ''
+        // This means the URL ends with /version.
+        AllowedMethods  = 'GET,OPTIONS'
+        Locate HTTPMethod in AllowedMethods using ',' setting MethodPos then
+            On MethodPos GoSub Get, Options
+        end else
+            ValidMethod = False$
+        end
+
+    Case Otherwise$
+        ValidService    = False$
+End Case
+
+// Resolve any invalid conditions with the HTTP request.
+Begin Case
+    Case Not(ValidService)
+        HTTP_Services('SetResponseStatus', 404, NextSegment : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+
+    Case Not(ValidMethod)
+        HTTP_Services('SetResponseStatus', 405, HTTPMethod : ' is not valid for this service.')
+
+        GoSub SetAllowedMethods
+End Case
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN                     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Web Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Get
+//
+// Returns the version resource.
+//----------------------------------------------------------------------------------------------------------------------
+Get:
+
+    Version     = HTTP_Services('GetVersion')
+    If Error_Services('NoError') then
+        Swap CRLF$ with @FM in Version
+        If SRP_JSON(hVersionObj, 'NEW', 'OBJECT') then
+            SRP_JSON(hVersionObj, 'SETVALUE', 'Version', Version<1>)
+            SRP_JSON(hVersionObj, 'SETVALUE', 'Date', Field(Version<2>, ' ', 1, 1))
+            SRP_JSON(hVersionObj, 'SETVALUE', 'Time', Field(Version<2>, ' ', 2, 1))
+            VersionBody = SRP_JSON(hVersionObj, 'STRINGIFY', 'STYLED')
+            SRP_JSON(hVersionObj, 'RELEASE')
+            HTTP_Services('SetResponseStatus', 200)
+            HTTP_Services('SetResponseBody', VersionBody, False, 'application/json')
+        end
+    end
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// Options
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+Options:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetCommonOptionResponseHeaders
+//
+// Sets the response headers that will be common for all OPTIONS methods.
+//----------------------------------------------------------------------------------------------------------------------
+SetCommonOptionResponseHeaders:
+
+    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)
+
+    GoSub SetAllowedMethods
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetAllowedMethods
+//
+// Sets the Allow response header field as appropriate for the requested URL.
+//----------------------------------------------------------------------------------------------------------------------
+SetAllowedMethods:
+
+    If AllowedMethods NE '' then
+        For Each Method in AllowedMethods using ','
+            HTTP_Services('SetResponseHeaderField', 'Allow', Method, True$)
+        Next Method
+    end
+
+return

FRAMEWORKS/STPROC/HTTP_WEBACCOUNTS_SERVICES.txt

@@ -0,0 +1,251 @@
+Function HTTP_WebAccounts_Services(RemainingURL)
+/***********************************************************************************************************************
+
+    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_WebAccounts_Services
+
+    Description :   Handler program for the HTTP WebAccounts service module.
+
+    Notes       :   All HTTP web services should include the HTTP_SERVICE_SETUP insert. This will provide several useful
+                    variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        SelfURL                 - The URL path representing the current service.
+                        FullEndPointURL         - The URL submitted by the client. This can be the same or longer than
+                                                  the SelfURL.
+                        NextSegment             - The URL segment immediately following the SelfURL (if any). This
+                                                  could contain the name of the next service or it could contain the
+                                                  Item ID for the current service (aka resource).
+                        CurrentServiceHandler   - The name of this stored procedure.
+
+    Parameters  :
+        RemainingURL    [in] -- The remaining portion of the URL that follows the URL that launched this current
+                                service. This information is used in the HTTP_SERVICE_SETUP insert to populate other
+                                useful variables (see Notes above).
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        10/12/18    dmb     Original programmer. - [SRPFW-254]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert HTTP_SERVICE_SETUP
+$insert HTTP_INSERTS
+
+Declare subroutine  WebAccounts_Services, HTTP_Authentication_Services
+Declare function    WebAccounts_Services, HTTP_Authentication_Services
+
+// Assume the current HTTP method is valid until proven otherwise.
+ValidMethod             = True$
+// Assume the current web service is valid until provent otherwise.
+ValidService            = True$
+// Assume no HTTP methods are valid until proven otherwise.
+AllowedMethods          = ''
+// A list of all services able to be called from this URL.
+AllowedServices         = 'password'
+
+AuthenticatedAccountID  = HTTP_Authentication_Services('GetAuthenticatedAccountID')
+
+// Handle the HTTP request as needed.
+Begin Case
+    Case Count(RemainingURL, '/') GE 1
+        // This means the URL ends with /webaccounts/{KeyID}/{property}.
+        Property    = FullEndPointURL[-1, 'B/']
+        Locate Property in AllowedServices using ',' setting ServicePos then
+            AllowedMethods  = 'PATCH,GET,OPTIONS'
+            Locate HTTPMethod in AllowedMethods using ',' setting MethodPos then
+                On MethodPos GoSub PatchItemProperty, GetItemProperty, OptionsItemProperty
+            end else
+                ValidMethod = False$
+            end
+        end else
+            ValidService    = False$
+        end
+
+    Case Otherwise$
+        ValidService    = False$
+End Case
+
+// Resolve any invalid conditions with the HTTP request.
+Begin Case
+    Case Not(ValidService)
+        HTTP_Services('SetResponseStatus', 404, NextSegment : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+
+    Case Not(ValidMethod)
+        HTTP_Services('SetResponseStatus', 405, HTTPMethod : ' is not valid for this service.')
+
+        GoSub SetAllowedMethods
+End Case
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN                     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Web Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// PatchItemProperty
+//
+// Attempts to update the property of a specific resource.
+//----------------------------------------------------------------------------------------------------------------------
+PatchItemProperty:
+
+    // Get the name of the property by looking at the last segment in the FullEndPointURL variable. An assumption is
+    // being made that there are no other segments in the URL that follow the property name.
+    Property    = FullEndPointURL[-1, 'B/']
+
+    If Property _EQC 'password' then
+        AccountID   = NextSegment
+        If AccountID EQ AuthenticatedAccountID then
+            Password    = HTTP_Authentication_Services('GetWebAccountPassword', AccountID, False$)
+            Body        = HTTP_Services('GetHTTPPostString')
+            Body        = HTTP_Services('DecodePercentString', Body)
+            If SRP_JSON(objJSON, 'Parse', Body) EQ '' then
+                NewPassword = SRP_JSON(objJSON, 'GetValue', 'value')
+                SRP_JSON(objJSON, 'Release')
+                HTTP_Authentication_Services('SetWebAccountPassword', AccountID, Password, NewPassword)
+                If Error_Services('NoError') then
+                    If SRP_JSON(objJSON, 'New', 'Object') then
+                        If SRP_JSON(objLinks, 'New', 'Object') then
+                            If SRP_JSON(objSelf, 'New', 'Object') then
+                                SRP_JSON(objSelf, 'SetValue', 'href', FullEndPointURL)
+                                SRP_JSON(objLinks, 'Set', 'self', objSelf)
+                                SRP_JSON(objSelf, 'Release')
+                            end
+                            SRP_JSON(objJSON, 'Set', '_links', objLinks)
+                            SRP_JSON(objLinks, 'Release')
+                        end
+                        SRP_JSON(objJSON, 'SetValue', 'value', NewPassword, 'String')
+                        HAL = SRP_JSON(objJSON, 'Stringify', 'Fast')
+                        SRP_JSON(objJSON, 'Release')
+                        HTTP_Services('SetResponseBody', HAL, False$, 'application/hal+json')
+                    end
+                end else
+                    HTTP_Services('SetResponseStatus', '403', Error_Services('GetMessage'))
+                end
+            end else
+                Error_Services('Add', 'Error parsing JSON body within the ' : CurrentServiceHandler : ' module.')
+                HTTP_Services('SetResponseStatus', '500', Error_Services('GetMessage'))
+            end
+        end else
+            HTTP_Services('SetResponseStatus', '401', 'This account is not authorized for this endpoint.')
+        end
+    end else
+        // The URL contains an unsupported property. Return a 404 error.
+        HTTP_Services('SetResponseStatus', 404, Property : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+    end
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetItemProperty
+//
+// Returns the property of a specific resource.
+//----------------------------------------------------------------------------------------------------------------------
+GetItemProperty:
+
+    // Get the name of the property by looking at the last segment in the FullEndPointURL variable. An assumption is
+    // being made that there are no other segments in the URL that follow the property name.
+    Property    = FullEndPointURL[-1, 'B/']
+    If Property _EQC 'password' then
+        AccountID       = NextSegment
+        If AccountID EQ AuthenticatedAccountID then
+            Password        = HTTP_Authentication_Services('GetWebAccountPassword', AccountID, False$)
+            jsonWebAccounts = WebAccounts_Services('GetWebAccounts', AccountID, True$)
+            If Error_Services('NoError') then
+                If SRP_JSON(objJSON, 'Parse', jsonWebAccounts) EQ '' then
+                    objPassword = SRP_JSON(objJSON, 'Get', 'password')
+                    SRP_JSON(objJSON, 'Release')
+                    If SRP_JSON(objLinks, 'New', 'Object') then
+                        If SRP_JSON(objSelf, 'New', 'Object') then
+                            SRP_JSON(objSelf, 'SetValue', 'href', FullEndPointURL)
+                            SRP_JSON(objLinks, 'Set', 'self', objSelf)
+                            SRP_JSON(objSelf, 'Release')
+                        end
+                        SRP_JSON(objPassword, 'Set', '_links', objLinks)
+                        SRP_JSON(objLinks, 'Release')
+                    end
+                    HAL = SRP_JSON(objPassword, 'Stringify', 'Fast')
+                    SRP_JSON(objPassword, 'Release')
+                    HTTP_Services('SetResponseBody', HAL, False$, 'application/hal+json')
+                end else
+                    Error_Services('Add', 'Error parsing JSON body within the ' : CurrentServiceHandler : ' module.')
+                    HTTP_Services('SetResponseStatus', '500', Error_Services('GetMessage'))
+                end
+            end else
+                HTTP_Services('SetResponseStatus', '403', Error_Services('GetMessage'))
+            end
+        end else
+            HTTP_Services('SetResponseStatus', '401', 'This account is not authorized for this endpoint.')
+        end
+    end else
+        // The URL contains an unsupported property. Return a 404 error.
+        HTTP_Services('SetResponseStatus', 404, Property : ' is not a valid service request within the ' : CurrentServiceHandler : ' module.')
+    end
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// OptionsItemProperty
+//
+// Sets the appropriate response header fields for an OPTIONS request.
+//----------------------------------------------------------------------------------------------------------------------
+OptionsItemProperty:
+
+    GoSub SetCommonOptionResponseHeaders
+
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetCommonOptionResponseHeaders
+//
+// Sets the response headers that will be common for all OPTIONS methods.
+//----------------------------------------------------------------------------------------------------------------------
+SetCommonOptionResponseHeaders:
+
+    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)
+
+    GoSub SetAllowedMethods
+
+return
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetAllowedMethods
+//
+// Sets the Allow response header field as appropriate for the requested URL.
+//----------------------------------------------------------------------------------------------------------------------
+SetAllowedMethods:
+
+    If AllowedMethods NE '' then
+        For Each Method in AllowedMethods using ','
+            HTTP_Services('SetResponseHeaderField', 'Allow', Method, True$)
+        Next Method
+    end
+
+return

FRAMEWORKS/STPROC/LOGGING_SERVICES.txt

@@ -0,0 +1,506 @@
+Function Logging_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        :   Logging_Services
+
+    Description :   Handler program for all module related services.
+
+    Notes       :   The generic parameters should contain all the necessary information to process the services. Often
+                    this will be information like the data Record and Key ID.
+
+    Parameters  :
+        Service         [in] -- Name of the service being requested
+        Param1-10   [in/out] -- Additional request parameter holders
+        Response       [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
+
+    Metadata    :
+
+    History     :   (Date, Initials, Notes)
+        08/30/17    dmb     Original programmer.
+        02/17/18    dmb     Use the new named cache feature of Memory_Services so logging data is protected when other
+                            processes release a cache table.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert LOGICAL
+$insert SERVICE_SETUP
+$insert SRPMail_Inserts
+
+Equ     CRLF$       to \0D0A\
+Equ     CR$         to \0D\
+Equ     LF$         to \0A\
+Equ     TAB$        to \09\
+Equ     COMMA$      to ','
+
+Common /LogginServices/ Unused1@, Unused2@, Unused3@, Unused4@, Unused5@, Unused6@, Unused7@, Unused8@
+
+Declare function    Logging_Services, Memory_Services, SRP_Hash, SRP_Path, SRP_Send_Mail, Environment_Services
+Declare subroutine  Logging_Services, Memory_Services, SetInitDirOptions
+
+GoToService else
+    Error_Services('Add', Service : ' is not a valid service request within the Logging services module.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// NewLog
+//
+// LogPath          - Path to where the log file is located. - [Required]
+// LogFileName      - Name of the log file. - [Required]
+// RowDelimiter     - Delimiter used to separate each log row. Default is CR/LF. - [Optional]
+// ColumnDelimiter  - Delimiter used to separate each column value. If ColumnWidths is empty then this will default to a
+//                    comma. - [Optional]
+// ColumnHeaders    - @FM list of Column headers to use in the log file. Default is no column headers will be used.
+//                    - [Optional]
+// ColumnWidths     - @FM list of Column widths for each column data value. If empty then the entire column value will
+//                    be stored. - [Optional]
+// QuoteValues      - Boolean flag to indicate if column values should be quoted. Default is false. - [Optional]
+// ClearLog         - Boolean flag to indicate if any existing log file should be cleared. Default is false.
+//                    - [Optional]
+//
+// Returns an object handle to a log file.
+//----------------------------------------------------------------------------------------------------------------------
+Service NewLog(LogPath, LogFileName, RowDelimiter, ColumnDelimiter, ColumnHeaders, ColumnWidths, QuoteValues=BOOLEAN, ClearLog=BOOLEAN)
+
+    objLog      = ''
+
+    If (LogPath NE '') AND (LogFileName NE '') then
+        If SRP_Path('Exists', LogPath) then
+            LogFullPath = SRP_Path('Combine', LogPath, LogFileName)
+            If LogFullPath[1, 1] EQ '\' AND LogFullPath[2, 1] NE '\' then LogFullPath = '\' : LogFullPath
+            objLog      = SRP_Hash(LogFullPath, 'SHA-1', 'BASE32')
+            Memory_Services('SetValue', objLog : '*LogPath', LogPath, ServiceModule)
+            Memory_Services('SetValue', objLog : '*LogFileName', LogFileName, ServiceModule)
+            Memory_Services('SetValue', objLog : '*LogFullPath', LogFullPath, ServiceModule)
+            If Dir(LogFullPath) NE '' then
+                If ClearLog then
+                    Logging_Services('CreateLogFile', objLog)
+                end
+            end else
+                Logging_Services('CreateLogFile', objLog)
+            end
+            If Error_Services('NoError') then
+                If RowDelimiter EQ '' then RowDelimiter = CRLF$
+                Memory_Services('SetValue', objLog : '*RowDelimiter', RowDelimiter, ServiceModule)
+                If (ColumnDelimiter EQ '') AND (ColumnWidths EQ '') then ColumnDelimiter = COMMA$
+                Memory_Services('SetValue', objLog : '*ColumnDelimiter', ColumnDelimiter, ServiceModule)
+                Memory_Services('SetValue', objLog : '*ColumnHeaders', ColumnHeaders, ServiceModule)
+                Memory_Services('SetValue', objLog : '*ColumnWidths', ColumnWidths, ServiceModule)
+                If QuoteValues NE True$ then QuoteValues = False$
+                Memory_Services('SetValue', objLog : '*QuoteValues', QuoteValues, ServiceModule)
+                If Dir(LogFullPath)<1> EQ 0 AND ColumnHeaders NE '' then
+                    // Add the column headers since this is a new log file.
+                    Logging_Services('AppendLog', objLog, ColumnHeaders, '', @FM, True$)
+                end
+            end
+        end else
+            Error_Services('Add', LogPath : ' does not exist.')
+        end
+    end else
+        Error_Services('Add', 'LogPath or LogFileName argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = objLog
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// AppendLog
+//
+// objLog                   - Object handle to the log file. - [Required]
+// LogData                  - Data to be appended to the log file. - [Required]
+// IncomingRowDelimiter     - Delimiter used to separate each log row coming in. This allows incoming log data to have
+//                            a different delimiter than what will be used in the log file. Default is the RowDelimiter
+//                            used for appending the log data. - [Optional]
+// IncomingColumnDelimiter  - Delimiter used to separate each column value in the log data. This allows incoming log
+//                            data to have a different delimiter than what will be used in the log file. Default is the
+//                            column delimiter used to separate the log data or a comma if fixed widths only are
+//                            indicated. - [Optional]
+// IgnoreColumnHeaders      - Boolean flag to indicate if the service should attempt to add column headers to an empty
+//                            log file. Default is false. - [Optional]
+// EmailAddresses           - Comma delimited list of email addresses that should be notified when this log is appended.
+//                            - [Optional]
+// EmailMessage             - Message to be sent to the email addresses.
+//
+// Appends data to the log file associated with the indicated log object handle.
+//----------------------------------------------------------------------------------------------------------------------
+Service AppendLog(objLog, LogData, IncomingRowDelimiter, IncomingColumnDelimiter, IgnoreColumnHeaders, EmailAddresses, EmailMessage)
+
+    If (objLog NE '') AND (LogData NE '') then
+        If IgnoreColumnHeaders NE True$ then IgnoreColumnHeaders = False$
+        LogFullPath     = Logging_Services('GetLogFullPath', objLog)
+        ColumnDelimiter = Logging_Services('GetColumnDelimiter', objLog)
+        LenColDel       = Len(ColumnDelimiter)
+        ColumnHeaders   = Logging_Services('GetColumnHeaders', objLog)
+        ColumnWidths    = Logging_Services('GetColumnWidths', objLog)
+        QuoteValues     = Logging_Services('GetQuoteValues', objLog)
+        RowDelimiter    = Logging_Services('GetRowDelimiter', objLog)
+        If IncomingRowDelimiter EQ '' then IncomingRowDelimiter = RowDelimiter
+        If (IncomingColumnDelimiter EQ '') AND (ColumnWidths EQ '') then IncomingColumnDelimiter = ColumnDelimiter
+        LenRowDel       = Len(RowDelimiter)
+        FileInfo        = Dir(LogFullPath)
+        FileSize        = FileInfo<1>
+        Status()        = 0
+        OutData         = ''
+        OSOpen LogFullPath to hFile then
+            If (FileSize EQ 0) AND (ColumnHeaders NE '') AND (Not(IgnoreColumnHeaders)) then
+                Logging_Services('AppendLog', objLog, ColumnHeaders, @RM, @FM, True$)
+            end
+            For Each RowData in LogData using IncomingRowDelimiter
+                If RowData NE '' then
+                    For Each ColumnData in RowData using IncomingColumnDelimiter setting cPos
+                        If ColumnWidths NE '' then
+                            ColumnWidth = ColumnWidths<cPos>
+                            ColumnData  = ColumnData[1, ColumnWidth] : Str(' ', ColumnWidth - Len(ColumnData))
+                        end
+                        If QuoteValues then
+                            Swap '"' with '""' in ColumnData    ; // Encode the quotes properly.
+                            ColumnData  = Quote(ColumnData)
+                        end
+                        OutData    := ColumnData : ColumnDelimiter
+                    Next ColumnData
+                    OutData[Neg(LenColDel), LenColDel]  = ''            ; // Strip off the last column delimiter.
+                    OutData                            := RowDelimiter  ; // Append a row delimiter.
+                end
+            Next LogRow
+            OutData[Neg(LenRowDel), LenRowDel]  = ''    ; // Strip off the last row delimiter.
+            If (FileSize NE 0) then OutData = RowDelimiter : OutData    ; // Prepend a row delimiter since there is existing data.
+            OSBWrite OutData to hFile at FileSize
+            OSError = Status()
+            If OSError then
+                Error_Services('Add', 'OSBWrite error code ' : OSError : ' in the ' : Service : ' service.')
+            end
+            OSClose hFile
+        end else
+            OSError = Status()
+            Error_Services('Add', 'OSOpen error code ' : OSError : ' in the ' : Service : ' service.')
+        end
+
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    If EmailAddresses NE '' then
+        GoSub EmailMessage
+    end
+   
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetLogPath
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Returns the path for the log file associated with the indicated log object handle. This will not include the name of
+// the log file itself.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetLogPath(objLog)
+
+    LogPath = ''
+
+    If objLog NE '' then
+        LogPath = Memory_Services('GetValue', objLog : '*LogPath', '', '', ServiceModule)
+        If LogPath EQ '' then
+            Error_Services('Add', 'Log path not found in the ' : Service : ' service.')
+        end
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = LogPath
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetLogFileName
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Returns the file name for the log file associated with the indicated log object handle. This will not include the
+// path to where the log file is located.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetLogFileName(objLog)
+
+    LogFileName = ''
+
+    If objLog NE '' then
+        LogFileName = Memory_Services('GetValue', objLog : '*LogFileName', '', '', ServiceModule)
+        If LogFileName EQ '' then
+            Error_Services('Add', 'Log file name not found in the ' : Service : ' service.')
+        end
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = LogFileName
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetLogFullPath
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Returns the full path for the log file associated with the indicated log object handle.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetLogFullPath(objLog)
+
+    LogFullPath = ''
+
+    If objLog NE '' then
+        LogFullPath = Memory_Services('GetValue', objLog : '*LogFullPath', '', '', ServiceModule)
+        If LogFullPath EQ '' then
+            Error_Services('Add', 'Log full path not found in the ' : Service : ' service.')
+        end
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = LogFullPath
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetRowDelimiter
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Returns the delimiter to use to separate each row in the log.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetRowDelimiter(objLog)
+
+    RowDelimiter    = ''
+
+    If objLog NE '' then
+        RowDelimiter    = Memory_Services('GetValue', objLog : '*RowDelimiter', '', '', ServiceModule)
+        If RowDelimiter EQ '' then
+            Error_Services('Add', 'Row delimiter not found in the ' : Service : ' service.')
+        end
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = RowDelimiter
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetColumnDelimiter
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Returns the delimiter to use to separate each column in the log.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetColumnDelimiter(objLog)
+
+    ColumnDelimiter = ''
+
+    If objLog NE '' then
+        ColumnDelimiter = Memory_Services('GetValue', objLog : '*ColumnDelimiter', '', '', ServiceModule)
+        If ColumnDelimiter EQ '' then
+            Error_Services('Add', 'Column delimiter not found in the ' : Service : ' service.')
+        end
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = ColumnDelimiter
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetColumnHeaders
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Returns the column headers that should be in the log.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetColumnHeaders(objLog)
+
+    ColumnHeaders   = ''
+
+    If objLog NE '' then
+        ColumnHeaders   = Memory_Services('GetValue', objLog : '*ColumnHeaders', '', '', ServiceModule)
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = ColumnHeaders
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetColumnWidths
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Returns the column widths that should be used to truncate or pad each column in the log.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetColumnWidths(objLog)
+
+    ColumnWidths    = ''
+
+    If objLog NE '' then
+        ColumnWidths    = Memory_Services('GetValue', objLog : '*ColumnWidths', '', '', ServiceModule)
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = ColumnWidths
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetQuoteValues
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Returns the flag to indicate whether column values should be quoted or not.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetQuoteValues(objLog)
+
+    QuoteValues = ''
+
+    If objLog NE '' then
+        QuoteValues = Memory_Services('GetValue', objLog : '*QuoteValues', '', '', ServiceModule)
+        If QuoteValues NE True$ then QuoteValues = False$
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+    Response    = QuoteValues
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// CreateLogFile
+//
+// objLog   - Object handle to the log file. - [Required]
+//
+// Creates (or clears out) a log file associated with the indicated log object handle.
+//----------------------------------------------------------------------------------------------------------------------
+Service CreateLogFile(objLog)
+
+    If objLog NE '' then
+        LogFullPath = Logging_Services('GetLogFullPath', objLog)
+        If Error_Services('NoError') then
+            Status()    = 0
+            OSWrite '' to LogFullPath
+            Status      = Status()
+            If Status GT 0 then
+                Error_Services('Add', 'Unable to clear ' : LogFullPath : ' in the ' : Service : ' service.')
+            end
+        end
+    end else
+        Error_Services('Add', 'objLog argument was missing from the ' : Service : ' service.')
+    end
+
+end service
+
+
+Service CleanLogFolders(NumDays)
+    
+    FileExclusionList   = 'Canary.txt':@VM:'Canary.vbs'
+    AppRootPath         = Environment_Services('GetApplicationRootPath')
+    LogPath             = AppRootPath : '\LogFiles\'
+    SetInitDirOptions("D")
+	InitDir LogPath:'*'
+	FolderList  = DirList()
+	// Remove . directory listing
+    FolderList  = Delete(FolderList, 1, 0, 0)
+    // Remove .. directory listing
+    FolderList  = Delete(FolderList, 1, 0, 0)
+    Today       = Date()
+	SetInitDirOptions("")
+	For each Folder in FolderList
+        FolderPath = LogPath:Folder:'\'
+        InitDir FolderPath:'*'
+        FileList   = DirList()
+        If FileList NE '' then
+            For each Filename in FileList
+                Locate FileName in FileExclusionList using @VM setting vPos else
+                    FilePath      = FolderPath:Filename
+                    FileInfo      = Dir(FilePath)
+                    LastWriteDate = FileInfo<2>
+                    FileAge       = Today - LastWriteDate
+                    If FileAge GT NumDays then
+                       OSDelete FilePath
+                    end
+                end
+            Next Filename
+        end
+	Next Folder
+    
+end service
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+EmailMessage:
+
+    Done            = False$
+    Error           = False$
+    MsgSent         = ''
+
+    ConfigFile      = ''
+    ConfigFile<1>   = SendUsing_Port$
+    ConfigFile<2>   = ''
+    ConfigFile<3>   = 25                        ; // Server port
+    *ConfigFile<4>   = 'appmail.eu.infineon.com' ; // Mail server
+    ConfigFile<4>   = 'mailrelay-external.infineon.com' ; // Mail server
+    ConfigFile<5>   = True$                     ; // Authenticate
+    ConfigFile<6>   = 'oinotify@infineon.com'   ; // Username
+    ConfigFile<7>   = 'oinotify1'               ; // Password
+    ConfigFile<8>   = False$                    ; // Use SSL
+
+    If EmailMessage EQ '' then
+        EmailMessage    = LogData : \0D0A0D0A\ : RetStack()<2>
+    end else
+        EmailMessage   := \0D0A0D0A\ : LogData : \0D0A0D0A\ : RetStack()<2>
+    end
+
+    SentFrom    = ''
+    SentTo      = ''
+    Message     = ''
+    Message<1>  = 'AppendLog Message'                   ; // Subject
+    Message<2>  = 'oinotify@infineon.com'               ; // From (email address)
+    Message<3>  = EmailAddresses                        ; // Send to (email address)
+    Message<5>  = ''                                    ; // Blind Carbon Copy (email address)
+    Message<6>  = ''                                    ; // Reply To (email address)
+    Message<7>  = 'TEXT'                                ; // Content Type (TEXT or HTML)
+    Message<8>  = EmailMessage                          ; // Content / Body
+    Message<9>  = ''                                    ; // Attachment(s) (path to file name(s))
+
+    Result      = SRP_Send_Mail(Message, ConfigFile)
+
+return
+

FRAMEWORKS/STPROC/MEMORY_SERVICES.txt

@@ -0,0 +1,408 @@
+Function Memory_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        :   Memory_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
+        Error          [out] -- Any errors that were created
+        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)
+        03/29/13    dmb     [SRPFW-9]   Original programmer.
+        08/01/13    dmb     [SRPFW-16]  Add PM_CURRENT_IMAGE_PATH as an option to the GETVALUES list.
+        10/01/13    dmb     [SRPFW-18]  Replace APP_INSERTS with LOGICAL and declare Error_Services. - 
+        10/05/13    dmb     [SRPFW-18]  Add the RemoveKey service.
+        11/06/14    dmb     [SRPFW-79]  Add support to tag cached data with a time marker in the SetValue service so
+                            subsequent GetValue calls can avoid using data that might be too old.
+        10/29/17    dmb     Retrofit to use Enhanced BASIC+.
+        02/17/18    dmb     Add support to name specific memory service caches. This was to allow some memory service
+                            data to be protect from the ReleaseHashTable service. All services will default to the
+                            general cache if no cache name is specified. Added ReleaseAllHashTables to clear all caches.
+        09/25/19    dmb     [SRPFW-278] Update all services that support named caches so that whenever the named cache
+                            doesn't exist it will create one automatically rather than default to the primary cache.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert LOGICAL
+$insert SERVICE_SETUP
+
+Common /MemoryServices/ MemoryServicesManagers@, MemoryCacheNames@, Unused3@, Unused4@, Unused5@, Unused6@
+
+Equ Day$            to 86400    ; // Seconds in one day.
+
+// Self referencing declarations.
+Declare function    Memory_Services
+Declare subroutine  Memory_Services, Error_Services
+// SRP FastArray declarations.
+Declare function    SRP_FastArray_Count, SRP_FastArray_Create, SRP_FastArray_Extract, SRP_FastArray_GetVariable, 
+Declare subroutine  SRP_FastArray_Delete, SRP_FastArray_Insert, SRP_FastArray_InsertFromList, SRP_FastArray_Release, SRP_FastArray_Replace, SRP_FastArray_ReplaceWithList
+// SRP HashTable declarations.
+Declare function    SRP_HashTable_Create, SRP_HashTable_Contains, SRP_HashTable_Count, SRP_HashTable_Get, SRP_HashTable_GetKeys, SRP_HashTable_GetValues, SRP_HashTable_GetKeyValuePairs
+Declare subroutine  SRP_HashTable_Set, SRP_HashTable_Release, SRP_HashTable_Remove
+// SRP List declarations.
+Declare function    SRP_List_Create, SRP_List_CreateFromFastArray, SRP_List_Count, SRP_List_GetAt, SRP_List_GetVariable, SRP_List_Locate
+Declare subroutine  SRP_List_Add, SRP_List_InsertAt, SRP_List_Release, SRP_List_RemoveAt, SRP_List_SetAt
+// SRP Array declarations.
+Declare function    SRP_Clean_Array, SRP_Join_Arrays, SRP_Reorder_Array, SRP_Rotate_Array, SRP_Sort_Array
+
+GoToService else
+    Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' module.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN     = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// KeyExists
+//
+// Returns a True or False depending on whether the Key ID exists.
+//----------------------------------------------------------------------------------------------------------------------
+Service KeyExists(KeyID, CacheName)
+
+    KeyExists   = False$    ; // Assume it does not exist for now.
+
+    If Len(KeyID) then
+        If CacheName EQ '' then
+            HandlePos   = 1
+        end else
+            Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                // The named cache does not exist so create it now.
+                Memory_Services('CreateHashTable', CacheName)
+                Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                    HandlePos = 1
+                end
+            end
+        end
+        If Len(MemoryServicesManagers@<HandlePos>) then
+            KeyExists   = SRP_HashTable_Contains(MemoryServicesManagers@<HandlePos>, KeyID)
+        end
+    end else
+        Error_Services('Set', 'Key ID did not contain a value in the KeyExists service request.')
+    end
+
+    Response    = KeyExists
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetValue
+//
+// Returns the value pair stored in the SRP Hash Table for the current Key ID. If the NotExpired flag is set, the
+// ExpirationDuration will be used to compare against the last time marker set for the current data.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetValue(KeyID, NotExpired, ExpirationDuration, CacheName)
+
+    Value               = ''    ; // Assume the value is null for now.
+
+    If Len(KeyID) then
+        If CacheName EQ '' then
+            HandlePos   = 1
+        end else
+            Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                // The named cache does not exist so create it now.
+                Memory_Services('CreateHashTable', CacheName)
+                Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                    HandlePos = 1
+                end
+            end
+        end
+        If Len(MemoryServicesManagers@<HandlePos>) then
+            If NotExpired then
+                CurrMarker  = (Date() * Day$) + Time()
+                PrevMarker  = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID)
+                If (CurrMarker - PrevMarker) LT ExpirationDuration then
+                    Value   = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, KeyID)
+                end
+            end else
+                Value   = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, KeyID)
+            end
+        end
+    end else
+        Error_Services('Set', 'Key ID did not contain a value in the GetValue service request.')
+    end
+
+    Response = Value
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetValue
+//
+// Updates the value pair stored in the SRP Hash Table for the current Key ID.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetValue(KeyID, Value, CacheName)
+
+    If Len(KeyID) then
+        // If the Memory Services's hash table does not yet exist then create it now.
+        If CacheName EQ '' then
+            HandlePos   = 1
+        end else
+            Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                // The named cache does not exist so create it now.
+                Memory_Services('CreateHashTable', CacheName)
+                Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                    HandlePos = 1
+                end
+            end
+        end
+        If Len(MemoryServicesManagers@<HandlePos>) else
+            Memory_Services('CreateHashTable', CacheName)
+        end
+        SRP_HashTable_Set(MemoryServicesManagers@<HandlePos>, KeyID, Value)
+        // Set a time marker for this data in case future GetValue services need to know how old the data is.
+        TimeMarker  = (Date() * Day$) + Time()
+        SRP_HashTable_Set(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID, TimeMarker)
+    end else
+        Error_Services('Set', 'Key ID did not contain a value in the SetValue service request.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// IsValueExpired
+//
+// Returns a Boolean flag indicated whether the current value for the indicated KeyID has expired. This relies upon the
+// time marker set using the SetValue service. If this value has net yet been set then the value will be considered as
+// expired.
+//----------------------------------------------------------------------------------------------------------------------
+Service IsValueExpired(KeyID, ExpirationDuration, ResetAge, CacheName)
+
+    If Not(Num(ExpirationDuration)) then ExpirationDuration = 0
+    ValueExpired    = True$                     ; // Assume the value has expired for now.
+    If ResetAge NE True$ then ResetAge = False$ ; // Default is false unless otherwise specified.
+
+    If Len(KeyID) AND (ExpirationDuration GT 0) then
+        If CacheName EQ '' then
+            HandlePos   = 1
+        end else
+            Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                // The named cache does not exist so create it now.
+                Memory_Services('CreateHashTable', CacheName)
+                Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                    HandlePos = 1
+                end
+            end
+        end
+        If Len(MemoryServicesManagers@<HandlePos>) then
+            PrevMarker  = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID)
+            If PrevMarker NE '' then
+                TimeMarker  = (Date() * Day$) + Time()
+                If (TimeMarker - PrevMarker) LE ExpirationDuration then
+                    ValueExpired    = False$
+                    If ResetAge EQ True$ then
+                        SRP_HashTable_Set(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID, TimeMarker)
+                    end
+                end
+            end
+        end
+    end else
+        Error_Services('Set', 'KeyID or ExpirationDuraton was missing in the IsValueExpired service.')
+    end
+
+    Response = ValueExpired
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// IsValueCurrent
+//
+// Returns a Boolean flag indicated whether the current value for the indicated KeyID is still current. This relies upon the
+// time marker set using the SetValue service. If this value has net yet been set then the value will be considered as
+// expired.
+//----------------------------------------------------------------------------------------------------------------------
+Service IsValueCurrent(KeyID, ExpirationDuration, ResetAge, CacheName)
+
+    If Not(Num(ExpirationDuration)) then ExpirationDuration = 0
+    ValueCurrent    = False$                    ; // Assume the value is not current for now.
+    If ResetAge NE True$ then ResetAge = False$ ; // Default is false unless otherwise specified.
+
+    If Len(KeyID) AND (ExpirationDuration GT 0) then
+        If CacheName EQ '' then
+            HandlePos   = 1
+        end else
+            Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                // The named cache does not exist so create it now.
+                Memory_Services('CreateHashTable', CacheName)
+                Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                    HandlePos = 1
+                end
+            end
+        end
+        If Len(MemoryServicesManagers@<HandlePos>) then
+            PrevMarker  = SRP_HashTable_Get(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID)
+            If PrevMarker NE '' then
+                TimeMarker  = (Date() * Day$) + Time()
+                If (TimeMarker - PrevMarker) LE ExpirationDuration then
+                    ValueCurrent    = True$
+                    If ResetAge EQ True$ then
+                        SRP_HashTable_Set(MemoryServicesManagers@<HandlePos>, 'TIMEMARKER*' : KeyID, TimeMarker)
+                    end
+                end
+            end
+        end
+    end else
+        Error_Services('Set', 'KeyID or ExpirationDuraton was missing in the IsValueCurrent service.')
+    end
+
+    Response = ValueCurrent
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// RemoveKey
+//
+// Removes the Key ID, and its value pair, from the SRP Hash Table.
+//----------------------------------------------------------------------------------------------------------------------
+Service RemoveKey(KeyID, CacheName)
+
+    If Len(KeyID) then
+        // If the Memory Services's hash table does not yet exist then create it now.
+        If CacheName EQ '' then
+            HandlePos   = 1
+        end else
+            Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                // The named cache does not exist so create it now.
+                Memory_Services('CreateHashTable', CacheName)
+                Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else
+                    HandlePos = 1
+                end
+            end
+        end
+        If Len(MemoryServicesManagers@<HandlePos>) then
+            SRP_HashTable_Remove(MemoryServicesManagers@<HandlePos>, KeyID)
+        end
+    end else
+        Error_Services('Set', 'Key ID did not contain a value in the RemoveKey service request.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// CreateHashTable
+//
+// Creates the SRP Hash Table that the Memory_Services module will use to manage various Key ID and Value pairs. A
+// check will first be made to see if the handle to the Hash Table already exists. If so then it will be released and
+// a new Hash Table will be created.
+//----------------------------------------------------------------------------------------------------------------------
+Service CreateHashTable(CacheName)
+
+    If CacheName EQ '' then
+        HandlePos   = 1
+        If Len(MemoryServicesManagers@<HandlePos>) then
+            Memory_Services('ReleaseHashTable')
+        end
+    end else
+        Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos then
+            Memory_Services('ReleaseHashTable', CacheName)
+        end else
+            HandlePos   = DCount(MemoryCacheNames@, @FM) + 1
+            If HandlePos EQ 1 then HandlePos = 2    ; // Handle position 1 is reserved for the default cache.
+        end
+    end
+
+    MemoryServicesManagers@<HandlePos>  = SRP_HashTable_Create()
+    If HandlePos GT 1 then
+        MemoryCacheNames@<HandlePos>    = CacheName
+    end
+
+    Response    = MemoryServicesManagers@<HandlePos>
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ReleaseHashTable
+//
+// Releases the SRP Hash Table handle. If CacheName is empty then the default handle is released.
+//----------------------------------------------------------------------------------------------------------------------
+Service ReleaseHashTable(CacheName)
+
+    HandlePos   = ''
+    If CacheName EQ '' then
+        HandlePos   = 1
+    end else
+        Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else Null
+    end
+
+    If HandlePos GE 1 then
+        SRP_HashTable_Release(MemoryServicesManagers@<HandlePos>)
+        MemoryServicesManagers@<HandlePos>  = ''
+        MemoryCacheNames@<HandlePos>        = ''
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ReleaseAllHashTables
+//
+// Releases all SRP Hash Table handles.
+//----------------------------------------------------------------------------------------------------------------------
+Service ReleaseAllHashTables(CacheName)
+
+    If MemoryServicesManagers@ NE '' then
+        For Each Handle in MemoryServicesManagers@ using @FM
+            If Handle NE '' then SRP_HashTable_Release(Handle)
+        Next Handle
+    end
+    MemoryServicesManagers@ = ''
+    MemoryCacheNames@       = ''
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetHandle
+//
+// Returns the handle to the SRP Hash Table used by Memory_Services.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetHandle(CacheName)
+
+    HandlePos   = ''
+    If CacheName EQ '' then
+        HandlePos   = 1
+    end else
+        Locate CacheName in MemoryCacheNames@ using @FM setting HandlePos else Null
+    end
+
+    If HandlePos GE 1 then
+        Handle  = MemoryServicesManagers@<HandlePos>
+    end
+    
+    Response = Handle
+
+end service
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////?
+

FRAMEWORKS/STPROC/NDW_AUDIT_VIEWER_EVENTS.txt

@@ -0,0 +1,437 @@
+Function NDW_Audit_Viewer_Events(CtrlEntId, Event, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10, Param11, Param12, Param13, Param14, Param15)
+
+/***********************************************************************************************************************
+
+    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        :   NDW_Audit_Viewer_Events
+
+    Description :   This function acts as a commuter module for all events related to this window.
+
+    Notes       :   Commuter Modules are automatically called from the Promoted_Events function which is called by the
+                    application-specific promoted event handler. This makes it possible to add QuickEvents that need to
+                    execute Basic+ logic without having use the Form Designer to make the association, although this is
+                    limited to the events which are currently promoted.
+
+                    If the form needs to call the commuter module directly then the QuickEvent parameters should be
+                    formatted like this:
+
+                        '@SELF','@EVENT',['@PARAM1','@PARAMx']
+
+    Parameters  :
+        CtrlEntId   [in] -- The fully qualified name of the control calling the promoted event
+        Event       [in] -- The event being executed. See the Notes section regarding "PRE" events
+        Param1-15   [in] -- Additional event parameter holders
+        EventFlow  [out] -- Set to 1 or 0 so the calling event knows whether or not to chain forward. See comments in
+                            EVENT_SETUP insert
+
+    History     :   (Date, Initials, Notes)
+        07/23/98    dmb     Original programmer.
+        03/30/06    axf     Removed reference to Application.dll.
+        04/06/13    dmb     Replace ErrorLines property with MismatchLines property for better comparison viewing.
+                            - [SRPFW-9]
+
+***********************************************************************************************************************/
+
+$insert APP_INSERTS
+$insert EVENT_SETUP
+$insert MSG_EQUATES
+
+Equ WM_USER$ To 1024
+Equ WM_SETREADONLY$ To WM_USER$ + 31
+
+AuditManagerTable = "APP_INFO"
+
+Declare Subroutine Msg, Send_Event, V119, SRP_Set_Prop_Array, Utility, Start_Window, Send_Message, Get_SysInfo, SRP_Show_Window, Set_Property, Post_Event
+Declare Function GetPointer, GetSystemInfo, Send_Message
+
+Begin Case
+    Case Control EQ Window
+        // This event is window specific.
+
+        Begin Case
+            Case Event EQ "CREATE"          ; GoSub CREATE
+            Case Event EQ 'EXPAND_ROW'      ; GoSub EXPAND_ROW
+            Case Event EQ 'COLLAPSE_ROW'    ; GoSub COLLAPSE_ROW
+            Case Event EQ 'GOTO_MARKER'     ; GoSub TOGGLE_CURSOR
+        End Case
+
+    Case EventType EQ "CLICK"
+        
+        Begin Case
+            Case Control EQ "PUB_RESTORE"   ; GoSub CLICK.PUB_RESTORE
+            Case Control EQ "PUB_COMPARE"   ; GoSub CLICK.PUB_COMPARE
+            Case Control EQ "PUB_RETURN"    ; GoSub CLICK.PUB_RETURN
+        End Case
+        
+    Case Event EQ "PosChanged"              ; GoSub PosChanged
+    Case Event EQ "OnGotFocus"              ; GoSub PosChanged
+    Case Event EQ "OnVScroll"
+        
+        Begin Case
+            Case Control EQ "OLE_ARCHIVE"   ; GoSub OnVScroll.OLE_ARCHIVE
+            Case Control EQ "OLE_ORIGINAL"  ; GoSub OnVScroll.OLE_ORIGINAL
+        End Case
+        
+    Case Event EQ 'MENU.EXPAND_ROW'         ; GoSub MENU.EXPAND_ROW
+    Case Event EQ 'MENU.COLLAPSE_ROW'       ; GoSub MENU.COLLAPSE_ROW
+    Case Event EQ 'MENU.NEXT_DIFFERENCE'    ; GoSub MENU.NEXT_DIFFERENCE
+
+End Case
+
+If Assigned(EventFlow) else EventFlow = EVENT_CONTINUE$
+
+Return EventFlow
+
+CREATE:
+
+    // qualify editor events
+    Events = "PosChanged,OnGotFocus,OnVScroll"
+	LenEvents = Len(Events)
+	Pos = 1
+	Loop Until Pos GE LenEvents
+		Event = "OLE.":Events[Pos, ","]
+		Pos = Col2() + 1
+		Send_Message(@Window:".OLE_ARCHIVE", "QUALIFY_EVENT", Event, Yes$)
+		Send_Message(@Window:".OLE_ORIGINAL", "QUALIFY_EVENT", Event, Yes$)
+	Repeat
+	Send_Message(@Window:".OLE_VIEWER", "QUALIFY_EVENT", "PosChanged", Yes$)
+    
+    // show the viewer
+	SRP_Show_Window(@Window, "", "L", "T", Yes$, "", No$, No$)
+	
+return
+
+EXPAND_ROW:
+    *----------------------------------------------------------------------------------------------------
+    * Expands row(s) in the Audit Viewer Window
+    *----------------------------------------------------------------------------------------------------
+    WindowControl = Get_Property(@Window, "FOCUS")
+    Set_Property(WindowControl, "READONLY", No$)
+    rv = Send_Message(WindowControl, "OLE.ExpandCurrLine")
+    Set_Property(WindowControl, "READONLY", Yes$)
+    
+return
+
+COLLAPSE_ROW:
+    *----------------------------------------------------------------------------------------------------
+    * Collapses Row(s) in the Audit Viewer Window
+    *----------------------------------------------------------------------------------------------------
+    WindowControl = Get_Property(@Window, "FOCUS")
+    Set_Property(WindowControl, "READONLY", No$)
+    rv = Send_Message(WindowControl, "OLE.CollapseCurrLine")
+    Set_Property(WindowControl, "READONLY", Yes$)
+return
+
+TOGGLE_CURSOR:
+    *----------------------------------------------------------------------------------------------------
+    * Toggles from marker to marker in the Audit View Window
+    *----------------------------------------------------------------------------------------------------
+    Set_Property(WindowControl, "READONLY", No$)
+    WindowControl = Get_Property(@Window, "FOCUS")
+    rv = Send_Message(WindowControl, "OLE.GoToMarker")
+    Set_Property(WindowControl, "READONLY", Yes$)
+return
+
+CLICK.PUB_RESTORE:
+    *----------------------------------------------------------------------------------------------------
+    * 
+    *----------------------------------------------------------------------------------------------------
+
+    Begin Case
+        Case Window = "NDW_AUDIT_TRAIL"
+            Win$ = @Window
+        Case Otherwise$
+            Win$ = Get_Property(@Window:".EDL_WINDOW", "INVALUE")
+    End Case
+    TableName = Get_Property(Win$:".COB_TABLE", "INVALUE")
+    Convert @Lower_Case to @Upper_Case in TableName
+    rVal = Get_Property(Win$:".EDT_INFO_BAK", "ARRAY")
+    Convert @VM to " " in rVal
+    rVal = Trim(rVal)
+    TestVal = Count(rVal, " ")
+    If TestVal GT 0 Then
+        ErrorMsg = "TOOMANY"
+        Gosub MsgAlert
+    End Else
+        ErrorMsg = "RESTORE"
+        Gosub MsgAlert
+        If rv = Yes$ Then
+            AuditId = rVal
+            OrigId = Get_Property(Win$:".EDL_ID", "INVALUE")
+            Begin Case
+                Case AuditId = ""
+                    ErrorMsg = "ID"
+                    IdName = "Audit Primary Key"
+                    Gosub MsgAlert
+                Case OrigId  = ""
+                    ErorMsg = "ID"
+                    IdName = "Primary Key"
+                    Gosub MsgAlert
+                Case Otherwise$
+                    Open TableName To hORT Then
+                        Open "AUDIT_":TableName To hADT Then
+                            ReadO Record From hADT, AuditId Then
+                                Write Record To hORT, OrigId Then
+                                    ErrorMsg = "RESTORED"
+                                    Gosub MsgAlert
+                                End Else
+                                    RecId = OrigId
+                                    ErrorMsg = "WRITE"
+                                    Gosub MsgAlert
+                                End
+                            End Else
+                                ErrorMsg = "READ"
+                                RecId = AuditId
+                                Gosub MsgAlert
+                            End
+                        End Else
+                            ErrorMsg = "OPEN"                
+                            Gosub MsgAlert
+                        End
+                    End Else
+                        ErrorMsg = "OPEN"
+                        Gosub MsgAlert
+                    End                    
+            End Case
+        End
+    End    
+    
+return
+
+CLICK.PUB_RETURN:
+    *----------------------------------------------------------------------------------------------------
+    * 
+    *----------------------------------------------------------------------------------------------------
+    Send_Event(@Window, "PAGE", 1)
+    cWin$ = @Window
+    Page  = 1
+    Gosub ResetTabOrder
+    
+return
+
+CLICK.PUB_COMPARE:
+    *----------------------------------------------------------------------------------------------------
+    * 
+    *----------------------------------------------------------------------------------------------------
+    Post_Event(@Window, "PAGE", 2)
+    OrigWin$ = Get_Property(@Window:".EDL_WINDOW", "INVALUE")    
+    TableName = Get_Property(OrigWin$:".COB_TABLE", "INVALUE")
+    Convert @Lower_Case to @Upper_Case In TableName 
+    RecId = Get_Property(OrigWin$:".EDL_ID", "INVALUE")
+    Open TableName to hORT Then
+        ReadO RecInfo From hORT, RecId Then            
+            Open "AUDIT_":TableName to hART Then
+                ARecId = Get_Property(@Window:".EDL_AREC_ID", "INVALUE")
+                ReadO ARecInfo From hART, ARecId Then
+                    cWin$ = @Window
+                    Page = 2
+                    Gosub ResetTabOrder
+                    Gosub CompareValues
+                End
+            End
+        End
+    End
+    
+return
+
+MENU.EXPAND_ROW:
+    FocusCtrl = Get_Property("SYSTEM", "FOCUS")
+*    Set_Property(FocusCtrl, "OLE.ReadOnly", No$)
+    Send_Message(FocusCtrl, "OLE.ExpandCurrLine")
+*    Set_Property(FocusCtrl, "OLE.ReadOnly", Yes$)
+return
+
+MENU.COLLAPSE_ROW:
+    FocusCtrl = Get_Property("SYSTEM", "FOCUS")
+*    Set_Property(FocusCtrl, "OLE.ReadOnly", No$)
+    Send_Message(FocusCtrl, "OLE.CollapseCurrLine")
+*    Set_Property(FocusCtrl, "OLE.ReadOnly", Yes$)
+return
+        
+MENU.NEXT_DIFFERENCE:
+    FocusCtrl = Get_Property("SYSTEM", "FOCUS")
+	Send_Message(FocusCtrl, "OLE.GotoMarker")
+	Begin Case
+	    Case FocusCtrl EQ @Window:".OLE_ARCHIVE"
+	        Set_Property(@Window:".OLE_ORIGINAL", "OLE.TopLine", Get_Property(@Window:".OLE_ARCHIVE", "OLE.TopLine"))
+	    Case FocusCtrl EQ @Window:".OLE_ORIGINAL"
+	        Set_Property(@Window:".OLE_ARCHIVE", "OLE.TopLine", Get_Property(@Window:".OLE_ORIGINAL", "OLE.TopLine"))
+	End Case
+return
+
+PosChanged:
+
+    TrailWindow = Get_Property(@Window:".EDL_WINDOW", "TEXT")
+    Table = Get_Property(TrailWindow:".COB_TABLE", "TEXT")
+    FieldsRec = Get_Property(@Window, "@RECORD_FIELDS")
+    CurrLine = Get_Property(CtrlEntId, "OLE.CurrPos")<2>
+    Line = Send_Message(CtrlEntId, "OLE.GetLineField", CurrLine)
+    
+    Field = ""
+    If FieldsRec EQ "" then
+	    DictTable = If Table[1, 5] EQ "DICT." then "DICT.SYSCOLUMNS" else "DICT.":Table
+	    Open DictTable to hTable then
+	        Read FieldsRec from hTable, "%FIELDS%" then
+	        	Set_Property(@Window, "@RECORD_FIELDS", FieldsRec)
+	        end
+	    end
+	end
+	
+    Fields = FieldsRec<3>
+    Positions = FieldsRec<5>
+    Locate Line in Positions setting Pos then
+	    Field = Fields<1, Pos>
+    end
+    
+    Set_Property(@Window:".STA_COLUMN", "TEXT", Field)
+    
+return
+
+OnVScroll.OLE_ARCHIVE:
+    Set_Property(@Window:".OLE_ORIGINAL", "OLE.TopLine", Param1)
+return
+
+OnVScroll.OLE_ORIGINAL:
+    Set_Property(@Window:".OLE_ARCHIVE", "OLE.TopLine", Param1)
+return
+
+*------------------------
+* Internal Processes
+*------------------------
+
+CompareValues:
+    *----------------------------------------------------------------------------------------------------
+    * 
+    *----------------------------------------------------------------------------------------------------
+    dRow = ""
+    MxORows = Count(RecInfo, @FM) + (RecInfo NE "")
+    MxARows = Count(ARecINfo, @FM) + (ARecInfo NE "")
+    
+    If MxORows GE MxARows Then
+        MxRows = MxORows
+    End Else
+        MxRows = MxARows
+    End
+    
+    For X = 1 to MxRows
+        If RecInfo<X> NE ARecInfo<X> Then
+            dRow<-1> = X
+        End
+    Next X
+    
+    If dRow NE "" Then
+        Ctrls = @Window:".OLE_ARCHIVE":@RM:@Window:".OLE_ORIGINAL":@RM:@Window:".OLE_VIEWER"
+*        Props = "OLE.ErrorLines":@RM:"OLE.ErrorLines":@RM:"OLE.ErrorLines"
+        Props = "OLE.MismatchLines":@RM:"OLE.MismatchLines":@RM:"OLE.MismatchLines"
+        Vals  = dRow:@RM:dRow:@RM:dRow
+        Set_Property(Ctrls, Props, Vals)
+    End
+return
+
+MsgAlert:
+    *-------------------------------------------------------------------------------------------------------------------------------------
+    *
+    *-------------------------------------------------------------------------------------------------------------------------------------
+
+    Mess = ""
+    Mess<MTYPE$>  = "BO"
+    Mess<MICON$>  = "!"
+    Mess<MCAPTION$> = "Audit Trail"
+
+    Error = "An undefined error has occurred with this process"
+    Begin Case
+        Case ErrorMsg = "OPEN"
+            Error = "Unable to Open the ": TableName: " table."
+
+        Case ErrorMsg = "READ"
+            Error = "Unable to Read ": RecId:" record."
+            
+        Case ErrorMsg = "WRITE"
+            Error = "Unable to Write ": RecId:" record."
+        
+        Case ErrorMsg = "NOIDS"
+            Error = "There are no audit records for the ":TableName:" table."
+                
+        Case ErrorMsg = "ID"
+            Error = IdName: " is Null."
+                        
+        Case ErrorMsg = "RESTORED"
+            Error = "Record ":OrigId:" has been restored to the ":TableName:" table."
+        
+        Case ErrorMsg = "TOOMANY"
+            Error = "You only restore one record at a time."
+            
+        Case ErrorMsg = "RESTORE"
+            Mess<MICON$>  = "?"
+            Mess<MTYPE$>  = "BNY"
+            Error = "Would you like to restore this entry?"
+            
+        Case ErrorMsg = "NOTABLE"
+            Error = "No Table Selected"        
+    End Case
+
+    Mess<MTEXT$> = Error
+    rv = Msg("",Mess)
+
+return
+
+ResetTabOrder:
+    *-------------------------------------------------------------------------------------------------------------------------
+    * Resets Tab Order
+    *-------------------------------------------------------------------------------------------------------------------------
+
+    LastPageCtrl = ""
+    LastCtrl = ""
+    FirstCtrl = ""
+    rVal = ""
+    PCtrls = ""
+    NCtrls = ""
+    NProps = ""
+
+    Begin Case
+        Case cWin$ EQ "NDW_AUDIT_TRAIL"
+            rVal<1> = @Window:".COB_TABLE"
+            rVal<2> = @Window:".EDL_ID"
+            rVal<3> = @Window:".EDT_AUDIT_INFO"
+            rVal<4> = @Window:".PUB_RESTORE"
+            rVal<5> = @Window:".PUB_VIEW"
+                    
+        Case Otherwise$
+            Begin Case
+                Case Page EQ 1
+                    Set_Property("SYSTEM", "FOCUS", cWin$:".OLE_VIEWER")
+                    rVal<1> = cWin$:".OLE_VIEWER"
+                    rVal<2> = cWin$:".PUB_RESTORE"
+                    rVal<3> = cWin$:".PUB_COMPARE"                    
+                    rVal<4> = cWin$:".PUB_CLOSE"
+                Case Page EQ 2
+                    Set_Property("SYSTEM", "FOCUS", cWin$:".OLE_ARCHIVE")
+                    rVal<1> = cWin$:".OLE_ARCHIVE"
+                    rVal<2> = cWin$:".OLE_ORIGINAL"
+                    rVal<3> = cWin$:".PUB_RESTORE"                    
+                    rVal<4> = cWin$:".PUB_RETURN"
+                    rVal<5> = cWin$:".PUB_CLOSE"
+            End Case    
+    End Case
+    MxC = Count(rVal,@FM) + (rVal NE "")
+
+    For i = 1 to MxC
+        If i = MxC Then
+            nVal = 1
+        End Else
+            nVal = i + 1
+        End
+        PCtrls<-1> = rVal<i>        
+        NCtrls<-1> = rVal<nVal>
+        NProps<-1> = "NEXT"
+    Next i
+    
+    Convert @FM to @RM in PCtrls
+    Convert @FM to @RM in NCtrls
+    Convert @FM to @RM in NProps
+
+    Set_Property(PCtrls, NProps, NCtrls)
+return
+

FRAMEWORKS/STPROC/NDW_HTTP_DATEPICKER_EVENTS.txt

@@ -0,0 +1,290 @@
+Function NDW_HTTP_DatePicker_Events(CtrlEntId, Event, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10, Param11, Param12, Param13, Param14, Param15)
+/***********************************************************************************************************************
+
+    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        :   NDW_HTTP_DatePicker_Events
+
+    Description :   This function acts as a commuter module for all events related to this window.
+
+    Notes       :   Commuter Modules are automatically called from the Promoted_Events function which is called by the
+                    application-specific promoted event handler. This makes it possible to add QuickEvents that need to
+                    execute Basic+ logic without having use the Form Designer to make the association, although this is
+                    limited to the events which are currently promoted.
+
+                    If the form needs to call the commuter module directly then the QuickEvent parameters should be
+                    formatted like this:                                        
+
+                        '@SELF','@EVENT',['@PARAM1','@PARAMx']
+
+    Parameters  :
+        CtrlEntId   [in] -- The fully qualified name of the control calling the promoted event
+        Event       [in] -- The event being executed. See the Notes section regarding "PRE" events
+        Param1-15   [in] -- Additional event parameter holders
+        EventFlow  [out] -- Set to 1 or 0 so the calling event knows whether or not to chain forward. See comments in
+                            EVENT_SETUP insert
+
+    History (Date, Initials, Notes)
+        07/18/19    dmb     Original programmer although ported the NDW_DATEPICKER from FrameWorks as a base.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+#window NDW_HTTP_DATEPICKER
+
+$insert LOGICAL
+$insert MSG_EQUATES
+
+Equ EVENT_CONTINUE$             to 1
+Equ EVENT_CONTINUE_NO_SYSTEM$   to 3
+Equ EVENT_STOP$                 to 0
+Equ CRLF$                       to \0D0A\
+
+Declare subroutine  Set_Property, Send_Event, Post_Event, Send_Message, SendMessage, End_Dialog
+Declare function    Get_Property, SRP_Get_Window_Rect, Send_Message, SendMessage
+
+// Get the design time name of the window in case this is a multi-instance window.
+Window = @Window[1, 'F*']
+
+// Always get the CtrlClassID since we are not passing it through the event parameters.
+CtrlClassId = Get_Property(CtrlEntId, 'TYPE')
+
+// Get the name of the control on the window based on the CtrlClassId.
+Begin Case
+    Case CtrlClassId EQ 'WINDOW'
+        Control = Window
+    Case CtrlClassId EQ 'RADIOBUTTON'
+        Control = Field(CtrlEntId, '.', 2, 2)
+    Case CtrlClassId EQ 'MENU'
+        Control = CtrlEntId[-1, 'B.']
+    Case 1
+        Control = Field(CtrlEntId, '.', 2, 1)
+End Case
+
+If Event EQ 'OLE' then GoSub TransferParams
+GoToEvent Event for CtrlEntID
+If Event EQ 'OLE' then GoSub RestoreParams
+
+Return EventFlow OR EVENT_CONTINUE$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Events
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+Event WINDOW.CREATE(CreateParam)
+
+	GoSub SetupOLEControls
+    GoSub DeterminePosition
+    Set_Property(@Window, 'SIZE', Size)
+
+end event
+
+
+Event WINDOW.INACTIVATED()
+
+    Post_Event(@Window, 'CLOSE')
+
+end event
+
+
+Event PUB_OK.CLICK()
+
+    GoSub ReturnDate
+
+return
+
+
+Event OLE_DATEPICKER.OnDblClick(Month, Week, DayOfWeek, Date, Point, Button, Shift, Ctrl)
+
+    If Date NE '' then
+        GoSub ReturnDate
+    end
+
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal Gosubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+SetupOLEControls:
+
+    // All OLE controls can use this qualify configuration.
+    Qualify     = ''
+    Qualify<1>  = 1
+    Qualify<3>  = ''
+    Qualify<4>  = 0
+
+    //------------------------------------------------------------------------------------------------------------------
+    //
+    //  SRP DatePicker Control
+    //
+    //------------------------------------------------------------------------------------------------------------------
+    Ctrl        = @Window : '.OLE_DATEPICKER'
+    SizeWindow  = Get_Property(@Window, 'SIZE')
+    SizePicker  = -1 : @FM : -1 : @FM : SizeWindow<3> : @FM : SizeWindow<4>
+    Set_Property(Ctrl, 'SIZE', SizePicker)
+    Set_Property(Ctrl, 'OLE.Theme', 'Windows7Blue')
+    Set_Property(Ctrl, 'OLE.Font', 'Segoe UI' : @SVM : 9 : @SVM : 400)
+
+	// Use asynchronous event handling (because in Dialog Box)
+	Send_Message(@Window : '.OLE_DATEPICKER', 'QUALIFY_EVENT', 'OLE.OnDblClick', Qualify)
+
+return
+
+
+TransferParams:
+
+    // ActiveX controls pass their own event names through Param1. Modify the parameter values so they conform to
+    // OpenInsight event parameter values. This will allow commuter modules to be structured the same for OpenInsight
+    // event and ActiveX (OLE) events.
+    Transfer Param1  to Event
+    Transfer Param2  to Param1
+    Transfer Param3  to Param2
+    Transfer Param4  to Param3
+    Transfer Param5  to Param4
+    Transfer Param6  to Param5
+    Transfer Param7  to Param6
+    Transfer Param8  to Param7
+    Transfer Param9  to Param8
+    Transfer Param10 to Param9
+    Transfer Param11 to Param10
+    Transfer Param12 to Param11
+    Transfer Param13 to Param12
+    Transfer Param14 to Param13
+    Transfer Param15 to Param14
+
+return
+
+
+RestoreParams:
+
+    // Restore the event parameters so the rest of the event chain will see the parameter values as they were originally
+    // created by OpenInsight. This will also prevent the parameter values from being transferred multiple times in case
+    // there are multiple OLE promoted event handlers (e.g. APPNAME*..OIWIN* and APPNAME*OLE..OIWIN*).
+    Transfer Param14 to Param15
+    Transfer Param13 to Param14
+    Transfer Param12 to Param13
+    Transfer Param11 to Param12
+    Transfer Param10 to Param11
+    Transfer Param9  to Param10
+    Transfer Param8  to Param9 
+    Transfer Param7  to Param8 
+    Transfer Param6  to Param7
+    Transfer Param5  to Param6
+    Transfer Param4  to Param5
+    Transfer Param3  to Param4
+    Transfer Param2  to Param3
+    Transfer Param1  to Param2
+    Transfer Event   to Param1
+    Event             = 'OLE'
+
+return
+
+
+DeterminePosition:
+
+    Parent  = Get_Property(@Window, 'PARENT')
+
+    // Determine the control to do the lookup for
+    CtrlId  = Get_Property(Parent, 'FOCUS')
+
+    // Get some property values
+    Ctrls   = Parent     : @RM : @Window : @RM : CtrlId : @RM : CtrlId   : @RM : CtrlId   : @RM : CtrlId      : @RM : 'SYSTEM'
+    Props   = 'MDIFRAME' : @RM : 'SIZE'  : @RM : 'TYPE' : @RM : 'HANDLE' : @RM : 'SELPOS' : @RM : 'ORIG_TEXT' : @RM : 'SIZE'
+    Vals    = Get_Property(Ctrls, Props)
+
+    Frame   = Field(Vals, @RM, 1)
+    Size    = Field(Vals, @RM, 2)
+    Type    = Field(Vals, @RM, 3)
+    CtlHdl  = Field(Vals, @RM, 4)
+    SelPos  = Field(Vals, @RM, 5)
+    ProgID  = Field(Vals, @RM, 6)    ; // To check for OLE EditTables
+    Screen  = Field(Vals, @RM, 7)
+
+    // If no frame, use window size to determine if calendar should show below or above control
+    If Frame then
+        WinSize = SRP_Get_Window_Rect(Frame)
+    end else
+        WinSize = SRP_Get_Window_Rect(Parent)
+    end        
+
+    Table = (Type EQ 'EDITTABLE') OR (ProgID _EQC 'SRP.EditTable.1')
+    If Table else
+        SelPos = ''
+    end
+  
+    If ProgID _EQC 'SRP.EditTable.1' then
+        // OLE EditTables need to use the CellText property
+        ColNo   = SelPos<1>
+        RowNo   = SelPos<2>
+        Convert @FM to ';' in SelPos
+        DfltDate = Iconv(Get_Property(CtrlId, 'OLE.CellText[':SelPos:']'), 'D')
+    end else
+        DfltDate = Get_Property(CtrlId, 'INVALUE', SelPos)
+    end
+	// Set initial selection to date passed in and make it visible
+	If DfltDate then
+        Set_Property(@Window:'.OLE_DATEPICKER', 'OLE.Selection', DfltDate)
+        Send_Message(@Window:'.OLE_DATEPICKER', 'OLE.EnsureVisible', DfltDate)
+    end
+
+    Rect = Str(\00\, 16)
+
+    CtlSize = SRP_Get_Window_Rect(CtrlId)
+    xPos    = CtlSize<1>
+    yPos    = CtlSize<2>
+
+    If Table then
+        // add x, y and y+h of cell
+        If ProgID _EQC 'SRP.EditTable.1' then
+            CellSize = Send_Message(CtrlId, 'OLE.GetCellRect', ColNo:@FM:RowNo)
+            *xPos   += CellSize<1>
+            xPos    += CellSize<1> + 1  ; // This makes alignment better
+            yPos    += CellSize<2>
+            cyPos    = yPos + CellSize<4>
+        end else
+            LeftBottom = SendMessage(CtlHdl, DTM_GETCELLLEFTBOTTOM$, DTA_CURRENT$,  0)
+            xPos += mod(LeftBottom, 65536)
+            cyPos = yPos + int(LeftBottom / 65536)
+
+            // Get y position with different SendMessage call
+            SendMessage(CtlHdl, DTM_READCELLRECT$, DTA_CURRENT$, GetPointer(Rect))
+            yPos += seq(Rect [5,1]) + (seq(Rect [6,1]) * 256)
+        end
+    end else
+        // get y+h of control
+        cyPos = CtlSize<2> + CtlSize<4>
+    end
+
+    // get y+h of frame or parent window
+    MaxCy = WinSize<2> + WinSize<4>
+
+    // Set x and y of calendar window
+    Size<1> = xPos
+    If Size<1> + Size<3> GT Screen<1> AND (Screen<1> GT Size<1>) then
+        // Shift calendar to left to fit on screen
+        Size<1> = Screen<1> - Size<3>
+    end    
+    If cyPos+Size<4> GT MaxCy then
+        // Position above control so calendar shows fully
+        Size<2> = yPos - Size<4>
+    end else    
+        Size<2> = cyPos
+    end
+
+return
+
+
+ReturnDate:
+
+    SelDate = Get_Property(@Window : '.OLE_DATEPICKER', 'OLE.Selection')
+    End_Dialog(@Window, SelDate)
+
+    // Since we are ending the window now, there is no need to allow the event chain to continue.
+    // If we do, then we will get the "labeled common variable has been freed and is no longer valid" error.
+    EventFlow   = EVENT_CONTINUE_NO_SYSTEM$
+
+return

FRAMEWORKS/STPROC/NDW_HTTP_LOGS_ARCHIVE_DATE_EVENTS.txt

@@ -0,0 +1,199 @@
+Function NDW_HTTP_Logs_Archive_Date_Events(CtrlEntId, Event, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10, Param11, Param12, Param13, Param14, Param15)
+/***********************************************************************************************************************
+
+    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        :   NDW_HTTP_Logs_Archive_Date_Events
+
+    Description :   This function acts as a commuter module for all events related to this window.
+
+    Notes       :   Commuter Modules are automatically called from the Promoted_Events function which is called by the
+                    application-specific promoted event handler. This makes it possible to add QuickEvents that need to
+                    execute Basic+ logic without having use the Form Designer to make the association, although this is
+                    limited to the events which are currently promoted.
+
+                    If the form needs to call the commuter module directly then the QuickEvent parameters should be
+                    formatted like this:                                        
+
+                        '@SELF','@EVENT',['@PARAM1','@PARAMx']
+
+    Parameters  :
+        CtrlEntId   [in] -- The fully qualified name of the control calling the promoted event
+        Event       [in] -- The event being executed. See the Notes section regarding "PRE" events
+        Param1-15   [in] -- Additional event parameter holders
+        EventFlow  [out] -- Set to 1 or 0 so the calling event knows whether or not to chain forward. See comments in
+                            EVENT_SETUP insert
+
+    History (Date, Initials, Notes)
+        09/23/19    dmb     [SRPFW-278] Initial development.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+#window NDW_HTTP_LOGS_ARCHIVE_DATE
+
+$insert LOGICAL
+$insert MSG_EQUATES
+
+Equ EVENT_CONTINUE$ to 1
+Equ EVENT_STOP$     to 0
+Equ CR$             to \0D\
+Equ CRLF$           to \0D0A\
+Equ BACKSPACE$      to \08\
+Equ TAB$            to \09\
+Equ NEXT$           to 1
+Equ PREVIOUS$       to 2
+
+Declare subroutine  Set_Property, Send_Event, Send_Message, PlaceDialog, End_Dialog
+Declare function    Get_Property, Dialog_Box
+
+// Get the design time name of the window in case this is a multi-instance window.
+Window = @Window[1, 'F*']
+
+// Always get the CtrlClassID since we are not passing it through the event parameters.
+CtrlClassId = Get_Property(CtrlEntId, 'TYPE')
+
+// Get the name of the control on the window based on the CtrlClassId.
+Begin Case
+    Case CtrlClassId EQ 'WINDOW'
+        Control = Window
+    Case CtrlClassId EQ 'RADIOBUTTON'
+        Control = Field(CtrlEntId, '.', 2, 2)
+    Case CtrlClassId EQ 'MENU'
+        Control = CtrlEntId[-1, 'B.']
+    Case 1
+        Control = Field(CtrlEntId, '.', 2, 1)
+End Case
+
+If Event EQ 'OLE' then GoSub TransferParams
+
+GoToEvent Event for CtrlEntID
+If Event EQ 'OLE' then GoSub RestoreParams
+
+Return EventFlow OR EVENT_CONTINUE$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Events
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+Event WINDOW.CREATE(CreateParam)
+    
+    GoSub SetupOLEControls
+
+    PlaceDialog(-1, -1)
+
+end event
+
+
+Event PUB_OK.CLICK()
+
+    ArchiveDate = Get_Property(@Window : '.EDL_DATE', 'INVALUE')
+    End_Dialog(@Window, ArchiveDate)
+
+    // Since we are ending the window now, there is no need to allow the event chain to continue.
+    // If we do, then we will get the "labeled common variable has been freed and is no longer valid" error.
+    EventFlow   = EVENT_STOP$
+
+end event
+
+
+Event EDL_DATE.OPTIONS()
+    
+    CurrentDate = Get_Property(@Window : '.EDL_DATE', 'INVALUE')
+    NewDate     = Dialog_Box('NDW_HTTP_DATEPICKER', @Window)
+    If CurrentDate NE NewDate then
+        Set_Property(CtrlEntId, 'INVALUE', NewDate)
+    end
+
+end event
+
+
+Event OLE_SUBCLASS.OnOptionClick(CtrlId)
+
+    Send_Event(CtrlId, 'OPTIONS')
+
+end event
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal Gosubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+SetupOLEControls:
+    
+    // All OLE controls can use this qualify configuration.
+    Qualify     = ''
+    Qualify<1>  = 1
+    Qualify<3>  = ''
+    Qualify<4>  = 0
+
+    //------------------------------------------------------------------------------------------------------------------
+    //
+    //  SRP Subclass Control
+    //
+    //------------------------------------------------------------------------------------------------------------------
+    Ctrl        = @Window : '.OLE_SUBCLASS'
+    EditCtrls   = 'EDL_DATE'
+    NumCtrls    = DCount(EditCtrls, ',')
+    For EditCnt = 1 to NumCtrls
+        EditCtrl    = Field(EditCtrls, ',', EditCnt, 1)
+        Handle      = Get_Property(@Window : '.' : EditCtrl, 'HANDLE')
+        Send_Message(Ctrl, 'OLE.Subclass', Handle, @Window : '.' : EditCtrl)
+        Set_Property(Ctrl, 'OLE.OptionButton[' : @Window : ';' : EditCtrl : ']', True$)
+        Set_Property(Ctrl, 'OLE.OptionImage[' : @Window : ';' : EditCtrl : ']', 'BMPS\SRPHTTPDateField.png')
+        Set_Property(Ctrl, 'OLE.Prompt[' : @Window : ';' : EditCtrl : ']', 'YYYY-MM-DD' : @FM : @FM : 'Center' : @FM : 'Center' : @FM : 'Segoe UI' : @SVM : 9 : @SVM : 400 : @VM : 0)
+        Send_Message(Ctrl, 'QUALIFY_EVENT', 'OLE.OnOptionClick', Qualify)
+    Next EditCnt
+
+return
+
+
+TransferParams:
+
+    // ActiveX controls pass their own event names through Param1. Modify the parameter values so they conform to
+    // OpenInsight event parameter values. This will allow commuter modules to be structured the same for OpenInsight
+    // event and ActiveX (OLE) events.
+    Transfer Param1  to Event
+    Transfer Param2  to Param1
+    Transfer Param3  to Param2
+    Transfer Param4  to Param3
+    Transfer Param5  to Param4
+    Transfer Param6  to Param5
+    Transfer Param7  to Param6
+    Transfer Param8  to Param7
+    Transfer Param9  to Param8
+    Transfer Param10 to Param9
+    Transfer Param11 to Param10
+    Transfer Param12 to Param11
+    Transfer Param13 to Param12
+    Transfer Param14 to Param13
+    Transfer Param15 to Param14
+
+return
+
+
+RestoreParams:
+
+    // Restore the event parameters so the rest of the event chain will see the parameter values as they were originally
+    // created by OpenInsight. This will also prevent the parameter values from being transferred multiple times in case
+    // there are multiple OLE promoted event handlers (e.g. APPNAME*..OIWIN* and APPNAME*OLE..OIWIN*).
+    Transfer Param14 to Param15
+    Transfer Param13 to Param14
+    Transfer Param12 to Param13
+    Transfer Param11 to Param12
+    Transfer Param10 to Param11
+    Transfer Param9  to Param10
+    Transfer Param8  to Param9 
+    Transfer Param7  to Param8 
+    Transfer Param6  to Param7
+    Transfer Param5  to Param6
+    Transfer Param4  to Param5
+    Transfer Param3  to Param4
+    Transfer Param2  to Param3
+    Transfer Param1  to Param2
+    Transfer Event   to Param1
+    Event             = 'OLE'
+
+return

FRAMEWORKS/STPROC/NDW_WEB_ACCOUNTS_EVENTS.txt

@@ -0,0 +1,403 @@
+Function NDW_Web_Accounts_Events(CtrlEntId, Event, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10, Param11, Param12, Param13, Param14, Param15)
+/***********************************************************************************************************************
+
+    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        :   NDW_Web_Accounts_Events
+
+    Description :   This function acts as a commuter module for all events related to this window.
+
+    Notes       :   Commuter Modules are automatically called from the Promoted_Events function which is called by the
+                    application-specific promoted event handler. This makes it possible to add QuickEvents that need to
+                    execute Basic+ logic without having use the Form Designer to make the association, although this is
+                    limited to the events which are currently promoted.
+
+                    If the form needs to call the commuter module directly then the QuickEvent parameters should be
+                    formatted like this:										
+
+                        '@SELF','@EVENT',['@PARAM1','@PARAMx']
+
+    Parameters  :
+        CtrlEntId   [in] -- The fully qualified name of the control calling the promoted event
+        Event       [in] -- The event being executed. See the Notes section regarding "PRE" events
+        Param1-15   [in] -- Additional event parameter holders
+        EventFlow  [out] -- Set to 1 or 0 so the calling event knows whether or not to chain forward. See comments in
+                            EVENT_SETUP insert
+
+    History (Date, Initials, Notes)
+        10/24/18    dmb     Initial development.
+        11/21/18    dmb     [SRPFW-257] Finish core functionality.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+#window NDW_WEB_ACCOUNTS
+
+$insert LOGICAL
+$insert MSG_EQUATES
+$insert WEB_ACCOUNTS_EQUATES
+
+Equ EVENT_CONTINUE$ to 1
+Equ EVENT_STOP$     to 0
+Equ SetupTable$     to 'SYSENV'
+
+Declare subroutine  WebAccounts_Services, Set_Property, PlaceDialog, End_Dialog, Msg, Send_Event, Send_Message
+Declare subroutine  Error_Services, HTTP_Authentication_Services
+Declare function    WebAccounts_Services, Get_Property, Memory_Services, HTTP_Authentication_Services, Error_Services
+Declare function    RTI_CreateGUID, Popup
+
+// Get the design time name of the window in case this is a multi-instance window.
+Window = @Window[1, 'F*']
+
+// Always get the CtrlClassID since we are not passing it through the event parameters.
+CtrlClassId = Get_Property(CtrlEntId, 'TYPE')
+
+// Get the name of the control on the window based on the CtrlClassId.
+Begin Case
+    Case CtrlClassId EQ 'WINDOW'
+        Control = Window
+    Case CtrlClassId EQ 'RADIOBUTTON'
+        Debug
+*        Control = Field(CtrlEntId, '.', 2, 2)
+        Control = Field(CtrlEntId, '.', 2, 1)
+    Case CtrlClassId EQ 'MENU'
+        Control = CtrlEntId[-1, 'B.']
+    Case 1
+        Control = Field(CtrlEntId, '.', 2, 1)
+End Case
+
+If Event EQ 'OLE' then GoSub TransferParams
+GoToEvent Event for CtrlEntID
+If Event EQ 'OLE' then GoSub RestoreParams
+
+Return EventFlow OR EVENT_CONTINUE$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Events
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+Event WINDOW.CREATE(CreateParam)
+
+    GoSub SetupOLEControls
+
+    PlaceDialog(-2, -2)
+
+end event
+
+
+Event EDL_ID.LOSTFOCUS(Flag, FocusID)
+
+    GotFocusID  = Get_Property(CtrlEntId, 'GOTFOCUS_VALUE')
+    ID          = Get_Property(CtrlEntId, 'TEXT')
+    If GotFocusID NE ID then
+        WebAccountRow   = WebAccounts_Services('GetWebAccounts', ID)
+        If Error_Services('NoError') then
+            GoSub UpdateForm
+        end
+    end
+
+end event
+
+
+Event EDL_ID.OPTIONS()
+
+    ID  = Popup(@Window, '', 'WEB_ACCOUNTS')
+    If ID NE '' AND ID NE Char(27) then
+        Set_Property(CtrlEntId, 'GOTFOCUS_VALUE', '')
+        Set_Property(CtrlEntId, 'TEXT', ID)
+        Send_Event(CtrlEntId, 'LOSTFOCUS')
+    end
+
+end event
+
+
+Event OLE_ACTION_BAR.OnClick(Group, Item, Point, Button, Shift, Ctrl)
+
+    ResetAttempts   = False$
+
+    Begin Case
+        Case Group EQ 1
+            Begin Case
+                Case Item EQ 1
+                    // Clear Form
+                    ID              = ''
+                    WebAccountRow   = ''
+                    GoSub UpdateForm
+                    Set_Property('SYSTEM', 'FOCUS', @Window : '.EDL_ID')
+                    Set_Property(@Window : '.EDL_ID', 'GOTFOCUS_VALUE', '')
+                    
+                Case Item EQ 2
+                    // Close Form
+                    Set_Property(@Window, 'TIMER', 1 : @FM : 1)
+            End Case
+        Case Group EQ 2
+            Begin Case
+                Case Item EQ 1
+                    // New Account
+                    GoSub CreateNewWebAccount
+                Case Item EQ 2
+                    // Save Account
+                    GoSub UpdateWebAccount
+            End Case
+        Case Group EQ 3
+            Begin Case
+                Case Item EQ 1
+                    // Reset Password
+                    ID  = Get_Property(@Window : '.EDL_ID', 'TEXT')
+                    If ID NE '' then
+                        CurrentPassword = HTTP_Authentication_Services('GetWebAccountPassword', ID, False$)
+                        Password        = HTTP_Authentication_Services('ResetWebAccountPassword', ID, CurrentPassword)
+                        If Error_Services('NoError') then
+                            WebAccountRow   = WebAccounts_Services('GetWebAccounts', ID)
+                            If Error_Services('NoError') then
+                                GoSub UpdateForm
+                            end
+                        end else
+                            MsgStruct               = ''
+                            MsgStruct<MTEXT$>       = Error_Services('GetMessage')
+                            MsgStruct<MTYPE$>       = 'BO'
+                            MsgStruct<MICON$>       = 'H'
+                            MsgStruct<MCAPTION$>    = 'SRP HTTP Framework'
+                            Msg(@Window, MsgStruct)
+                        end
+                    end
+                Case Item EQ 2
+                    // Reset Attempts
+                    ResetAttempts   = True$
+                    GoSub UpdateWebAccount
+                    If Error_Services('NoError') then
+                        Set_Property(@Window : '.EDL_INVALID_PASSWORD_ATTEMPTS', 'INVALUE', 0)
+                    end
+                Case Item EQ 3
+                    // Copy to Clipboard
+                    AccountID   = Get_Property(@Window : '.EDL_ID', 'INVALUE')
+                    Name        = Get_Property(@Window : '.EDL_NAME', 'INVALUE')
+                    Password    = Get_Property(@Window : '.EDL_CURRENT_PASSWORD', 'INVALUE')
+                    Clipboard   = 'Account ID: ' : AccountID : \0D0A\ : 'Name: ' : Name : \0D0A\ : 'Password: ' : Password
+                    Set_Property('CLIPBOARD', 'TEXT', Clipboard)
+            End Case
+    End Case
+
+end event
+
+
+Event OLE_SUBCLASS.OnOptionClick(CtrlId)
+
+    Send_Event(CtrlId, 'OPTIONS')
+
+end event
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal Gosubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+SetupOLEControls:
+
+    // All OLE controls can use this qualify configuration.
+    Qualify     = ''
+    Qualify<1>  = 1
+    Qualify<3>  = ''
+    Qualify<4>  = 0
+
+    //------------------------------------------------------------------------------------------------------------------
+    //
+    //  SRP ShortcutBar Control
+    //
+    //------------------------------------------------------------------------------------------------------------------
+    Ctrl = @Window : '.OLE_ACTION_BAR'
+    Set_Property(Ctrl, 'OLE.Border', 'XP Flat')
+    Set_Property(Ctrl, 'OLE.Animation', 'Never')
+    Set_Property(Ctrl, 'OLE.Theme', 'Office2007Blue')
+    Set_Property(Ctrl, 'OLE.GroupFont', 'Segoe UI' : @SVM : 11 : @SVM : 400)
+    Set_Property(Ctrl, 'OLE.ItemFont', 'Segoe UI' : @SVM : 9 : @SVM : 400)
+    Set_Property(Ctrl, 'OLE.GroupCount', 3)
+    Set_Property(Ctrl, 'OLE.GroupCaption[1]', 'Form Actions')
+    Set_Property(Ctrl, 'OLE.GroupCaption[2]', 'Account Actions')
+    Set_Property(Ctrl, 'OLE.GroupCaption[3]', 'Password Actions')
+    Set_Property(Ctrl, 'OLE.GroupExpandable[All]', False$)
+    Set_Property(Ctrl, 'OLE.GroupSpecial[All]', True$)
+    Set_Property(Ctrl, 'OLE.GroupItemCount[1]', 2)
+    Set_Property(Ctrl, 'OLE.ItemCaption[1;1]', 'Clear Form')
+    Set_Property(Ctrl, 'OLE.ItemCaption[1;2]', 'Close Form')
+    Set_Property(Ctrl, 'OLE.GroupItemCount[2]', 2)
+    Set_Property(Ctrl, 'OLE.ItemCaption[2;1]', 'New Account')
+    Set_Property(Ctrl, 'OLE.ItemCaption[2;2]', 'Save Account')
+    Set_Property(Ctrl, 'OLE.GroupItemCount[3]', 3)
+    Set_Property(Ctrl, 'OLE.ItemCaption[3;1]', 'Reset Password')
+    Set_Property(Ctrl, 'OLE.ItemCaption[3;2]', 'Reset Attempts')
+    Set_Property(Ctrl, 'OLE.ItemCaption[3;3]', 'Copy to Clipboard')
+    Margins = 0 : @FM : 0 : @FM : 0 : @FM : 0 : @FM : 0
+    Set_Property(Ctrl, 'OLE.HotTrackStyle', 'Item')
+    Set_Property(Ctrl, 'OLE.ItemBold[All; All]', True$)
+    Send_Message(Ctrl, 'QUALIFY_EVENT', 'OLE.OnClick', Qualify)
+
+    //------------------------------------------------------------------------------------------------------------------
+    //
+    //  SRP Subclass Control
+    //
+    //------------------------------------------------------------------------------------------------------------------
+    Ctrl        = @Window : '.OLE_SUBCLASS'
+    EditCtrls   = 'EDL_ID'
+    NumCtrls    = DCount(EditCtrls, ',')
+    For EditCnt = 1 to NumCtrls
+        EditCtrl    = Field(EditCtrls, ',', EditCnt, 1)
+        Handle      = Get_Property(@Window : '.' : EditCtrl, 'HANDLE')
+        Send_Message(Ctrl, 'OLE.Subclass', Handle, @Window : '.' : EditCtrl)
+        Set_Property(Ctrl, 'OLE.OptionButton[' : @Window : ';' : EditCtrl : ']', True$)
+        Send_Message(Ctrl, 'QUALIFY_EVENT', 'OLE.OnOptionClick', Qualify)
+    Next EditCnt
+
+return
+
+
+TransferParams:
+
+    // ActiveX controls pass their own event names through Param1. Modify the parameter values so they conform to
+    // OpenInsight event parameter values. This will allow commuter modules to be structured the same for OpenInsight
+    // event and ActiveX (OLE) events.
+    Transfer Param1  to Event
+    Transfer Param2  to Param1
+    Transfer Param3  to Param2
+    Transfer Param4  to Param3
+    Transfer Param5  to Param4
+    Transfer Param6  to Param5
+    Transfer Param7  to Param6
+    Transfer Param8  to Param7
+    Transfer Param9  to Param8
+    Transfer Param10 to Param9
+    Transfer Param11 to Param10
+    Transfer Param12 to Param11
+    Transfer Param13 to Param12
+    Transfer Param14 to Param13
+    Transfer Param15 to Param14
+
+return
+
+
+RestoreParams:
+
+    // Restore the event parameters so the rest of the event chain will see the parameter values as they were originally
+    // created by OpenInsight. This will also prevent the parameter values from being transferred multiple times in case
+    // there are multiple OLE promoted event handlers (e.g. APPNAME*..OIWIN* and APPNAME*OLE..OIWIN*).
+    Transfer Param14 to Param15
+    Transfer Param13 to Param14
+    Transfer Param12 to Param13
+    Transfer Param11 to Param12
+    Transfer Param10 to Param11
+    Transfer Param9  to Param10
+    Transfer Param8  to Param9 
+    Transfer Param7  to Param8 
+    Transfer Param6  to Param7
+    Transfer Param5  to Param6
+    Transfer Param4  to Param5
+    Transfer Param3  to Param4
+    Transfer Param2  to Param3
+    Transfer Param1  to Param2
+    Transfer Event   to Param1
+    Event             = 'OLE'
+
+return
+
+
+UpdateForm:
+    
+    Set_Property(@Window : '.EDL_ID', 'INVALUE', ID)
+    Set_Property(@Window : '.EDL_NAME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.NAME$>)
+    Set_Property(@Window : '.COB_ACCOUNT_ENABLED', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.ACCOUNT_ENABLED$>)
+    Set_Property(@Window : '.EDL_CURRENT_PASSWORD', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD$>)
+    Set_Property(@Window : '.EDL_CURRENT_PASSWORD_CREATE_DATE', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_DATE$>)
+    Set_Property(@Window : '.EDL_CURRENT_PASSWORD_CREATE_TIME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_TIME$>)
+    Set_Property(@Window : '.EDL_CURRENT_PASSWORD_EXPIRE_DATE', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_DATE$>)
+    Set_Property(@Window : '.EDL_CURRENT_PASSWORD_EXPIRE_TIME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_TIME$>)
+    Set_Property(@Window : '.EDL_OLD_PASSWORD', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD$>)
+    Set_Property(@Window : '.EDL_OLD_PASSWORD_CREATE_DATE', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_CREATE_DATE$>)
+    Set_Property(@Window : '.EDL_OLD_PASSWORD_CREATE_TIME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_CREATE_TIME$>)
+    Set_Property(@Window : '.EDL_OLD_PASSWORD_EXPIRE_DATE', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_EXPIRE_DATE$>)
+    Set_Property(@Window : '.EDL_OLD_PASSWORD_EXPIRE_TIME', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_EXPIRE_TIME$>)
+    Set_Property(@Window : '.EDL_INVALID_PASSWORD_ATTEMPTS', 'INVALUE', WebAccountRow<WEB_ACCOUNTS.INVALID_PASSWORD_ATTEMPTS$>)
+    
+return
+
+
+CreateNewWebAccount:
+
+    Send_Event(@Window : '.OLE_ACTION_BAR', 'OLE', 'OnClick', 1, 1)
+    ID                                                          = RTI_CreateGUID('B')
+    Convert '.,' to '' in ID
+    ID                                                          = ID[1, 6]
+    WebAccountRow                                               = ''
+    WebAccountRow<WEB_ACCOUNTS.ACCOUNT_ENABLED$>                = True$
+    WebAccountRow<WEB_ACCOUNTS.INVALID_PASSWORD_ATTEMPTS$>      = 0
+    WebAccounts_Services('SetWebAccounts', ID, WebAccountRow)
+    If Error_Services('NoError') then
+        HTTP_Authentication_Services('ResetWebAccountPassword', ID)
+        If Error_Services('NoError') then
+            Set_Property(@Window : '.EDL_ID', 'INVALUE', ID)
+            WebAccountRow           = WebAccounts_Services('GetWebAccounts', ID)
+            If Error_Services('NoError') then
+                GoSub UpdateForm
+                Set_Property(@Window : '.EDL_NAME', 'FOCUS', True$)
+            end else
+                MsgStruct               = ''
+                MsgStruct<MTEXT$>       = Error_Services('GetMessage')
+                MsgStruct<MTYPE$>       = 'BO'
+                MsgStruct<MICON$>       = 'H'
+                MsgStruct<MCAPTION$>    = 'SRP HTTP Framework'
+                Msg(@Window, MsgStruct)
+            end
+        end else
+            MsgStruct               = ''
+            MsgStruct<MTEXT$>       = Error_Services('GetMessage')
+            MsgStruct<MTYPE$>       = 'BO'
+            MsgStruct<MICON$>       = 'H'
+            MsgStruct<MCAPTION$>    = 'SRP HTTP Framework'
+            Msg(@Window, MsgStruct)
+        end
+    end else
+        MsgStruct               = ''
+        MsgStruct<MTEXT$>       = Error_Services('GetMessage')
+        MsgStruct<MTYPE$>       = 'BO'
+        MsgStruct<MICON$>       = 'H'
+        MsgStruct<MCAPTION$>    = 'SRP HTTP Framework'
+        Msg(@Window, MsgStruct)
+    end
+
+return
+
+
+UpdateWebAccount:
+
+    ID                                                          = Get_Property(@Window : '.EDL_ID', 'INVALUE')
+    WebAccountRow                                               = ''
+    WebAccountRow<WEB_ACCOUNTS.NAME$>                           = Get_Property(@Window : '.EDL_NAME', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.ACCOUNT_ENABLED$>                = Get_Property(@Window : '.COB_ACCOUNT_ENABLED', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD$>               = Get_Property(@Window : '.EDL_CURRENT_PASSWORD', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_DATE$>   = Get_Property(@Window : '.EDL_CURRENT_PASSWORD_CREATE_DATE', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_TIME$>   = Get_Property(@Window : '.EDL_CURRENT_PASSWORD_CREATE_TIME', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_DATE$>   = Get_Property(@Window : '.EDL_CURRENT_PASSWORD_EXPIRE_DATE', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_TIME$>   = Get_Property(@Window : '.EDL_CURRENT_PASSWORD_EXPIRE_TIME', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD$>                   = Get_Property(@Window : '.EDL_OLD_PASSWORD', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_CREATE_DATE$>       = Get_Property(@Window : '.EDL_OLD_PASSWORD_CREATE_DATE', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_CREATE_TIME$>       = Get_Property(@Window : '.EDL_OLD_PASSWORD_CREATE_TIME', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_EXPIRE_DATE$>       = Get_Property(@Window : '.EDL_OLD_PASSWORD_EXPIRE_DATE', 'INVALUE')
+    WebAccountRow<WEB_ACCOUNTS.OLD_PASSWORD_EXPIRE_TIME$>       = Get_Property(@Window : '.EDL_OLD_PASSWORD_EXPIRE_TIME', 'INVALUE')
+    If ResetAttempts EQ True$ then
+        Attempts    = 0
+    end else
+        Attempts    = Get_Property(@Window : '.EDL_INVALID_PASSWORD_ATTEMPTS', 'INVALUE')
+    end
+    WebAccountRow<WEB_ACCOUNTS.INVALID_PASSWORD_ATTEMPTS$>      = Attempts
+    WebAccounts_Services('SetWebAccounts', ID, WebAccountRow)
+    If Error_Services('HasError') then
+        MsgStruct               = ''
+        MsgStruct<MTEXT$>       = Error_Services('GetMessage')
+        MsgStruct<MTYPE$>       = 'BO'
+        MsgStruct<MICON$>       = 'H'
+        MsgStruct<MCAPTION$>    = 'SRP HTTP Framework'
+        Msg(@Window, MsgStruct)
+    end
+
+return

FRAMEWORKS/STPROC/OATH_API.txt

@@ -0,0 +1,56 @@
+Function Oath_API(@API)
+/***********************************************************************************************************************
+
+    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        :   Oath_API
+
+    Description :   API logic for the Oath resource.
+
+    Notes       :   All web APIs should include the API_SETUP insert. This will provide several useful variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        FullEndpointURL         - The URL submitted by the client, including query params.
+                        FullEndpointURLNoQuery  - The URL submitted by the client, excluding query params.
+                        ParentURL               - The URL path preceeding the current endpoint.
+                        CurrentAPI              - The name of this stored procedure.    
+
+    Parameters  :
+        API             [in] -- Web API to process. Format is [Resource].[HTTPMethod]. For example:
+                                    - Oath.POST
+                                    - Oath.ID.PUT
+                                    - Oath.ID.firstName.GET
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        11/22/18    dmb     Original programmer. - [SRPFW-256]
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert API_SETUP
+$insert HTTP_INSERTS
+
+GoToAPI else
+    // The specific resource endpoint doesn't have a API handler yet.
+    HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but a web API handler has not yet been created.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Web APIs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+
+API oath.GET
+
+end api

FRAMEWORKS/STPROC/OAUTH_API.txt

@@ -0,0 +1,61 @@
+Function Oauth_API(@API)
+/***********************************************************************************************************************
+
+    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        :   Oauth_API
+
+    Description :   API logic for the Oauth resource.
+
+    Notes       :   All web APIs should include the API_SETUP insert. This will provide several useful variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        FullEndpointURL         - The URL submitted by the client, including query params.
+                        FullEndpointURLNoQuery  - The URL submitted by the client, excluding query params.
+                        EndpointSegment         - The URL endpoint segment.
+                        ParentURL               - The URL path preceeding the current endpoint.
+                        CurrentAPI              - The name of this stored procedure.
+
+    Parameters  :
+        API             [in] -- Web API to process. Format is [APIPattern].[HTTPMethod]:
+                                    - APIPattern must follow this structure Oauth[.ID.[<Property>]]
+                                    - HTTPMethod can be any valid HTTP method, e.g., GET, POST, PUT, DELETE, etc.
+                                Examples:
+                                    - Oauth.POST
+                                    - Oauth.ID.PUT
+                                    - Oauth.ID.firstName.GET
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        07/12/19    dmb     Original programmer.
+        01/23/20    dmb     [SRPFW-296] Add matching HEAD APIs for all GET APIs.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert API_SETUP
+$insert HTTP_INSERTS
+
+GoToAPI else
+    // The specific resource endpoint doesn't have a API handler yet.
+    HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but a web API handler has not yet been created.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Endpoint Handlers
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+API oauth.HEAD
+API oauth.GET
+
+end api

FRAMEWORKS/STPROC/PICTURE_API.txt

@@ -0,0 +1,167 @@
+Function Picture_API(@API)
+/***********************************************************************************************************************
+
+    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        :   Picture_API
+
+    Description :   API logic for the Picture resource.
+
+    Notes       :   All web APIs should include the API_SETUP insert. This will provide several useful variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        FullEndpointURL         - The URL submitted by the client, including query params.
+                        FullEndpointURLNoQuery  - The URL submitted by the client, excluding query params.
+                        ParentURL               - The URL path preceeding the current endpoint.
+                        CurrentAPI              - The name of this stored procedure.    
+
+    Parameters  :
+        API             [in] -- Web API to process. Format is [APIPattern].[HTTPMethod]:
+                                    - APIPattern must follow this structure <Resource>[.ID.[<Property>]]
+                                    - HTTPMethod can be any valid HTTP method, e.g., GET, POST, PUT, DELETE, etc.
+                                Examples:
+                                    - Picture.POST
+                                    - Picture.ID.PUT
+                                    - Picture.ID.firstName.GET
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        11/19/18    dmb     Original programmer.
+        01/23/20    dmb     [SRPFW-296] Add matching HEAD APIs for all GET APIs.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert API_SETUP
+$insert HTTP_INSERTS
+$insert CONTACTS_EQUATES
+
+PictureFolder   = '\WebAppData\ContactPictures\'
+
+GoToAPI else
+    // The specific resource endpoint doesn't have a API handler yet.
+    HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but a web API handler has not yet been created.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Endpoint Handlers
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+API picture.GET
+API picture.HEAD
+
+    // Get the picture's physical file path from the CONTACT database row.
+    KeyID           = ParentSegment
+    PicturePath     = Drive() : HTTP_Resource_Services('GetColumnValues', 'CONTACTS', 'picture', KeyID)
+
+    If PicturePath NE '' then
+        // Verify the picture actually exists.
+        If Dir(PicturePath) NE '' then
+            // Get the image extension.
+            ImageExt    = PicturePath[-1, 'B.']
+            If ImageExt _EQC 'jpg' then ImageExt = 'jpeg'
+            // Get the best content type that matches the client's and server's ability.
+            ContentType = HTTP_Services('GetBestContentNegotiation', 'Accept', 'text/plain' : @FM : 'image/' : ImageExt)
+            If ContentType NE '' then
+                OSRead PictureBinary from PicturePath then
+                    Begin Case
+                        Case ContentType _EQC 'text/plain'
+                            PictureBody = SRP_Encode(PictureBinary, 'BASE64')
+                            PictureBody = 'data:' : 'image/' : ImageExt : ';base64,' : PictureBody
+                            HTTP_Services('SetResponseHeaderField', 'Content-Encoding', 'base64')
+                            HTTP_Services('SetResponseBody', PictureBody, False$, 'text/plain')
+
+                        Case ContentType[1, 6] _EQC 'image/'
+                            HTTP_Services('SetResponseBody', PictureBinary, True$, ContentType)
+
+                    End Case
+                end else
+                    HTTP_Services('SetResponseError', '', '', 404, 'Picture for contact ' : KeyID : ' does not exist.', FullEndpointURL)
+                end
+            end
+        end else
+            HTTP_Services('SetResponseError', '', '', 404, 'Picture for contact ' : KeyID : ' does not exist.', FullEndpointURL)
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 404, 'Picture for contact ' : KeyID : ' does not exist.', FullEndpointURL)
+    end
+
+end api
+
+
+API picture.PUT
+
+    KeyID           = ParentSegment
+    TableName       = 'CONTACTS'
+
+    ContentType = HTTP_Services('GetHTTPContentType')
+
+    If ContentType EQ '' OR ContentType _EQC 'text/plain' then
+        Open TableName to hTable then
+            Lock hTable, KeyID then
+                ResponseStatus  = 200       ; // Updating an existing resource.
+                Read DataRow from hTable, KeyID else
+                    DataRow         = ''
+                    ResponseStatus  = 201   ; // Creating a new resource.
+                end
+
+                // A URI scheme of the Base64 encoded image will be in the Data variable.
+                HTTPPostString  = HTTP_Services('GetHTTPPostString')
+                HTTPPostString  = HTTP_Services('DecodePercentString', HTTPPostString)
+                Scheme          = HTTPPostString[1, 'F:']
+                If Scheme _EQC 'data' then
+                    MediaType   = HTTPPostString[Col2() + 1, 'F;']                  ; // Should be "image/png" or "image/jpg"
+                    Encoding    = HTTPPostString[Col2() + 1, 'F,']                  ; // Should be "base64"
+                    EncodedData = HTTPPostString[Col2() + 1, Len(HTTPPostString)]   ; // Should be the actual Base64 encoded content.
+                    DecodedData = SRP_Decode(EncodedData, 'BASE64')
+                    FileType    = MediaType[-1, 'B/']
+                    FileName    = KeyID : '.' : FileType
+                    FilePath    = Drive() : PictureFolder : FileName
+                    Status()    = 0
+                    OSWrite DecodedData to FilePath
+                    StatusCode = Status()
+                    If StatusCode then
+                        Begin Case
+                            Case StatusCode EQ 1    ; Error = 'Bad OS filename. Code: ' : StatusCode
+                            Case StatusCode EQ 2    ; Error = 'Access denied by operating system. Code: ' : StatusCode
+                            Case StatusCode EQ 3    ; Error = 'Disk or directory full. Code: ' : StatusCode
+                            Case StatusCode EQ 4    ; Error = 'File does not exist. Code: ' : StatusCode
+                            Case StatusCode EQ 5    ; Error = 'Unknown error. Code: ' : StatusCode
+                            Case StatusCode EQ 6    ; Error = 'Attempt to write to read-only file. Code: ' : StatusCode
+                            Case Otherwise$         ; Error = 'Unknown error. Code: ' : StatusCode
+                        End Case
+                        HTTP_Services('SetResponseError', '', '', 501, Error, FullEndpointURL)
+                    end else
+                        DataRow<CONTACTS_PICTURE$>  = PictureFolder : FileName
+                        Write DataRow to hTable, KeyID then
+                            HTTP_Services('SetResponseStatus', ResponseStatus)
+                            HTTP_Services('SetResponseHeaderField', 'Content-Location', FullEndpointURL)
+                        end else
+                            HTTP_Services('SetResponseError', '', '', 500, 'Error writing ' : KeyID : ' to the ' : TableName : ' table.', FullEndpointURL)
+                        end
+                    end
+                end else
+                    HTTP_Services('SetResponseError', '', '', 415, '', FullEndpointURL)
+                end
+                Unlock hTable, KeyID else Null
+            end else
+                HTTP_Services('SetResponseError', '', '', 423, KeyID : ' is currently locked.', FullEndpointURL)
+            end
+        end else
+            HTTP_Services('SetResponseError', '', '', 500, 'Error opening the ' : TableName : ' table.', FullEndpointURL)
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 415, 'Content-Type ' : ContentType : ' is not supported. Must specify "text/plain" or nothing.', FullEndpointURL)
+    end
+
+end api

FRAMEWORKS/STPROC/PING_API.txt

@@ -0,0 +1,82 @@
+Function Ping_API(@API)
+/***********************************************************************************************************************
+
+    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        :   Ping_API
+
+    Description :   API logic for the Ping resource.
+
+    Notes       :   All web APIs should include the API_SETUP insert. This will provide several useful variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        FullEndpointURL         - The URL submitted by the client, including query params.
+                        FullEndpointURLNoQuery  - The URL submitted by the client, excluding query params.
+                        ParentURL               - The URL path preceeding the current endpoint.
+                        CurrentAPI              - The name of this stored procedure.
+
+    Parameters  :
+        API             [in] -- Web API to process. Format is [APIPattern].[HTTPMethod]:
+                                    - APIPattern must follow this structure Ping[.ID.[<Property>]]
+                                    - HTTPMethod can be any valid HTTP method, e.g., GET, POST, PUT, DELETE, etc.
+                                Examples:
+                                    - Ping.POST
+                                    - Ping.ID.PUT
+                                    - Ping.ID.firstName.GET
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        06/24/19    dmb     [SRPFW-276] Original programmer.
+        01/18/20    dmb     [SRPFW-296] Update the ping.GET API 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] Add matching HEAD APIs for all GET APIs.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert API_SETUP
+$insert HTTP_INSERTS
+
+Declare function    SRP_DateTime
+
+GoToAPI else
+    // The specific resource endpoint doesn't have a API handler yet.
+    HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but a web API handler has not yet been created.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Endpoint Handlers
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+
+API ping.HEAD
+API ping.GET
+
+    Properties  = 'currentDateTime'
+    Values      = SRP_DateTime('Format', SRP_DateTime('Now', True$), "DDD, DD MMM YYYY hh:mm:ss 'GMT'")
+    objResource = HTTP_Resource_Services('AddProperties', '', Properties, Values)
+    Rels        = 'self' : @FM : 'apiEntryPoint'
+    URLs        = FullEndpointURL : @FM : APIURL
+    HTTP_Resource_Services('AddLinkRelations', objResource, Rels, URLs)
+
+    If Error_Services('NoError') then
+        // Serialize the object into a JSON string.
+        jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+        // Set the response body with the JSON string and set the Content-Type response header.
+        HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+    end else
+        HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+    end
+
+end api

FRAMEWORKS/STPROC/VERSION_API.txt

@@ -0,0 +1,81 @@
+Function Version_API(@API)
+/***********************************************************************************************************************
+
+    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        :   Version_API
+
+    Description :   API logic for the Version resource.
+
+    Notes       :   All web APIs should include the API_SETUP insert. This will provide several useful variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        FullEndpointURL         - The URL submitted by the client.
+                        CurrentAPI              - The name of this stored procedure.    
+
+    Parameters  :
+        API             [in] -- Web API to process. Format is [APIPattern].[HTTPMethod]:
+                                    - APIPattern must follow this structure <Resource>[.ID.[<Property>]]
+                                    - HTTPMethod can be any valid HTTP method, e.g., GET, POST, PUT, DELETE, etc.
+                                Examples:
+                                    - Version.POST
+                                    - Version.ID.PUT
+                                    - Version.ID.firstName.GET
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        11/19/18    dmb     Original programmer.
+        05/28/19    dmb     [SRPFW-274] Replace all references to AddLinkRelationships with AddLinkRelations.
+        01/23/20    dmb     [SRPFW-296] Add matching HEAD APIs for all GET APIs.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert API_SETUP
+$insert HTTP_INSERTS
+
+GoToAPI else
+    // The specific resource endpoint doesn't have a API handler yet.
+    HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but a web API handler has not yet been created.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Endpoint Handlers
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+API version.HEAD
+API version.GET
+
+    Version     = HTTP_Services('GetVersion')
+    If Error_Services('NoError') then
+        Swap CRLF$ with @FM in Version
+        Properties  = 'version' : @FM : 'date' : @FM : 'time'
+        Values      = Version<1> : @FM : Field(Version<2>, ' ', 1, 1) : @FM : Field(Version<2>, ' ', 2, 1)
+        objResource = HTTP_Resource_Services('AddProperties', '', Properties, Values)
+        Rels        = 'self' : @FM : 'apiEntryPoint'
+        URLs        = FullEndpointURL : @FM : APIURL
+        HTTP_Resource_Services('AddLinkRelations', objResource, Rels, URLs)
+
+        If Error_Services('NoError') then
+            // Serialize the object into a JSON string.
+            jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+            // Set the response body with the JSON string and set the Content-Type response header.
+            HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+        end else
+            HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+    end
+
+end api

FRAMEWORKS/STPROC/WEBACCOUNTS_API.txt

@@ -0,0 +1,205 @@
+Function Webaccounts_API(@API)
+/***********************************************************************************************************************
+
+    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        :   Webaccounts_API
+
+    Description :   API logic for the Webaccounts resource.
+
+    Notes       :   All web APIs should include the API_SETUP insert. This will provide several useful variables:
+
+                        HTTPMethod              - The HTTP Method (Verb) submitted by the client (e.g., GET, POST, etc.)
+                        APIURL                  - The URL for the API entry point (e.g., api.mysite.com/v1).
+                        FullEndpointURL         - The URL submitted by the client, including query params.
+                        FullEndpointURLNoQuery  - The URL submitted by the client, excluding query params.
+                        ParentURL               - The URL path preceeding the current endpoint.
+                                                  the SelfURL.
+                        CurrentAPI              - The name of this stored procedure.
+
+    Parameters  :
+        API             [in] -- Web API to process. Format is [APIPattern].[HTTPMethod]:
+                                    - APIPattern must follow this structure <Resource>[.ID.[<Property>]]
+                                    - HTTPMethod can be any valid HTTP method, e.g., GET, POST, PUT, DELETE, etc.
+                                Examples:
+                                    - Webaccounts.POST
+                                    - Webaccounts.ID.PUT
+                                    - Webaccounts.ID.firstName.GET
+        Response       [out] -- Response to be sent back to the Controller (HTTP_MCP) or requesting procedure. Web API
+                                services do not rely upon anything being returned in the response. This is what the
+                                various services like SetResponseBody and SetResponseStatus services are for. A response
+                                value is only helpful if the developers want to use it for debug purposes.
+
+    History     :   (Date, Initials, Notes)
+        11/19/18    dmb     Original programmer.
+        04/09/19    dmb     [SRPFW-271] Replace FullEndpointURL with FullEndpointURLNoQuery in the GetObjects service
+                            within the webaccounts.GET API to avoid query params in the embedded object self URLs.
+        05/28/19    dmb     [SRPFW-274] Replace all references to AddLinkRelationships with AddLinkRelations.
+        01/23/20    dmb     [SRPFW-296] Add matching HEAD APIs for all GET APIs.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert APP_INSERTS
+$insert API_SETUP
+$insert HTTP_INSERTS
+
+Declare function    WebAccounts_Services
+
+AuthenticatedAccountID  = HTTP_Authentication_Services('GetAuthenticatedAccountID')
+
+GoToAPI else
+    // The specific resource endpoint doesn't have a API handler yet.
+    HTTP_Services('SetResponseStatus', 204, 'This is a valid endpoint but a web API handler has not yet been created.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Endpoint Handlers
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+API webaccounts.HEAD
+API webaccounts.GET
+
+    objResource = HTTP_Resource_Services('GetObject')
+    If Error_Services('NoError') then
+        objWebAccounts  = HTTP_Resource_Services('GetObject', 'WEB_ACCOUNTS', AuthenticatedAccountID, 'NAME', '', '', '', '', FullEndpointURLNoQuery)
+        If Error_Services('NoError') then
+            HTTP_Resource_Services('AddEmbeddedResources', objResource, 'webaccounts', objWebAccounts)
+            // Add _links sub-properties for HAL implementation.
+            Rels    = 'self' : @FM : 'apiEntryPoint'
+            URLs    = FullEndpointURL : @FM : ParentURL
+            HTTP_Resource_Services('AddLinkRelations', objResource, Rels, URLs)
+            If Error_Services('NoError') then
+                // Serialize the object into a JSON string.
+                jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+                // Set the response body with the JSON string and set the Content-Type response header.
+                HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+            end else
+                HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+            end
+        end else
+            HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+    end
+
+end api
+
+
+API webaccounts.ID.HEAD
+API webaccounts.ID.GET
+
+    AccountID   = EndpointSegment
+
+    If AccountID EQ AuthenticatedAccountID then
+        objResource = HTTP_Resource_Services('GetObject', 'WEB_ACCOUNTS', AccountID, 'NAME')
+        If Error_Services('NoError') then
+            objPassword = HTTP_Resource_Services('GetObject', 'WEB_ACCOUNTS', AccountID, 'CURRENT_PASSWORD' : @FM : 'CURRENT_PASSWORD_CREATED' : @FM : 'CURRENT_PASSWORD_EXPIRES', 'value' : @FM : 'created' : @FM : 'expires')
+            If Error_Services('NoError') then
+                // Add the password nested property.
+                HTTP_Resource_Services('AddProperty', objResource, 'password', objPassword, 'ObjectHandle')
+            end
+            If Error_Services('NoError') then
+                // Add _links sub-properties for HAL implementation.
+                Names           = 'self' : @FM : 'password' : @FM : 'apiEntryPoint'
+                URLs            = FullEndpointURL : @FM : FullEndpointURL : '/password' : @FM : APIURL
+                HTTP_Resource_Services('AddLinkRelations', objResource, Names, URLs)
+            end
+            If Error_Services('NoError') then
+                // Serialize the object into a JSON string.
+                jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+                // Set the response body with the JSON string and set the Content-Type response header.
+                HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+            end else
+                HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+            end
+        end else
+            HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 401, 'This account is not authorized for this endpoint.', FullEndpointURL)
+    end
+
+end api
+
+
+API webaccounts.ID.password.HEAD
+API webaccounts.ID.password.GET
+
+    AccountID   = ParentSegment
+
+    If AccountID EQ AuthenticatedAccountID then
+        objResource = HTTP_Resource_Services('GetObject', 'WEB_ACCOUNTS', AccountID, 'CURRENT_PASSWORD' : @FM : 'CURRENT_PASSWORD_CREATED' : @FM : 'CURRENT_PASSWORD_EXPIRES', 'value' : @FM : 'created' : @FM : 'expires')
+        If Error_Services('NoError') then
+            // Add _links sub-properties for HAL implementation.
+            Names           = 'self' : @FM : 'apiEntryPoint'
+            URLs            = FullEndpointURL : @FM : APIURL
+            HTTP_Resource_Services('AddLinkRelations', objResource, Names, URLs)
+        end
+        If Error_Services('NoError') then
+            HTTP_Resource_Services('AddFormAction', objResource, 'resetPassword', 'PATCH', FullEndpointURL, 'Reset Password', 'value', '' : @VM : True$ : @VM : True$)
+        end
+        If Error_Services('NoError') then
+            // Serialize the object into a JSON string.
+            jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+            // Set the response body with the JSON string and set the Content-Type response header.
+            HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+        end else
+            HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 401, 'This account is not authorized for this endpoint.', FullEndpointURL)
+    end
+
+end api
+
+
+API webaccounts.ID.password.PATCH
+
+    AccountID   = ParentSegment
+
+    If AccountID EQ AuthenticatedAccountID then
+        Password        = HTTP_Authentication_Services('GetWebAccountPassword', AccountID, False$)
+        Body            = HTTP_Services('GetHTTPPostString')
+        Body            = HTTP_Services('DecodePercentString', Body)
+        If SRP_JSON(objJSON, 'Parse', Body) EQ '' then
+            NewPassword = SRP_JSON(objJSON, 'GetValue', 'value')
+            SRP_JSON(objJSON, 'Release')
+            HTTP_Authentication_Services('SetWebAccountPassword', AccountID, Password, NewPassword)
+            If Error_Services('NoError') then
+                objResource = HTTP_Resource_Services('GetObject', 'WEB_ACCOUNTS', AccountID, 'CURRENT_PASSWORD' : @FM : 'CURRENT_PASSWORD_CREATED' : @FM : 'CURRENT_PASSWORD_EXPIRES', 'value' : @FM : 'created' : @FM : 'expires')
+                If Error_Services('NoError') then
+                    // Add _links sub-properties for HAL implementation.
+                    Names           = 'self' : @FM : 'apiEntryPoint'
+                    URLs            = FullEndpointURL : @FM : APIURL
+                    HTTP_Resource_Services('AddLinkRelations', objResource, Names, URLs)
+                end
+                If Error_Services('NoError') then
+                    HTTP_Resource_Services('AddFormAction', objResource, 'resetPassword', 'PATCH', FullEndpointURL, 'Reset Password', 'value', '' : @VM : True$ : @VM : True$)
+                end
+                If Error_Services('NoError') then
+                    // Serialize the object into a JSON string.
+                    jsonResource    = HTTP_Resource_Services('GetSerializedResource', objResource)
+                    // Set the response body with the JSON string and set the Content-Type response header.
+                    HTTP_Services('SetResponseBody', jsonResource, False$, 'application/hal+json')
+                end else
+                    HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+                end
+            end else
+                HTTP_Services('SetResponseError', '', '', 403, Error_Services('GetMessage'), FullEndpointURL)
+            end
+        end else
+            Error_Services('Add', 'Error parsing JSON body within the ' : CurrentAPI : ' module.')
+            HTTP_Services('SetResponseError', '', '', 500, Error_Services('GetMessage'), FullEndpointURL)
+        end
+    end else
+        HTTP_Services('SetResponseError', '', '', 401, 'This account is not authorized for this endpoint.', FullEndpointURL)
+    end
+
+end api

FRAMEWORKS/STPROC/WEBACCOUNTS_SERVICES.txt

@@ -0,0 +1,204 @@
+Function WebAccounts_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        :   WebAccounts_Services
+
+    Description :   Handler program for all WebAccounts services.
+
+    Notes       :   
+
+    Parameters  :
+        Service         [in] -- Name of the service being requested
+        Param1-10   [in/out] -- Additional request parameter holders
+        Response       [out] -- Response to be sent back to the Controller (MCP) or requesting procedure
+
+    Metadata    :
+
+    History     :   (Date, Initials, Notes)
+        10/13/18    dmb     [SRPFW-254] Original programmer.
+        10/13/18    dmb     [SRPFW-254] Add GetWebAccounts, SetWebAccounts, and ConvertMVWebAccountsToJSON serives.
+        10/22/18    dmb     [SRPFW-254] Add ConvertJSONWebAccountsToMV service.
+        01/18/20    dmb     [SRPFW-296] Update the ConvertJSONWebAccountsToMV 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.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert LOGICAL
+$insert SERVICE_SETUP
+$insert WEB_ACCOUNTS_EQUATES
+
+Equ SecondsPerHour$ to 60 * 60              ; // 60 minutes * 60 seconds = 3600
+Equ SecondsPerDay$  to 24 * SecondsPerHour$ ; // 24 hours * 60 minutes * 60 seconds = 86400
+
+Declare function    WebAccounts_Services, Memory_Services, Database_Services, SRP_JSON, RTI_CreateGUID, SRP_DateTime
+Declare subroutine  WebAccounts_Services, Memory_Services, Database_Services, SRP_JSON
+
+GoToService else
+    Error_Services('Add', Service : ' is not a valid service request within the ' : ServiceModule : ' module.')
+end
+
+Return Response OR ''
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Service Parameter Options
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+Options BOOLEAN         = True$, False$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Services
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// GetWebAccounts
+//
+// Returns the database row from the WebAccounts table for the indicated Account ID. The default format is MultiValue.
+//----------------------------------------------------------------------------------------------------------------------
+Service GetWebAccounts(AccountID, ReturnJSON)
+
+    WebAccountsRow  = ''
+
+    If AccountID NE '' then
+        WebAccountsRow  = Database_Services('ReadDataRow', 'WEB_ACCOUNTS', AccountID)
+        If ReturnJSON EQ True$ then
+            WebAccountsRow  = WebAccounts_Services('ConvertMVWebAccountsToJSON', AccountID, WebAccountsRow)
+        end
+    end else
+        Error_Services('Add', 'AccountID argument was missing in the ' : Service : ' service.')
+    end
+
+    Response    = WebAccountsRow
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// SetWebAccounts
+//
+// Updates the WebAccounts database row for the indicated Account ID.
+//----------------------------------------------------------------------------------------------------------------------
+Service SetWebAccounts(AccountID, WebAccountsRow)
+
+    If (AccountID NE '') AND (WebAccountsRow NE '') then
+        Database_Services('WriteDataRow', 'WEB_ACCOUNTS', AccountID, WebAccountsRow)
+    end else
+        Error_Services('Add', 'AccountID or WebAccountsRow argument was missing in the ' : Service : ' service.')
+    end
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ConvertMVWebAccountsToJSON
+//
+// Converts a MultiValue formatted WebAccounts row into a serialized JSON object and returns the result. If the
+// mvWebAccounts argument is empty, the service will attempt to get it from the WebAccounts table. If the itemURL
+// argument is not empty, HAL+JSON properties will be added to the JSON object.
+//----------------------------------------------------------------------------------------------------------------------
+Service ConvertMVWebAccountsToJSON(AccountID, mvWebAccounts, itemURL)
+
+    jsonWebAccounts   = ''
+
+    If AccountID NE '' then
+
+        If mvWebAccounts EQ '' then mvWebAccounts = Database_Services('ReadDataRow', 'WEB_ACCOUNTS', AccountID)
+        If Error_Services('NoError') then
+            @DICT   = Database_Services('GetTableHandle', 'DICT.WEB_ACCOUNTS')
+            @ID     = AccountID
+            @RECORD = mvWebAccounts
+
+            // WebAccounts object.
+            If SRP_JSON(objJSONWebAccounts, 'New', 'Object') then
+                SRP_JSON(objJSONWebAccounts, 'SetValue', 'id', @ID, 'String')
+                SRP_JSON(objJSONWebAccounts, 'SetValue', 'name', {NAME}, 'String')
+                If SRP_JSON(objPassword, 'New', 'Object') then
+                    SRP_JSON(objPassword, 'SetValue', 'value', {CURRENT_PASSWORD}, 'String')
+                    SRP_JSON(objPassword, 'SetValue', 'created', {CURRENT_PASSWORD_CREATED}, 'String')
+                    SRP_JSON(objPassword, 'SetValue', 'expires', {CURRENT_PASSWORD_EXPIRES}, 'String')
+                    SRP_JSON(objJSONWebAccounts, 'Set', 'password', objPassword)
+                    SRP_JSON(objPassword, 'Release')
+                end
+
+                jsonWebAccounts    = SRP_JSON(objJSONWebAccounts, 'Stringify', 'Styled')
+*                Swap \0D0A\ with @FM in jsonWebAccounts
+                SRP_JSON(objJSONWebAccounts, 'Release')
+            end else
+                Error_Services('Add', 'Unable to create JSON representation in the ' : Service : ' service.')
+            end
+        end
+    end else
+        Error_Services('Add', 'AccountID argument was missing in the ' : Service : ' service.')
+    end
+ 
+    Response    = jsonWebAccounts
+
+end service
+
+
+//----------------------------------------------------------------------------------------------------------------------
+// ConvertJSONWebAccountsToMV
+//
+// Converts a serialized JSON WebAccounts object into a MultiValue formatted WebAccounts row and returns the result.
+//----------------------------------------------------------------------------------------------------------------------
+Service ConvertJSONWebAccountsToMV(jsonWebAccounts)
+
+    mvWebAccounts      = ''
+
+    If jsonWebAccounts NE '' then
+        If SRP_JSON(objJSONWebAccounts, 'Parse', jsonWebAccounts) EQ '' then
+            AccountID       = SRP_JSON(objJSONWebAccounts, 'GetValue', 'id')
+            mvWebAccounts   = WebAccounts_Services('GetWebAccounts', AccountID, False$)
+            If Error_Services('NoError') then
+                mvWebAccounts<WEB_ACCOUNTS.NAME$>                           = SRP_JSON(objJSONWebAccounts, 'GetValue', 'name')
+                mvWebAccounts<WEB_ACCOUNTS.CURRENT_PASSWORD$>               = SRP_JSON(objJSONWebAccounts, 'GetValue', 'password.value')
+                CreateDateTime                                              = SRP_JSON(objJSONWebAccounts, 'GetValue', 'password.created')
+                TMZ                                                         = Oconv(SRP_DateTime('Format', SRP_DateTime('Now', True$), "DDD, DD MMM YYYY hh:mm:ss 'GMT'")[-1, 'B '], 'MD2') ; // Get the TimeZone modifier.
+                CreateDate                                                  = Iconv(Field(CreateDateTime, ' ', 2, 3), 'D')
+                CreateTime                                                  = Iconv(Field(CreateDateTime, ' ', 5, 1), 'MT')
+                thisSeconds                                                 = CreateDate * SecondsPerDay$ + CreateTime
+                thisSeconds                                                += TMZ * SecondsPerHour$
+                CreateDate                                                  = Int(thisSeconds / SecondsPerDay$)
+                CreateTime                                                  = Mod(thisSeconds, SecondsPerDay$)
+                mvWebAccounts<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_DATE$>   = CreateDate
+                mvWebAccounts<WEB_ACCOUNTS.CURRENT_PASSWORD_CREATE_TIME$>   = CreateTime
+                ExpireDateTime                                              = SRP_JSON(objJSONWebAccounts, 'GetValue', 'password.expires')
+                ExpireDate                                                  = Iconv(Field(ExpireDateTime, ' ', 2, 3), 'D')
+                ExpireTime                                                  = Iconv(Field(ExpireDateTime, ' ', 5, 1), 'MT')
+                thisSeconds                                                 = ExpireDate * SecondsPerDay$ + ExpireTime
+                thisSeconds                                                += TMZ * SecondsPerHour$
+                ExpireDate                                                  = Int(thisSeconds / SecondsPerDay$)
+                ExpireTime                                                  = Mod(thisSeconds, SecondsPerDay$)
+                mvWebAccounts<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_DATE$>   = ExpireDate
+                mvWebAccounts<WEB_ACCOUNTS.CURRENT_PASSWORD_EXPIRE_TIME$>   = ExpireTime
+                SRP_JSON(objJSONWebAccounts, 'Release')
+            end
+        end else
+            Error_Services('Add', 'Error parsing jsonWebAccounts in the ' : Service : ' service.')
+        end
+    end else
+        Error_Services('Add', 'jsonWebAccounts argument was missing in the ' : Service : ' service.')
+    end
+
+    Response    = mvWebAccounts
+
+end service
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+//----------------------------------------------------------------------------------------------------------------------
+// GoSubLabel
+//
+//----------------------------------------------------------------------------------------------------------------------
+GoSubLabel:
+
+return

FRAMEWORKS/STPROC/WEB_ACCOUNTS_ACTIONS.txt

@@ -0,0 +1,226 @@
+Function Web_Accounts_Actions(Action, CalcColName, FSList, Handle, Name, FMC, Record, Status, OrigRecord, Param1, Param2, Param3, Param4, Param5, Param6, Param7, Param8, Param9, Param10)
+/***********************************************************************************************************************
+
+    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        :   Web_Accounts_Actions
+
+    Description :   Handles calculated columns and MFS calls for the current table.
+
+    Notes       :   This function uses @ID, @RECORD, and @DICT to make sure {ColumnName} references work correctly.
+                    If called from outside of a calculated column these will need to be set and restored.
+
+    Parameters  :
+        Action          [in] -- Name of the action to be taken
+        CalcColName     [in] -- Name of the calculated column that needs to be processed. Normally this should only be
+                                populated when the CalcField action is being used.
+        FSList          [in] -- The list of MFSs and the BFS name for the current file or volume. This is an @SVM
+                                delimited array, with the current MFS name as the first value in the array, and the BFS
+                                name as the last value. Normally set by a calling MFS.
+        Handle          [in] -- The file handle of the file or media map being accessed. Note, this does contain the
+                                entire handle structure that the Basic+ Open statement would provide. Normally set by a
+                                calling MFS.
+        Name            [in] -- The name (key) of the record or file being accessed. Normally set by a calling MFS.
+        FMC             [in] -- Various functions. Normally set by a calling MFS.
+        Record          [in] -- The entire record (for record-oriented functions) or a newly-created handle (for
+                                "get handle" functions). Normally set by a calling MFS.
+        Status      [in/out] -- Indicator of the success or failure of an action. Normally set by the calling MFS but
+                                for some actions can be set by the action handler to indicate failure.
+        OrigRecord      [in] -- Original content of the record being processed by the current action. This is
+                                automatically being assigned by the WRITE_RECORD and DELETE_RECORD actions within
+                                BASE_MFS.
+        Param1-10   [in/out] -- Additional request parameter holders
+        ActionFlow     [out] -- Used to control the action chain (see the ACTION_SETUP insert for more information.)
+                                Can also be used to return a special value, such as the results of the CalcField
+                                method.
+
+    History     :   (Date, Initials, Notes)
+        10/30/18    dmb     [SRPFW-254] Original programmer.
+        01/18/20    dmb     [SRPFW-296] Update the CURRENT_PASSWORD_CREATED and CURRENT_PASSWORD_EXPIRES calculated
+                            column logic by replacing Utility_DotNet('TIMEZONE') with the SRP_DateTime service (SRP
+                            Utilities 2.1) to avoid localization problems and potential 502 Bad Gateway errors.
+
+***********************************************************************************************************************/
+
+#pragma precomp SRP_PreCompiler
+
+$insert LOGICAL
+$insert FILE.SYSTEM.EQUATES
+$insert ACTION_SETUP
+$insert WEB_ACCOUNTS_EQUATES
+
+Declare function    SRP_DateTime
+
+If KeyID then GoSub Initialize_System_Variables
+
+Begin Case
+
+    Case Action _EQC 'CalculateColumn'      ;   GoSub CalculateColumn
+    Case Action _EQC 'READ_RECORD_PRE'      ;   GoSub READ_RECORD_PRE
+    Case Action _EQC 'READ_RECORD'          ;   GoSub READ_RECORD
+    Case Action _EQC 'READONLY_RECORD_PRE'  ;   GoSub READONLY_RECORD_PRE
+    Case Action _EQC 'READONLY_RECORD'      ;   GoSub READONLY_RECORD
+    Case Action _EQC 'WRITE_RECORD_PRE'     ;   GoSub WRITE_RECORD_PRE
+    Case Action _EQC 'WRITE_RECORD'         ;   GoSub WRITE_RECORD
+    Case Action _EQC 'DELETE_RECORD_PRE'    ;   GoSub DELETE_RECORD_PRE
+    Case Action _EQC 'DELETE_RECORD'        ;   GoSub DELETE_RECORD
+    Case Otherwise$                         ;   Status = 'Invalid Action'
+
+End Case
+
+If KeyID then GoSub Restore_System_Variables
+
+Return ActionFlow OR ACTION_CONTINUE$
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Calculated Columns 
+//
+// The typical structure of a calculated column will look like this:
+//
+// Declare function Database_Services
+//
+// @ANS = Database_Services('CalculatedColumn')
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+CalculateColumn:
+
+    // Make sure the ActionFlow return variable is cleared in case nothing is calculated.
+    ActionFlow = ''
+
+    Begin Case
+        Case CalcColName EQ 'CURRENT_PASSWORD_CREATED'  ; GoSub CURRENT_PASSWORD_CREATED
+        Case CalcColName EQ 'CURRENT_PASSWORD_EXPIRES'  ; GoSub CURRENT_PASSWORD_EXPIRES
+    End Case
+
+return
+
+
+CURRENT_PASSWORD_CREATED:
+
+    Created     = Iconv(Oconv({CURRENT_PASSWORD_CREATE_DATE}, 'D4/') : ' ' : Oconv({CURRENT_PASSWORD_CREATE_TIME}, 'MTS'), 'DTS')
+    Created     = SRP_DateTime('Format', SRP_DateTime('ToUTC', Created), "DDD, DD MMM YYYY hh:mm:ss 'GMT'")
+    ActionFlow  = Created
+
+return
+
+
+CURRENT_PASSWORD_EXPIRES:
+
+    Expires     = Iconv(Oconv({CURRENT_PASSWORD_EXPIRE_DATE}, 'D4/') : ' ' : Oconv({CURRENT_PASSWORD_EXPIRE_TIME}, 'MTS'), 'DTS')
+    Expires     = SRP_DateTime('Format', SRP_DateTime('ToUTC', Expires), "DDD, DD MMM YYYY hh:mm:ss 'GMT'")
+    ActionFlow  = Expires
+
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// MFS Actions
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+READ_RECORD_PRE:
+    // In order to stop a record from being read in this action these lines of code must be used:
+    //
+    //    OrigFileError   = 100 : @FM : KeyID
+    //    Status          = 0
+    //    Record          = ''
+    //    ActionFlow      = ACTION_STOP$
+return
+
+
+READ_RECORD:
+    // In order to stop a record from being read in this action these lines of code must be used:
+    //
+    //    OrigFileError   = 100 : @FM : KeyID
+    //    Status          = 0
+    //    Record          = ''
+return
+
+
+READONLY_RECORD_PRE:
+    // In order to stop a record from being read in this action these lines of code must be used:
+    //
+    //    OrigFileError   = 100 : @FM : KeyID
+    //    Status          = 0
+    //    Record          = ''
+    //    ActionFlow      = ACTION_STOP$
+return
+
+
+READONLY_RECORD:
+    // In order to stop a record from being read in this action these lines of code must be used:
+    //
+    //    OrigFileError   = 100 : @FM : KeyID
+    //    Status          = 0
+    //    Record          = ''
+return
+
+
+WRITE_RECORD_PRE:
+return
+
+
+WRITE_RECORD:
+return
+
+
+DELETE_RECORD_PRE:
+return
+
+
+DELETE_RECORD:
+return
+
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+// Internal GoSubs
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+Initialize_System_Variables:
+
+    // Save these for restoration later
+    SaveDict        = @DICT
+    SaveID          = @ID
+    SaveRecord      = @RECORD
+    OrigFileError   = @FILE.ERROR
+
+    // Now make sure @DICT, ID, and @RECORD are populated
+    CurrentDictName = ''
+    If @DICT then
+        DictHandle = @DICT<1, 2>
+        Locate DictHandle in @TABLES(5) Using @FM Setting fPos then
+            CurrentDictName = Field(@TABLES(0), @FM, fPos, 1)
+        end
+    end
+
+    If CurrentDictName NE DictName then
+         Open DictName to @DICT else Status = 'Unable to initialize @DICT'
+    end    
+
+    @ID = KeyID
+    If Record else
+        // Record might not have been passed in. Read the record from the database table just to make sure.
+        @FILE.ERROR     = ''
+        Open TableName to hTable then
+            FullFSList  = hTable[1, 'F' : @VM]
+            BFS         = FullFSList[-1, 'B' : @SVM]
+            LastHandle  = hTable[-1, 'B' : \0D\]
+            FileHandle  = \0D\ : LastHandle[1, @VM]
+
+            Call @BFS(READO.RECORD, BFS, FileHandle, KeyID, FMC, Record, ReadOStatus)
+        end
+    end
+    @RECORD = Record
+
+return
+
+
+Restore_System_Variables:
+
+    Transfer SaveDict   to @DICT
+    Transfer SaveID     to @ID
+    Transfer SaveRecord to @RECORD
+    @FILE.ERROR = OrigFileError
+
+return