fix(tci): рекордер линейного выхода — память под потолком, файл только в своём каталоге

Два дефекта уровня P1 в LINE_OUT_RECORDER_*. Авторизации в протоколе нет
(§3.1), bind наружу разрешён — значит «сколько стоит одна строка из сети»
это вопрос живучести процесса, а не аккуратности.

1. Неограниченное выделение памяти. CmdRecorder проверял только ValidRx
   (номер в потолке), а конструктор выделял буфер целиком: 300 с × 48 кГц
   × 2 канала × int16 = 57.6 МБ на команду, приёмников 1+MAX_SLICES=7, то
   есть 403 МБ семью строками. У мёртвого приёмника Feed не зовут — значит
   срок записи никто не проверял; уход клиента рекордеры не трогал вовсе;
   DropDeadRxStreams бежит только на rfDevice/rfConnected и смене карты
   слайсов, в покое не срабатывает. Память жила до остановки сервера.

   Лечение тремя замками:
   - память набирается кусками по секунде, START не стоит ни байта;
     куски не перевыделяются (никакого realloc в DSP-потоке) и склеиваются
     один раз в Take — уже после того, как рекордер вынут из таблицы;
   - общий бюджет TCI_RECORD_MAX_BYTES (128 МБ) на все рекордеры сразу,
     спрашивается на каждый кусок; отказ не рушит запись, набранное
     остаётся сохраняемым;
   - освобождение по трём событиям: START требует живого приёмника
     (RxActive, ответ receiver is not running), тик сервера подметает
     истёкшие окна по часам (SweepRecorders — окно закрывается от START
     и без единого блока звука), уход клиента забирает его записи
     (DropClientRecorders; рекордер живёт на приёмнике, но платит за него
     тот, кто нажал START).

2. Перезапись произвольного файла. Путь из сети уходил в fmCreate почти
   как пришёл — вместе с '..' и абсолютными путями. Теперь TCIRecordPath
   берёт из строки ТОЛЬКО имя файла, каталог — настроенный tci.record_dir
   (пусто = <каталог конфигурации>/records). Каталог из просьбы
   отбрасывается молча: полный путь на сервере клиенту всё равно
   бесполезен, файл ложится не на его машину. Имя валидируется (пусто,
   '.', '..', управляющие, ':', длиннее 120, расширение не .wav →
   bad file name); после ExtractFileName выйти за каталог нечем. Файл
   создаётся эксклюзивно (TCICreateNewFile: O_EXCL|O_NOFOLLOW на Unix,
   CREATE_NEW на Windows) — ни перезаписи, ни симлинка, без окна между
   FileExists и созданием; клиенту заранее file exists.

Попутно: MainForm.ApplyTCISettings собирал TTCISettings по полям с
чистого листа — новое поле RecordDir обнулялось бы при каждом применении
вкладки CAT. В uses TCIStreams Windows стоит первым намеренно: иначе его
TCriticalSection перекрыл бы SyncObjs (та же грабля, что в DX-кластере).

Стенд 189/189 (было 169): 11 проверок имени файла (/etc/passwd.wav,
../../.., D|\rec\a.wav), бюджет (START не выделяет, растёт кусками,
потолок, отказ не рушит запись, срок истекает без Feed), существующий WAV
не перезаписывается, START на мёртвом приёмнике и с чужим номером, и
сквозная проверка в части E — клиент стартует запись, набирает память
живым звуком через WDSP, рвёт TCP, бюджет возвращается к нулю. Без фиксов
новые проверки краснеют. GUI (--ws=qt6) и демон зелёные.

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

TCIStreams.pas

@@ -32,6 +32,11 @@ unit TCIStreams;
 interface
 
 uses
+  // ★Windows идёт ПЕРВЫМ намеренно: он объявляет свой TCriticalSection (запись,
+  // а не класс), и стоя последним перекрыл бы SyncObjs — на win64 это уже
+  // ловилось в DX-кластере. Порядок здесь и есть лечение.
+  {$IFDEF WINDOWS}Windows,{$ENDIF}
+  {$IFDEF UNIX}BaseUnix,{$ENDIF}
   Classes, SysUtils, Math, SyncObjs, TCIProtocol, TCIServer;
 
 const
@@ -179,26 +184,44 @@ type
 
     Срок считаем по ЧАСАМ, а не по накопленным сэмплам: линейный выход молчит
     (мьют, пауза приёмника), а время записи всё равно идёт. }
+  { ★Память набирается КУСКАМИ по мере записи, а не вся сразу на START.
+    Раньше конструктор выделял MaxSec × 48 кГц × 2 канала × int16 — до 57.6 МБ
+    на одну строку из сети; семь приёмников давали 403 МБ, и удержать их мог
+    любой клиент (авторизации в TCI нет). Теперь START не стоит ни байта:
+    молчащий, мёртвый или замьюченный приёмник не занимает ничего, а растущая
+    запись спрашивает разрешения на каждый кусок у общего бюджета
+    TCI_RECORD_MAX_BYTES. Куски не перевыделяются (никакого realloc в
+    DSP-потоке) и склеиваются один раз, в Take — а он идёт уже после того, как
+    рекордер вынут из таблицы, то есть без DSP-потока на плечах. }
   TTCIRecorder = class
   private
     FLock:    TCriticalSection;
-    FBuf:     array of SmallInt;   // чередование L/R
-    FCap:     Integer;             // ёмкость в сэмплах на канал
+    FChunks:  array of TTCIPcm;    // куски по FChunk сэмплов на канал, L/R вперемешку
+    FChunk:   Integer;             // сэмплов на канал в куске
+    FCap:     Integer;             // потолок в сэмплах на канал
     FCount:   Integer;             // накоплено сэмплов на канал
+    FBytes:   Int64;               // занято под FChunks (столько же взято у бюджета)
     FRate:    Integer;
     FRx:      Integer;
+    FOwner:   TObject;             // клиент, попросивший START (для его ухода)
     FExpired: Boolean;             // окно записи закрылось, данные удалены
+    FStarved: Boolean;             // бюджет не дал расти — пишем сколько влезло
     FEndsAt:  QWord;               // GetTickCount64 конца окна
     procedure DropData;            // под FLock
+    function  EnsureRoom: Boolean; // под FLock: место под ещё один сэмпл
   public
-    constructor Create(ARx, ARateHz, AMaxSec: Integer);
+    constructor Create(ARx, ARateHz, AMaxSec: Integer; AOwner: TObject);
     destructor  Destroy; override;
     procedure Feed(const L, R: array of Single; N: Integer);
     { Забрать накопленное и завершить запись. nil — либо не записано ничего,
       либо окно уже истекло (по документу это одно и то же: записи нет). }
     function  Take: TTCIPcm;
+    { Окно закрылось по часам. Спрашивает тик сервера: у мёртвого приёмника
+      Feed не зовут вовсе, и без этого вопроса память жила бы до Stop. }
+    function  Expired: Boolean;
     property Rx:   Integer read FRx;
     property Rate: Integer read FRate;
+    property Owner: TObject read FOwner;
   end;
 
   { Писатель WAV в своём потоке: файл до 60 МБ, а зовут сохранение из тика
@@ -229,9 +252,33 @@ function TCIDecimFactor(SrcRate, WantRate: Integer): Integer;
   TCIDecimFactor, а настоящая частота уйдёт в заголовке блока. }
 function TCIPickIQRate(SrcRate, WantRate: Integer): Integer;
 
-{ Путь из LINE_OUT_RECORDER_SAVE в путь файловой системы: в протоколе ':'
-  запрещён и заменён на '|' (§4.3), слэши допускаются любые. }
-function TCIRecordPath(const S: string): string;
+{ ═══ Общий бюджет памяти рекордеров ═══════════════════════════════════════
+  Взять/вернуть можно из любого потока (Take зовёт DSP-поток, Free — тик,
+  поток клиента и поток контроллера). TCIRecBudgetTake возвращает False, если
+  запрошенное не влезает в TCI_RECORD_MAX_BYTES. }
+function TCIRecBudgetTake(Bytes: Int64): Boolean;
+procedure TCIRecBudgetFree(Bytes: Int64);
+function TCIRecBudgetUsed: Int64;      // для стенда и диагностики
+
+{ ═══ Имя файла записи ═════════════════════════════════════════════════════
+  ★Из строки LINE_OUT_RECORDER_SAVE берётся ТОЛЬКО имя файла, а каталог —
+  всегда настроенный каталог записей. Причина простая: авторизации в TCI нет
+  (§3.1), а bind наружу разрешён, поэтому любой, кто дотянулся до порта, писал
+  бы файлы от имени EWSDR куда угодно — путь уходил в fmCreate почти как
+  пришёл, вместе с '..' и абсолютными путями. Документ (§4.3) в примерах даёт
+  полный путь, но полный путь на СЕРВЕРЕ клиенту всё равно бесполезен: файл
+  ложится не на его машину, а на нашу. Поэтому каталог из просьбы отбрасываем
+  молча (клиент получает разумный файл, а не ошибку), а имя проверяем: пусто,
+  '.', '..', управляющие символы и слишком длинное — отказ; расширение обязано
+  быть .wav (кодировать MP3 нам нечем). Выйти за каталог после ExtractFileName
+  нечем — разделителей в имени уже не осталось.
+  Result = '' — имя не годится; иначе полный путь внутри BaseDir. }
+function TCIRecordPath(const BaseDir, Req: string): string;
+
+{ Создать файл, НЕ перезаписывая существующий и не идя по симлинку. Отдельно
+  от TFileStream: fmCreate молча затирает то, что уже лежит по этому пути, а
+  имя приходит из сети. THandle(-1) — не вышло. }
+function TCICreateNewFile(const Path: string): THandle;
 
 implementation
 
@@ -676,18 +723,24 @@ end;
   Рекордер линейного выхода
   ═══════════════════════════════════════════════════════════════════════════ }
 
-constructor TTCIRecorder.Create(ARx, ARateHz, AMaxSec: Integer);
+constructor TTCIRecorder.Create(ARx, ARateHz, AMaxSec: Integer; AOwner: TObject);
 begin
   inherited Create;
-  FLock := TCriticalSection.Create;
-  FRx   := ARx;
-  FRate := ARateHz;
+  FLock  := TCriticalSection.Create;
+  FRx    := ARx;
+  FRate  := ARateHz;
+  FOwner := AOwner;
   if AMaxSec < 1 then AMaxSec := 1;
   if AMaxSec > TCI_RECORD_MAX_SEC then AMaxSec := TCI_RECORD_MAX_SEC;
-  FCap := ARateHz * AMaxSec;
-  SetLength(FBuf, FCap * 2);
+  FCap   := ARateHz * AMaxSec;
+  FChunk := ARateHz * TCI_RECORD_CHUNK_SEC;
+  if FChunk < 1 then FChunk := 1;
+  if FChunk > FCap then FChunk := FCap;
+  // ★Ни одного байта под звук здесь не выделяется — см. шапку объявления.
   FCount   := 0;
+  FBytes   := 0;
   FExpired := False;
+  FStarved := False;
   // Окно открывается прямо здесь: клиент отсчитывает его от своей команды
   // START, и ждать первого блока аудио, чтобы завести часы, нельзя.
   FEndsAt := GetTickCount64 + QWord(AMaxSec) * 1000;
@@ -695,23 +748,66 @@ end;
 
 destructor TTCIRecorder.Destroy;
 begin
+  // Бюджет возвращаем и на аварийном пути: рекордер освобождают и по уходу
+  // клиента, и по исчезновению приёмника, и на Stop — DropData зовут не все.
+  TCIRecBudgetFree(FBytes);
+  FBytes := 0;
   FLock.Free;
   inherited;
 end;
 
+function TTCIRecorder.EnsureRoom: Boolean;
+// Под FLock. True — в последнем куске есть место хотя бы под один сэмпл.
+var
+  Need: Int64;
+  N:    Integer;
+begin
+  Result := False;
+  if FCount >= FCap then Exit;               // набрали свои MaxSec
+  N := Length(FChunks);
+  if FCount < N * FChunk then Exit(True);    // место в текущем куске
+  if FStarved then Exit;                     // бюджет уже отказал — не долбим его
+  Need := Int64(FChunk) * 2 * SizeOf(SmallInt);
+  if not TCIRecBudgetTake(Need) then
+  begin
+    // Отказ не рушит запись: то, что успели набрать, остаётся сохраняемым.
+    FStarved := True;
+    Exit;
+  end;
+  SetLength(FChunks, N + 1);
+  SetLength(FChunks[N], FChunk * 2);
+  Inc(FBytes, Need);
+  Result := True;
+end;
+
 procedure TTCIRecorder.DropData;
 // Под FLock. Память отдаём сразу: истёкшая запись на 300 с держала бы 57 МБ
 // до тех пор, пока клиент не вспомнит про BREAK.
+var i: Integer;
 begin
   FCount   := 0;
   FExpired := True;
-  SetLength(FBuf, 0);
+  for i := 0 to High(FChunks) do FChunks[i] := nil;
+  FChunks := nil;
+  TCIRecBudgetFree(FBytes);
+  FBytes := 0;
+end;
+
+function TTCIRecorder.Expired: Boolean;
+begin
+  FLock.Enter;
+  try
+    if (not FExpired) and (GetTickCount64 >= FEndsAt) then DropData;
+    Result := FExpired;
+  finally
+    FLock.Leave;
+  end;
 end;
 
 procedure TTCIRecorder.Feed(const L, R: array of Single; N: Integer);
 // DSP-поток. Пишем линейно до конца окна; истекло — данных больше нет (§4.3).
 var
-  i: Integer;
+  i, j, C: Integer;
   A, B: Single;
 begin
   if (N <= 0) or (FCap <= 0) then Exit;
@@ -730,13 +826,18 @@ begin
     if N > FCap - FCount then N := FCap - FCount;
     for i := 0 to N - 1 do
     begin
+      // Место спрашиваем на каждый сэмпл: кусок мог кончиться посередине
+      // блока, а бюджет — отказать (тогда дописываем ровно до его границы).
+      if not EnsureRoom then Break;
       A := L[i]; B := R[i];
       if A >  1.0 then A :=  1.0;  if A < -1.0 then A := -1.0;
       if B >  1.0 then B :=  1.0;  if B < -1.0 then B := -1.0;
-      FBuf[(FCount + i) * 2]     := Round(A * 32767);
-      FBuf[(FCount + i) * 2 + 1] := Round(B * 32767);
+      C := FCount div FChunk;
+      j := (FCount mod FChunk) * 2;
+      FChunks[C][j]     := Round(A * 32767);
+      FChunks[C][j + 1] := Round(B * 32767);
+      Inc(FCount);
     end;
-    Inc(FCount, N);
   finally
     FLock.Leave;
   end;
@@ -744,7 +845,7 @@ end;
 
 function TTCIRecorder.Take: TTCIPcm;
 var
-  i: Integer;
+  C, n, Left: Integer;
 begin
   Result := nil;
   FLock.Enter;
@@ -753,8 +854,19 @@ begin
     // приёмник), и тогда Feed часы не смотрел ни разу.
     if (not FExpired) and (GetTickCount64 >= FEndsAt) then DropData;
     if FExpired or (FCount <= 0) then Exit;
+    // Склейка кусков в один буфер — единственное копирование за всю запись, и
+    // оно идёт уже вне DSP-потока: SAVE вынимает рекордер из таблицы раньше,
+    // чем зовёт Take, так что кормить его больше некому.
     SetLength(Result, FCount * 2);
-    for i := 0 to FCount * 2 - 1 do Result[i] := FBuf[i];
+    Left := FCount;
+    for C := 0 to High(FChunks) do
+    begin
+      if Left <= 0 then Break;
+      n := FChunk;
+      if n > Left then n := Left;
+      Move(FChunks[C][0], Result[(FCount - Left) * 2], n * 2 * SizeOf(SmallInt));
+      Dec(Left, n);
+    end;
     DropData;   // SAVE завершает запись (§4.3)
   finally
     FLock.Leave;
@@ -781,7 +893,8 @@ procedure TTCIWavWriter.Execute;
 // два десятка отдельных Write ради них незачем (а строковые литералы в
 // нетипизированный Write в FPC ещё и передаются не тем, чем кажется).
 var
-  FS: TFileStream;
+  FS: THandleStream;
+  H:  THandle;
   Hdr: array[0..43] of Byte;
   DataBytes: LongWord;
 
@@ -820,12 +933,21 @@ begin
     PutTag(36, 'data');
     PutU32(40, DataBytes);
 
-    FS := TFileStream.Create(FPath, fmCreate);
-    try
-      FS.Write(Hdr[0], SizeOf(Hdr));
-      if DataBytes > 0 then FS.Write(FData[0], DataBytes);
-    finally
-      FS.Free;
+    // ★Не TFileStream/fmCreate: имя пришло из сети, и затирать им чужой файл
+    // нельзя. TCICreateNewFile создаёт только новый и не идёт по симлинку.
+    H := TCICreateNewFile(FPath);
+    // Не вышло (файл уже есть, нет прав, нет каталога) — просто уходим: выйти
+    // отсюда через Exit нельзя, ниже ещё возврат памяти под данные.
+    if H <> THandle(-1) then
+    begin
+      FS := THandleStream.Create(H);
+      try
+        FS.Write(Hdr[0], SizeOf(Hdr));
+        if DataBytes > 0 then FS.Write(FData[0], DataBytes);
+      finally
+        FS.Free;
+        FileClose(H);
+      end;
     end;
   except
     // Записать не вышло (нет прав, нет каталога, диск полон) — сказать об этом
@@ -867,19 +989,108 @@ begin
       Exit(LEGAL[i]);
 end;
 
-function TCIRecordPath(const S: string): string;
-var i: Integer;
+{ ═══════════════════════════════════════════════════════════════════════════
+  Бюджет памяти рекордеров
+  ═══════════════════════════════════════════════════════════════════════════ }
+
+var
+  RecBudgetLock: TCriticalSection = nil;
+  RecBudgetUsed: Int64 = 0;
+
+function TCIRecBudgetTake(Bytes: Int64): Boolean;
 begin
-  Result := S;
-  for i := 1 to Length(Result) do
-    if Result[i] = '|' then Result[i] := ':';
-  {$IFDEF WINDOWS}
-  for i := 1 to Length(Result) do
-    if Result[i] = '/' then Result[i] := '\';
-  {$ELSE}
-  for i := 1 to Length(Result) do
-    if Result[i] = '\' then Result[i] := '/';
-  {$ENDIF}
+  Result := False;
+  if Bytes <= 0 then Exit(True);
+  if RecBudgetLock = nil then Exit;
+  RecBudgetLock.Enter;
+  try
+    if RecBudgetUsed + Bytes > TCI_RECORD_MAX_BYTES then Exit;
+    Inc(RecBudgetUsed, Bytes);
+    Result := True;
+  finally
+    RecBudgetLock.Leave;
+  end;
 end;
 
+procedure TCIRecBudgetFree(Bytes: Int64);
+begin
+  if (Bytes <= 0) or (RecBudgetLock = nil) then Exit;
+  RecBudgetLock.Enter;
+  try
+    Dec(RecBudgetUsed, Bytes);
+    if RecBudgetUsed < 0 then RecBudgetUsed := 0;
+  finally
+    RecBudgetLock.Leave;
+  end;
+end;
+
+function TCIRecBudgetUsed: Int64;
+begin
+  Result := 0;
+  if RecBudgetLock = nil then Exit;
+  RecBudgetLock.Enter;
+  try
+    Result := RecBudgetUsed;
+  finally
+    RecBudgetLock.Leave;
+  end;
+end;
+
+{ ═══════════════════════════════════════════════════════════════════════════
+  Имя файла записи
+  ═══════════════════════════════════════════════════════════════════════════ }
+
+function TCIRecordPath(const BaseDir, Req: string): string;
+const
+  MAX_NAME = 120;
+var
+  S, Name: string;
+  i: Integer;
+begin
+  Result := '';
+  if BaseDir = '' then Exit;
+  S := Req;
+  // ':' в протоколе запрещён и заменён на '|' (§4.3) — возвращаем на место,
+  // иначе 'D|\rec\a.wav' стало бы каталогом с именем 'D|'. Слэши допускаются
+  // любые, приводим к своему: без этого ExtractFileName на Linux не увидит
+  // разделителя в 'D:\rec\a.wav' и примет всю строку за имя файла.
+  for i := 1 to Length(S) do
+    if S[i] = '|' then S[i] := ':';
+  for i := 1 to Length(S) do
+    if (S[i] = '/') or (S[i] = '\') then S[i] := PathDelim;
+  // ★Каталог из просьбы отбрасываем целиком — вместе с '..', абсолютным путём
+  // и буквой диска. Именно здесь закрывается запись в произвольный файл.
+  Name := ExtractFileName(S);
+  if (Name = '') or (Name = '.') or (Name = '..') then Exit;
+  if Length(Name) > MAX_NAME then Exit;
+  for i := 1 to Length(Name) do
+    if (Name[i] < ' ') or (Name[i] = ':') then Exit;
+  // Пишем мы только WAV, а расширение — единственное, по чему клиент потом
+  // узнает файл. Чужое расширение здесь честнее молчаливой подмены.
+  if not SameText(ExtractFileExt(Name), '.wav') then Exit;
+  Result := IncludeTrailingPathDelimiter(BaseDir) + Name;
+end;
+
+function TCICreateNewFile(const Path: string): THandle;
+begin
+{$IFDEF UNIX}
+  // O_EXCL — не трогать существующий файл, O_NOFOLLOW — не идти по симлинку,
+  // подложенному вместо него. Обе проверки делает ядро одним вызовом: FileExists
+  // перед FileCreate оставлял бы окно между проверкой и созданием.
+  Result := THandle(FpOpen(PChar(Path),
+              O_WRONLY or O_CREAT or O_EXCL or O_NOFOLLOW, &644));
+{$ELSE}
+  // CREATE_NEW = «создать, только если файла нет»; симлинки в Windows без прав
+  // администратора не создаются, отдельной защиты от них не нужно.
+  Result := CreateFileW(PWideChar(UnicodeString(Path)), GENERIC_WRITE, 0, nil,
+                        CREATE_NEW, FILE_ATTRIBUTE_NORMAL, 0);
+{$ENDIF}
+end;
+
+initialization
+  RecBudgetLock := TCriticalSection.Create;
+
+finalization
+  FreeAndNil(RecBudgetLock);
+
 end.