Skip to content

Commit

Permalink
tx-registry robustness work
Browse files Browse the repository at this point in the history
  • Loading branch information
Grahame Grieve committed Jan 12, 2024
1 parent 21b1109 commit 234f48d
Show file tree
Hide file tree
Showing 4 changed files with 142 additions and 82 deletions.
175 changes: 101 additions & 74 deletions server/endpoint_txregistry.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -298,19 +298,31 @@ procedure TTxRegistryUpdaterThread.doSendEmail(dest, subj, body : String);
procedure TTxRegistryUpdaterThread.RunUpdater;
var
upd : TTxRegistryScanner;
info : TServerRegistries;
new, existing : TServerRegistries;
begin
upd := TTxRegistryScanner.Create(FZulip.link);
try
upd.address := FEndPoint.FAddress;
upd.OnSendEmail := doSendEmail;
try
info := TServerRegistries.Create;
existing := FEndPoint.FTxRegistryServer.FInfo;
new := TServerRegistries.Create;
try
upd.update(FEndPoint.FTxRegistryServer.code, info);
FEndPoint.FTxRegistryServer.FInfo.update(info);
existing.Lock('start');
try
existing.Outcome := 'Processing Now';
finally
existing.Unlock;
end;
upd.update(FEndPoint.FTxRegistryServer.code, new);
existing.Lock('merge');
try
existing.update(new);
finally
existing.Unlock;
end;
finally
info.free;
new.free;
end;
if (TFslDateTime.makeToday.DateTime <> FLastEmail) then
begin
Expand Down Expand Up @@ -540,37 +552,42 @@ function TFHIRTxRegistryWebServer.resolveCS(version, cs, usage: String; var matc
try
result.str['formatVersion'] := '1';
result.str['registry-url'] := FInfo.address;
for reg in FInfo.Registries do
for srvr in reg.Servers do
begin
added := false;
if (srvr.UsageList.Count = 0) or (srvr.UsageList.IndexOf(usage) > -1) then
FInfo.Lock('search');
try
for reg in FInfo.Registries do
for srvr in reg.Servers do
begin
if (srvr.isAuthCS(cs)) then
added := false;
if (srvr.UsageList.Count = 0) or (srvr.UsageList.IndexOf(usage) > -1) then
begin
for ver in srvr.Versions do
if (srvr.isAuthCS(cs)) then
begin
if TSemanticVersion.matches(version, ver.version, semverAuto) then
if TServerRegistryUtilities.hasMatchingCodeSystem(cs, ver.CodeSystems, false) then
begin
populate(result.forceArr['authoritative'].addObject, srvr, ver);
added := true;
end;
for ver in srvr.Versions do
begin
if TSemanticVersion.matches(version, ver.version, semverAuto) then
if TServerRegistryUtilities.hasMatchingCodeSystem(cs, ver.CodeSystems, false) then
begin
populate(result.forceArr['authoritative'].addObject, srvr, ver);
added := true;
end;
end;
end
else
begin
for ver in srvr.Versions do
if TSemanticVersion.matches(version, ver.version, semverAuto) then
if TServerRegistryUtilities.hasMatchingCodeSystem(cs, ver.CodeSystems, false) then
begin
populate(result.forceArr['candidates'].addObject, srvr, ver);
added := true;
end;
end;
end
else
begin
for ver in srvr.Versions do
if TSemanticVersion.matches(version, ver.version, semverAuto) then
if TServerRegistryUtilities.hasMatchingCodeSystem(cs, ver.CodeSystems, false) then
begin
populate(result.forceArr['candidates'].addObject, srvr, ver);
added := true;
end;
if (added) then
CommaAdd(matches, srvr.Code);
end;
if (added) then
CommaAdd(matches, srvr.Code);
end;
finally
FInfo.Unlock;
end;
result.link;
finally
Expand Down Expand Up @@ -598,38 +615,43 @@ function TFHIRTxRegistryWebServer.resolveVS(version, vs, usage: String;
try
result.str['formatVersion'] := '1';
result.str['registry-url'] := FInfo.address;
for reg in FInfo.Registries do
for srvr in reg.Servers do
begin
added := false;
if (srvr.UsageList.Count = 0) or (srvr.UsageList.IndexOf(usage) > -1) then
FInfo.Lock('search');
try
for reg in FInfo.Registries do
for srvr in reg.Servers do
begin
if (srvr.isAuthVS(vs)) then
added := false;
if (srvr.UsageList.Count = 0) or (srvr.UsageList.IndexOf(usage) > -1) then
begin
for ver in srvr.Versions do
if (srvr.isAuthVS(vs)) then
begin
if TSemanticVersion.matches(version, ver.version, semverAuto) then
if TServerRegistryUtilities.hasMatchingValueSet(vs, ver.ValueSets, false) then
begin
populate(result.forceArr['authoritative'].addObject, srvr, ver);
added := true;
end;
for ver in srvr.Versions do
begin
if TSemanticVersion.matches(version, ver.version, semverAuto) then
if TServerRegistryUtilities.hasMatchingValueSet(vs, ver.ValueSets, false) then
begin
populate(result.forceArr['authoritative'].addObject, srvr, ver);
added := true;
end;
end;
end
else
begin
for ver in srvr.Versions do
if TSemanticVersion.matches(version, ver.version, semverAuto) then
if TServerRegistryUtilities.hasMatchingValueSet(vs, ver.ValueSets, false) then
begin
populate(result.forceArr['candidates'].addObject, srvr, ver);
added := true;
end;
end;
end
else
begin
for ver in srvr.Versions do
if TSemanticVersion.matches(version, ver.version, semverAuto) then
if TServerRegistryUtilities.hasMatchingValueSet(vs, ver.ValueSets, false) then
begin
populate(result.forceArr['candidates'].addObject, srvr, ver);
added := true;
end;
if (added) then
CommaAdd(matches, srvr.Code);
end;
if (added) then
CommaAdd(matches, srvr.Code);
end;
end;
finally
FInfo.Unlock;
end;
result.link;
finally
result.free;
Expand All @@ -645,30 +667,35 @@ function TFHIRTxRegistryWebServer.renderInfo: String;
s : TServerInformation;
v : TServerVersionInformation;
begin
b := TFslStringBuilder.create();
FInfo.Lock('render');
try
b.Append('<table class="grid">');
b.append('<tr><td width="130px"><img src="/assets/images/tx-registry-root.gif">&nbsp;Registries</td><td>'+FInfo.Address+' ('+FormatTextToHTML(FInfo.Outcome)+')</td></tr>');
for r in FInfo.Registries do
begin
if (r.error <> '') then
b.append('<tr><td title='+FormatTextToHTML(r.Name)+'">&nbsp;<img src="/assets/images/tx-registry.png">&nbsp;'+r.Code+'</td><td><a href="'+FormatTextToHTML(r.Address)+'">'+FormatTextToHTML(r.Address)+'</a>. Error: '+FormatTextToHTML(r.Error)+'</td></tr>')
else
b.append('<tr><td title='+FormatTextToHTML(r.Name)+'">&nbsp;&nbsp;<img src="/assets/images/tx-registry.png">&nbsp;'+r.Code+'</td><td><a href="'+FormatTextToHTML(r.Address)+'">'+FormatTextToHTML(r.Address)+'</a></td></tr>');
for s in r.Servers do
b := TFslStringBuilder.create();
try
b.Append('<table class="grid">');
b.append('<tr><td width="130px"><img src="/assets/images/tx-registry-root.gif">&nbsp;Registries</td><td>'+FInfo.Address+' ('+FormatTextToHTML(FInfo.Outcome)+')</td></tr>');
for r in FInfo.Registries do
begin
if (s.AuthCSList.Count > 0) or (s.AuthVSList.Count > 0) or (s.UsageList.count > 0) then
b.append('<tr><td title='+FormatTextToHTML(s.Name)+'">&nbsp;&nbsp;&nbsp;&nbsp;<img src="/assets/images/tx-server.png">&nbsp;'+s.Code+'</td><td><a href="'+FormatTextToHTML(s.Address)+'">'+FormatTextToHTML(s.Address)+'</a>. '+s.details+'</td></tr>')
if (r.error <> '') then
b.append('<tr><td title='+FormatTextToHTML(r.Name)+'">&nbsp;<img src="/assets/images/tx-registry.png">&nbsp;'+r.Code+'</td><td><a href="'+FormatTextToHTML(r.Address)+'">'+FormatTextToHTML(r.Address)+'</a>. Error: '+FormatTextToHTML(r.Error)+'</td></tr>')
else
b.append('<tr><td title='+FormatTextToHTML(s.Name)+'">&nbsp;&nbsp;&nbsp;&nbsp;<img src="/assets/images/tx-server.png">&nbsp;'+s.Code+'</td><td><a href="'+FormatTextToHTML(s.Address)+'">'+FormatTextToHTML(s.Address)+'</a></td></tr>');
for v in s.Versions do
b.append('<tr><td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<img src="/assets/images/tx-version.png">&nbsp;v'+TSemanticVersion.getMajMin(v.Version)+'</td><td><a href="'+FormatTextToHTML(v.Address)+'">'+FormatTextToHTML(v.Address)+'</a>. Status: '+FormatTextToHTML(v.Details)+'. '+inttostr(v.CodeSystems.Count)+' Items</td></tr>');
b.append('<tr><td title='+FormatTextToHTML(r.Name)+'">&nbsp;&nbsp;<img src="/assets/images/tx-registry.png">&nbsp;'+r.Code+'</td><td><a href="'+FormatTextToHTML(r.Address)+'">'+FormatTextToHTML(r.Address)+'</a></td></tr>');
for s in r.Servers do
begin
if (s.AuthCSList.Count > 0) or (s.AuthVSList.Count > 0) or (s.UsageList.count > 0) then
b.append('<tr><td title='+FormatTextToHTML(s.Name)+'">&nbsp;&nbsp;&nbsp;&nbsp;<img src="/assets/images/tx-server.png">&nbsp;'+s.Code+'</td><td><a href="'+FormatTextToHTML(s.Address)+'">'+FormatTextToHTML(s.Address)+'</a>. '+s.details+'</td></tr>')
else
b.append('<tr><td title='+FormatTextToHTML(s.Name)+'">&nbsp;&nbsp;&nbsp;&nbsp;<img src="/assets/images/tx-server.png">&nbsp;'+s.Code+'</td><td><a href="'+FormatTextToHTML(s.Address)+'">'+FormatTextToHTML(s.Address)+'</a></td></tr>');
for v in s.Versions do
b.append('<tr><td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<img src="/assets/images/tx-version.png">&nbsp;v'+TSemanticVersion.getMajMin(v.Version)+'</td><td><a href="'+FormatTextToHTML(v.Address)+'">'+FormatTextToHTML(v.Address)+'</a>. Status: '+FormatTextToHTML(v.Details)+'. '+inttostr(v.CodeSystems.Count)+' Items</td></tr>');
end;
end;
b.Append('</table>');
result := b.ToString;
finally
b.free;
end;
b.Append('</table>');
result := b.ToString;
finally
b.free;
FInfo.Unlock;
end;
end;

Expand Down
11 changes: 10 additions & 1 deletion server/server_constants.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@
POSSIBILITY OF SUCH DAMAGE.
}

{$i fhir.inc}

interface

Expand All @@ -45,7 +46,15 @@ interface

DEFAULT_DWELL_TIME_MIN = 30;
DEFAULT_DWELL_TIME = DEFAULT_DWELL_TIME_MIN / (24*60) {min};

{$IFDEF LINUX}
SERVER_OS = 'LINUX';
{$ENDIF}
{$IFDEF OSX}
SERVER_OS = 'OSX';
{$ENDIF}
{$IFDEF WINDOWS}
SERVER_OS = 'WINDOWS';
{$ENDIF}

implementation

Expand Down
33 changes: 27 additions & 6 deletions server/tx_registry_model.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ interface

uses
Classes, SysUtils,
fsl_base, fsl_json, fsl_utilities, fsl_versions;
fsl_base, fsl_json, fsl_utilities, fsl_versions, fsl_threads;

Type
TServerSecurity = (ssOpen, ssPassword, ssToken, ssOAuth, ssSmart, ssCert);
Expand Down Expand Up @@ -112,6 +112,7 @@ TServerRegistries = class (TFslObject)
FLastRun : TFslDateTime;
FOutcome : String;
FRegistries: TFslList<TServerRegistry>;
FLock : TFslLock;
public
constructor Create; override;
destructor Destroy; override;
Expand All @@ -121,7 +122,9 @@ TServerRegistries = class (TFslObject)
property LastRun : TFslDateTime read FLastRun write FLastRun;
property Outcome : String read FOutcome write FOutcome;
property Registries : TFslList<TServerRegistry> read FRegistries;

procedure Lock(name : String);
procedure UnLock;

function registry(code : String) : TServerRegistry;
procedure update(source : TServerRegistries);
end;
Expand Down Expand Up @@ -528,12 +531,17 @@ class function TServerRegistryUtilities.toJson(row: TServerRow): TJsonObject;

class function TServerRegistryUtilities.buildRows(info: TServerRegistries; regCode, srvrCode, version, tx: String): TFslList<TServerRow>;
begin
result := TFslList<TServerRow>.Create;
info.Lock('build');
try
buildRows(info, regCode, srvrCode, version, tx, result);
result.link;
result := TFslList<TServerRow>.Create;
try
buildRows(info, regCode, srvrCode, version, tx, result);
result.link;
finally
result.free;
end;
finally
result.free;
info.unlock;
end;
end;

Expand Down Expand Up @@ -569,6 +577,7 @@ constructor TServerRegistries.Create;

destructor TServerRegistries.Destroy;
begin
FLock.Free;
FRegistries.free;
inherited Destroy;
end;
Expand All @@ -578,6 +587,18 @@ function TServerRegistries.Link: TServerRegistries;
result := TServerRegistries(inherited link);
end;

procedure TServerRegistries.Lock(name: String);
begin
if (FLock = nil) then
FLock := TFslLock.create('ServerRegistries');
FLock.Lock(name);
end;

procedure TServerRegistries.UnLock;
begin
FLock.unlock;
end;

function TServerRegistries.registry(code: String): TServerRegistry;
var
t : TServerRegistry;
Expand Down
5 changes: 4 additions & 1 deletion server/tx_registry_spider.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -319,10 +319,12 @@ procedure TTxRegistryScanner.processServer(source : String; obj: TJsonObject; sr
procedure TTxRegistryScanner.processServerVersion(source: String; srvr: TServerInformation; obj: TJsonObject; ver: TServerVersionInformation);
var
v : TSemanticVersion;
d : TDateTime;
begin
try
ver.Address := obj.str['url'];
ver.Address := obj.str['url'];
Logging.log('Check on server '+ver.Address);
d := now;
ver.Security := [ssOpen];
v := TSemanticVersion.fromString(obj.str['version']);
try
Expand All @@ -339,6 +341,7 @@ procedure TTxRegistryScanner.processServerVersion(source: String; srvr: TServerI
ver.CodeSystems.sort;
ver.ValueSets.sort;
ver.LastSuccess := TFslDateTime.makeUTC;
Logging.log('Server '+ver.Address+': '+DescribePeriod(now - d)+' for '+inttostr(ver.CodeSystems.count)+' CodeSystems and '+inttostr(ver.ValueSets.count)+' ValueSets');
except
on e : Exception do
ver.Error := e.message;
Expand Down

0 comments on commit 234f48d

Please sign in to comment.