|
|
|
@@ -0,0 +1,319 @@
|
|
|
|
|
unit PM.Licence;
|
|
|
|
|
|
|
|
|
|
{
|
|
|
|
|
Verification hors ligne d'une licence signee ECDSA P-256.
|
|
|
|
|
|
|
|
|
|
Une licence est une chaine "charge-utile.signature", chacune en base64url,
|
|
|
|
|
fabriquee par tools\licence.ps1 avec la cle privee qui reste chez l'editeur.
|
|
|
|
|
La cle PUBLIQUE seule est ici, en dur : elle ne permet que de verifier.
|
|
|
|
|
|
|
|
|
|
CE QUE CA ARRETE, ET CE QUE CA N'ARRETE PAS. Sans la cle privee, personne ne
|
|
|
|
|
fabrique de licence valable — c'est tout ce qu'un schema local peut promettre.
|
|
|
|
|
Rien n'empeche de rapiecer l'exe pour sauter l'appel : c'est vrai de tous les
|
|
|
|
|
schemas hors ligne, y compris ceux qui se vendent cher. La seule parade reelle
|
|
|
|
|
serait de deporter une fonction sur un serveur, ce qui contredit le "100 %
|
|
|
|
|
hors ligne" de cette application.
|
|
|
|
|
|
|
|
|
|
POURQUOI AUCUN ASN.1 NULLE PART. .NET sur Windows EST CNG : la signature que
|
|
|
|
|
produit le script (r||s brut, 64 octets) est deja celle qu'attend
|
|
|
|
|
BCryptVerifySignature, et les coordonnees X/Y exportees se rangent telles
|
|
|
|
|
quelles dans un BCRYPT_ECCPUBLIC_BLOB. Le decodage DER, moitie penible de
|
|
|
|
|
l'exercice d'habitude, n'existe pas ici.
|
|
|
|
|
|
|
|
|
|
La licence acceptee est rangee en pref DPAPI (PM.UserPrefs), donc liee au
|
|
|
|
|
compte Windows et survivant au changement de port comme le reste.
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
interface
|
|
|
|
|
|
|
|
|
|
uses
|
|
|
|
|
System.SysUtils, System.Classes;
|
|
|
|
|
|
|
|
|
|
type
|
|
|
|
|
TLicenceInfo = record
|
|
|
|
|
Holder: string; // nom affichable
|
|
|
|
|
Email: string;
|
|
|
|
|
IssuedOn: string; // 'yyyy-mm-dd', date d'emission (PAS une expiration)
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
// Verifie une chaine de licence sans rien ecrire. False = signature invalide,
|
|
|
|
|
// charge utile trafiquee, format casse, ou cle publique pas encore posee.
|
|
|
|
|
function VerifyLicence(const ALicence: string; out AInfo: TLicenceInfo): Boolean;
|
|
|
|
|
|
|
|
|
|
// Verifie puis range la licence si elle tient. C'est le point d'entree du
|
|
|
|
|
// bouton "Activer".
|
|
|
|
|
function ActivateLicence(const ALicence: string; out AInfo: TLicenceInfo): Boolean;
|
|
|
|
|
|
|
|
|
|
// Etat courant : relit la licence rangee et la REVERIFIE. Ne se contente
|
|
|
|
|
// jamais d'un drapeau booleen stocke — un drapeau se retourne, une signature
|
|
|
|
|
// se refabrique seulement avec la cle privee.
|
|
|
|
|
function IsLicensed: Boolean;
|
|
|
|
|
function LicenceInfo: TLicenceInfo;
|
|
|
|
|
procedure ClearLicence;
|
|
|
|
|
|
|
|
|
|
// Verifie le chemin complet contre un vecteur de test fige. Appele a
|
|
|
|
|
// l'initialisation de l'unite, comme SelfTestCrypto.
|
|
|
|
|
procedure SelfTestLicence;
|
|
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
|
|
|
|
|
uses
|
|
|
|
|
System.JSON, System.Hash, System.NetEncoding, Winapi.Windows, PM.UserPrefs;
|
|
|
|
|
|
|
|
|
|
const
|
|
|
|
|
LicencePrefKey = 'licenceKey';
|
|
|
|
|
|
|
|
|
|
// ===== LA CLE PUBLIQUE DE L'EDITEUR ========================================
|
|
|
|
|
//
|
|
|
|
|
// BCRYPT_ECCPUBLIC_BLOB : magic 'ECS1' + longueur(32) + X(32) + Y(32).
|
|
|
|
|
//
|
|
|
|
|
// TOUT A ZERO = AUCUNE LICENCE NE SERA JAMAIS VALIDE. Lance
|
|
|
|
|
// powershell -ExecutionPolicy Bypass -File tools\licence.ps1 -Init
|
|
|
|
|
// et colle ici les 72 octets qu'il imprime. Ne regenere JAMAIS la paire
|
|
|
|
|
// ensuite : toutes les licences deja emises tomberaient d'un coup.
|
|
|
|
|
LicencePublicKeyBlob: array[0..71] of Byte = (
|
|
|
|
|
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
|
|
|
|
|
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
|
|
|
|
|
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
|
|
|
|
|
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
|
|
|
|
|
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
|
|
|
|
|
$00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00, $00
|
|
|
|
|
);
|
|
|
|
|
|
|
|
|
|
// ===== CNG ===================================================================
|
|
|
|
|
|
|
|
|
|
const
|
|
|
|
|
STATUS_SUCCESS = NTSTATUS(0);
|
|
|
|
|
BCRYPT_ECDSA_P256 = 'ECDSA_P256';
|
|
|
|
|
BCRYPT_ECCPUBLIC = 'ECCPUBLICBLOB';
|
|
|
|
|
EccBlobLen = 72;
|
|
|
|
|
P256SignatureLen = 64; // r||s, 32 octets chacun
|
|
|
|
|
|
|
|
|
|
function BCryptOpenAlgorithmProvider(out phAlgorithm: Pointer;
|
|
|
|
|
pszAlgId, pszImplementation: PWideChar; dwFlags: ULONG): NTSTATUS; stdcall;
|
|
|
|
|
external 'bcrypt.dll' name 'BCryptOpenAlgorithmProvider';
|
|
|
|
|
|
|
|
|
|
function BCryptCloseAlgorithmProvider(hAlgorithm: Pointer;
|
|
|
|
|
dwFlags: ULONG): NTSTATUS; stdcall;
|
|
|
|
|
external 'bcrypt.dll' name 'BCryptCloseAlgorithmProvider';
|
|
|
|
|
|
|
|
|
|
function BCryptImportKeyPair(hAlgorithm, hImportKey: Pointer;
|
|
|
|
|
pszBlobType: PWideChar; out phKey: Pointer; pbInput: PByte;
|
|
|
|
|
cbInput, dwFlags: ULONG): NTSTATUS; stdcall;
|
|
|
|
|
external 'bcrypt.dll' name 'BCryptImportKeyPair';
|
|
|
|
|
|
|
|
|
|
function BCryptDestroyKey(hKey: Pointer): NTSTATUS; stdcall;
|
|
|
|
|
external 'bcrypt.dll' name 'BCryptDestroyKey';
|
|
|
|
|
|
|
|
|
|
function BCryptVerifySignature(hKey, pPaddingInfo: Pointer;
|
|
|
|
|
pbHash: PByte; cbHash: ULONG; pbSignature: PByte;
|
|
|
|
|
cbSignature, dwFlags: ULONG): NTSTATUS; stdcall;
|
|
|
|
|
external 'bcrypt.dll' name 'BCryptVerifySignature';
|
|
|
|
|
|
|
|
|
|
// ===== Outils ================================================================
|
|
|
|
|
|
|
|
|
|
function Base64UrlDecode(const AText: string): TBytes;
|
|
|
|
|
var
|
|
|
|
|
LStd: string;
|
|
|
|
|
begin
|
|
|
|
|
LStd := StringReplace(AText, '-', '+', [rfReplaceAll]);
|
|
|
|
|
LStd := StringReplace(LStd, '_', '/', [rfReplaceAll]);
|
|
|
|
|
while (Length(LStd) mod 4) <> 0 do
|
|
|
|
|
LStd := LStd + '=';
|
|
|
|
|
try
|
|
|
|
|
Result := TNetEncoding.Base64.DecodeStringToBytes(LStd);
|
|
|
|
|
except
|
|
|
|
|
// Une chaine recopiee de travers n'est pas une panne : c'est un refus.
|
|
|
|
|
Result := nil;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
// Verifie contre UNE cle publique donnee. La production passe la constante
|
|
|
|
|
// ci-dessus ; l'auto-test passe la sienne, ce qui evite de figer un second
|
|
|
|
|
// jeu de constantes pour la meme mecanique.
|
|
|
|
|
function VerifyAgainstKey(const AKeyBlob: TBytes; const AMessage,
|
|
|
|
|
ASignature: TBytes): Boolean;
|
|
|
|
|
var
|
|
|
|
|
LAlg, LKey: Pointer;
|
|
|
|
|
LHash: TBytes;
|
|
|
|
|
LSha: THashSHA2;
|
|
|
|
|
begin
|
|
|
|
|
Result := False;
|
|
|
|
|
if (Length(AKeyBlob) <> EccBlobLen) or
|
|
|
|
|
(Length(ASignature) <> P256SignatureLen) or (Length(AMessage) = 0) then
|
|
|
|
|
Exit;
|
|
|
|
|
|
|
|
|
|
if BCryptOpenAlgorithmProvider(LAlg, BCRYPT_ECDSA_P256, nil, 0) <> STATUS_SUCCESS then
|
|
|
|
|
Exit;
|
|
|
|
|
try
|
|
|
|
|
if BCryptImportKeyPair(LAlg, nil, BCRYPT_ECCPUBLIC, LKey,
|
|
|
|
|
@AKeyBlob[0], EccBlobLen, 0) <> STATUS_SUCCESS then
|
|
|
|
|
Exit;
|
|
|
|
|
try
|
|
|
|
|
// BCryptVerifySignature attend l'EMPREINTE, pas le message.
|
|
|
|
|
LSha := THashSHA2.Create(THashSHA2.TSHA2Version.SHA256);
|
|
|
|
|
LSha.Update(AMessage);
|
|
|
|
|
LHash := LSha.HashAsBytes;
|
|
|
|
|
Result := BCryptVerifySignature(LKey, nil, @LHash[0], Length(LHash),
|
|
|
|
|
@ASignature[0], P256SignatureLen, 0) = STATUS_SUCCESS;
|
|
|
|
|
finally
|
|
|
|
|
BCryptDestroyKey(LKey);
|
|
|
|
|
end;
|
|
|
|
|
finally
|
|
|
|
|
BCryptCloseAlgorithmProvider(LAlg, 0);
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function ParsePayload(const APayload: TBytes; out AInfo: TLicenceInfo): Boolean;
|
|
|
|
|
var
|
|
|
|
|
LVal: TJSONValue;
|
|
|
|
|
LObj: TJSONObject;
|
|
|
|
|
begin
|
|
|
|
|
Result := False;
|
|
|
|
|
AInfo := Default(TLicenceInfo);
|
|
|
|
|
LVal := TJSONObject.ParseJSONValue(TEncoding.UTF8.GetString(APayload));
|
|
|
|
|
if LVal = nil then
|
|
|
|
|
Exit;
|
|
|
|
|
try
|
|
|
|
|
// Un transtypage direct leverait sur une charge utile qui n'est pas un
|
|
|
|
|
// objet, et fuirait la valeur au passage.
|
|
|
|
|
if not (LVal is TJSONObject) then
|
|
|
|
|
Exit;
|
|
|
|
|
LObj := TJSONObject(LVal);
|
|
|
|
|
AInfo.Holder := LObj.GetValue<string>('n', '');
|
|
|
|
|
AInfo.Email := LObj.GetValue<string>('e', '');
|
|
|
|
|
AInfo.IssuedOn := LObj.GetValue<string>('d', '');
|
|
|
|
|
Result := AInfo.Email <> '';
|
|
|
|
|
finally
|
|
|
|
|
LVal.Free;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function SplitAndVerify(const AKeyBlob: TBytes; const ALicence: string;
|
|
|
|
|
out AInfo: TLicenceInfo): Boolean;
|
|
|
|
|
var
|
|
|
|
|
LDot: Integer;
|
|
|
|
|
LMsg, LSig: TBytes;
|
|
|
|
|
begin
|
|
|
|
|
Result := False;
|
|
|
|
|
AInfo := Default(TLicenceInfo);
|
|
|
|
|
|
|
|
|
|
LDot := Pos('.', ALicence);
|
|
|
|
|
if (LDot < 2) or (LDot = Length(ALicence)) then
|
|
|
|
|
Exit;
|
|
|
|
|
|
|
|
|
|
LMsg := Base64UrlDecode(Copy(ALicence, 1, LDot - 1));
|
|
|
|
|
LSig := Base64UrlDecode(Copy(ALicence, LDot + 1, MaxInt));
|
|
|
|
|
if not VerifyAgainstKey(AKeyBlob, LMsg, LSig) then
|
|
|
|
|
Exit;
|
|
|
|
|
|
|
|
|
|
// La signature d'abord, la lecture ensuite : on n'analyse jamais une charge
|
|
|
|
|
// utile dont on ne sait pas encore qu'elle vient de nous.
|
|
|
|
|
Result := ParsePayload(LMsg, AInfo);
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
// ===== API ===================================================================
|
|
|
|
|
|
|
|
|
|
var
|
|
|
|
|
CachedChecked: Boolean = False;
|
|
|
|
|
CachedValid: Boolean = False;
|
|
|
|
|
CachedInfo: TLicenceInfo;
|
|
|
|
|
|
|
|
|
|
function ProductionKey: TBytes;
|
|
|
|
|
begin
|
|
|
|
|
SetLength(Result, EccBlobLen);
|
|
|
|
|
Move(LicencePublicKeyBlob[0], Result[0], EccBlobLen);
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function VerifyLicence(const ALicence: string; out AInfo: TLicenceInfo): Boolean;
|
|
|
|
|
begin
|
|
|
|
|
Result := SplitAndVerify(ProductionKey, Trim(ALicence), AInfo);
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function ActivateLicence(const ALicence: string; out AInfo: TLicenceInfo): Boolean;
|
|
|
|
|
begin
|
|
|
|
|
Result := VerifyLicence(ALicence, AInfo);
|
|
|
|
|
if Result then
|
|
|
|
|
begin
|
|
|
|
|
SetPref(LicencePrefKey, Trim(ALicence));
|
|
|
|
|
CachedChecked := True;
|
|
|
|
|
CachedValid := True;
|
|
|
|
|
CachedInfo := AInfo;
|
|
|
|
|
end;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure Refresh;
|
|
|
|
|
var
|
|
|
|
|
LStored: string;
|
|
|
|
|
begin
|
|
|
|
|
if CachedChecked then
|
|
|
|
|
Exit;
|
|
|
|
|
CachedChecked := True;
|
|
|
|
|
LStored := GetPref(LicencePrefKey);
|
|
|
|
|
CachedValid := (LStored <> '') and VerifyLicence(LStored, CachedInfo);
|
|
|
|
|
if not CachedValid then
|
|
|
|
|
CachedInfo := Default(TLicenceInfo);
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function IsLicensed: Boolean;
|
|
|
|
|
begin
|
|
|
|
|
Refresh;
|
|
|
|
|
Result := CachedValid;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
function LicenceInfo: TLicenceInfo;
|
|
|
|
|
begin
|
|
|
|
|
Refresh;
|
|
|
|
|
Result := CachedInfo;
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
procedure ClearLicence;
|
|
|
|
|
begin
|
|
|
|
|
SetPref(LicencePrefKey, '');
|
|
|
|
|
CachedChecked := True;
|
|
|
|
|
CachedValid := False;
|
|
|
|
|
CachedInfo := Default(TLicenceInfo);
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
// ===== Auto-test =============================================================
|
|
|
|
|
|
|
|
|
|
procedure SelfTestLicence;
|
|
|
|
|
const
|
|
|
|
|
// Paire de test, sans rapport avec la cle de production : sa privee a ete
|
|
|
|
|
// jetee. Elle ne prouve qu'une chose, mais elle la prouve entierement — que
|
|
|
|
|
// le blob, l'empreinte et le format r||s s'accordent avec CNG.
|
|
|
|
|
TestKey: array[0..71] of Byte = (
|
|
|
|
|
$45, $43, $53, $31, $20, $00, $00, $00, $27, $24, $81, $FF,
|
|
|
|
|
$7E, $21, $27, $90, $91, $3D, $B7, $7E, $6E, $20, $18, $8B,
|
|
|
|
|
$48, $51, $D2, $DD, $1A, $BB, $3D, $E8, $65, $06, $55, $AD,
|
|
|
|
|
$A3, $93, $EE, $6D, $D4, $56, $42, $9D, $F7, $85, $3C, $C9,
|
|
|
|
|
$98, $FA, $42, $43, $47, $E6, $2F, $2B, $9B, $30, $6B, $15,
|
|
|
|
|
$88, $AA, $2D, $C3, $79, $2B, $1E, $A2, $4D, $1F, $E3, $55
|
|
|
|
|
);
|
|
|
|
|
TestLicence = 'eyJuIjoiTW9uIEFtaSIsImUiOiJhbWlAZXhlbXBsZS5jb20iLCJkIjoiMjAyNi0wOS0wNSJ9.' +
|
|
|
|
|
'u9q3GvBByVU0pLbuRrgT98-kZqOBSnYptJ2Mx1B1OjXxJAFgNgnxyjj8SmYpkFt1GuP2PlzRXB3A3HYRMwW2gA';
|
|
|
|
|
var
|
|
|
|
|
LKey: TBytes;
|
|
|
|
|
LInfo: TLicenceInfo;
|
|
|
|
|
LTampered: string;
|
|
|
|
|
begin
|
|
|
|
|
SetLength(LKey, EccBlobLen);
|
|
|
|
|
Move(TestKey[0], LKey[0], EccBlobLen);
|
|
|
|
|
|
|
|
|
|
if not SplitAndVerify(LKey, TestLicence, LInfo) then
|
|
|
|
|
raise Exception.Create('Auto-test licence ECHOUE : une licence valable est refusee.');
|
|
|
|
|
if LInfo.Email <> 'ami@exemple.com' then
|
|
|
|
|
raise Exception.CreateFmt(
|
|
|
|
|
'Auto-test licence ECHOUE : charge utile mal lue (got "%s").', [LInfo.Email]);
|
|
|
|
|
|
|
|
|
|
// Un octet retourne dans la charge utile doit faire tomber la signature.
|
|
|
|
|
LTampered := 'e0JuIjoiTW9uIEFtaSIsImUiOiJhbWlAZXhlbXBsZS5jb20iLCJkIjoiMjAyNi0wOS0wNSJ9.' +
|
|
|
|
|
'u9q3GvBByVU0pLbuRrgT98-kZqOBSnYptJ2Mx1B1OjXxJAFgNgnxyjj8SmYpkFt1GuP2PlzRXB3A3HYRMwW2gA';
|
|
|
|
|
if SplitAndVerify(LKey, LTampered, LInfo) then
|
|
|
|
|
raise Exception.Create('Auto-test licence ECHOUE : une licence trafiquee est acceptee.');
|
|
|
|
|
end;
|
|
|
|
|
|
|
|
|
|
initialization
|
|
|
|
|
SelfTestLicence;
|
|
|
|
|
|
|
|
|
|
end.
|