unit CodeSigning;

{$mode objfpc}{$H+}

{
   Code Signing on Windows, FreePascal unit by Jorg3000, 2023-06-25

   To get signtool.exe, download and install Windows SDK  https://go.microsoft.com/fwlink/?linkid=2237387
   In the installer deselect all options except "Windows SDK Signing Tools für Desktop Apps" (1.6 MB).
   After the installation search your Program Files folder for "signtool.exe"  =>  set SignTool_Filename below
}

interface


var
    SignTool_Filename: String = 'C:\Program Files (x86)\Windows Kits\10\bin\10.0.22621.0\x64\signtool.exe';   // from Windows SDK

    PFX_Filename: String = 'C:\ ... \MyCertifcate.pfx';

    PFX_Password: String = 'MyPassword';


type
     TSigningStatus = (IsSigned, NotSigned, DestFileError, SignToolNotFound, PfxNotFound);


function signFile (const aFilename: String; forceSignAgain: Boolean): TSigningStatus;

function checkFile(const aFilename: String): TSigningStatus;  // => Result: IsSigned, NotSigned, DestFileError   // Cannot verify if a signature is really valid.

function damageFile(const aFilename: String): Boolean;  // changes only one random byte in the middle of the file

function makeCmdLineParams(const aFilename: String; insertCmd: Boolean): String;  // if you need the command line for a manual input


implementation


uses SysUtils;


function checkFile(const aFilename: String): TSigningStatus;  // => Result: IsSigned, NotSigned, DestFileError
var
    FileHandle: THandle;
    FileSize: Int64;
    ReadLen:  Int32;
    FileData, Seek: RawByteString;
label bye;
begin
  Result:=DestFileError;  // default error status

  FileHandle:=FileOpen(aFilename,fmOpenRead);
  if FileHandle=feInvalidHandle then Exit;

  FileSize:=FileSeek(FileHandle,Int64(0),fsFromEnd);
  if FileSize<0 then Goto bye;

  ReadLen:=2000;  // read 2000 bytes from the end(!) of the file
  if FileSize<ReadLen then ReadLen:=FileSize;
  if FileSeek(FileHandle,FileSize-ReadLen,fsFromBeginning)<0 then Goto bye;

  SetLength(FileData,ReadLen);
  if FileRead(FileHandle,FileData[1],ReadLen)<>ReadLen then Goto bye;

  Seek:='USERTrustRSA';
  Seek:=Seek+'CertificationAuthority';  // built from 2 parts because I don't want to have a one-piece "USERTrustRSACertificationAuthority" string in this compiled binary

  if Pos(Seek,FileData)>0 then Result:=IsSigned
                          else Result:=NotSigned;
  bye:
  FileClose(FileHandle);
end;


function makeCmdLineParams(const aFilename: String; insertCmd: Boolean): String;  // for more parameters see  https://learn.microsoft.com/de-de/dotnet/framework/tools/signtool-exe
begin
  Result:='';
  if insertCmd then Result:='"'+SignTool_Filename+'" ';

  Result:=Result+'sign /fd SHA256 /td SHA256';
  Result:=Result+' /f "'+PFX_Filename+'" /p '+PFX_Password;
  Result:=Result+' /tr http://timestamp.comodoca.com';  // some time server (RFC 3161)
  Result:=Result+' "'+aFilename+'"';
end;


function signFile(const aFilename: String; forceSignAgain: Boolean): TSigningStatus;
var
    Params: String;
begin
  if not ((Copy(aFilename,2,1)=':') or (Copy(aFilename,1,2)='\\')) then Exit(DestFileError);  // will need a full path for the command line

  Result:=checkFile(aFilename);
  case Result of
    DestFileError: Exit;
    IsSigned: if not forceSignAgain then Exit;  // an already signed file does not need to be signed again
  end;

  if not FileExists(SignTool_Filename,false) then Exit(SignToolNotFound);
  if not FileExists(PFX_Filename,false)      then Exit(PfxNotFound);

  Params:=makeCmdLineParams(aFilename,false);   // for more parameters see  https://learn.microsoft.com/de-de/dotnet/framework/tools/signtool-exe
  ExecuteProcess(SignTool_Filename,Params,[]);  // returns 0 if the call was successful. But I don't pay attention to it, because below I prefer to check if the file actually contains a signature.

  Result:=checkFile(aFilename);
end;


function damageFile(const aFilename: String): Boolean;  // changes only one random byte in the middle of the file
// Only to prove that a signature/hash is then no longer valid (check it manually via Windows GUI). Do not use the damaged file!
// A second pass over the same file, repairs the file (repeated XOR = "un"damage)
var
    FileHandle: THandle;
    FileSize, FilePos: Int64;
    b: Byte;
label bye;
begin
  Result:=false;
  FileHandle:=FileOpen(aFilename,fmOpenReadWrite);
  if FileHandle=feInvalidHandle then Exit;

  FileSize:=FileSeek(FileHandle,Int64(0),fsFromEnd);
  if FileSize<0 then Goto bye;

  FilePos:=FileSize div 2;  // in midstream
  if FileSeek(FileHandle,FilePos,fsFromBeginning)<0 then Goto bye;
  if FileRead(FileHandle,b,1)<>1 then Goto bye;

  b:=b XOR 255;
  FileSeek(FileHandle,FilePos,fsFromBeginning);
  Result:=FileWrite(FileHandle,b,1)=1;

  bye:
  FileClose(FileHandle);
end;



end.