From 405ac7fac47e384ac4b669400c34fbf35c2708db Mon Sep 17 00:00:00 2001 From: r-zakarya <82443831+r-zakarya@users.noreply.github.com> Date: Sat, 5 Sep 2026 15:16:35 +0100 Subject: [PATCH] feat(licence): lier la licence au poste (carte mere + disque) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- CLAUDE.md | 31 ++++++ css/style.css | 15 +++ delphi-backend/PMServer.dpr | 1 + delphi-backend/PMServer.dproj | 1 + delphi-backend/Source/PM.Licence.pas | 44 +++++++- delphi-backend/Source/PM.MachineId.pas | 145 +++++++++++++++++++++++++ delphi-backend/UMainForm.pas | 2 +- index.html | 5 + js/app.js | 14 ++- tools/licence.ps1 | 37 ++++++- 10 files changed, 287 insertions(+), 8 deletions(-) create mode 100644 delphi-backend/Source/PM.MachineId.pas 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 ''