Support authentication on the tx-registry servers

HealthIntersections · Oct 17, 2024 · 350e8ec · 350e8ec
1 parent 60e665e
commit 350e8ec
Show file tree

Hide file tree

Showing 4 changed files with 27 additions and 13 deletions.
diff --git a/library/web/fsl_fetcher.pas b/library/web/fsl_fetcher.pas
@@ -134,7 +134,11 @@ procedure TInternetFetcher.Fetch;
   oFtp : TIdFTP;
 begin
   if StringStartsWith(url, 'file:') Then
+  begin
+    if (url.contains('?')) then
+      url := url.substring(0, url.indexof('?'));
     FBuffer.LoadFromFileName(Copy(url, 6, $FFFF))
+  end
   else
   Begin
     oUri := TIdURI.Create(url);

diff --git a/server/endpoint_txregistry.pas b/server/endpoint_txregistry.pas
@@ -40,7 +40,7 @@ interface
   tx_registry_spider, tx_registry_model,
 
   server_config, utilities, telnet_server,
-  tx_manager, time_tracker, kernel_thread, server_stats,
+  tx_manager,  kernel_thread, server_stats,
   web_event, web_base, endpoint, session;
 
 const
@@ -100,8 +100,8 @@   TFHIRTxRegistryWebServer = class (TFhirWebServerEndpoint)
     property NextScan : TDateTime read FNextScan write FNextScan;
     property scanning : boolean read FScanning write SetScanning;
 
-    function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String; override;
-    function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TTimeTracker) : String; override;
+    function PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String; override;
+    function SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; cert : TIdOpenSSLX509; id : String; tt : TFslTimeTracker) : String; override;
     function logId : string; override;
   end;
 
@@ -303,7 +303,7 @@ procedure TTxRegistryUpdaterThread.RunUpdater;
   upd : TTxRegistryScanner;
   new, existing : TServerRegistries;
 begin
-  upd := TTxRegistryScanner.Create(FZulip.link);
+  upd := TTxRegistryScanner.Create(FZulip.link, FEndPoint.Settings.Ini.admin.link);
   try
     upd.address := FEndPoint.FAddress;
     upd.OnSendEmail := doSendEmail;
@@ -769,7 +769,7 @@ function TFHIRTxRegistryWebServer.logId: string;
   result := 'TXR';
 end;
 
-function TFHIRTxRegistryWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TTimeTracker) : String;
+function TFHIRTxRegistryWebServer.PlainRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : String; tt : TFslTimeTracker) : String;
 begin
   countRequest;
   result := doRequest(AContext, request, response, id, false);
@@ -832,7 +832,7 @@ function TFHIRTxRegistryWebServer.doRequest(AContext: TIdContext; request: TIdHT
   end;
 end;
 
-function TFHIRTxRegistryWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo;  cert: TIdOpenSSLX509; id: String; tt : TTimeTracker): String;
+function TFHIRTxRegistryWebServer.SecureRequest(AContext: TIdContext; ip : String; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo;  cert: TIdOpenSSLX509; id: String; tt : TFslTimeTracker): String;
 begin
   countRequest;
   result := doRequest(AContext, request, response, id, true);

diff --git a/server/web_server.pas b/server/web_server.pas
@@ -96,7 +96,7 @@
   scim_server,
   auth_manager, reverse_client, cds_hooks_server, web_source, analytics, bundlebuilder, server_factory,
   user_manager, server_context, server_constants, utilities, jwt, usage_stats,
-  subscriptions, twilio, time_tracker,
+  subscriptions, twilio, 
   web_base, endpoint, endpoint_storage;
 
 Type
@@ -224,7 +224,7 @@   TFHIRWebServerExtension = class abstract (TFHIRPathEngineExtension)
 
     Procedure PlainRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo);
     Procedure SecureRequest(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo);
-    Procedure logOutput(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : string; tt : TTimeTracker; secure : boolean; epn, summ : string);
+    Procedure logOutput(AContext: TIdContext; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id : string; tt : TFslTimeTracker; secure : boolean; epn, summ : string);
 
     Procedure StartServer();
     Procedure StopServer;
@@ -745,7 +745,7 @@ function letterForOp(request : TIdHTTPRequestInfo) : String;
 
 procedure TFhirWebServer.logOutput(AContext: TIdContext;
   request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; id: string;
-  tt: TTimeTracker; secure: boolean; epn, summ: string);
+  tt: TFslTimeTracker; secure: boolean; epn, summ: string);
   function mimeType(mt : String) : String;
   var
     f : TFHIRFormat;
@@ -802,7 +802,7 @@ procedure TFhirWebServer.PlainRequest(AContext: TIdContext;
   ep : TFhirWebServerEndpoint;
   ok : boolean;
   epn, cid, ip : String;
-  tt : TTimeTracker;
+  tt : TFslTimeTracker;
   ci : TFHIRHTTPConnectionInfo;
 begin
   ci := TFHIRHTTPConnectionInfo.create(request, AContext);
@@ -821,7 +821,7 @@ procedure TFhirWebServer.PlainRequest(AContext: TIdContext;
     begin
       ip := getClientIP(AContext, request);
       ci.FClientIP := ip;
-      tt := TTimeTracker.Create;
+      tt := TFslTimeTracker.Create;
       try
         InterlockedIncrement(GCounterWebRequests);
         SetThreadStatus('Processing '+request.Document);
@@ -993,7 +993,7 @@ procedure TFhirWebServer.SecureRequest(AContext: TIdContext;
 var
   cert: TIdOpenSSLX509;
   id, summ : String;
-  tt : TTimeTracker;
+  tt : TFslTimeTracker;
   ok : boolean;
   ep: TFhirWebServerEndpoint;
   epn, ip: String;
@@ -1013,7 +1013,7 @@ procedure TFhirWebServer.SecureRequest(AContext: TIdContext;
     begin
       ip := getClientIP(AContext, request);
       ci.FClientIP := ip;
-      tt := TTimeTracker.Create;
+      tt := TFslTimeTracker.Create;
       try
         InterlockedIncrement(GCounterWebRequests);
         cert := nil; // (AContext.Connection.IOHandler as TIdSSLIOHandlerSocketOpenSSL).SSLSocket.PeerCert;

diff --git a/server/zero_config.pas b/server/zero_config.pas
@@ -215,6 +215,7 @@ procedure TConfigurationBuilder.buildConfig(fn: String; local : TCustomIniFile);
   sct : TFHIRServerConfigSection;
   ep, o : TJsonObject;
   lwi, mode : String;
+  ts : TStringList;
 begin
   rn := 1;
   if FileExists(fn) then
@@ -259,6 +260,15 @@ procedure TConfigurationBuilder.buildConfig(fn: String; local : TCustomIniFile);
     cfg.service['package-cache'].value := ExtractFilePath(fn);
     cfg.admin['scim-salt'].value := NewGuidId;
 
+    ts := TStringList.create;
+    try
+      local.ReadSection('server-auth', ts);
+      for n in ts do
+        cfg.admin[n].value := local.ReadString('server-auth', n, '');
+    finally
+      ts.free;
+    end;
+
     for n in FFiles.Keys do
     begin
       sct := cfg.section['terminologies'].section[PathTitle(n)];