diff --git a/CLAUDE.md b/CLAUDE.md
index d3dd7e6..a0199b7 100644
--- a/CLAUDE.md
+++ b/CLAUDE.md
@@ -280,6 +280,37 @@ tools\licence.ps1 -For "a@b.com" -Name "Ami" # une licence
- **Pas d'expiration dans la charge utile**, volontairement : une date qu'on
fait respecter avec l'horloge de la machine du client ne prouve rien. Le
champ `d` n'est qu'une date d'emission.
+
+### Liage au poste (`PM.MachineId`)
+
+Le champ `m` de la charge utile porte l'empreinte du poste ; `MachineMatches`
+la compare **apres** la verification de signature — une empreinte n'a de sens
+que dans une charge utile dont on sait deja qu'elle vient de nous.
+
+- Empreinte = `SHA256('pmserver/machine/v1|' + UUID carte mere + '|' + serie du
+ volume systeme)`, tronquee a 16 hexa, affichee en groupes de quatre
+ (`CD6F-F1B3-25C4-0111`). **Hachee, pas concatenee** : elle se recopie dans un
+ courriel, et l'UUID brut de la carte mere est un identifiant materiel unique
+ qui n'a pas a circuler en clair ni a finir dans nos journaux.
+- UUID lu par WMI (`Win32_ComputerSystemProduct`, COM via `Winapi.ActiveX` pour
+ `IEnumVariant`). **Un UUID nul ou tout a FF est rejete** : beaucoup de VM et
+ d'images clonees l'annoncent, et s'en contenter ferait tomber des postes
+ differents sur la MEME empreinte — une licence emise pour l'un ouvrirait chez
+ l'autre. Repli sur `MachineGuid` (HKLM\...\Cryptography), distinct par
+ installation. Les deux sources absentes → `'unavailable'`, qui ne correspond a
+ aucune licence : mieux qu'une chaine vide, identique partout.
+- Calculee une fois puis retenue (l'appel WMI coute quelques centaines de ms).
+- **`m` absent = licence flottante, acceptee** — seule la cle privee peut en
+ emettre une, et un tiers ne peut pas retirer le champ sans casser la
+ signature. Ce n'est donc pas un contournement, c'est une licence de site.
+ Cote script, `-Machine` est **obligatoire** sauf `-Floating` explicite :
+ l'oubli produirait sinon la licence la plus permissive en silence.
+- **Consequence de flux** : on ne peut plus emettre une licence avant que le
+ client ait installe. L'ecran d'activation affiche l'Installation ID, il
+ l'envoie, on emet. Changer la carte mere ou le disque systeme casse la
+ licence — la reparation est une reemission.
+- Ce qui casse l'empreinte : carte mere remplacee, disque systeme remplace,
+ Windows reinstalle sur un autre volume, machine clonee.
- `SelfTestLicence` a l'`initialization` (comme `SelfTestCrypto`) rejoue un
vecteur fige signe par une **paire de test** dont la privee a ete jetee :
licence valable acceptee, un octet retourne dans la charge utile refuse.
diff --git a/css/style.css b/css/style.css
index 11c7a7e..ea7920c 100644
--- a/css/style.css
+++ b/css/style.css
@@ -237,6 +237,21 @@ input[type="range"]::-webkit-slider-thumb {
var(--bg);
}
#licenceScreen { z-index: 300; }
+/* L'empreinte se recopie a la main dans un courriel : chasse fixe, selectionnable,
+ et assez grande pour qu'un 8 ne passe pas pour un B. */
+.licence-machine {
+ margin-top: 18px; padding-top: 14px;
+ border-top: 1px solid var(--border);
+ text-align: center;
+}
+.licence-machine span { display: block; color: var(--text-dim); font-size: 11px; margin-bottom: 6px; }
+.licence-machine code {
+ display: inline-block; padding: 6px 10px;
+ background: var(--bg); border: 1px solid var(--border); border-radius: var(--radius-sm);
+ font-family: ui-monospace, "Cascadia Mono", Consolas, monospace;
+ font-size: 14px; letter-spacing: 1px; color: var(--text);
+ user-select: all;
+}
.auth-card {
width: 100%; max-width: 400px;
padding: 32px;
diff --git a/delphi-backend/PMServer.dpr b/delphi-backend/PMServer.dpr
index b9ccc14..ba85b28 100644
--- a/delphi-backend/PMServer.dpr
+++ b/delphi-backend/PMServer.dpr
@@ -20,6 +20,7 @@ uses
PM.QuickUnlock in 'Source\PM.QuickUnlock.pas',
PM.PinUnlock in 'Source\PM.PinUnlock.pas',
PM.UserPrefs in 'Source\PM.UserPrefs.pas',
+ PM.MachineId in 'Source\PM.MachineId.pas',
PM.Licence in 'Source\PM.Licence.pas',
PM.AutoStart in 'Source\PM.AutoStart.pas',
PM.Favicon in 'Source\PM.Favicon.pas',
diff --git a/delphi-backend/PMServer.dproj b/delphi-backend/PMServer.dproj
index ebf12a8..e6a790a 100644
--- a/delphi-backend/PMServer.dproj
+++ b/delphi-backend/PMServer.dproj
@@ -227,6 +227,7 @@ $(PreBuildEvent)]]>
+
diff --git a/delphi-backend/Source/PM.Licence.pas b/delphi-backend/Source/PM.Licence.pas
index f38b278..2980e36 100644
--- a/delphi-backend/Source/PM.Licence.pas
+++ b/delphi-backend/Source/PM.Licence.pas
@@ -34,6 +34,7 @@ type
Holder: string; // nom affichable
Email: string;
IssuedOn: string; // 'yyyy-mm-dd', date d'emission (PAS une expiration)
+ Machine: string; // empreinte du poste, vide = licence flottante
end;
// Verifie une chaine de licence sans rien ecrire. False = signature invalide,
@@ -51,6 +52,10 @@ function IsLicensed: Boolean;
function LicenceInfo: TLicenceInfo;
procedure ClearLicence;
+// L'empreinte de CE poste, a montrer sur l'ecran d'activation : sans elle
+// l'utilisateur n'a rien a envoyer pour qu'on lui emette une licence liee.
+function ThisMachineId: string;
+
// Verifie le chemin complet contre un vecteur de test fige. Appele a
// l'initialisation de l'unite, comme SelfTestCrypto.
procedure SelfTestLicence;
@@ -58,7 +63,8 @@ procedure SelfTestLicence;
implementation
uses
- System.JSON, System.Hash, System.NetEncoding, Winapi.Windows, PM.UserPrefs;
+ System.JSON, System.Hash, System.NetEncoding, Winapi.Windows,
+ PM.UserPrefs, PM.MachineId;
const
LicencePrefKey = 'licenceKey';
@@ -182,6 +188,7 @@ begin
AInfo.Holder := LObj.GetValue('n', '');
AInfo.Email := LObj.GetValue('e', '');
AInfo.IssuedOn := LObj.GetValue('d', '');
+ AInfo.Machine := LowerCase(LObj.GetValue('m', ''));
Result := AInfo.Email <> '';
finally
LVal.Free;
@@ -211,6 +218,20 @@ begin
Result := ParsePayload(LMsg, AInfo);
end;
+// Le liage au poste, verifie APRES la signature — l'empreinte n'a de sens que
+// dans une charge utile dont on sait deja qu'elle vient de nous.
+//
+// UNE EMPREINTE ABSENTE PASSE, ET C'EST VOULU : c'est une licence flottante,
+// que seule la cle privee peut emettre. Ce n'est pas un contournement — un
+// tiers ne peut pas retirer le champ d'une licence liee sans casser la
+// signature. Le script d'emission, lui, exige -Floating pour en fabriquer une,
+// pour qu'elle ne sorte jamais par distraction.
+function MachineMatches(const AInfo: TLicenceInfo): Boolean;
+begin
+ Result := (AInfo.Machine = '') or
+ SameText(AInfo.Machine, PM.MachineId.MachineFingerprint);
+end;
+
// ===== API ===================================================================
var
@@ -226,7 +247,8 @@ end;
function VerifyLicence(const ALicence: string; out AInfo: TLicenceInfo): Boolean;
begin
- Result := SplitAndVerify(ProductionKey, Trim(ALicence), AInfo);
+ Result := SplitAndVerify(ProductionKey, Trim(ALicence), AInfo) and
+ MachineMatches(AInfo);
end;
function ActivateLicence(const ALicence: string; out AInfo: TLicenceInfo): Boolean;
@@ -266,6 +288,11 @@ begin
Result := CachedInfo;
end;
+function ThisMachineId: string;
+begin
+ Result := PM.MachineId.MachineFingerprintDisplay;
+end;
+
procedure ClearLicence;
begin
SetPref(LicencePrefKey, '');
@@ -310,6 +337,19 @@ begin
'u9q3GvBByVU0pLbuRrgT98-kZqOBSnYptJ2Mx1B1OjXxJAFgNgnxyjj8SmYpkFt1GuP2PlzRXB3A3HYRMwW2gA';
if SplitAndVerify(LKey, LTampered, LInfo) then
raise Exception.Create('Auto-test licence ECHOUE : une licence trafiquee est acceptee.');
+
+ // Le liage au poste, eprouve sur l'enregistrement : on ne peut pas signer un
+ // vecteur lie sans la cle privee de test, jetee — mais c'est MachineMatches
+ // qui porte la regle, et c'est lui qu'il faut voir tomber.
+ LInfo.Machine := '';
+ if not MachineMatches(LInfo) then
+ raise Exception.Create('Auto-test licence ECHOUE : une licence flottante est refusee.');
+ LInfo.Machine := 'ffffffffffffffff';
+ if MachineMatches(LInfo) then
+ raise Exception.Create('Auto-test licence ECHOUE : une licence d''un AUTRE poste est acceptee.');
+ LInfo.Machine := PM.MachineId.MachineFingerprint;
+ if not MachineMatches(LInfo) then
+ raise Exception.Create('Auto-test licence ECHOUE : la licence de CE poste est refusee.');
end;
initialization
diff --git a/delphi-backend/Source/PM.MachineId.pas b/delphi-backend/Source/PM.MachineId.pas
new file mode 100644
index 0000000..93c9c9b
--- /dev/null
+++ b/delphi-backend/Source/PM.MachineId.pas
@@ -0,0 +1,145 @@
+unit PM.MachineId;
+
+{
+ Empreinte de la machine : carte mere + disque systeme.
+
+ Sert a lier une licence a UN poste (PM.Licence). Deux sources, melangees puis
+ hachees, dont on ne publie que 16 caracteres hexadecimaux :
+
+ - UUID de la carte mere, lu dans le SMBIOS via Win32_ComputerSystemProduct.
+ - Numero de serie du volume systeme (GetVolumeInformation).
+
+ POURQUOI HACHER PLUTOT QUE CONCATENER. L'empreinte se recopie dans un
+ courriel pour demander une licence. L'UUID brut de la carte mere est un
+ identifiant materiel stable et mondialement unique : il n'a pas a circuler
+ en clair, ni a se retrouver dans nos journaux. Le condense suffit a comparer,
+ et ne se remonte pas.
+
+ CE QUI LA CHANGE, ET DONC CASSE LA LICENCE : remplacer la carte mere,
+ remplacer le disque systeme, reinstaller Windows sur un autre volume, ou
+ cloner vers une autre machine. C'est le prix assume du liage — la reparation
+ est une reemission, pas un correctif.
+
+ QUAND LE SMBIOS MENT. Beaucoup de machines virtuelles et d'images clonees
+ annoncent un UUID nul ou tout a FF. S'en contenter ferait tomber des postes
+ differents sur la MEME empreinte, et une licence emise pour l'un ouvrirait
+ chez l'autre. On retombe alors sur MachineGuid, pose par Windows a
+ l'installation et distinct sur chaque installation.
+}
+
+interface
+
+// 16 caracteres hexadecimaux, minuscules. Calcule une fois, puis retenu :
+// l'appel WMI coute quelques centaines de millisecondes.
+function MachineFingerprint: string;
+
+// La meme, en groupes de quatre — c'est un code qu'un humain recopie a la
+// main dans un courriel, et le decoupage divise les fautes de transcription.
+function MachineFingerprintDisplay: string;
+
+implementation
+
+uses
+ System.SysUtils, System.Win.ComObj, System.Win.Registry, System.Variants,
+ Winapi.Windows, Winapi.ActiveX, PM.Crypto;
+
+var
+ CachedPrint: string = '';
+
+function BoardUUID: string;
+var
+ LLocator, LServices, LSet, LItem: OleVariant;
+ LEnum: IEnumVariant;
+ LFetched: LongWord;
+begin
+ Result := '';
+ try
+ LLocator := CreateOleObject('WbemScripting.SWbemLocator');
+ LServices := LLocator.ConnectServer('.', 'root\CIMV2');
+ LSet := LServices.ExecQuery('SELECT UUID FROM Win32_ComputerSystemProduct');
+ LEnum := IUnknown(LSet._NewEnum) as IEnumVariant;
+ if LEnum.Next(1, LItem, LFetched) = S_OK then
+ if not VarIsNull(LItem.UUID) then
+ Result := UpperCase(Trim(string(LItem.UUID)));
+ except
+ // WMI desactive, service arrete, droits refuses : ce n'est pas une panne,
+ // c'est une source en moins. L'appelant retombe sur MachineGuid.
+ Result := '';
+ end;
+
+ // Un UUID nul ou tout a FF n'identifie rien : il est partage par toutes les
+ // machines qui portent le meme defaut de micrologiciel.
+ if (Result = '00000000-0000-0000-0000-000000000000') or
+ (Result = 'FFFFFFFF-FFFF-FFFF-FFFF-FFFFFFFFFFFF') then
+ Result := '';
+end;
+
+function MachineGuid: string;
+var
+ LReg: TRegistry;
+begin
+ Result := '';
+ LReg := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
+ try
+ LReg.RootKey := HKEY_LOCAL_MACHINE;
+ if LReg.OpenKeyReadOnly('SOFTWARE\Microsoft\Cryptography') then
+ Result := LReg.ReadString('MachineGuid');
+ except
+ Result := '';
+ end;
+ LReg.Free;
+end;
+
+function SystemVolumeSerial: string;
+var
+ LRoot: array[0..MAX_PATH] of Char;
+ LSerial, LMaxLen, LFlags: DWORD;
+begin
+ Result := '';
+ if GetWindowsDirectory(LRoot, MAX_PATH) = 0 then Exit;
+ // "C:\" — la racine du volume qui porte Windows.
+ var LDrive := Copy(string(LRoot), 1, 3);
+ LSerial := 0;
+ if GetVolumeInformation(PChar(LDrive), nil, 0, @LSerial, LMaxLen, LFlags, nil, 0) then
+ Result := IntToHex(LSerial, 8);
+end;
+
+function MachineFingerprint: string;
+var
+ LBoard, LVolume, LSeed: string;
+begin
+ if CachedPrint <> '' then
+ Exit(CachedPrint);
+
+ LBoard := BoardUUID;
+ if LBoard = '' then
+ LBoard := MachineGuid;
+ LVolume := SystemVolumeSerial;
+
+ // Les deux sources peuvent manquer sur un poste verrouille a l'extreme.
+ // Une empreinte vide serait la MEME partout : mieux vaut une chaine qui ne
+ // correspondra a aucune licence qu'une chaine qui les accepterait toutes.
+ if (LBoard = '') and (LVolume = '') then
+ Exit('unavailable');
+
+ LSeed := 'pmserver/machine/v1|' + LBoard + '|' + LVolume;
+ CachedPrint := Copy(PM.Crypto.SHA256Hex(LSeed), 1, 16);
+ Result := CachedPrint;
+end;
+
+function MachineFingerprintDisplay: string;
+var
+ LRaw: string;
+ I: Integer;
+begin
+ LRaw := UpperCase(MachineFingerprint);
+ Result := '';
+ for I := 1 to Length(LRaw) do
+ begin
+ if (I > 1) and ((I - 1) mod 4 = 0) then
+ Result := Result + '-';
+ Result := Result + LRaw[I];
+ end;
+end;
+
+end.
diff --git a/delphi-backend/UMainForm.pas b/delphi-backend/UMainForm.pas
index 1cc0335..cdbc790 100644
--- a/delphi-backend/UMainForm.pas
+++ b/delphi-backend/UMainForm.pas
@@ -1359,7 +1359,7 @@ begin
WebBrowser.ExecuteJavaScript(
'if(window.Bridge&&Bridge.onLicenceResult)' +
'Bridge.onLicenceResult(' + BoolToStr(LLicOk, True).ToLower +
- ',"' + LHolder + '")');
+ ',"' + LHolder + '","' + PM.Licence.ThisMachineId + '")');
end
// ---- Start with Windows (HKCU Run registry) --------------------------
diff --git a/index.html b/index.html
index 51a0cde..eaa4bc5 100644
--- a/index.html
+++ b/index.html
@@ -105,6 +105,11 @@
+
+
+ Installation ID — send this to get your key
+ —
+
diff --git a/js/app.js b/js/app.js
index 6bd58b3..2734ef4 100644
--- a/js/app.js
+++ b/js/app.js
@@ -315,11 +315,11 @@ const Bridge = (() => {
}, 3000);
});
},
- onLicenceResult(ok, holder) {
+ onLicenceResult(ok, holder, machine) {
const r = licenceResolver;
if (!r) return;
licenceResolver = null;
- r({ ok: !!ok, holder: holder || '' });
+ r({ ok: !!ok, holder: holder || '', machine: machine || '' });
},
onPrefResult(key, value) {
const r = prefResolvers[key];
@@ -6940,15 +6940,21 @@ function resetAutoLock() {
// Ne rend la main QUE sur une licence acceptée — il n'y a pas de bouton
// "plus tard", c'est tout l'objet de l'écran.
async function ensureLicence() {
- if ((await Bridge.licence('status')).ok) return;
+ let st = await Bridge.licence('status');
+ if (st.ok) return;
// Un démarrage à froid lent peut manquer la fenêtre de réponse, et le
// silence se lit alors comme un refus : redemander une fois coûte moins
// qu'un écran d'activation présenté à quelqu'un qui a déjà payé.
- if ((await Bridge.licence('status')).ok) return;
+ st = await Bridge.licence('status');
+ if (st.ok) return;
const screen = $('#licenceScreen');
const hint = $('#licenceHint');
const input = $('#licenceKey');
+
+ // L'empreinte du poste : une licence est émise POUR une machine, donc
+ // sans ce code à recopier l'utilisateur n'a rien à demander.
+ $('#licenceMachine').textContent = st.machine || '—';
screen.classList.remove('is-hidden');
input.focus();
diff --git a/tools/licence.ps1 b/tools/licence.ps1
index b275333..89379ee 100644
--- a/tools/licence.ps1
+++ b/tools/licence.ps1
@@ -14,6 +14,8 @@ param(
[switch]$Init,
[string]$For,
[string]$Name = '',
+ [string]$Machine,
+ [switch]$Floating,
[string]$KeyFile = "$PSScriptRoot\licence-private.key"
)
@@ -77,10 +79,42 @@ $p.Q = $q
$ecdsa = [System.Security.Cryptography.ECDsa]::Create($p)
+# LE LIAGE AU POSTE EST LE DEFAUT, ET IL FAUT LE DIRE POUR Y COUPER.
+#
+# Une licence flottante s'active sur autant de machines qu'on veut : c'est
+# parfois voulu (licence de site), jamais par distraction. -Floating l'exige
+# explicitement, sinon l'oubli de -Machine produirait en silence la licence
+# la plus permissive - exactement le defaut qu'on ne veut pas.
+#
+# L'empreinte est celle qu'affiche l'ecran d'activation sur le poste du
+# client : il faut donc qu'il ait installe l'application AVANT qu'on emette
+# sa licence. C'est le prix du liage.
+if (-not $Machine -and -not $Floating) {
+ throw @'
+Il manque -Machine .
+
+Fais-toi envoyer l'empreinte affichee sur l'ecran d'activation du poste
+(format XXXX-XXXX-XXXX-XXXX), puis :
+
+ .\licence.ps1 -For "a@b.com" -Name "Nom" -Machine "XXXX-XXXX-XXXX-XXXX"
+
+Pour une licence NON liee, qui s'activera sur n'importe quelle machine,
+demande-la explicitement avec -Floating.
+'@
+}
+
# Charge utile courte : elle voyage dans la cle que l'utilisateur recopie.
# Pas d'expiration - une date qu'on fait respecter avec l'horloge de la
# machine du client ne prouve rien. A ajouter le jour ou on vend un abonnement.
$payload = [ordered]@{ n = $Name; e = $For; d = (Get-Date).ToString('yyyy-MM-dd') }
+if ($Machine) {
+ # Les tirets ne sont qu'une aide a la recopie ; Delphi compare le condense
+ # nu, en minuscules.
+ $payload.m = ($Machine -replace '[^0-9A-Fa-f]', '').ToLower()
+ if ($payload.m.Length -ne 16) {
+ throw "Empreinte attendue : 16 caracteres hexadecimaux (recu $($payload.m.Length))."
+ }
+}
$json = ($payload | ConvertTo-Json -Compress)
$bytes = [Text.Encoding]::UTF8.GetBytes($json)
$sig = $ecdsa.SignData($bytes, [System.Security.Cryptography.HashAlgorithmName]::SHA256)
@@ -88,7 +122,8 @@ $sig = $ecdsa.SignData($bytes, [System.Security.Cryptography.HashAlgorithmNa
$licence = (ToB64Url $bytes) + '.' + (ToB64Url $sig)
''
-'Licence pour ' + $For
+if ($Machine) { 'Licence pour ' + $For + ' — liee au poste ' + $Machine }
+else { 'Licence pour ' + $For + ' — FLOTTANTE (toute machine)' }
''
$licence
''