Skip to content

Commit

Permalink
Merge branch 'makelinuxinstallscript' of https://github.com/costateix…
Browse files Browse the repository at this point in the history 
…eira/fhirserver into makelinuxinstallscript
  • Loading branch information
@costateixeira
costateixeira committed Sep 21, 2024
2 parents 0d2eaa9 + 09c7505 commit 89b6475
Show file tree
Hide file tree
Showing 4 changed files with 41 additions and 21 deletions.
8 changes: 7 additions & 1 deletion library/fhir/fhir_objects.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -162,7 +162,13 @@ EFHIRException = class (EFslException)
Constructor Create(place : String);
End;

ETooCostly = class (EFHIRException);
ETooCostly = class (EFHIRException)
private
FDiagnostics : String;
public
property Diagnostics : String read FDiagnostics write FDiagnostics;
end;

EFinished = class (EFHIRException);
EUnsafeOperation = class (EFHIRException);
EDefinitionException = class (EFHIRException);
Expand Down
14 changes: 11 additions & 3 deletions library/fhir/fhir_tx.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -214,7 +214,9 @@ TTerminologyWorker = class (TFslObject)
FParams : TFHIRTxOperationParams;
FRequiredSupplements : TStringList;

function costDiags(e : ETooCostly) : ETooCostly;
function sizeInBytesV(magic : integer) : cardinal; override;
function vsHandle : TFHIRValueSetW; virtual; abstract;
procedure deadCheck(place : String); virtual;
function findInAdditionalResources(url, version, resourceType : String; error : boolean) : TFHIRMetadataResourceW;
function findCodeSystem(url, version : String; params : TFHIRTxOperationParams; kinds : TFhirCodeSystemContentModeSet; nullOk : boolean) : TCodeSystemProvider;
Expand Down Expand Up @@ -318,7 +320,7 @@ procedure TTerminologyOperationContext.addNote(vs : TFHIRValueSetW; note: String
var
s : string;
begin
s := vs.vurl+': '+note;
s := DescribePeriodMS(GetTickCount64 - FStartTime)+' '+vs.vurl+': '+note;
Logging.log(s);
FNotes.add(s);
end;
Expand Down Expand Up @@ -511,6 +513,12 @@ function TTerminologyWorker.findCodeSystem(url, version: String; params: TFHIRTx
end;
end;

function TTerminologyWorker.costDiags(e: ETooCostly): ETooCostly;
begin
e.diagnostics := FOpContext.notes;
result := e;
end;

function TTerminologyWorker.sizeInBytesV(magic : integer) : cardinal;
begin
result := inherited sizeInBytesV(magic);
Expand All @@ -526,8 +534,8 @@ procedure TTerminologyWorker.deadCheck(place: String);
SetThreadStatus(ClassName+'.'+place);
if FOpContext.deadCheck(time) then
begin
logging.log('Operation took too long ('+className+')');
raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_TIME', FParams.HTTPlanguages, ['??', inttostr(time)]));
FOpContext.addNote(vsHandle, 'Operation took too long @ '+place+' ('+className+')');
raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_TIME', FParams.HTTPlanguages, ['??', inttostr(time)])));
end;
end;

Expand Down
32 changes: 19 additions & 13 deletions library/ftx/fhir_valuesets.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -100,6 +100,7 @@ TValueSetWorker = class (TTerminologyWorker)
FAllAltCodes : TAlternateCodeOptions;

procedure seeValueSet(vs : TFHIRValueSetW);
function vsHandle : TFHIRValueSetW; override;

function sizeInBytesV(magic : integer) : cardinal; override;
procedure listDisplays(displays : TConceptDesignations; cs : TCodeSystemProvider; c: TCodeSystemProviderContext); overload;
Expand Down Expand Up @@ -315,6 +316,11 @@ procedure TValueSetWorker.seeValueSet(vs: TFHIRValueSetW);
FParams.HTTPLanguages := THTTPLanguageList.create(vs.language, not isValidating);
end;

function TValueSetWorker.vsHandle: TFHIRValueSetW;
begin
result := FValueSet;
end;

function TValueSetWorker.findValueSet(url, version: String): TFHIRValueSetW;
var
r : TFHIRMetadataResourceW;
Expand Down Expand Up @@ -2548,7 +2554,7 @@ function TFHIRValueSetExpander.expand(source: TFHIRValueSetW;

if (offset + count < 0) and (FFullList.count > limit) then
begin
raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_COUNT', FParams.HTTPLanguages, [source.vurl, '>'+inttostr(limit), inttostr(FFullList.count)]));
raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_COUNT', FParams.HTTPLanguages, [source.vurl, '>'+inttostr(limit), inttostr(FFullList.count)])));
end
else
begin
Expand Down Expand Up @@ -2834,7 +2840,7 @@ procedure TValueSetWorker.deadCheck(place: String);
{$ELSE}
logging.log('Expansion took too long');
{$ENDIF}
raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_TIME', FParams.HTTPLanguages, [FValueSet.vurl, inttostr(time)]));
raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY_TIME', FParams.HTTPLanguages, [FValueSet.vurl, inttostr(time)])));
end;
end;

Expand Down Expand Up @@ -3013,7 +3019,7 @@ function TFHIRValueSetExpander.includeCode(cs : TCodeSystemProvider; parent : TF
begin
if (srcUrl = '') then
srcUrl := '??';
raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [srcUrl, '>'+inttostr(FLimitCount)]));
raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [srcUrl, '>'+inttostr(FLimitCount)])));
end;
end;

Expand Down Expand Up @@ -3211,7 +3217,7 @@ procedure TFHIRValueSetExpander.excludeCode(cs : TCodeSystemProvider; system, ve
begin
if (srcUrl = '') then
srcUrl := '??';
raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [srcUrl, '>'+inttostr(FLimitCount)]));
raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [srcUrl, '>'+inttostr(FLimitCount)])));
end;
end;

Expand Down Expand Up @@ -3377,12 +3383,12 @@ procedure TFHIRValueSetExpander.checkSource(cset: TFhirValueSetComposeIncludeW;
begin
if cs.isNotClosed(filter) then
if cs.SpecialEnumeration <> '' then
raise ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned')
raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned'))
else
raise ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly');
raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly'));

if not imp and (FLimitCount > 0) and (cs.TotalCount > FLimitCount) and not (FParams.limitedExpansion) then
raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [srcUrl, '>'+inttostr(FLimitCount)]));
raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [srcUrl, '>'+inttostr(FLimitCount)])));
end
end;

Expand Down Expand Up @@ -3524,14 +3530,14 @@ procedure TFHIRValueSetExpander.includeCodes(cset: TFhirValueSetComposeIncludeW;
begin
if cs.isNotClosed(filter) then
if cs.SpecialEnumeration <> '' then
raise ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned')
raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned'))
else
raise ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly');
raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly'));

iter := cs.getIterator(nil);
try
if valueSets.Empty and (FLimitCount > 0) and (iter.count > FLimitCount) and not (FParams.limitedExpansion) then
raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [vsSrc.url, '>'+inttostr(FLimitCount)]));
raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [vsSrc.url, '>'+inttostr(FLimitCount)])));
tcount := 0;
while iter.more do
begin
Expand Down Expand Up @@ -3846,14 +3852,14 @@ procedure TFHIRValueSetExpander.excludeCodes(cset: TFhirValueSetComposeIncludeW;
begin
if cs.isNotClosed(filter) then
if cs.SpecialEnumeration <> '' then
raise ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned')
raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly. If an incomplete expansion is requested, a limited enumeration will be returned'))
else
raise ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly');
raise costDiags(ETooCostly.create('The code System "'+cs.systemUri+'" has a grammar, and cannot be enumerated directly'));

iter := cs.getIterator(nil);
try
if valueSets.Empty and (FLimitCount > 0) and (iter.count > FLimitCount) and not (FParams.limitedExpansion) then
raise ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [vsSrc.url, '>'+inttostr(FLimitCount)]));
raise costDiags(ETooCostly.create(FI18n.translate('VALUESET_TOO_COSTLY', FParams.HTTPLanguages, [vsSrc.url, '>'+inttostr(FLimitCount)])));
while iter.more do
begin
deadCheck('processCodes#3a');
Expand Down
8 changes: 4 additions & 4 deletions server/endpoint_storage.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -170,7 +170,7 @@ TStorageWebEndpoint = class (TFhirWebServerEndpoint)
sCookie, provenance, sBearer: String; oPostStream: TStream; oResponse: TFHIRResponse; var aFormat: TFHIRFormat; var redirect: boolean; form: TMimeMessage;
bAuth, secure: boolean; out relativeReferenceAdjustment: integer; var style : TFHIROutputStyle; Session: TFHIRSession; cert: TIdOpenSSLX509; tt : TTimeTracker): TFHIRRequest;
Procedure ProcessOutput(start : UInt64; oRequest: TFHIRRequest; oResponse: TFHIRResponse; request: TIdHTTPRequestInfo; response: TIdHTTPResponseInfo; relativeReferenceAdjustment: integer; style : TFHIROutputStyle; gzip, cache: boolean; summary : String);
procedure SendError(response: TIdHTTPResponseInfo; logid : string; status: word; format: TFHIRFormat; langList : THTTPLanguageList; message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType);
procedure SendError(response: TIdHTTPResponseInfo; logid : string; status: word; format: TFHIRFormat; langList : THTTPLanguageList; message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType; diagnostics : String = '');
function processProvenanceHeader(header : String; langList : THTTPLanguageList): TFhirProvenanceW;
function EncodeVersionsJson(r: TFHIRResourceV): TBytes;
function EncodeVersionsXml(r: TFHIRResourceV): TBytes;
Expand Down Expand Up @@ -1562,10 +1562,10 @@ function TStorageWebEndpoint.HandleRequest(AContext: TIdContext; request: TIdHTT
begin
result := result + ' (msg: Too-Costly)';
if noErrCode then
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itTooCostly)
SendError(response, logId, 200, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment, itTooCostly, e.Diagnostics)
else
SendError(response, logId, HTTP_ERR_BUSINESS_RULES_FAILED, aFormat, langList, e.message, sPath, e, Session, false, path, relativeReferenceAdjustment,
itTooCostly);
itTooCostly, e.Diagnostics);
end;
on e: ERestfulException do
begin
Expand Down Expand Up @@ -2241,7 +2241,7 @@ procedure TStorageWebEndpoint.ProcessOutput(start: UInt64;
end;

procedure TStorageWebEndpoint.SendError(response: TIdHTTPResponseInfo; logid: string; status: word; format: TFHIRFormat; langList : THTTPLanguageList;
message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType);
message, url: String; e: exception; Session: TFHIRSession; addLogins: boolean; path: String; relativeReferenceAdjustment: integer; code: TFHIRIssueType; diagnostics : String);
var
issue: TFhirOperationOutcomeW;
oComp: TFHIRComposer;
Expand Down

0 comments on commit 89b6475

Please sign in to comment.