mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 17:27:32 +00:00
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>
This commit is contained in:
Claude Opus 5
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
|
||||
+105
-9
@@ -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;
|
||||
|
||||
@@ -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;
|
||||
|
||||
+249
-38
@@ -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.
|
||||
|
||||
+64
-2
@@ -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`
|
||||
|
||||
+168
-5
@@ -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: панов больше одного там не бывает, и «второй
|
||||
// приёмник» существует только как слайс. Приёмник = слот слайса, поэтому
|
||||
|
||||
Reference in New Issue
Block a user