feat(licence): lier la licence au poste (carte mere + disque)

C'etait la decision prise, et je l'avais mal lue : "pour le moment 1"
repondait a la question 1, pas "une seule licence".

PM.MachineId melange l'UUID de la carte mere (WMI) et la serie du volume
systeme, puis n'en publie que 16 hexa : l'empreinte se recopie dans un
courriel, l'UUID brut n'a pas a circuler. Un UUID nul ou tout a FF est
rejete — VM et images clonees l'annoncent, et deux postes tomberaient
alors sur la meme empreinte.

Le champ m est compare APRES la signature. m absent = licence flottante,
acceptee : seule la cle privee peut en emettre, et le champ ne peut pas
etre retire sans casser la signature. Cote script -Machine est
obligatoire sauf -Floating explicite.

L'ecran d'activation affiche l'Installation ID : une licence liee ne peut
plus etre emise avant l'installation.

Verifie sur ce poste : liee a lui acceptee, liee a un autre refusee,
flottante acceptee.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>

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.

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;

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',

delphi-backend/PMServer.dproj

@@ -227,6 +227,7 @@ $(PreBuildEvent)]]></PreBuildEvent>
         <DCCReference Include="Source\PM.QuickUnlock.pas"/>
         <DCCReference Include="Source\PM.PinUnlock.pas"/>
         <DCCReference Include="Source\PM.UserPrefs.pas"/>
+        <DCCReference Include="Source\PM.MachineId.pas"/>
         <DCCReference Include="Source\PM.Licence.pas"/>
         <DCCReference Include="Source\PM.AutoStart.pas"/>
         <DCCReference Include="Source\PM.Favicon.pas"/>

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<string>('n', '');
     AInfo.Email    := LObj.GetValue<string>('e', '');
     AInfo.IssuedOn := LObj.GetValue<string>('d', '');
+    AInfo.Machine  := LowerCase(LObj.GetValue<string>('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

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.

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) --------------------------

index.html

@@ -105,6 +105,11 @@
             </label>
             <button type="submit" class="btn btn-primary btn-block">Activate</button>
         </form>
+
+        <div class="licence-machine">
+            <span>Installation ID — send this to get your key</span>
+            <code id="licenceMachine">&mdash;</code>
+        </div>
     </div>
 </section>
 

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();
 

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 <empreinte>.
+
+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
 ''