feat(server): un port occupe ne tue plus le demarrage

Le lien n'etait garde par rien : un port pris levait, et l'application
s'ouvrait sur une boite d'erreur. Trois essais desormais - le premier
honore le port de config.txt, que l'utilisateur a peut-etre choisi
expres, les suivants prennent un ephemere.

SE LIER EST LE TEST. Sonder le port avant serait plus faible - un service
qui ecoute sans repondre passerait inapercu - et sujet a une course : le
port peut etre pris entre le sondage et le lien. Chaque deplacement est
journalise, un serveur qui change de port en silence etant pire qu'un
serveur qui refuse de demarrer.

Trouve en chemin : Randomize n'est appele NULLE PART, donc le port
"aleatoire" de port=0 etait le meme a chaque lancement - l'aleatoire cense
compliquer un balayage exterieur n'existait pas. Il vient maintenant de
RandomBytes, donc de BCryptGenRandom, deja utilise pour le jeton d'acces.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
r-zakarya
2026-09-05 08:45:32 +01:00
parent 77688a5af2
commit bf9b62a541
2 changed files with 70 additions and 9 deletions
+58 -8
View File
@@ -117,10 +117,31 @@ procedure TPMHTTPServer.Start(APort: Integer; SameFolder: Boolean;
const
EphemeralPortMin = 49152;
EphemeralPortMax = 65535;
// Trois essais : le port demande, puis deux replis. Au-dela, ce n'est plus
// un port occupe mais une pile reseau qui ne veut pas de nous, et insister
// ne ferait que retarder le message d'erreur.
BindAttempts = 3;
/// Un port ephemere tire du generateur cryptographique de Windows.
///
/// PAS Random() : Randomize n'est appele nulle part dans ce programme, donc
/// Random rend la MEME suite a chaque lancement - le port "aleatoire" de
/// `port=0` etait en realite le meme tous les jours, ce qui vide de son sens
/// l'aleatoire cense compliquer un balayage exterieur. RandomBytes passe par
/// BCryptGenRandom, deja utilise pour le jeton d'acces.
function PickEphemeralPort: Integer;
var
LRaw: TBytes;
begin
LRaw := PM.Crypto.RandomBytes(2);
Result := EphemeralPortMin +
((LRaw[0] shl 8 or LRaw[1]) mod (EphemeralPortMax - EphemeralPortMin + 1));
end;
var
LBinding: TIdSocketHandle;
LDBPath, LWebRoot, LResolvedPort: string;
LRequestedPort: Integer;
LRequestedPort, LAttempt: Integer;
begin
if FServer.Active then Exit;
@@ -133,7 +154,7 @@ begin
LRequestedPort := APort;
if LRequestedPort = 0 then
LRequestedPort := EphemeralPortMin + Random(EphemeralPortMax - EphemeralPortMin);
LRequestedPort := PickEphemeralPort;
var pathParent := '..\';
if SameFolder then
@@ -146,12 +167,41 @@ begin
Log('Web root: ' + LWebRoot);
InitStaticServer(LWebRoot);
FServer.Bindings.Clear;
LBinding := FServer.Bindings.Add;
LBinding.IP := '127.0.0.1';
LBinding.Port := LRequestedPort;
FServer.Active := True;
// SE LIER EST LE TEST, ET IL N'Y EN A PAS D'AUTRE QUI VAILLE.
//
// On pourrait sonder le port avant, pour voir si quelqu'un repond. Ce serait
// a la fois plus faible et plus fragile : un service qui ecoute sans repondre
// passerait inapercu, et le port peut etre pris entre le sondage et le lien.
// Tenter le lien tranche pour de bon, sans course.
//
// Le PREMIER essai honore le port demande - celui de config.txt, que
// l'utilisateur a peut-etre choisi expres. Les suivants prennent un port
// ephemere, exactement ce que fait un lancement sans port configure. Et on le
// DIT a chaque fois : un serveur qui deplace son port en silence est pire
// qu'un serveur qui refuse de demarrer, parce que rien n'explique ensuite
// pourquoi une adresse notee quelque part ne repond plus.
for LAttempt := 1 to BindAttempts do
begin
FServer.Bindings.Clear;
LBinding := FServer.Bindings.Add;
LBinding.IP := '127.0.0.1';
LBinding.Port := LRequestedPort;
try
FServer.Active := True;
Break;
except
on E: Exception do
begin
FServer.Active := False; // Indy peut laisser le lien a moitie ouvert
Log(Format('Port %d unavailable: %s', [LRequestedPort, E.Message]));
// Le dernier echec remonte tel quel : l'appelant sait deja l'afficher.
if LAttempt = BindAttempts then raise;
LRequestedPort := PickEphemeralPort;
Log(Format(' falling back to port %d (attempt %d of %d)',
[LRequestedPort, LAttempt + 1, BindAttempts]));
end;
end;
end;
FBoundPort := LRequestedPort;
LResolvedPort := IntToStr(FBoundPort);
Log(Format('Server started on http://127.0.0.1:%s (token:%s process_check:%s)',