unit ProbeDecision; {$mode objfpc}{$H+}{$codepage utf8} {$ifndef ANDROID}{$fatal Decision probes are Android-only}{$endif} interface uses ProbeReport; procedure RunDecisionChecks(Report:TProbeReport;const WorkDir:string); implementation uses Classes,SysUtils,fpjson,jsonparser,CastleDownload,CastleFilesUtils; procedure WriteAscii(const Name,Value:string); var F:TFileStream; A:AnsiString; begin A:=AnsiString(Value);F:=TFileStream.Create(Name,fmCreate); try if Length(A)>0 then F.WriteBuffer(A[1],Length(A));finally F.Free;end; end; function ReadAscii(const Name:string):string; var F:TFileStream; A:AnsiString; begin Result:='';F:=TFileStream.Create(Name,fmOpenRead or fmShareDenyWrite); try SetLength(A,F.Size);if Length(A)>0 then F.ReadBuffer(A[1],Length(A));Result:=string(A);finally F.Free;end; end; procedure ProbeRenameReplace(Report:TProbeReport;const WorkDir:string); var Target,Temp,Detail:string; Ok:Boolean; begin Target:=WorkDir+'decision-rename-target.txt';Temp:=Target+'.tmp'; try WriteAscii(Target,'old');WriteAscii(Temp,'new'); Ok:=RenameFile(Temp,Target); if Ok then Ok:=(ReadAscii(Target)='new') and not FileExists(Temp); Detail:='replace_existing=' + LowerCase(BoolToStr(Ok,True)); if (not Ok) and FileExists(Temp) then DeleteFile(Temp); Report.Add('decision.persistence.rename_replace','OBSERVED',Detail); except on E:Exception do Report.Add('decision.persistence.rename_replace','OBSERVED','replace_existing=false; error='+E.ClassName+': '+E.Message); end; end; procedure ProbeAppend(Report:TProbeReport;const WorkDir:string); var Name:string;F:TFileStream;A:AnsiString;Ok:Boolean; procedure Append(const S:AnsiString); begin F:=TFileStream.Create(Name,fmOpenReadWrite or fmShareDenyNone); try F.Position:=F.Size;if Length(S)>0 then F.WriteBuffer(S[1],Length(S));finally F.Free;end; end; begin Name:=WorkDir+'decision-append.log'; try WriteAscii(Name,'A'+LineEnding);Append('B'+LineEnding);Append('C'+LineEnding); A:=AnsiString(ReadAscii(Name)); Ok:=A=AnsiString('A'+LineEnding+'B'+LineEnding+'C'+LineEnding); Report.Add('decision.persistence.append_reopen','OBSERVED', 'append_reopen_ordered='+LowerCase(BoolToStr(Ok,True))+'; bytes='+IntToStr(Length(A))); except on E:Exception do Report.Add('decision.persistence.append_reopen','OBSERVED','append_reopen_ordered=false; error='+E.ClassName+': '+E.Message); end; end; function FirstAsset(out Rel,Url:string;out Expected:Int64):Boolean; var Manifest:TJSONData;Files:TJSONArray; begin Result:=False;Rel:='';Url:='';Expected:=-1; Manifest:=GetJSON(FileToString('castle-data:/assets-manifest.json')); try Files:=TJSONObject(Manifest).Arrays['files']; if Files.Count=0 then Exit; Rel:=Files.Objects[0].Strings['path']; Url:=Files.Objects[0].Strings['url']; Expected:=Files.Objects[0].Int64s['size']; Result:=True; finally Manifest.Free;end; end; procedure ProbeCastleStream(Report:TProbeReport); var S:TStream;Rel,Url:string;Expected,SizeValue:Int64;N:Integer;B:array[0..31] of Byte;SizeOk,SeekOk:Boolean; begin if not FirstAsset(Rel,Url,Expected) then begin Report.Add('decision.fixture.castle_stream','NOT_RUN','No server fixture selected; pass --assets and --asset-path');Exit; end; SizeOk:=False;SeekOk:=False;SizeValue:=-1; try S:=Download(Url); try try SizeValue:=S.Size;SizeOk:=SizeValue=Expected;except SizeOk:=False;end; try if Expected>SizeOf(B) then S.Position:=Expected div 2 else S.Position:=0; N:=S.Read(B,SizeOf(B));SeekOk:=N>0; except SeekOk:=False;end; finally S.Free;end; Report.Add('decision.fixture.castle_stream','OBSERVED', Format('path=%s; expected_size=%d; size=%d; size_matches=%s; seek_read=%s', [Rel,Expected,SizeValue,LowerCase(BoolToStr(SizeOk,True)),LowerCase(BoolToStr(SeekOk,True))])); except on E:Exception do Report.Add('decision.fixture.castle_stream','OBSERVED','path='+Rel+'; open=false; error='+E.ClassName+': '+E.Message); end; end; procedure ProbeMaterialize(Report:TProbeReport;const WorkDir:string); var S:TStream;F:TFileStream;Rel,Url,Name:string;Expected:Int64;Ok:Boolean; begin if not FirstAsset(Rel,Url,Expected) then begin Report.Add('decision.fixture.materialized_native_path','NOT_RUN','No server fixture selected; pass --assets and --asset-path');Exit; end; Name:=WorkDir+'decision-materialized.dat';Ok:=False; try S:=Download(Url); try F:=TFileStream.Create(Name,fmCreate); try F.CopyFrom(S,0);finally F.Free;end; finally S.Free;end; F:=TFileStream.Create(Name,fmOpenRead or fmShareDenyWrite); try Ok:=F.Size=Expected;finally F.Free;end; Report.Add('decision.fixture.materialized_native_path','OBSERVED', 'source='+Rel+'; supported='+LowerCase(BoolToStr(Ok,True))+'; native_path='+Name+'; bytes='+IntToStr(Expected)); except on E:Exception do Report.Add('decision.fixture.materialized_native_path','OBSERVED','source='+Rel+'; supported=false; error='+E.ClassName+': '+E.Message); end; end; procedure RunDecisionChecks(Report:TProbeReport;const WorkDir:string); begin ProbeRenameReplace(Report,WorkDir); ProbeAppend(Report,WorkDir); ProbeCastleStream(Report); ProbeMaterialize(Report,WorkDir); end; end.