kam-mobile/code/ProbeDecision.pas

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.