|
|
|
@@ -0,0 +1,220 @@
|
|
|
|
|
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.
|
r-zakarya