From 79132f133c98f238d936c148035b8f66ccd88a13 Mon Sep 17 00:00:00 2001 From: Vladimir Date: Wed, 19 Aug 2026 12:30:36 +0300 Subject: [PATCH] =?UTF-8?q?fix(tci):=20=D1=80=D0=B5=D0=BA=D0=BE=D1=80?= =?UTF-8?q?=D0=B4=D0=B5=D1=80=20=D0=BB=D0=B8=D0=BD=D0=B5=D0=B9=D0=BD=D0=BE?= =?UTF-8?q?=D0=B3=D0=BE=20=D0=B2=D1=8B=D1=85=D0=BE=D0=B4=D0=B0=20=E2=80=94?= =?UTF-8?q?=20=D0=BF=D0=B0=D0=BC=D1=8F=D1=82=D1=8C=20=D0=BF=D0=BE=D0=B4=20?= =?UTF-8?q?=D0=BF=D0=BE=D1=82=D0=BE=D0=BB=D0=BA=D0=BE=D0=BC,=20=D1=84?= =?UTF-8?q?=D0=B0=D0=B9=D0=BB=20=D1=82=D0=BE=D0=BB=D1=8C=D0=BA=D0=BE=20?= =?UTF-8?q?=D0=B2=20=D1=81=D0=B2=D0=BE=D1=91=D0=BC=20=D0=BA=D0=B0=D1=82?= =?UTF-8?q?=D0=B0=D0=BB=D0=BE=D0=B3=D0=B5?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Два дефекта уровня 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 --- MainForm.pas | 3 + Settings.pas | 9 ++ TCIAdapter.pas | 114 +++++++++++++++-- TCIProtocol.pas | 11 ++ TCIStreams.pas | 287 +++++++++++++++++++++++++++++++++++++------ doc/TCI.md | 66 +++++++++- test/tci/tcitest.pas | 173 +++++++++++++++++++++++++- 7 files changed, 609 insertions(+), 54 deletions(-) diff --git a/MainForm.pas b/MainForm.pas index 234d8b4..741b20e 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -6598,6 +6598,9 @@ procedure TMainForm.ApplyTCISettings(Enabled: Boolean; Port: Integer; var Prev, Cfg: TTCISettings; begin Prev := FTCICfg; + // ★От текущей конфигурации, а не с чистого листа: вкладка правит три поля, + // а в записи есть и другие (RecordDir), и сборка по полям их обнуляла бы. + Cfg := FTCICfg; Cfg.Enabled := Enabled; Cfg.Port := Port; Cfg.BindAddr := BindAddr; diff --git a/Settings.pas b/Settings.pas index 9709784..2ee9ffe 100644 --- a/Settings.pas +++ b/Settings.pas @@ -466,6 +466,12 @@ type Enabled: Boolean; Port: Integer; // 1..65535, умолчание 40001 (как у ExpertSDR3) BindAddr: string; // '127.0.0.1' или '0.0.0.0' + // ★Единственный каталог, куда TCI пишет записи линейного выхода + // (LINE_OUT_RECORDER_SAVE). Пусто — <каталог конфигурации>/records. + // Имя файла клиент выбирает сам, но КАТАЛОГ из его строки не берётся + // никогда: авторизации в протоколе нет, и полный путь из сети означал бы + // запись в любой доступный процессу файл (см. TCIRecordPath). + RecordDir: string; end; // Transverter (XVTR) entry — один трансвертер. @@ -2999,6 +3005,7 @@ begin T.Enabled := False; // включается осознанно, как CAT-транспорты T.Port := 40001; T.BindAddr := '127.0.0.1'; + T.RecordDir := ''; // пусто = <каталог конфигурации>/records end; procedure TSettingsManager.LoadTCISettings(out T: TTCISettings); @@ -3010,6 +3017,7 @@ begin T.Enabled := JB(O, 'enabled', False); T.Port := EnsureRange(JI(O, 'port', 40001), 1, 65535); T.BindAddr := JS(O, 'bind_addr', '127.0.0.1'); + T.RecordDir := JS(O, 'record_dir', ''); end; procedure TSettingsManager.SaveTCISettings(const T: TTCISettings); @@ -3019,6 +3027,7 @@ begin JW(O, 'enabled', T.Enabled); JW(O, 'port', T.Port); JWS(O, 'bind_addr', T.BindAddr); + JWS(O, 'record_dir', T.RecordDir); Save; end; diff --git a/TCIAdapter.pas b/TCIAdapter.pas index ac2c615..53fe548 100644 --- a/TCIAdapter.pas +++ b/TCIAdapter.pas @@ -43,7 +43,7 @@ interface uses Classes, SysUtils, DateUtils, Math, SyncObjs, - RadioController, RadioBackend, WDSPEngine, Settings, + RadioController, RadioBackend, WDSPEngine, Settings, PlatformUtils, DXSpotStore, TCIProtocol, TCIServer, TCIStreams; const @@ -236,6 +236,9 @@ type procedure PushTxChrono; // тик: маркеры времени клиенту procedure CmdStream(Client: TTCIClient; const M: TTCIMessage); procedure CmdRecorder(Client: TTCIClient; const M: TTCIMessage); + procedure DropClientRecorders(C: TTCIClient); // клиент ушёл — и запись с ним + procedure SweepRecorders; // тик: истёкшие окна записи + function RecordDir: string; // каталог, куда пишем WAV procedure ClearTxClient(C: TTCIClient); // клиент ушёл/перестал модулировать procedure StopTxOf(C: TTCIClient); // ★снять эфир, начатый этим клиентом procedure ForgetTxOwner; // передача кончилась не по TCI @@ -1329,6 +1332,7 @@ procedure TTCIAdapter.HandleDisconnect(Client: TTCIClient); begin DropHolds(Client); DropClientStreams(Client); + DropClientRecorders(Client); ClearTxClient(Client); // ★И только теперь — сама передача: если в эфир нас поставил именно этот // клиент, снимаем MOX. Оставить включённый передатчик за ушедшим клиентом @@ -2640,6 +2644,7 @@ begin try FServer.EnumClients(PushSensors); PushTxChrono; + SweepRecorders; except // молча: следующий тик через 20 мс попробует снова end; @@ -2992,7 +2997,7 @@ end; procedure TTCIAdapter.CmdRecorder(Client: TTCIClient; const M: TTCIMessage); var Rx, Sec, Rate: Integer; - Path: string; + Path, Req: string; Data: TTCIPcm; Old, New_: TTCIRecorder; begin @@ -3004,11 +3009,21 @@ begin if M.Name = 'LINE_OUT_RECORDER_START' then begin + // ★Только ЖИВОЙ приёмник. Раньше хватало номера в потолке, а у мёртвого + // приёмника Feed не зовут вовсе — значит и срок записи никто не проверял: + // рекордер висел до перезапуска сервера. Отвечаем как потокам. + if not RxActive(Rx) then + begin + Reply(Client, TCIBuild('tci_error', + [LowerCase(M.Name), 'receiver is not running'])); + Exit; + end; if not TCITryArgInt(M, 1, Sec) then Sec := TCI_RECORD_MAX_SEC; Sec := EnsureRange(Sec, 1, TCI_RECORD_MAX_SEC); - // Кольцо заводим ДО лока: на предельных 300 с это 57 МБ, и выделять их - // под локом, которого ждёт DSP-поток, значит уронить звук на десятки мс. - New_ := TTCIRecorder.Create(Rx, TCI_AUDIO_ENGINE_RATE, Sec); + // Объект заводим ДО лока — не ради памяти (её он больше не выделяет, см. + // TTCIRecorder), а чтобы не звать чужой конструктор под локом DSP-потока. + // Владельца помним: уйдёт клиент — уйдёт и его запись. + New_ := TTCIRecorder.Create(Rx, TCI_AUDIO_ENGINE_RATE, Sec, Client); FStreamLock.Enter; try // Рекордер один на приёмник, а не на клиента: пишет он то, что слышно @@ -3036,20 +3051,35 @@ begin end; // LINE_OUT_RECORDER_SAVE - Path := TCIRecordPath(TCIUnescape(TCIArg(M, 1))); - if Path = '' then + Req := TCIUnescape(TCIArg(M, 1)); + if Req = '' then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'no file name'])); Exit; end; // MP3 у нас кодировать нечем — молча подсунуть WAV с расширением .mp3 хуже, - // чем сказать правду: клиент такой файл всё равно не откроет. - if SameText(ExtractFileExt(Path), '.mp3') then + // чем сказать правду: клиент такой файл всё равно не откроет. Проверяем до + // TCIRecordPath, чтобы у самой частой причины отказа был свой текст. + if SameText(ExtractFileExt(Req), '.mp3') then begin Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'only wav is supported'])); Exit; end; + // ★Каталог всегда наш, из просьбы берётся одно имя файла — см. TCIRecordPath. + Path := TCIRecordPath(RecordDir, Req); + if Path = '' then + begin + Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'bad file name'])); + Exit; + end; + // Существующий файл не трогаем (окончательно это решит O_EXCL в писателе, + // здесь — только чтобы клиент услышал причину). + if FileExists(Path) then + begin + Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), 'file exists'])); + Exit; + end; // Забираем рекордер из таблицы (сохранение завершает запись, §4.3) и только // потом снимаем с него данные: копия кольца — это десятки мегабайт, и делать @@ -3079,6 +3109,72 @@ begin TTCIWavWriter.Create(Path, Data, Rate); end; +procedure TTCIAdapter.DropClientRecorders(C: TTCIClient); +// ★Клиент ушёл — забираем его записи. Рекордер живёт на приёмнике, а не на +// клиенте (второй такой же был бы копией памяти), но платит за него тот, кто +// нажал START: без этого пары «подключился, START, отключился» набивали память +// до потолка бюджета, и вернуть её было некому до перезапуска сервера. +var + Rx: Integer; + Dead: array[0..TCI_MAX_RX-1] of TTCIRecorder; +begin + if C = nil then Exit; + FStreamLock.Enter; + try + for Rx := 0 to TCI_MAX_RX - 1 do + begin + Dead[Rx] := nil; + if (FRec[Rx] <> nil) and (FRec[Rx].Owner = TObject(C)) then + begin + Dead[Rx] := FRec[Rx]; + FRec[Rx] := nil; + end; + end; + finally + FStreamLock.Leave; + end; + // Освобождаем вне лока: его ждёт DSP-поток, а деструктор трогает свой лок. + for Rx := 0 to TCI_MAX_RX - 1 do Dead[Rx].Free; +end; + +procedure TTCIAdapter.SweepRecorders; +// Тик сервера. ★Срок записи раньше проверял только Feed, то есть DSP-поток — +// а он к рекордеру замьюченного, молчащего или пропавшего приёмника не приходит +// вовсе. Окно закрывается по ЧАСАМ от START (§4.3), значит и спрашивать про +// него надо по часам, а не по звуку. +var + Rx: Integer; + Dead: array[0..TCI_MAX_RX-1] of TTCIRecorder; +begin + FStreamLock.Enter; + try + for Rx := 0 to TCI_MAX_RX - 1 do + begin + Dead[Rx] := nil; + if (FRec[Rx] <> nil) and FRec[Rx].Expired then + begin + Dead[Rx] := FRec[Rx]; + FRec[Rx] := nil; + end; + end; + finally + FStreamLock.Leave; + end; + for Rx := 0 to TCI_MAX_RX - 1 do Dead[Rx].Free; +end; + +function TTCIAdapter.RecordDir: string; +// Каталог записей: настройка, а пусто — <каталог конфигурации>/records. +// Каталог создаём здесь же: писатель работает в своём потоке и сказать об +// отсутствии каталога ему уже некому. +begin + Result := Trim(FCfg.RecordDir); + if Result = '' then Result := GetAppCfgDir + 'records'; + Result := IncludeTrailingPathDelimiter(Result); + if not DirectoryExists(Result) then + if not ForceDirectories(Result) then Result := ''; +end; + procedure TTCIAdapter.ClearTxClient(C: TTCIClient); // C = nil — снять кого угодно (остановка сервера). var Drop: Boolean; diff --git a/TCIProtocol.pas b/TCIProtocol.pas index 66377cf..c96c4d7 100644 --- a/TCIProtocol.pas +++ b/TCIProtocol.pas @@ -58,6 +58,17 @@ const TCI_TX_BUFFERING_MIN = 50; TCI_TX_BUFFERING_MAX = 500; TCI_RECORD_MAX_SEC = 300; // потолок записи линейного выхода + // ★Общий потолок памяти ВСЕХ рекордеров сразу. Приёмников у нас + // 1 + MAX_SLICES, и предельные 300 с на каждом — это 57.6 МБ × 7 ≈ 403 МБ, + // которые неавторизованный клиент выпрашивал бы семью строками. Бюджет + // общий на адаптер, спрашивается при выделении КАЖДОГО куска (см. + // TTCIRecorder): 128 МБ — это две полных записи предельной длины, больше + // одновременно не нужно никому. + TCI_RECORD_MAX_BYTES = Int64(128) * 1024 * 1024; + // Кусок кольца записи — секунда звука (48000 × 2 канала × int16 = 192 КБ). + // Выделяем их по мере набора: команда START больше не стоит ни байта, а + // молчащий или мёртвый приёмник не стоит ничего вовсе. + TCI_RECORD_CHUNK_SEC = 1; TCI_VOL_MIN_DB = -60; TCI_VOL_MAX_DB = 0; TCI_SQL_MIN_DB = -140; TCI_SQL_MAX_DB = 0; diff --git a/TCIStreams.pas b/TCIStreams.pas index 18024a8..b4c111b 100644 --- a/TCIStreams.pas +++ b/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. diff --git a/doc/TCI.md b/doc/TCI.md index ff88265..84072b9 100644 --- a/doc/TCI.md +++ b/doc/TCI.md @@ -136,9 +136,16 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─ Секция `tci` в корне `settings.json`: ```json -"tci": { "enabled": false, "port": 40001, "bind_addr": "127.0.0.1" } +"tci": { "enabled": false, "port": 40001, "bind_addr": "127.0.0.1", + "record_dir": "" } ``` +`record_dir` — единственный каталог, куда TCI пишет записи линейного выхода; +пусто = `<каталог конфигурации>/records`, каталог создаётся при первом `SAVE`. +Поля в UI у него нет намеренно: это не рабочая настройка, а граница, и менять +её осмысленно только руками в файле. Почему каталог вообще существует и почему +путь из команды в него не попадает — §2.5, «Имя файла: каталог всегда наш». + UI — вкладка **CAT → TCI Server**, справа от «TCP CAT Server» (галка, порт, интерфейс): TCI — такой же канал внешнего управления трансивером, что и CAT, и оператор ищет его там, а не в «Advanced». В протоколе @@ -506,6 +513,50 @@ ExpertSDR3 давно бы не было. это время не читает свой сокет. MP3 не поддержан — кодера в проекте нет, и на `.mp3` уходит честный `tci_error`. +**★Память рекордера — три замка, и все три нужны.** Авторизации в протоколе +нет (§3.1), поэтому «сколько памяти займёт одна строка из сети» — это вопрос +не об аккуратности, а о живучести процесса. Раньше `START` выделял буфер +целиком: 300 с × 48 кГц × 2 канала × int16 = 57.6 МБ на команду, а приёмников +1 + `MAX_SLICES` = 7, то есть 403 МБ семью строками, и держать их можно было +сколько угодно. + +1. **Память набирается кусками по секунде, а не вся сразу.** `START` не стоит + ни байта; молчащий, замьюченный или просто не звучащий приёмник не стоит + ничего вовсе. Куски не перевыделяются (никакого `realloc` в DSP-потоке) и + склеиваются один раз — в `Take`, а он идёт уже после того, как рекордер + вынут из таблицы, то есть без DSP-потока на плечах. +2. **Общий бюджет `TCI_RECORD_MAX_BYTES` (128 МБ) на все рекордеры сразу.** + Спрашивается при выделении каждого куска. Отказ не рушит запись: набранное + остаётся сохраняемым, просто дальше она не растёт — иначе клиент терял бы + уже записанное из-за чужой записи на другом приёмнике. +3. **Освобождение по трём событиям, а не по одному.** Раньше срок проверял + только `Feed`, то есть DSP-поток — а к мёртвому приёмнику он не приходит + никогда, и `START` на несуществующий номер оставлял память навсегда. + Теперь: `START` требует **живого** приёмника (`RxActive`, ответ + `receiver is not running` — как у потоков); тик сервера подметает истёкшие + окна по часам (`SweepRecorders`, окно закрывается от `START` и без единого + блока звука); уход клиента забирает его записи (`DropClientRecorders` — + рекордер живёт на приёмнике, но платит за него тот, кто нажал `START`, иначе + пары «подключился, `START`, отключился» набивали бы бюджет до потолка). + +**★Имя файла: каталог всегда наш.** `LINE_OUT_RECORDER_SAVE` в §4.3 принимает +«полное имя файла», и раньше оно почти без изменений уходило в `fmCreate` — +то есть любой, кто дотянулся до порта (а bind наружу разрешён), писал файлы от +имени EWSDR куда угодно и затирал существующие. Теперь из строки берётся +**только имя файла** (`TCIRecordPath`), а каталог — настроенный каталог +записей (`tci.record_dir`, пусто = `<каталог конфигурации>/records`). Полный +путь на СЕРВЕРЕ клиенту всё равно бесполезен: файл ложится не на его машину, а +на нашу, поэтому каталог из просьбы отбрасывается молча — клиент получает +разумный файл, а не ошибку. Само имя проверяется: пусто, `.`, `..`, +управляющие символы, `:`, длиннее 120 и расширение не `.wav` — отказ +(`bad file name`). Выйти за каталог после `ExtractFileName` нечем: +разделителей в имени уже не осталось, а `..` не проходит проверку. Файл +создаётся **эксклюзивно** (`TCICreateNewFile`: `O_EXCL or O_NOFOLLOW` на Unix, +`CREATE_NEW` на Windows) — существующий не перезаписывается и симлинк не +уводит наружу, причём одним вызовом ядра, без окна между `FileExists` и +созданием. Клиенту про уже занятое имя отвечаем `file exists` до постановки +задачи писателю. + **Потолок кадра.** Приёмный буфер соединения (`WsClient.WS_BUF_SIZE`) поднят с 4 до 32 КБ: блок TX-аудио — это 64 байта заголовка плюс `data[16384]`, а кадр крупнее буфера не собирается никогда (BufLen упирается в потолок и разбор @@ -806,11 +857,22 @@ ExpertSDR3 давно бы не было. - **Рекордер и WAV:** буфер ограничен запрошенным временем и пишется с начала окна (переполнение отбрасывает новое, а не затирает старое), до срока запись есть, после срока её нет и истёкший рекордер не оживает, `Take` завершает - запись, файл получает верные RIFF/fmt/data и длину. + запись, файл получает верные RIFF/fmt/data и длину. ★Память: `START` не + выделяет ни байта, бюджет растёт кусками по мере звука и возвращается по + `Free`, потолок берётся целиком и сверх него следует отказ, при отказе запись + не рушится, окно истекает по часам **без единого `Feed`** и отдаёт память + само. ★Имя файла: простое имя ложится в каталог записей, а каталог из + просьбы отбрасывается — абсолютный путь, `..` и буква диска наружу не + выводят; пусто, `..`, не-`.wav`, управляющий символ и отсутствие каталога + записей дают отказ; существующий файл писатель не перезаписывает. - **Команды на живом сервере** (настоящий `TRadioController`, WS-клиент на сыром сокете): отказ на несуществующий приёмник и на нечисловой аргумент, отказ на старт потока с незапущенного пана, подтверждение и отбраковка параметров, `SAVE` без записи и `SAVE` в `.mp3` отвечают ошибкой, + `LINE_OUT_RECORDER_START` на мёртвом приёмнике и с чужим номером отвечает + ошибкой и **не стоит памяти**, `SAVE` с чужим путём отбивается по имени; + запись, начатая ушедшим клиентом, освобождается вместе с ним (видно насквозь + по общему бюджету в части E); `TRX:0,true,tci` без аудиопотока модуляцию не берёт, а с потоком берёт, реально поднимает передачу и снимает её по `TRX:0,false` и по уходу клиента; чужой бинарный блок не рвёт соединение; без передачи маркеров `TX_CHRONO` diff --git a/test/tci/tcitest.pas b/test/tci/tcitest.pas index dd35972..746df56 100644 --- a/test/tci/tcitest.pas +++ b/test/tci/tcitest.pas @@ -72,6 +72,7 @@ var Buf: array[0..63] of Byte; N, i: Integer; T: TTCISampleType; + Base: string; begin WriteLn('A. Протокол потоков'); @@ -140,7 +141,37 @@ begin Check('клип int16 +', SmallInt(Word(Buf[0]) or (Word(Buf[1]) shl 8)) = 32767); Check('клип int16 −', SmallInt(Word(Buf[2]) or (Word(Buf[3]) shl 8)) = -32767); - Check('путь | → :', TCIRecordPath('home|user/rec.wav') = 'home:user/rec.wav'); + // ★Имя файла записи: каталог из просьбы клиента не берётся НИКОГДА — + // авторизации в TCI нет, и полный путь из сети означал бы запись в любой + // доступный процессу файл. Берём одно имя и кладём в свой каталог. + Base := IncludeTrailingPathDelimiter(GetTempDir) + 'tcirec'; + Check('путь: простое имя', + TCIRecordPath(Base, 'rec.wav') = + IncludeTrailingPathDelimiter(Base) + 'rec.wav', + TCIRecordPath(Base, 'rec.wav')); + Check('путь: каталог из просьбы отброшен', + TCIRecordPath(Base, 'home/user/rec_dir/a.wav') = + IncludeTrailingPathDelimiter(Base) + 'a.wav', + TCIRecordPath(Base, 'home/user/rec_dir/a.wav')); + Check('путь: абсолютный не выводит наружу', + TCIRecordPath(Base, '/etc/passwd.wav') = + IncludeTrailingPathDelimiter(Base) + 'passwd.wav', + TCIRecordPath(Base, '/etc/passwd.wav')); + Check('путь: .. не выводит наружу', + TCIRecordPath(Base, '../../../home/vladimir/.bashrc.wav') = + IncludeTrailingPathDelimiter(Base) + '.bashrc.wav', + TCIRecordPath(Base, '../../../home/vladimir/.bashrc.wav')); + Check('путь: буква диска (| → :) не выводит наружу', + TCIRecordPath(Base, 'D|\\rec\\a.wav') = + IncludeTrailingPathDelimiter(Base) + 'a.wav', + TCIRecordPath(Base, 'D|\\rec\\a.wav')); + Check('путь: пусто — отказ', TCIRecordPath(Base, '') = ''); + Check('путь: только каталог — отказ', TCIRecordPath(Base, 'a/b/') = ''); + Check('путь: «..» — отказ', TCIRecordPath(Base, '..') = ''); + Check('путь: не .wav — отказ', TCIRecordPath(Base, 'a.mp3') = ''); + Check('путь: управляющий символ — отказ', + TCIRecordPath(Base, 'a' + #10 + 'b.wav') = ''); + Check('путь: без каталога — отказ', TCIRecordPath('', 'a.wav') = ''); // Частоты Pluto (576…5760 кГц) на 384 делятся не все: клиенту обязана // достаться ЗАКОННАЯ частота из набора протокола, а не 576/480 кГц. @@ -531,12 +562,13 @@ var Sz: LongWord; W: TTCIWavWriter; Waited: Integer; + Was: Int64; begin WriteLn('C. Рекордер линейного выхода'); // Максимум записи — 1 секунда: подаём полторы, лишнее не берём. ★Именно НЕ // берём: окно записи по §4.3 начинается со START, а не «последняя секунда». - Rec := TTCIRecorder.Create(0, 48000, 1); + Rec := TTCIRecorder.Create(0, 48000, 1, nil); try Total := 0; for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end; @@ -556,7 +588,7 @@ begin end; // Порядок отсчётов: первым обязан идти самый ПЕРВЫЙ записанный. - Rec := TTCIRecorder.Create(0, 1000, 1); // ёмкость 1000 отсчётов + Rec := TTCIRecorder.Create(0, 1000, 1, nil); // ёмкость 1000 отсчётов try for i := 0 to 1499 do begin @@ -575,7 +607,7 @@ begin // ★Истечение срока: по документу «по истечении времени запись удаляется». // Секунду ждать незачем — окно берём минимальное и смотрим на часы. - Rec := TTCIRecorder.Create(0, 48000, 1); + Rec := TTCIRecorder.Create(0, 48000, 1, nil); try for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end; Rec.Feed(L, R, 8192); @@ -583,7 +615,7 @@ begin finally Rec.Free; end; - Rec := TTCIRecorder.Create(0, 48000, 1); + Rec := TTCIRecorder.Create(0, 48000, 1, nil); try Rec.Feed(L, R, 8192); Sleep(1100); // окно закрылось @@ -594,6 +626,58 @@ begin Rec.Free; end; + // ★Бюджет памяти. Раньше конструктор выделял MaxSec × 48 кГц × 2 × int16 + // СРАЗУ — 57.6 МБ на строку из сети, 403 МБ на семь приёмников, и держать их + // мог кто угодно (авторизации в TCI нет). Теперь START не стоит ни байта. + Was := TCIRecBudgetUsed; + Rec := TTCIRecorder.Create(0, 48000, TCI_RECORD_MAX_SEC, nil); + try + Check('бюджет: START не выделяет памяти', TCIRecBudgetUsed = Was, + IntToStr(TCIRecBudgetUsed - Was)); + for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end; + Rec.Feed(L, R, 8192); + Check('бюджет: растёт по мере записи', TCIRecBudgetUsed > Was); + Check('бюджет: кусками, а не всей ёмкостью', + TCIRecBudgetUsed - Was <= 4 * 48000 * 2 * 2, + IntToStr(TCIRecBudgetUsed - Was)); + finally + Rec.Free; + end; + Check('бюджет: возвращается по Free', TCIRecBudgetUsed = Was); + + // Потолок общий на все рекордеры сразу — иначе семь живых приёмников по + // 300 с всё равно дали бы 403 МБ. + Check('бюджет: потолок берётся целиком', + TCIRecBudgetTake(TCI_RECORD_MAX_BYTES - TCIRecBudgetUsed)); + Check('бюджет: сверх потолка отказ', not TCIRecBudgetTake(1)); + Rec := TTCIRecorder.Create(0, 48000, 10, nil); + try + Rec.Feed(L, R, 8192); + Check('бюджет: при отказе запись не рушится, а стоит пустой', + Length(Rec.Take) = 0); + finally + Rec.Free; + end; + TCIRecBudgetFree(TCI_RECORD_MAX_BYTES - Was); + Check('бюджет: после возврата снова можно брать', TCIRecBudgetTake(1)); + TCIRecBudgetFree(1); + + // ★Срок по ЧАСАМ спрашивает тик сервера: у мёртвого, молчащего или + // замьюченного приёмника Feed не зовут вовсе, и без этого вопроса память + // жила бы до остановки сервера. + Rec := TTCIRecorder.Create(0, 48000, 1, nil); + try + Rec.Feed(L, R, 8192); + Check('срок: до истечения окно открыто', not Rec.Expired); + Check('срок: память занята', TCIRecBudgetUsed > Was); + Sleep(1100); + Check('срок: истекло без единого Feed', Rec.Expired); + Check('срок: память отдана без Take и Free', TCIRecBudgetUsed = Was, + IntToStr(TCIRecBudgetUsed - Was)); + finally + Rec.Free; + end; + // WAV: заголовок и длина. Path := GetTempDir + 'tcitest_rec.wav'; DeleteFile(Path); @@ -629,6 +713,20 @@ begin finally FS.Free; end; + // ★Существующий файл не трогаем: имя приходит из сети, и fmCreate затирал + // бы любой доступный процессу файл. Пишем поверх заведомо другой длиной — + // файл обязан остаться прежним. + SetLength(Data, 10); + for i := 0 to 9 do Data[i] := 1; + TTCIWavWriter.Create(Path, Data, 48000); + Sleep(200); + FS := TFileStream.Create(Path, fmOpenRead); + try + Check('WAV: существующий файл не перезаписан', + FS.Size = 44 + 2000 * 2, IntToStr(FS.Size)); + finally + FS.Free; + end; DeleteFile(Path); end; end; @@ -890,6 +988,7 @@ var Op: Byte; Pay: TBytes; GotBinary, GotClose: Boolean; + Was: Int64; begin WriteLn('D. Команды потоков на живом сервере'); @@ -979,6 +1078,28 @@ begin Ctrl.SetSampleRate(192000); C.WaitText('if_limits', 1000); + // ★Рекордер только на ЖИВОМ приёмнике. Раньше хватало номера в потолке, и + // семь строк подряд занимали 403 МБ, которые никто не освобождал: у + // мёртвого приёмника Feed не зовут, значит и срок никто не проверял. + Was := TCIRecBudgetUsed; + C.SendText('line_out_recorder_start:3,300;'); + S := C.WaitText('tci_error', 1500); + Check('recorder start на мёртвом приёмнике → ошибка', + Pos('receiver is not running', S) > 0, S); + C.SendText('line_out_recorder_start:99,300;'); + S := C.WaitText('tci_error', 1500); + Check('recorder start с чужим номером → ошибка', + Pos('bad receiver', S) > 0, S); + Check('recorder: отказ не стоил памяти', TCIRecBudgetUsed = Was, + IntToStr(TCIRecBudgetUsed - Was)); + + // Имя файла из сети: каталог из просьбы игнорируется целиком, наружу + // записи не выходят (подробный разбор имён — в части A). + C.SendText('line_out_recorder_start:0,10;'); + C.SendText('line_out_recorder_save:0,..' + '/' + '..' + '/etc/passwd;'); + S := C.WaitText('tci_error', 1500); + Check('save с чужим путём → отказ по имени', Pos('bad file name', S) > 0, S); + // Рекордер: сохранять нечего — честная ошибка вместо пустого файла. C.SendText('line_out_recorder_save:0,' + StringReplace(GetTempDir + 'tcitest_none.wav', ':', '|', [rfReplaceAll]) + ';'); @@ -1205,6 +1326,8 @@ var SliceId: Integer; SV: TSliceView; S: string; + Was: Int64; + C2: TRawClient; begin WriteLn('E. Сквозной прогон через движок'); @@ -1304,6 +1427,46 @@ begin Check('сквозной: блоки IQ пришли', IQBlocks > 0, IntToStr(IQBlocks)); Check('сквозной: заголовки верны', BadHdr = 0, IntToStr(BadHdr)); + // ── ★Запись линейного выхода и уход клиента ────────────────────────── + // Рекордер живёт на приёмнике, но платит за него тот, кто нажал START. + // Раньше уход клиента его не трогал вовсе: пары «подключился, START, + // отключился» набивали память до потолка, и вернуть её было некому до + // остановки сервера. Тут это видно насквозь — по общему бюджету. + Was := TCIRecBudgetUsed; + C2 := TRawClient.Create; + try + Check('запись: второй клиент подключился', C2.Connect(PORT)); + C2.WaitText('ready;', 2000); + C2.SendText('line_out_recorder_start:0,300;'); + C2.Pump(100); + for k := 0 to 40 do + begin + for i := 0 to PAIRS - 1 do + begin + V := Round(Cos(2 * Pi * 1000 * Phase / RATE) * 4000000); + Pkt[i * 6] := Byte(V shr 16); + Pkt[i * 6 + 1] := Byte(V shr 8); + Pkt[i * 6 + 2] := Byte(V); + V := Round(Sin(2 * Pi * 1000 * Phase / RATE) * 4000000); + Pkt[i * 6 + 3] := Byte(V shr 16); + Pkt[i * 6 + 4] := Byte(V shr 8); + Pkt[i * 6 + 5] := Byte(V); + Inc(Phase); + end; + Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS); + Sleep(2); + end; + C2.Pump(200); + Check('запись: набирает память по мере звука', TCIRecBudgetUsed > Was, + IntToStr(TCIRecBudgetUsed - Was)); + finally + C2.Close_; // уход без close-кадра, как при обрыве + C2.Free; + end; + Sleep(400); + Check('запись: уход клиента освобождает её память', + TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was)); + // ── ★Слайс главного пана = приёмник 1 ──────────────────────────────── // Ровно случай Pluto: панов больше одного там не бывает, и «второй // приёмник» существует только как слайс. Приёмник = слот слайса, поэтому