Initial import

code/ProbeDecision.pas

@@ -0,0 +1,120 @@
+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.