unit PM.LicenceGate;

{
  Deuxieme couche de licence : l'API refuse de servir sans licence valable.

  POURQUOI UNE DEUXIEME COUCHE, ET POURQUOI ICI. La premiere couche est l'ecran
  d'activation, qui consulte PM.Licence.IsLicensed. C'est un seul branchement :
  le rapiecer ouvrait tout, puisque l'API elle-meme ne demandait rien. Celle-ci
  garde la porte LA OU SONT LES DONNEES — chaque route de PM.Router passe par
  ApiLicenceOk avant son handler. Sauter l'ecran ne donne plus acces a rien.

  AUCUNE FONCTION DE DECISION PARTAGEE AVEC PM.Licence. Si les deux couches
  appelaient IsLicensed, rapiecer IsLicensed ouvrirait les deux d'un coup, et il
  n'y aurait qu'une couche habillee en deux. Cette unite refait donc sa propre
  verification de bout en bout — decodage, empreinte SHA-256, appel CNG, lecture
  du champ machine — et ne prend a PM.Licence que des DONNEES : la cle publique
  et le nom de la pref. Il faut trouver et rapiecer deux branchements distincts.

  LE PRIX DE L'INDEPENDANCE : deux implementations qui doivent dire la meme
  chose. Si elles divergeaient, un client licencie verrait l'ecran s'effacer
  puis chaque requete tomber en 404 — le pire defaut possible, celui qui refuse
  quelqu'un qui a paye. Deux garde-fous, et il faut savoir ce que chacun
  couvre :
  - SelfTestLicenceGate eprouve CETTE verification seule, sur un vecteur lie a
    une empreinte fixe, et commence par le sens qui accepte — celui dont
    l'echec coute le plus.
  - L'ACCORD entre les deux couches ne se teste pas ici : la premiere compare a
    l'empreinte reelle du poste, qui n'est pas un vecteur. Il se prouve en
    lancant l'application avec une vraie licence — l'ecran passe (1re couche) ET
    la connexion aboutit (2e couche).

  CE QUE CA N'ARRETE PAS : quelqu'un qui trouve et rapiece les deux. Ca passe
  d'une heure a deux ; ca ne change pas la nature d'un schema hors ligne.
}

interface

uses
  System.SysUtils;

// L'API peut-elle servir ? Revenu vrai une fois, retenu pour le processus :
// une licence valable ne cesse pas de l'etre en cours de route, et ce test se
// trouve sur le chemin de CHAQUE requete. Un refus n'est jamais retenu — une
// activation faite juste apres doit etre vue a la requete suivante.
function ApiLicenceOk: Boolean;

procedure SelfTestLicenceGate;

implementation

uses
  System.JSON, System.Hash, System.NetEncoding, Winapi.Windows,
  PM.UserPrefs, PM.MachineId, PM.Licence;

// ===== CNG, redeclare ici expres ============================================
//
// Les memes fonctions que PM.Licence, declarees une seconde fois : les partager
// ferait de leur appelant commun un point de rapiecage unique.

const
  GateStatusSuccess  = NTSTATUS(0);
  GateAlgEcdsaP256   = 'ECDSA_P256';
  GateBlobEccPublic  = 'ECCPUBLICBLOB';
  GateBlobLen        = 72;
  GateSigLen         = 64;

function GateOpenAlg(out phAlgorithm: Pointer; pszAlgId, pszImplementation: PWideChar;
  dwFlags: ULONG): NTSTATUS; stdcall; external 'bcrypt.dll' name 'BCryptOpenAlgorithmProvider';
function GateCloseAlg(hAlgorithm: Pointer; dwFlags: ULONG): NTSTATUS; stdcall;
  external 'bcrypt.dll' name 'BCryptCloseAlgorithmProvider';
function GateImportKey(hAlgorithm, hImportKey: Pointer; pszBlobType: PWideChar;
  out phKey: Pointer; pbInput: PByte; cbInput, dwFlags: ULONG): NTSTATUS; stdcall;
  external 'bcrypt.dll' name 'BCryptImportKeyPair';
function GateDestroyKey(hKey: Pointer): NTSTATUS; stdcall;
  external 'bcrypt.dll' name 'BCryptDestroyKey';
function GateVerifySig(hKey, pPaddingInfo: Pointer; pbHash: PByte; cbHash: ULONG;
  pbSignature: PByte; cbSignature, dwFlags: ULONG): NTSTATUS; stdcall;
  external 'bcrypt.dll' name 'BCryptVerifySignature';

function GateB64Url(const AText: string): TBytes;
var
  S: string;
begin
  S := AText.Replace('-', '+').Replace('_', '/');
  while Length(S) mod 4 <> 0 do
    S := S + '=';
  try
    Result := TNetEncoding.Base64.DecodeStringToBytes(S);
  except
    Result := nil;
  end;
end;

function GateSignatureHolds(const AKey, AMsg, ASig: TBytes): Boolean;
var
  LAlg, LKey: Pointer;
  LSha: THashSHA2;
  LDigest: TBytes;
begin
  Result := False;
  if (Length(AKey) <> GateBlobLen) or (Length(ASig) <> GateSigLen) or
     (Length(AMsg) = 0) then
    Exit;
  if GateOpenAlg(LAlg, GateAlgEcdsaP256, nil, 0) <> GateStatusSuccess then
    Exit;
  try
    if GateImportKey(LAlg, nil, GateBlobEccPublic, LKey, @AKey[0],
         GateBlobLen, 0) <> GateStatusSuccess then
      Exit;
    try
      LSha := THashSHA2.Create(THashSHA2.TSHA2Version.SHA256);
      LSha.Update(AMsg);
      LDigest := LSha.HashAsBytes;
      Result := GateVerifySig(LKey, nil, @LDigest[0], Length(LDigest),
                  @ASig[0], GateSigLen, 0) = GateStatusSuccess;
    finally
      GateDestroyKey(LKey);
    end;
  finally
    GateCloseAlg(LAlg, 0);
  end;
end;

// La meme regle d'acceptation que PM.Licence, reecrite : signature valable,
// adresse presente, empreinte presente ET egale a celle attendue. AMachine est
// un parametre pour que l'auto-test puisse la fixer — une empreinte reelle
// change d'un poste a l'autre et ne ferait pas un vecteur.
function GateAccepts(const AKey: TBytes; const ALicence, AMachine: string): Boolean;
var
  LDot: Integer;
  LMsg, LSig: TBytes;
  LVal: TJSONValue;
  LMachine, LEmail: string;
begin
  Result := False;
  LDot := Pos('.', ALicence);
  if (LDot < 2) or (LDot = Length(ALicence)) then
    Exit;
  LMsg := GateB64Url(Copy(ALicence, 1, LDot - 1));
  LSig := GateB64Url(Copy(ALicence, LDot + 1, MaxInt));
  // La signature d'abord : on ne lit pas une charge utile qui ne vient pas de
  // l'editeur.
  if not GateSignatureHolds(AKey, LMsg, LSig) then
    Exit;

  LVal := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetString(LMsg));
  if LVal = nil then
    Exit;
  try
    if not (LVal is TJSONObject) then
      Exit;
    LEmail   := TJSONObject(LVal).GetValue<string>('e', '');
    LMachine := LowerCase(TJSONObject(LVal).GetValue<string>('m', ''));
  finally
    LVal.Free;
  end;

  Result := (LEmail <> '') and (LMachine <> '') and
            SameText(LMachine, AMachine);
end;

var
  GateOpen: Boolean = False;

function ApiLicenceOk: Boolean;
begin
  if GateOpen then
    Exit(True);
  GateOpen := GateAccepts(LicencePublicKey,
                Trim(GetPref(LicencePrefKey)),
                MachineFingerprint);
  Result := GateOpen;
end;

// ===== Auto-test =============================================================

procedure SelfTestLicenceGate;
const
  // Paire jetable, privee jamais ecrite : la licence ci-dessous est liee a
  // l'empreinte fixe 0123456789abcdef.
  GateTestKey: array[0..71] of Byte = (
    $45, $43, $53, $31, $20, $00, $00, $00, $5D, $7C, $98, $73,
    $08, $66, $2E, $01, $38, $95, $9B, $57, $ED, $14, $E7, $15,
    $D8, $54, $4B, $F9, $A9, $A0, $D8, $25, $44, $11, $75, $63,
    $F5, $B8, $ED, $D0, $97, $13, $C3, $E6, $3D, $64, $B5, $D0,
    $7F, $83, $2D, $8B, $E4, $2F, $56, $17, $A9, $7A, $1D, $90,
    $EF, $95, $8A, $9F, $D4, $D3, $C5, $34, $22, $7B, $F3, $D8
  );
  GateTestLicence =
    'eyJuIjoiR2F0ZSIsImUiOiJnYXRlQHRlc3QubG9jYWwiLCJkIjoiMjAyNi0wOS0xNiIsIm0iOiIwMTIzNDU2Nzg5YWJjZGVmIn0.' +
    '3LuJ7UGsEw3M3v6UmuUcjNRB5FWGF5Y8clLy1cKQtHXZ9O3foW7woVCuN1F9JD68N1DfILwFr2wT9OfUDt_pPw';
  GateTestMachine = '0123456789abcdef';
var
  LKey: TBytes;
  LTampered: string;
begin
  SetLength(LKey, GateBlobLen);
  Move(GateTestKey[0], LKey[0], GateBlobLen);

  // LE SENS QUI COMPTE LE PLUS : une deuxieme couche qui refuserait tout
  // bloquerait chaque client licencie. Ce cas-la d'abord.
  if not GateAccepts(LKey, GateTestLicence, GateTestMachine) then
    raise Exception.Create('Auto-test 2e couche ECHOUE : une licence valable est refusee.');
  if GateAccepts(LKey, GateTestLicence, 'ffffffffffffffff') then
    raise Exception.Create('Auto-test 2e couche ECHOUE : une licence d''un autre poste est acceptee.');

  LTampered := GateTestLicence;
  LTampered[10] := Chr(Ord(LTampered[10]) xor 1);
  if GateAccepts(LKey, LTampered, GateTestMachine) then
    raise Exception.Create('Auto-test 2e couche ECHOUE : une licence trafiquee est acceptee.');

  if GateAccepts(LKey, '', GateTestMachine) or
     GateAccepts(LKey, 'nimportequoi', GateTestMachine) then
    raise Exception.Create('Auto-test 2e couche ECHOUE : du charabia est accepte.');
end;

initialization
  SelfTestLicenceGate;

end.