mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 18:43:51 +00:00
ew8bakandClaude Opus 5
b173b7f542
Всплеск, рождённый нашим трактом, невозможен без одного события: очередь DUC
простаивает дольше подушки отправителя (DUC_FIFO_THROTTLE = 2000 отсчётов при
192 кГц = 10.42 мс). Съём 2026-08-21 это показал прямо: шесть всплесков — шесть
простоев 10.3-23.5 мс, а паузы 8 мс и короче не дали ни одного. Значит счётчик
таких простоев — полный детектор «наш/не наш», и оператору больше не нужно
называть интервал на глаз.
Новый юнит TxHealth.pas. Включён всегда: переменной окружения нет намеренно —
прибор, который надо не забыть включить, к моменту дефекта выключен.
* поток отправителя DUC мерит каждый простой очереди на передаче — одно чтение
монотонных часов на ПЕРЕХОД, ни файлов, ни локов (обе ветки, win и unix);
* планировщик TCI публикует рядом состояние пейсинга (аванс, долг, в полёте,
квант, шаг, период пачек клиента) — простыми записями, без лока: числа
диагностические, а лок в потоке отправителя DUC недопустим для тайминга;
* сетевой поток считает бит HPS_FIFO_EMPTY из HP-статуса радио — поле ГЛУБИНЫ
FIFO на этой прошивке статично (256) и веры ему нет, а бит мы не читали вовсе;
* ★журнал пишет ТОЛЬКО потребитель — таймер UI (100 мс) и цикл демона через
TxHealthService. В тракте передачи диска нет по построению.
Последнее — правило, оплаченное регрессом: прошлый прибор (TxTrace) сбрасывал
дамп синхронно в хвосте SetMOX, и эти десятки миллисекунд закрывали гонку в
пейсинге TCI (лечение — fa38fa7). Инструмент чинил дефект собой.
Журнал ~/.config/ewsdr/txhealth.log, строка на передачу: «чисто» либо «ОПАСНО
(первое на N мс)» плюс подробности с контекстом пейсинга. В статусной строке
UI — «·сухо N» за сеанс, чтобы не помнить, какая посылка была плохой.
Стенд: секция G в test/tci (порог подушки, сводка, момент от фронта PTT,
контекст рядом с событием, молчание вне передачи) — 276/276. Диск стенд не
трогает намеренно: берёт сводки через TxHealthTake/TxHealthDetail, мимо
TxHealthService, иначе писал бы в настоящий журнал пользователя.
Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Bkwwyj7xVRrqnSVEseTRfV
2742 lines
130 KiB
ObjectPascal
2742 lines
130 KiB
ObjectPascal
program tcitest;
|
||
|
||
{
|
||
Стенд этапа 2 TCI: бинарные потоки (§3.4). Запуск: test/tci/run.sh
|
||
|
||
Проверяет слои по отдельности и сквозным прогоном:
|
||
A. формат блока и математика — TCIProtocol;
|
||
A2. пересчёт частоты — дециматор, каскад, интерполятор;
|
||
B. исходящий блок до сокета — TTCIStreamOut → TTCIClient → socketpair;
|
||
C. рекордер и WAV;
|
||
D. команды потоков в живом сервере с настоящим TRadioController;
|
||
E. сквозной прогон через ЖИВОЙ WDSP: синтетический IQ в движок → блоки
|
||
RX-аудио и IQ у настоящего WS-клиента, и обратно TX-аудио клиента →
|
||
блоки TX-IQ.
|
||
|
||
Внешних библиотек не требует: WS-клиент написан на сыром сокете. Для части E
|
||
нужен libwdsp (тот же, что и приложению); если он не поднялся, эта часть
|
||
сообщает о пропуске, а не валит прогон.
|
||
|
||
★Собирать только с -Mobjfpc (см. run.sh): в режиме Delphi выключаются
|
||
вложенные комментарии, и {$MODE Delphi} внутри шапки WebUtils.pas закрывает
|
||
комментарий раньше времени — компиляция падает на «illegal character».
|
||
}
|
||
|
||
{$MODE Delphi}
|
||
{$LONGSTRINGS ON}
|
||
|
||
uses
|
||
cthreads, Classes, SysUtils, Math, SyncObjs, Sockets, BaseUnix,
|
||
TCIProtocol, TCIStreams, TCIServer, TCIAdapter, RadioController,
|
||
WsClient, WebUtils, WDSPEngine, Settings, CWMorse, TxHealth, PlatformUtils;
|
||
|
||
var
|
||
Passed, Failed: Integer;
|
||
|
||
procedure Check(const Name: string; OK: Boolean; const Detail: string = '');
|
||
begin
|
||
if OK then
|
||
begin
|
||
Inc(Passed);
|
||
WriteLn(' ok ', Name);
|
||
end
|
||
else
|
||
begin
|
||
Inc(Failed);
|
||
WriteLn(' FAIL ', Name, ' ', Detail);
|
||
end;
|
||
end;
|
||
|
||
function Near(A, B, Eps: Double): Boolean;
|
||
begin
|
||
Result := Abs(A - B) <= Eps;
|
||
end;
|
||
|
||
function RMS(const A: array of Single; N: Integer): Double;
|
||
var i: Integer; S: Double;
|
||
begin
|
||
S := 0;
|
||
for i := 0 to N - 1 do S := S + A[i] * A[i];
|
||
if N = 0 then Result := 0 else Result := Sqrt(S / N);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
A. Протокол и математика
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
procedure TestProtocol;
|
||
var
|
||
H: TTCIStreamHeader;
|
||
Src: array[0..7] of Single;
|
||
Dst: array[0..7] of Single;
|
||
Buf: array[0..63] of Byte;
|
||
N, i: Integer;
|
||
T: TTCISampleType;
|
||
Base: string;
|
||
begin
|
||
WriteLn('A. Протокол потоков');
|
||
|
||
Check('decim 48k→12k = 4', TCIDecimFactor(48000, 12000) = 4);
|
||
Check('decim 48k→8k = 6', TCIDecimFactor(48000, 8000) = 6);
|
||
Check('decim 48k→48k = 1', TCIDecimFactor(48000, 48000) = 1);
|
||
Check('decim 384k→48k = 8', TCIDecimFactor(384000, 48000) = 8);
|
||
Check('decim 192k→48k = 4', TCIDecimFactor(192000, 48000) = 4);
|
||
// Запрошено больше, чем есть, — вверх не тянем, отдаём как есть.
|
||
Check('decim 48k→96k = 1', TCIDecimFactor(48000, 96000) = 1);
|
||
// Нацело не делится: берём ближайший делитель, не опускаясь ниже просьбы.
|
||
Check('decim 50k→12k = 4', TCIDecimFactor(50000, 12000) = 4,
|
||
IntToStr(TCIDecimFactor(50000, 12000)));
|
||
|
||
Check('samples@48k = 2048', TCIDefaultAudioSamples(48000) = 2048);
|
||
Check('samples@12k = 512', TCIDefaultAudioSamples(12000) = 512);
|
||
Check('block float32×2', TCIMaxBlockSamples(tsyFloat32, 2) = 2048);
|
||
Check('block int16×1', TCIMaxBlockSamples(tsyInt16, 1) = 8192);
|
||
Check('bytes int24 = 3', TCISampleBytes(tsyInt24) = 3);
|
||
|
||
Check('type by name int24', TCISampleTypeByName('INT24', T) and (T = tsyInt24));
|
||
Check('type by name мусор', not TCISampleTypeByName('int8', T));
|
||
Check('type name float32', TCISampleTypeName(tsyFloat32) = 'float32');
|
||
|
||
TCIFillHeader(H, tstRXAudio, 2, 12000, tsyInt16, 512, 2);
|
||
Check('header receiver', H.Receiver = 2);
|
||
Check('header rate', H.SampleRate = 12000);
|
||
Check('header format', H.Format = LongWord(Ord(tsyInt16)));
|
||
// ★length — вещественные отсчёты ВСЕГО блока, и у аудио тоже: клиенты
|
||
// считают по нему число байт (MSHV: `cr2 = length*bit_s`). Объявишь «на
|
||
// канал» — у стерео разберётся половина блока, и звук пойдёт с дырами.
|
||
Check('header length аудио = ×каналы', H.DataLength = 1024);
|
||
Check('header type', H.StreamType = LongWord(Ord(tstRXAudio)));
|
||
Check('header channels', H.Channels = 2);
|
||
Check('header codec/crc', (H.Codec = 0) and (H.CRC = 0));
|
||
Check('header size 64', SizeOf(H) = TCI_STREAM_HDR_SIZE);
|
||
// ★IQ: а тут length — вещественные отсчёты, то есть вдвое больше
|
||
// комплексных (§3.4 прямо: комплексных = length/channels).
|
||
TCIFillHeader(H, tstIQ, 0, 48000, tsyFloat32, 512, 2);
|
||
Check('header length IQ = ×каналы', H.DataLength = 1024);
|
||
// Маркер времени TX_CHRONO живёт по тем же правилам: он называет клиенту
|
||
// размер блока, который тот пришлёт (§3.4).
|
||
TCIFillHeader(H, tstTXChrono, 0, 12000, tsyFloat32, 256, 2);
|
||
Check('header length chrono = ×каналы', H.DataLength = 512);
|
||
// Моно: отсчётов столько же, сколько сэмплов на канал.
|
||
TCIFillHeader(H, tstRXAudio, 0, 12000, tsyInt16, 512, 1);
|
||
Check('header length моно = сэмплы', H.DataLength = 512);
|
||
|
||
// Упаковка/распаковка: сквозной проход по всем форматам.
|
||
for i := 0 to 7 do Src[i] := (i - 4) / 8.0; // −0.5 … +0.375
|
||
for T := tsyInt16 to tsyFloat32 do
|
||
begin
|
||
N := TCIPackSamples(Src, 8, T, @Buf[0]);
|
||
Check('pack размер ' + TCISampleTypeName(T), N = 8 * TCISampleBytes(T));
|
||
N := TCIUnpackSamples(@Buf[0], N, T, Dst);
|
||
Check('unpack счёт ' + TCISampleTypeName(T), N = 8);
|
||
Check('round-trip ' + TCISampleTypeName(T),
|
||
Near(Dst[0], Src[0], 1E-4) and Near(Dst[7], Src[7], 1E-4),
|
||
Format('%.6f vs %.6f', [Dst[0], Src[0]]));
|
||
end;
|
||
|
||
// Клип: перегруз обязан упереться в шкалу, а не завернуться через знак.
|
||
Src[0] := 2.0;
|
||
Src[1] := -2.0;
|
||
TCIPackSamples(Src, 2, tsyInt16, @Buf[0]);
|
||
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);
|
||
|
||
// ★Имя файла записи: каталог из просьбы клиента не берётся НИКОГДА —
|
||
// авторизации в 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 кГц.
|
||
Check('IQ rate 576к, просят 384к → 192к',
|
||
TCIPickIQRate(576000, 384000) = 192000,
|
||
IntToStr(TCIPickIQRate(576000, 384000)));
|
||
Check('IQ rate 960к, просят 384к → 192к',
|
||
TCIPickIQRate(960000, 384000) = 192000,
|
||
IntToStr(TCIPickIQRate(960000, 384000)));
|
||
Check('IQ rate 768к, просят 384к → 384к',
|
||
TCIPickIQRate(768000, 384000) = 384000);
|
||
Check('IQ rate 5760к, просят 48к → 48к',
|
||
TCIPickIQRate(5760000, 48000) = 48000);
|
||
Check('IQ rate 192к, просят 384к → 192к',
|
||
TCIPickIQRate(192000, 384000) = 192000);
|
||
Check('IQ rate чужой 50к → просьба как есть',
|
||
TCIPickIQRate(50000, 48000) = 48000);
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
A2. Дециматор и интерполятор
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
{ Прогон каскада: тон в полосе обязан пройти без потерь, тон за новой границей
|
||
Найквиста — исчезнуть. Кормим кусками по 4096, как это делает поток. }
|
||
procedure TestChain(M: Integer; SrcRate, PassHz, StopHz: Double;
|
||
const What: string);
|
||
const
|
||
NTOT = 65536;
|
||
var
|
||
C: TTCIDecimChain;
|
||
Src: array[0..4095] of Single;
|
||
Dst: array[0..4095] of Single;
|
||
i, off, n: Integer;
|
||
Acc: Double;
|
||
|
||
function RunTone(ToneHz: Double): Double;
|
||
var j: Integer;
|
||
begin
|
||
C := TTCIDecimChain.Create(M);
|
||
try
|
||
Acc := 0;
|
||
n := 0;
|
||
off := 0;
|
||
while off + 4096 <= NTOT do
|
||
begin
|
||
for j := 0 to 4095 do
|
||
Src[j] := Sin(2 * Pi * ToneHz * (off + j) / SrcRate);
|
||
i := C.Process(Src, 4096, Dst);
|
||
// Первую половину прогона пропускаем: там переходный процесс фильтра.
|
||
if off >= NTOT div 2 then
|
||
for j := 0 to i - 1 do
|
||
begin
|
||
Acc := Acc + Dst[j] * Dst[j];
|
||
Inc(n);
|
||
end;
|
||
Inc(off, 4096);
|
||
end;
|
||
if n = 0 then Result := 0 else Result := Sqrt(Acc / n);
|
||
finally
|
||
C.Free;
|
||
end;
|
||
end;
|
||
|
||
var
|
||
Pass, Stop: Double;
|
||
begin
|
||
Pass := RunTone(PassHz);
|
||
Stop := RunTone(StopHz);
|
||
Check(What + ': полоса цела', Abs(Pass - 0.707) < 0.03,
|
||
Format('%.4f', [Pass]));
|
||
Check(What + ': зеркало давится (>60 дБ)', Stop < 0.0007,
|
||
Format('%.6f', [Stop]));
|
||
end;
|
||
|
||
procedure TestResampling;
|
||
const
|
||
NIN = 8192;
|
||
var
|
||
D: TTCIDecimator;
|
||
I_: TTCIInterpolator;
|
||
Src: array[0..NIN-1] of Single;
|
||
Dst: array[0..NIN-1] of Single;
|
||
Out_: array[0..NIN*8-1] of Double;
|
||
i, n: Integer;
|
||
Ph, Lo, Hi: Double;
|
||
begin
|
||
WriteLn('A2. Пересчёт частоты');
|
||
|
||
// Постоянка: усиление на нуле обязано быть единичным, иначе поток тише/громче
|
||
// ровно на коэффициент прореживания.
|
||
D := TTCIDecimator.Create(4);
|
||
try
|
||
for i := 0 to NIN - 1 do Src[i] := 1.0;
|
||
n := D.Process(Src, NIN, Dst);
|
||
Check('децим счёт = N/M', n = NIN div 4, IntToStr(n));
|
||
Check('децим усиление 1.0', Near(Dst[n - 1], 1.0, 0.01),
|
||
Format('%.4f', [Dst[n - 1]]));
|
||
finally
|
||
D.Free;
|
||
end;
|
||
|
||
// Тон в полосе проходит, тон за новой границей Найквиста — давится.
|
||
D := TTCIDecimator.Create(4); // 48к → 12к, Найквист 6 кГц
|
||
try
|
||
Ph := 0;
|
||
for i := 0 to NIN - 1 do
|
||
begin
|
||
Src[i] := Sin(2 * Pi * 1000 * i / 48000);
|
||
Ph := Ph;
|
||
end;
|
||
n := D.Process(Src, NIN, Dst);
|
||
Check('децим 1 кГц проходит', Near(RMS(Dst, n), 0.707, 0.05),
|
||
Format('%.4f', [RMS(Dst, n)]));
|
||
finally
|
||
D.Free;
|
||
end;
|
||
|
||
D := TTCIDecimator.Create(4);
|
||
try
|
||
for i := 0 to NIN - 1 do Src[i] := Sin(2 * Pi * 20000 * i / 48000);
|
||
n := D.Process(Src, NIN, Dst);
|
||
Check('децим 20 кГц давится (>40 дБ)', RMS(Dst, n) < 0.007,
|
||
Format('%.5f', [RMS(Dst, n)]));
|
||
finally
|
||
D.Free;
|
||
end;
|
||
|
||
// Коэффициент 1 — сквозной проход без фильтра (иначе теряли бы верх полосы).
|
||
D := TTCIDecimator.Create(1);
|
||
try
|
||
for i := 0 to 15 do Src[i] := i / 16.0;
|
||
n := D.Process(Src, 16, Dst);
|
||
Check('децим ×1 прозрачен', (n = 16) and Near(Dst[15], 15 / 16.0, 1E-6));
|
||
finally
|
||
D.Free;
|
||
end;
|
||
|
||
// ★Каскад на коэффициентах Pluto. Одной ступенью это не берётся: замер до
|
||
// каскада дал на M=120 завал 1.3 дБ в полосе и подавление зеркала 16 дБ.
|
||
TestChain(4, 192000, 12000, 40000, 'HPSDR 192→48');
|
||
TestChain(8, 384000, 12000, 40000, 'HPSDR 384→48');
|
||
TestChain(12, 576000, 12000, 40000, 'Pluto 576→48');
|
||
TestChain(32, 1536000, 12000, 40000, 'Pluto 1536→48');
|
||
TestChain(120,5760000, 12000, 40000, 'Pluto 5760→48');
|
||
TestChain(15, 5760000, 100000, 300000, 'Pluto 5760→384');
|
||
|
||
// Интерполятор: счёт и отсутствие выбросов за пределы соседних отсчётов.
|
||
I_ := TTCIInterpolator.Create(4);
|
||
try
|
||
for i := 0 to 99 do Src[i] := Sin(2 * Pi * i / 25);
|
||
n := I_.Process(Src, 100, Out_);
|
||
Check('интерп счёт = N×M', n = 400, IntToStr(n));
|
||
// Смотрим ТОЛЬКО заполненную часть: хвост буфера — мусор со стека, и
|
||
// MaxValue по нему ловит сигнальный NaN (проверено: с -O2 прогон падал
|
||
// с EInvalidOp ровно здесь).
|
||
Lo := Out_[0];
|
||
Hi := Out_[0];
|
||
for i := 1 to n - 1 do
|
||
begin
|
||
if Out_[i] < Lo then Lo := Out_[i];
|
||
if Out_[i] > Hi then Hi := Out_[i];
|
||
end;
|
||
Check('интерп без выбросов', (Hi <= 1.0001) and (Lo >= -1.0001),
|
||
Format('%.4f..%.4f', [Lo, Hi]));
|
||
finally
|
||
I_.Free;
|
||
end;
|
||
|
||
I_ := TTCIInterpolator.Create(1);
|
||
try
|
||
for i := 0 to 9 do Src[i] := i;
|
||
n := I_.Process(Src, 10, Out_);
|
||
Check('интерп ×1 прозрачен', (n = 10) and Near(Out_[9], 9, 1E-9));
|
||
finally
|
||
I_.Free;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
B. Блок до сокета: TTCIStreamOut → TTCIClient → socketpair
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
type
|
||
{ Приёмник кадров с другого конца socketpair: разбирает WS-кадры сервера
|
||
(немаскированные, FIN=1) и отдаёт полезную нагрузку. }
|
||
TFrameSink = record
|
||
Fd: Integer;
|
||
Buf: array[0..262143] of Byte;
|
||
Len: Integer;
|
||
end;
|
||
|
||
procedure SinkDrain(var S: TFrameSink);
|
||
var R: Integer;
|
||
begin
|
||
repeat
|
||
R := fpRecv(S.Fd, @S.Buf[S.Len], SizeOf(S.Buf) - S.Len, MSG_DONTWAIT);
|
||
if R > 0 then Inc(S.Len, R);
|
||
until R <= 0;
|
||
end;
|
||
|
||
{ Достаёт следующий кадр. False — кадров больше нет. }
|
||
function SinkNext(var S: TFrameSink; out Opcode: Byte; out Payload: TBytes): Boolean;
|
||
var
|
||
PayLen, Need, i: Integer;
|
||
begin
|
||
Result := False;
|
||
Payload := nil;
|
||
if S.Len < 2 then Exit;
|
||
Opcode := S.Buf[0] and $0F;
|
||
PayLen := S.Buf[1] and $7F;
|
||
Need := 2;
|
||
if PayLen = 126 then
|
||
begin
|
||
if S.Len < 4 then Exit;
|
||
PayLen := (S.Buf[2] shl 8) or S.Buf[3];
|
||
Need := 4;
|
||
end
|
||
else if PayLen = 127 then
|
||
begin
|
||
if S.Len < 10 then Exit;
|
||
PayLen := (S.Buf[6] shl 24) or (S.Buf[7] shl 16) or (S.Buf[8] shl 8) or S.Buf[9];
|
||
Need := 10;
|
||
end;
|
||
if S.Len < Need + PayLen then Exit;
|
||
SetLength(Payload, PayLen);
|
||
for i := 0 to PayLen - 1 do Payload[i] := S.Buf[Need + i];
|
||
if S.Len > Need + PayLen then
|
||
Move(S.Buf[Need + PayLen], S.Buf[0], S.Len - Need - PayLen);
|
||
Dec(S.Len, Need + PayLen);
|
||
Result := True;
|
||
end;
|
||
|
||
procedure TestStreamOut;
|
||
var
|
||
Fds: array[0..1] of Integer;
|
||
Ws: TWsClient;
|
||
C: TTCIClient;
|
||
S: TTCIStreamOut;
|
||
Sink: TFrameSink;
|
||
L, R: array[0..8191] of Single;
|
||
i, Blocks: Integer;
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
H: TTCIStreamHeader;
|
||
IQI, IQQ: array[0..8191] of Double;
|
||
OkHdr: Boolean;
|
||
begin
|
||
WriteLn('B. Исходящий блок до сокета');
|
||
|
||
if fpSocketPair(AF_UNIX, SOCK_STREAM, 0, @Fds[0]) <> 0 then
|
||
begin
|
||
Check('socketpair', False, 'создать пару не удалось');
|
||
Exit;
|
||
end;
|
||
FillChar(Sink, SizeOf(Sink), 0);
|
||
Sink.Fd := Fds[1];
|
||
|
||
Ws := TWsClient.Create(Fds[0]);
|
||
Ws.State := wsOpen;
|
||
C := TTCIClient.Create(Ws);
|
||
try
|
||
// 48 кГц стерео → 12 кГц стерео float32, блок 512 сэмплов на канал.
|
||
S := TTCIStreamOut.Create(C, tstRXAudio, 0, 48000, 12000, 2, tsyFloat32, 512);
|
||
try
|
||
for i := 0 to 8191 do
|
||
begin
|
||
L[i] := Sin(2 * Pi * 1000 * i / 48000);
|
||
R[i] := L[i] * 0.5;
|
||
end;
|
||
S.FeedAudio(L, R, 8192); // 8192/4 = 2048 выходных = 4 блока по 512
|
||
Check('поток: частота на выходе', S.OutRate = 12000, IntToStr(S.OutRate));
|
||
finally
|
||
S.Free;
|
||
end;
|
||
OkHdr := C.Flush;
|
||
Check('аудио: flush socketpair', OkHdr,
|
||
'dead=' + BoolToStr(C.Dead, True) + ', errno=' + IntToStr(fpGetErrno) +
|
||
', txfd=' + IntToStr(Fds[0]) + ', rxfd=' + IntToStr(Fds[1]));
|
||
SinkDrain(Sink);
|
||
|
||
Blocks := 0;
|
||
OkHdr := True;
|
||
while SinkNext(Sink, Op, Pay) do
|
||
begin
|
||
if Op <> $02 then begin OkHdr := False; Continue; end;
|
||
if Length(Pay) < SizeOf(H) then begin OkHdr := False; Continue; end;
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if (H.SampleRate <> 12000) or (H.Channels <> 2) or
|
||
(H.DataLength <> 1024) or // вещественных отсчётов = 512 × 2
|
||
(H.StreamType <> LongWord(Ord(tstRXAudio))) or
|
||
(H.Format <> LongWord(Ord(tsyFloat32))) or
|
||
// ★Правило, по которому живут клиенты: байт данных = length × размер
|
||
// отсчёта. Ровно так считает MSHV (`cr2 = length*bit_s`).
|
||
(Length(Pay) <> SizeOf(H) + Integer(H.DataLength) * 4) then OkHdr := False;
|
||
Inc(Blocks);
|
||
end;
|
||
Check('аудио: 4 блока', Blocks = 4, IntToStr(Blocks));
|
||
Check('аудио: заголовок и размер', OkHdr);
|
||
|
||
// IQ: 384 кГц → 48 кГц, блок 2048 комплексных.
|
||
S := TTCIStreamOut.Create(C, tstIQ, 1, 384000, 48000, 2, tsyFloat32, 2048);
|
||
try
|
||
Check('IQ: частота на выходе', S.OutRate = 48000, IntToStr(S.OutRate));
|
||
for i := 0 to 8191 do
|
||
begin
|
||
IQI[i] := Cos(2 * Pi * 1000 * i / 384000);
|
||
IQQ[i] := Sin(2 * Pi * 1000 * i / 384000);
|
||
end;
|
||
// 8192/8 = 1024 выходных — половина блока, отправки быть не должно.
|
||
S.FeedIQ(@IQI[0], @IQQ[0], 8192);
|
||
C.Flush;
|
||
SinkDrain(Sink);
|
||
Check('IQ: полблока не уходит', not SinkNext(Sink, Op, Pay));
|
||
S.FeedIQ(@IQI[0], @IQQ[0], 8192); // ещё половина — теперь блок целый
|
||
C.Flush;
|
||
SinkDrain(Sink);
|
||
OkHdr := SinkNext(Sink, Op, Pay);
|
||
if OkHdr then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
OkHdr := (H.Receiver = 1) and (H.SampleRate = 48000) and
|
||
(H.DataLength = 4096) and
|
||
(H.StreamType = LongWord(Ord(tstIQ))) and
|
||
(Length(Pay) = SizeOf(H) + 4096 * 4);
|
||
end;
|
||
Check('IQ: блок целиком и по формату', OkHdr);
|
||
|
||
// Смена частоты источника на ходу (сменили rate DDC).
|
||
S.SetSourceRate(192000);
|
||
Check('IQ: пересчёт после смены rate', S.OutRate = 48000);
|
||
finally
|
||
S.Free;
|
||
end;
|
||
|
||
// Моно: 1 канал = среднее двух.
|
||
S := TTCIStreamOut.Create(C, tstRXAudio, 0, 48000, 48000, 1, tsyInt16, 100);
|
||
try
|
||
for i := 0 to 199 do begin L[i] := 0.5; R[i] := -0.5; end;
|
||
S.FeedAudio(L, R, 200);
|
||
C.Flush;
|
||
SinkDrain(Sink);
|
||
OkHdr := SinkNext(Sink, Op, Pay);
|
||
if OkHdr then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
OkHdr := (H.Channels = 1) and (H.DataLength = 100) and
|
||
(H.Format = LongWord(Ord(tsyInt16))) and
|
||
(Length(Pay) = SizeOf(H) + 100 * 2);
|
||
end;
|
||
Check('моно int16: заголовок и размер', OkHdr);
|
||
finally
|
||
S.Free;
|
||
end;
|
||
|
||
// Переполнение кольца блоков: клиент не читает — теряем старые блоки,
|
||
// но соединение живо и команды по нему ходят.
|
||
S := TTCIStreamOut.Create(C, tstRXAudio, 0, 48000, 48000, 2, tsyFloat32, 100);
|
||
try
|
||
for i := 0 to 8191 do begin L[i] := 0.1; R[i] := 0.1; end;
|
||
for i := 0 to 99 do S.FeedAudio(L, R, 8192); // много блоков без Flush
|
||
Check('переполнение: блоки теряются', C.BinDropped > 0,
|
||
IntToStr(C.BinDropped));
|
||
Check('переполнение: клиент жив', not C.Dead);
|
||
finally
|
||
S.Free;
|
||
end;
|
||
finally
|
||
C.Free;
|
||
Ws.Free;
|
||
fpClose(Fds[1]);
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
C. Рекордер и WAV
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
function FlatTake(const T: TTCIRecTake): TTCIPcm;
|
||
// Склейка кусков записи в один буфер. Живёт ТОЛЬКО в стенде: продовый путь
|
||
// сплошной копии не делает вовсе — писатель пишет куски подряд, иначе на
|
||
// полном бюджете рядом жили бы куски и их копия, то есть двойной пик.
|
||
var C, n, Left: Integer;
|
||
begin
|
||
Result := nil;
|
||
if T.Count <= 0 then Exit;
|
||
SetLength(Result, T.Count * 2);
|
||
Left := T.Count;
|
||
for C := 0 to High(T.Chunks) do
|
||
begin
|
||
if Left <= 0 then Break;
|
||
n := T.Chunk;
|
||
if n > Left then n := Left;
|
||
Move(T.Chunks[C][0], Result[(T.Count - Left) * 2], n * 2 * SizeOf(SmallInt));
|
||
Dec(Left, n);
|
||
end;
|
||
end;
|
||
|
||
function MakeTake(const Data: TTCIPcm; Reserved: Int64): TTCIRecTake;
|
||
// Одно задание писателю из готового куска: в проде куски приносит Take.
|
||
begin
|
||
Result.Chunks := nil;
|
||
SetLength(Result.Chunks, 1);
|
||
Result.Chunks[0] := Data;
|
||
Result.Chunk := Length(Data) div 2;
|
||
Result.Count := Result.Chunk;
|
||
Result.Reserved := Reserved;
|
||
end;
|
||
|
||
function Drained(W: TTCIWavWriter; TimeoutMs: Integer): Boolean;
|
||
// Ограниченное ожидание очереди — ТОЛЬКО для стенда: у писателя WaitDrained
|
||
// срока не имеет (см. TCIStopWriter), а зависший стенд ничего не сообщает.
|
||
var Waited: Integer;
|
||
begin
|
||
Waited := 0;
|
||
while (W.Pending > 0) and (Waited < TimeoutMs) do
|
||
begin
|
||
Sleep(5);
|
||
Inc(Waited, 5);
|
||
end;
|
||
Result := W.Pending = 0;
|
||
end;
|
||
|
||
function NextTempName(const Name: string): string;
|
||
// Имя «.part», следующее за данным: у писателя счётчик один на процесс, и
|
||
// стенду нужно занять именно то имя, которое он возьмёт после нашего вызова.
|
||
var i, p1, p2: Integer;
|
||
begin
|
||
p2 := Pos('.part', Name);
|
||
p1 := p2;
|
||
for i := p2 - 1 downto 1 do
|
||
if Name[i] = '-' then begin p1 := i; Break; end;
|
||
Result := Copy(Name, 1, p1) +
|
||
IntToStr(StrToIntDef(Copy(Name, p1 + 1, p2 - p1 - 1), 0) + 1) +
|
||
'.part';
|
||
end;
|
||
|
||
function PartFiles(const Path: string): Integer;
|
||
// Сколько временных файлов писателя осталось рядом с целью.
|
||
var SR: TSearchRec;
|
||
begin
|
||
Result := 0;
|
||
if FindFirst(Path + '.*', faAnyFile, SR) = 0 then
|
||
begin
|
||
repeat
|
||
Inc(Result);
|
||
until FindNext(SR) <> 0;
|
||
end;
|
||
FindClose(SR);
|
||
end;
|
||
|
||
procedure TestRecorder;
|
||
var
|
||
Rec: TTCIRecorder;
|
||
L, R: array[0..8191] of Single;
|
||
Data: TTCIPcm;
|
||
i, Total: Integer;
|
||
Path: string;
|
||
FS: TFileStream;
|
||
Hdr: array[0..43] of Byte;
|
||
Sz: LongWord;
|
||
W: TTCIWavWriter;
|
||
Was: Int64;
|
||
Tk: TTCIRecTake;
|
||
Big: TTCIPcm;
|
||
Refused, k, Bad: Integer;
|
||
Path2, Squat: string;
|
||
begin
|
||
WriteLn('C. Рекордер линейного выхода');
|
||
|
||
// Максимум записи — 1 секунда: подаём полторы, лишнее не берём. ★Именно НЕ
|
||
// берём: окно записи по §4.3 начинается со START, а не «последняя секунда».
|
||
Was := TCIRecBudgetUsed; // счёт бюджета ДО записи
|
||
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;
|
||
while Total < 72000 do
|
||
begin
|
||
Rec.Feed(L, R, 8192);
|
||
Inc(Total, 8192);
|
||
end;
|
||
Tk := Rec.Take; Data := FlatTake(Tk);
|
||
Check('рекордер: длина по максимуму', Length(Data) = 48000 * 2,
|
||
IntToStr(Length(Data)));
|
||
// ★Take отдаёт данные ВМЕСТЕ с их местом в бюджете: копия живёт дальше в
|
||
// писателе, и до конца записи она обязана оставаться учтённой. Иначе SAVE
|
||
// был бы дырой в потолке — куски вернулись бы сразу, а копия висела бы
|
||
// неучтённой, и очередь сохранений на медленном диске росла бы без границ.
|
||
// ★Куски отдаются КАК ЕСТЬ: сплошной копии нет ни на миг, поэтому и пика
|
||
// в два бюджета нет. Резерв переезжает вместе с ними — целиком.
|
||
Check('рекордер: Take отдаёт сами куски, не копию',
|
||
(Length(Tk.Chunks) > 0) and (Tk.Count = Length(Data) div 2),
|
||
IntToStr(Length(Tk.Chunks)));
|
||
Check('рекордер: резерв переехал целиком, счёт не изменился',
|
||
TCIRecBudgetUsed = Was + Tk.Reserved,
|
||
IntToStr(TCIRecBudgetUsed - Was) + '/' + IntToStr(Tk.Reserved));
|
||
Check('рекордер: резерва хватает на отданные куски',
|
||
Tk.Reserved >= Int64(Length(Data)) * SizeOf(SmallInt),
|
||
IntToStr(Tk.Reserved));
|
||
TCIRecBudgetFree(Tk.Reserved); // как это сделает писатель
|
||
Tk.Chunks := nil;
|
||
Check('рекордер: возврат резерва закрывает счёт',
|
||
TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was));
|
||
Check('рекордер: уровень сохранён',
|
||
(Data[0] = Round(0.25 * 32767)) and (Data[1] = -Round(0.25 * 32767)));
|
||
Check('рекордер: Take завершает запись', Length(FlatTake(Rec.Take)) = 0);
|
||
finally
|
||
Rec.Free;
|
||
end;
|
||
|
||
// ★Отдаются именно куски, а не свёрнутая в один буфер копия: 2.5 секунды
|
||
// при куске в секунду — это ТРИ куска. Если бы Take собирал сплошную копию
|
||
// (как было), кусок пришёл бы один, а пик памяти на полном бюджете вырос бы
|
||
// вдвое: 128 МБ кусков и 128 МБ копии рядом, при счётчике в 128.
|
||
Was := TCIRecBudgetUsed;
|
||
Rec := TTCIRecorder.Create(0, 48000, 3, nil);
|
||
try
|
||
for i := 0 to 8191 do begin L[i] := 0.25; R[i] := -0.25; end;
|
||
Total := 0;
|
||
while Total < 120000 do // 2.5 с при 48 кГц
|
||
begin
|
||
Rec.Feed(L, R, 8192);
|
||
Inc(Total, 8192);
|
||
end;
|
||
Tk := Rec.Take;
|
||
Check('рекордер: кусков ровно по секундам записи',
|
||
(Tk.Chunk = 48000) and (Length(Tk.Chunks) = 3) and
|
||
(Tk.Count >= 120000),
|
||
IntToStr(Length(Tk.Chunks)) + ' × ' + IntToStr(Tk.Chunk));
|
||
Check('рекордер: сплошной копии не появилось',
|
||
TCIRecBudgetUsed = Was + Tk.Reserved,
|
||
IntToStr(TCIRecBudgetUsed - Was));
|
||
Data := FlatTake(Tk);
|
||
Check('рекордер: куски склеиваются в непрерывный звук',
|
||
(Length(Data) = Tk.Count * 2) and
|
||
(Data[0] = Round(0.25 * 32767)) and
|
||
(Data[Length(Data) - 2] = Round(0.25 * 32767)));
|
||
Tk.Chunks := nil;
|
||
TCIRecBudgetFree(Tk.Reserved);
|
||
finally
|
||
Rec.Free;
|
||
end;
|
||
Check('рекордер: счёт закрыт', TCIRecBudgetUsed = Was);
|
||
|
||
// Порядок отсчётов: первым обязан идти самый ПЕРВЫЙ записанный.
|
||
Rec := TTCIRecorder.Create(0, 1000, 1, nil); // ёмкость 1000 отсчётов
|
||
try
|
||
for i := 0 to 1499 do
|
||
begin
|
||
L[0] := i / 4000.0;
|
||
R[0] := 0;
|
||
Rec.Feed(L, R, 1);
|
||
end;
|
||
Tk := Rec.Take; Data := FlatTake(Tk);
|
||
Check('рекордер: с начала записи, а не с конца',
|
||
(Length(Data) = 2000) and (Data[0] = 0) and
|
||
(Abs(Data[1998] - Round((999 / 4000.0) * 32767)) <= 1),
|
||
IntToStr(Data[1998]));
|
||
finally
|
||
Rec.Free;
|
||
end;
|
||
|
||
// ★Истечение срока: по документу «по истечении времени запись удаляется».
|
||
// Секунду ждать незачем — окно берём минимальное и смотрим на часы.
|
||
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);
|
||
Check('рекордер: до срока запись есть', Length(FlatTake(Rec.Take)) > 0);
|
||
finally
|
||
Rec.Free;
|
||
end;
|
||
Rec := TTCIRecorder.Create(0, 48000, 1, nil);
|
||
try
|
||
Rec.Feed(L, R, 8192);
|
||
Sleep(1100); // окно закрылось
|
||
Check('рекордер: после срока запись удалена', Length(FlatTake(Rec.Take)) = 0);
|
||
Rec.Feed(L, R, 8192); // и новое аудио уже не принимает
|
||
Check('рекордер: истёкший не оживает', Length(FlatTake(Rec.Take)) = 0);
|
||
finally
|
||
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(FlatTake(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 и писатель ═══════════════════════════════════════════════════
|
||
// ★Писатель — ОДИН поток с очередью, которым владеет адаптер. Поток на
|
||
// каждый SAVE с FreeOnTerminate не держал никто: штатный выход из программы
|
||
// обрывал запись на полуслове (из 100000044 байт на диске оставалось
|
||
// 40960), а медленный каталог плодил сотни потоков мимо бюджета.
|
||
Path := GetTempDir + 'tcitest_rec.wav';
|
||
Path2 := GetTempDir + 'tcitest_rec2.wav';
|
||
DeleteFile(Path);
|
||
DeleteFile(Path2);
|
||
SetLength(Data, 2000);
|
||
for i := 0 to 1999 do Data[i] := i * 8;
|
||
W := TTCIWavWriter.Create;
|
||
|
||
Check('WAV: задание принято', W.Enqueue(Path, MakeTake(Data, 0), 48000));
|
||
Check('WAV: очередь дописана', Drained(W, 5000));
|
||
if not FileExists(Path) then
|
||
Check('WAV: файл создан', False)
|
||
else
|
||
begin
|
||
FS := TFileStream.Create(Path, fmOpenRead);
|
||
try
|
||
Check('WAV: размер', FS.Size = 44 + 2000 * 2, IntToStr(FS.Size));
|
||
FS.Read(Hdr[0], 44);
|
||
Check('WAV: RIFF/WAVE',
|
||
(Hdr[0] = Ord('R')) and (Hdr[1] = Ord('I')) and
|
||
(Hdr[8] = Ord('W')) and (Hdr[9] = Ord('A')));
|
||
Sz := LongWord(Hdr[24]) or (LongWord(Hdr[25]) shl 8) or
|
||
(LongWord(Hdr[26]) shl 16) or (LongWord(Hdr[27]) shl 24);
|
||
Check('WAV: частота 48000', Sz = 48000, IntToStr(Sz));
|
||
Check('WAV: 2 канала, 16 бит',
|
||
(Hdr[22] = 2) and (Hdr[34] = 16));
|
||
Sz := LongWord(Hdr[40]) or (LongWord(Hdr[41]) shl 8) or
|
||
(LongWord(Hdr[42]) shl 16) or (LongWord(Hdr[43]) shl 24);
|
||
Check('WAV: длина данных', Sz = 4000, IntToStr(Sz));
|
||
finally
|
||
FS.Free;
|
||
end;
|
||
// ★Данные пишутся во временный файл, а под целевым именем он появляется
|
||
// одним вызовом ядра и уже целым: по имени файла клиент считает запись
|
||
// готовой, и незаконченного содержимого он там видеть не должен. После
|
||
// удачи «.part» рядом не остаётся.
|
||
Check('WAV: временный файл убран', PartFiles(Path) = 0,
|
||
IntToStr(PartFiles(Path)));
|
||
|
||
// ★Писатель отпускает резерв, когда данные ему больше не нужны — иначе
|
||
// потолок памяти держал бы только сами записи, а очередь сохранений на
|
||
// медленном диске росла бы мимо него.
|
||
Was := TCIRecBudgetUsed;
|
||
Check('WAV: резерв под писателя взят', TCIRecBudgetTake(4096));
|
||
DeleteFile(Path);
|
||
W.Enqueue(Path, MakeTake(Data, 4096), 48000);
|
||
Drained(W, 5000);
|
||
Check('WAV: писатель вернул резерв по окончании',
|
||
TCIRecBudgetUsed = Was, IntToStr(TCIRecBudgetUsed - Was));
|
||
|
||
// ★Существующий файл не трогаем: имя приходит из сети, и fmCreate затирал
|
||
// бы любой доступный процессу файл. Публикация идёт без замены
|
||
// (renameat2(RENAME_NOREPLACE) → link), так что занятое имя = отказ. Пишем
|
||
// поверх заведомо другой длиной — файл обязан остаться прежним.
|
||
Tk := MakeTake(Copy(Data, 0, 10), 0);
|
||
W.Enqueue(Path, Tk, 48000);
|
||
Drained(W, 5000);
|
||
FS := TFileStream.Create(Path, fmOpenRead);
|
||
try
|
||
Check('WAV: существующий файл не перезаписан',
|
||
FS.Size = 44 + 2000 * 2, IntToStr(FS.Size));
|
||
finally
|
||
FS.Free;
|
||
end;
|
||
Check('WAV: отказ не оставил временного файла', PartFiles(Path) = 0);
|
||
DeleteFile(Path);
|
||
end;
|
||
|
||
// ★Имя «.part» уникально внутри процесса (pid + счётчик), но не между
|
||
// запусками: файл, оставшийся от прошлой жизни (публиковать было нечем),
|
||
// плюс повторно выданный системой pid дают EEXIST на создании — и задание
|
||
// пропадало бы молча. Занимаем ровно то имя, которое писатель возьмёт
|
||
// следующим, и убеждаемся, что запись всё равно легла.
|
||
DeleteFile(Path);
|
||
Squat := NextTempName(TCIRecTempName(Path));
|
||
FS := TFileStream.Create(Squat, fmCreate);
|
||
FS.Free;
|
||
W.Enqueue(Path, MakeTake(Data, 0), 48000);
|
||
Drained(W, 5000);
|
||
Check('WAV: занятое имя «.part» не теряет запись', FileExists(Path));
|
||
DeleteFile(Squat);
|
||
DeleteFile(Path);
|
||
|
||
// ★Запись не удалась на полпути — по имени не остаётся НИЧЕГО. Прежний код
|
||
// не смотрел на результат записи вовсе (FileWrite и THandleStream.Write при
|
||
// ошибке возвращают 0 и не поднимают исключения), и на полном диске
|
||
// оставался огрызок с заголовком на полную длину. Здесь тот же путь:
|
||
// счётчик обещает больше, чем есть в кусках.
|
||
Tk := MakeTake(Data, 0);
|
||
Tk.Count := Tk.Count * 3; // кусков под это нет
|
||
W.Enqueue(Path, Tk, 48000);
|
||
Drained(W, 5000);
|
||
Check('WAV: неудачная запись не оставила файла', not FileExists(Path));
|
||
Check('WAV: неудачная запись не оставила «.part»', PartFiles(Path) = 0);
|
||
|
||
// ★Целевого имени не существует, ПОКА запись не готова. Раньше по нему
|
||
// сразу появлялась пустышка на 0 байт (имя занималось эксклюзивно, а данные
|
||
// шли во временный файл), и на медленном диске клиент видел её всю запись —
|
||
// а по имени файла он вправе считать запись готовой. Пишем 32 МБ и всё это
|
||
// время следим за именем: увидели его непустым, но не полным, или пустым —
|
||
// проверка красная.
|
||
SetLength(Big, 16 * 1024 * 1024); // 32 МБ: заведомо дольше, чем цикл ниже
|
||
FillChar(Big[0], Length(Big) * SizeOf(SmallInt), 0);
|
||
DeleteFile(Path2);
|
||
W.Enqueue(Path2, MakeTake(Big, 0), 48000);
|
||
Bad := 0;
|
||
while W.Pending > 0 do
|
||
if FileExists(Path2) then
|
||
begin
|
||
FS := TFileStream.Create(Path2, fmOpenRead or fmShareDenyNone);
|
||
try
|
||
if FS.Size <> 44 + Int64(Length(Big)) * SizeOf(SmallInt) then Inc(Bad);
|
||
finally
|
||
FS.Free;
|
||
end;
|
||
end;
|
||
Check('WAV: незаконченной записи под целевым именем не видно', Bad = 0,
|
||
IntToStr(Bad));
|
||
Check('WAV: 32 МБ дописаны', Drained(W, 20000));
|
||
DeleteFile(Path2);
|
||
|
||
// ★Очередь ограничена. Раньше «сохранить» было равно «создать поток», и
|
||
// зависший сетевой каталог давал их сотни — память стеков в бюджет не
|
||
// входит. Занимаем писателя большой записью и стучимся сверх потолка.
|
||
W.Enqueue(Path2, MakeTake(Big, 0), 48000);
|
||
Refused := 0;
|
||
for k := 0 to TCI_RECORD_MAX_JOBS + 3 do
|
||
if not W.Enqueue(GetTempDir + Format('tcitest_q%d.wav', [k]),
|
||
MakeTake(Data, 0), 48000) then
|
||
Inc(Refused);
|
||
Check('очередь: сверх потолка заданий отказ', Refused > 0,
|
||
IntToStr(Refused));
|
||
Check('очередь: дописалась', Drained(W, 20000));
|
||
for k := 0 to TCI_RECORD_MAX_JOBS + 3 do
|
||
DeleteFile(GetTempDir + Format('tcitest_q%d.wav', [k]));
|
||
|
||
// Гасят — новых заданий не принимаем: место в бюджете остаётся на
|
||
// вызывающем, и он обязан его вернуть сам (так и делает CmdRecorder).
|
||
W.Close;
|
||
Check('очередь: после Close заданий не берём',
|
||
not W.Enqueue(Path, MakeTake(Data, 0), 48000));
|
||
TCIStopWriter(W);
|
||
Check('очередь: TCIStopWriter обнуляет ссылку', W = nil);
|
||
|
||
// ★★Главная проверка P1: закрытие программы ДОЖИДАЕТСЯ записи. Раньше
|
||
// FreeOnTerminate-поток никто не ждал, и файл обрывался там, где его застал
|
||
// выход. Здесь сразу после остановки писателя файл обязан быть целым.
|
||
// ★И не только первый: за хвостом очереди клиенту тоже сказано «сохранено»,
|
||
// поэтому ждём ВСЮ очередь (срок остановки считается от последнего
|
||
// продвижения, а не от её начала).
|
||
DeleteFile(Path2);
|
||
for k := 0 to 1 do DeleteFile(GetTempDir + Format('tcitest_tail%d.wav', [k]));
|
||
W := TTCIWavWriter.Create;
|
||
Check('выход: задание принято', W.Enqueue(Path2, MakeTake(Big, 0), 48000));
|
||
for k := 0 to 1 do
|
||
W.Enqueue(GetTempDir + Format('tcitest_tail%d.wav', [k]),
|
||
MakeTake(Data, 0), 48000);
|
||
TCIStopWriter(W);
|
||
Bad := 0;
|
||
for k := 0 to 1 do
|
||
begin
|
||
Path := GetTempDir + Format('tcitest_tail%d.wav', [k]);
|
||
if not FileExists(Path) then Inc(Bad)
|
||
else
|
||
begin
|
||
FS := TFileStream.Create(Path, fmOpenRead);
|
||
try
|
||
if FS.Size <> 44 + 2000 * 2 then Inc(Bad);
|
||
finally
|
||
FS.Free;
|
||
end;
|
||
DeleteFile(Path);
|
||
end;
|
||
end;
|
||
Check('выход: хвост очереди тоже дописан', Bad = 0, IntToStr(Bad));
|
||
if not FileExists(Path2) then
|
||
Check('выход: файл дописан до конца', False)
|
||
else
|
||
begin
|
||
FS := TFileStream.Create(Path2, fmOpenRead);
|
||
try
|
||
Check('выход: файл дописан до конца',
|
||
FS.Size = 44 + Int64(Length(Big)) * SizeOf(SmallInt),
|
||
IntToStr(FS.Size));
|
||
finally
|
||
FS.Free;
|
||
end;
|
||
DeleteFile(Path2);
|
||
end;
|
||
Big := nil;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
C2. Чужая манипуляция (KEYER, §4.3)
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
type
|
||
{ Приёмник фронтов ключа: пишет, ЧТО и КОГДА пришло. }
|
||
TKeyLog = class
|
||
public
|
||
Down: array[0..63] of Boolean;
|
||
At: array[0..63] of QWord;
|
||
Count: Integer;
|
||
T0: QWord;
|
||
procedure Key(D: Boolean);
|
||
end;
|
||
|
||
procedure TKeyLog.Key(D: Boolean);
|
||
begin
|
||
if Count > High(Down) then Exit;
|
||
if Count = 0 then T0 := GetTickCount64;
|
||
Down[Count] := D;
|
||
At[Count] := GetTickCount64 - T0;
|
||
Inc(Count);
|
||
end;
|
||
|
||
procedure TestKeyPlayer;
|
||
// ★Смысл проигрывателя: длительности приходят ГОТОВЫМИ (клиент замерил свой
|
||
// ключ), и в эфир они обязаны лечь такими же, сколько бы ни болталась сеть.
|
||
// Поэтому проверяем не «дёрнулся ключ», а ДЛИНЫ интервалов между фронтами.
|
||
var
|
||
Log: TKeyLog;
|
||
P: TCWElemPlayer;
|
||
Ev: TCWKeyEvent;
|
||
i, Waited, Bad: Integer;
|
||
D1, D2, D3: Int64;
|
||
T0: QWord;
|
||
begin
|
||
WriteLn('C2. Чужая манипуляция (KEYER)');
|
||
Log := TKeyLog.Create;
|
||
Ev := Log.Key;
|
||
P := TCWElemPlayer.Create(Ev);
|
||
try
|
||
// Посылка 150 мс, пауза 60, посылка 150 — «точка-тире» чужим ключом.
|
||
P.Enqueue(True, 150);
|
||
P.Enqueue(False, 60);
|
||
P.Enqueue(True, 150);
|
||
Waited := 0;
|
||
while (P.Busy or (P.Pending > 0)) and (Waited < 3000) do
|
||
begin
|
||
Sleep(10);
|
||
Inc(Waited, 10);
|
||
end;
|
||
Sleep(50);
|
||
Check('KEYER: фронтов ровно четыре', Log.Count = 4, IntToStr(Log.Count));
|
||
if Log.Count = 4 then
|
||
begin
|
||
Check('KEYER: чередование вниз-вверх-вниз-вверх',
|
||
Log.Down[0] and (not Log.Down[1]) and Log.Down[2] and
|
||
(not Log.Down[3]));
|
||
D1 := Int64(Log.At[1]) - Int64(Log.At[0]);
|
||
D2 := Int64(Log.At[2]) - Int64(Log.At[1]);
|
||
D3 := Int64(Log.At[3]) - Int64(Log.At[2]);
|
||
// Допуск на планировщик — тот же порядок, что у дробного сна (5 мс).
|
||
Check('KEYER: длительность посылки сохранена',
|
||
(Abs(D1 - 150) < 30) and (Abs(D3 - 150) < 30),
|
||
Format('%d/%d', [D1, D3]));
|
||
Check('KEYER: длительность паузы сохранена', Abs(D2 - 60) < 30,
|
||
IntToStr(D2));
|
||
end
|
||
else
|
||
begin
|
||
Check('KEYER: чередование вниз-вверх-вниз-вверх', False);
|
||
Check('KEYER: длительность посылки сохранена', False);
|
||
Check('KEYER: длительность паузы сохранена', False);
|
||
end;
|
||
// ★Очередь опустела — ключ ОТПУЩЕН. Иначе оборвавшийся клиент оставил бы в
|
||
// эфире несущую, снять которую некому.
|
||
Check('KEYER: на пустой очереди ключ отпущен',
|
||
(Log.Count > 0) and (not Log.Down[Log.Count - 1]));
|
||
|
||
// Пачка после простоя начинается сразу, а не «догоняет» старый дедлайн.
|
||
Log.Count := 0;
|
||
Sleep(300);
|
||
P.Enqueue(True, 100);
|
||
Waited := 0;
|
||
while (Log.Count < 2) and (Waited < 2000) do
|
||
begin
|
||
Sleep(10);
|
||
Inc(Waited, 10);
|
||
end;
|
||
Check('KEYER: следующая пачка играется целиком',
|
||
(Log.Count = 2) and (Abs(Int64(Log.At[1]) - Int64(Log.At[0]) - 100) < 30),
|
||
IntToStr(Log.Count));
|
||
|
||
// Обрыв: очередь бросается, ключ отпускается.
|
||
Log.Count := 0;
|
||
for i := 0 to 9 do P.Enqueue(True, 400);
|
||
Sleep(60);
|
||
P.AbortPlay;
|
||
Sleep(120);
|
||
Bad := Log.Count;
|
||
Sleep(300);
|
||
Check('KEYER: обрыв гасит очередь', Log.Count = Bad, IntToStr(Log.Count - Bad));
|
||
Check('KEYER: после обрыва ключ отпущен',
|
||
(Log.Count > 0) and (not Log.Down[Log.Count - 1]));
|
||
|
||
// ★Обрыв нельзя отменить пакетом из сети. Клиент шлёт элементы пачками по
|
||
// несколько десятков в секунду; такой пакет, прилетевший в те миллисекунды,
|
||
// пока поток спит в Hold, раньше снимал флаг обрыва — оператор трогает
|
||
// манипулятор, а чужая манипуляция продолжает держать ключ до конца
|
||
// текущего элемента. Меряем задержку отпускания от момента обрыва.
|
||
for i := 0 to 4 do P.Enqueue(True, 400);
|
||
Sleep(60);
|
||
Log.Count := 0; // ключ уже замкнут — ждём именно отпускания
|
||
T0 := GetTickCount64;
|
||
P.AbortPlay;
|
||
P.Enqueue(True, 400); // «пакет пришёл следом за обрывом»
|
||
Waited := 0;
|
||
while (Log.Count = 0) and (Waited < 1000) do
|
||
begin
|
||
Sleep(5);
|
||
Inc(Waited, 5);
|
||
end;
|
||
// Отсчёт по стенным часам: Log.At отсчитывается от ПЕРВОГО фронта пачки,
|
||
// а нам нужна задержка от самого обрыва (опрос с шагом 5 мс).
|
||
D1 := Int64(GetTickCount64) - Int64(T0);
|
||
Check('KEYER: обрыв не отменяется пакетом следом',
|
||
(Log.Count > 0) and (not Log.Down[0]) and (D1 < 100),
|
||
Format('%d/%d', [Log.Count, D1]));
|
||
P.AbortPlay; // и хвост этого пакета тоже гасим
|
||
Sleep(120);
|
||
// Нулевые и отрицательные длительности не элементы: первое нажатие клиента
|
||
// (keyer:0,true,0) не должно порождать ни одного фронта.
|
||
Log.Count := 0;
|
||
P.Enqueue(True, 0);
|
||
P.Enqueue(False, -5);
|
||
Sleep(150);
|
||
Check('KEYER: нулевая длительность ничего не играет', Log.Count = 0,
|
||
IntToStr(Log.Count));
|
||
finally
|
||
P.Free;
|
||
Log.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TestTextSender;
|
||
// Передача текста (F1..F8, набор в терминале, CAT KY). Проверяем не «пошли
|
||
// фронты», а что ОБРЫВ работает: касание манипулятора и снятие MOX обязаны
|
||
// прекратить программную манипуляцию, чем бы её ни кормили.
|
||
var
|
||
Log: TKeyLog;
|
||
S: TCWSender;
|
||
Ev: TCWKeyEvent;
|
||
Waited: Integer;
|
||
D: Int64;
|
||
T0: QWord;
|
||
begin
|
||
WriteLn('C3. Передача текста (KY / F1..F8)');
|
||
Log := TKeyLog.Create;
|
||
Ev := Log.Key;
|
||
S := TCWSender.Create(Ev);
|
||
try
|
||
// 'E' на 20 WPM — одна точка длиной в один Dit (1200/20 = 60 мс).
|
||
S.SetSpeed(20, 50);
|
||
S.Enqueue('E');
|
||
Waited := 0;
|
||
while (Log.Count < 2) and (Waited < 2000) do
|
||
begin
|
||
Sleep(5);
|
||
Inc(Waited, 5);
|
||
end;
|
||
Sleep(50);
|
||
Check('KY: точка — два фронта', Log.Count = 2, IntToStr(Log.Count));
|
||
if Log.Count >= 2 then
|
||
begin
|
||
D := Int64(Log.At[1]) - Int64(Log.At[0]);
|
||
Check('KY: длительность точки по скорости', Abs(D - 60) < 30, IntToStr(D));
|
||
end
|
||
else
|
||
Check('KY: длительность точки по скорости', False);
|
||
|
||
// ★Обрыв нельзя отменить символом, набранным следом. Терминал шлёт текст
|
||
// ПО СИМВОЛУ на нажатие клавиши, логгер — кусками по 25 знаков в KY;
|
||
// такой символ, пришедший в те миллисекунды, пока поток спит в Hold,
|
||
// раньше снимал флаг обрыва — и в эфир уходил весь остаток сообщения,
|
||
// хотя оператор уже взял манипулятор. 5 WPM: тире длиной 720 мс, попасть
|
||
// в него легко.
|
||
S.SetSpeed(5, 50);
|
||
Log.Count := 0;
|
||
S.Enqueue('OOOO');
|
||
// Ждём не «появился фронт», а замыкания ключа ЭТИМ сообщением: предыдущее
|
||
// ещё доигрывает межзнаковую паузу, и его завершающий Key(False) прилетит
|
||
// сюда же.
|
||
Waited := 0;
|
||
while (Waited < 3000)
|
||
and not ((Log.Count > 0) and Log.Down[Log.Count - 1]) do
|
||
begin
|
||
Sleep(5);
|
||
Inc(Waited, 5);
|
||
end;
|
||
Check('KY: сообщение пошло',
|
||
(Log.Count > 0) and Log.Down[Log.Count - 1], IntToStr(Log.Count));
|
||
Sleep(100); // середина первого тире (720 мс на 5 WPM)
|
||
Log.Count := 0; // ключ уже замкнут — ждём именно отпускания
|
||
T0 := GetTickCount64;
|
||
S.AbortSending;
|
||
S.Enqueue('E'); // «символ пришёл следом за обрывом»
|
||
Waited := 0;
|
||
while (Log.Count = 0) and (Waited < 2000) do
|
||
begin
|
||
Sleep(5);
|
||
Inc(Waited, 5);
|
||
end;
|
||
D := Int64(GetTickCount64) - Int64(T0);
|
||
Check('KY: обрыв не отменяется символом следом',
|
||
(Log.Count > 0) and (not Log.Down[0]) and (D < 100),
|
||
Format('%d/%d', [Log.Count, D]));
|
||
S.AbortSending; // и хвост этого символа тоже гасим
|
||
Sleep(150);
|
||
|
||
// Обрыв не глушит передачу навсегда: следующее сообщение играется.
|
||
Log.Count := 0;
|
||
S.SetSpeed(20, 50);
|
||
S.Enqueue('E');
|
||
Waited := 0;
|
||
while (Log.Count < 2) and (Waited < 2000) do
|
||
begin
|
||
Sleep(5);
|
||
Inc(Waited, 5);
|
||
end;
|
||
Check('KY: после обрыва передача снова идёт', Log.Count = 2,
|
||
IntToStr(Log.Count));
|
||
finally
|
||
S.Free;
|
||
Log.Free;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
D. Живой сервер: команды потоков
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
type
|
||
{ Минимальный WS-клиент на сыром сокете: handshake, отправка команд с
|
||
маской (как обязан клиент), приём текста и бинарных блоков. }
|
||
TRawClient = class
|
||
private
|
||
FSock: Integer;
|
||
FIn: array[0..262143] of Byte;
|
||
FLen: Integer;
|
||
public
|
||
function Connect(Port: Word): Boolean;
|
||
procedure SendText(const S: string);
|
||
procedure SendBinary(const Data; Len: Integer);
|
||
{ Штатное прощание по RFC 6455: close-кадр с кодом 1000. Второй путь
|
||
отключения — просто закрыть сокет (Close_), и сервер обязан отпускать
|
||
слот в обоих. }
|
||
procedure SendClose;
|
||
procedure Pump(Ms: Integer);
|
||
{ ★То же, но с шагом сна в 1 мс. Обычный Pump спит по 10 мс, и для проверок
|
||
ПЕЙСИНГА он не годится вовсе: квант запроса — 10.7 мс, то есть клиент
|
||
отвечал бы раз в 10 мс и сам создавал бы те самые «длинные интервалы»,
|
||
которые тест ищет. }
|
||
procedure PumpFine(Ms: Integer);
|
||
function NextFrame(out Opcode: Byte; out Payload: TBytes): Boolean;
|
||
{ Ждать строку с подстрокой Needle не дольше Ms. }
|
||
function WaitText(const Needle: string; Ms: Integer): string;
|
||
function Alive: Boolean;
|
||
procedure Close_;
|
||
end;
|
||
|
||
function TRawClient.Connect(Port: Word): Boolean;
|
||
var
|
||
Addr: TInetSockAddr;
|
||
Req: string;
|
||
begin
|
||
Result := False;
|
||
FLen := 0;
|
||
FSock := fpSocket(AF_INET, SOCK_STREAM, 0);
|
||
if FSock < 0 then Exit;
|
||
FillChar(Addr, SizeOf(Addr), 0);
|
||
Addr.sin_family := AF_INET;
|
||
Addr.sin_port := htons(Port);
|
||
Addr.sin_addr.s_addr := htonl($7F000001);
|
||
if fpConnect(FSock, @Addr, SizeOf(Addr)) <> 0 then Exit;
|
||
Req := 'GET / HTTP/1.1'#13#10 +
|
||
'Host: 127.0.0.1'#13#10 +
|
||
'Upgrade: websocket'#13#10 +
|
||
'Connection: Upgrade'#13#10 +
|
||
'Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ=='#13#10 +
|
||
'Sec-WebSocket-Version: 13'#13#10#13#10;
|
||
fpSend(FSock, @Req[1], Length(Req), 0);
|
||
// Ответ handshake: ждём конца заголовков и выкидываем их из буфера.
|
||
Pump(1000);
|
||
Result := FLen > 0;
|
||
if Result then
|
||
begin
|
||
Req := '';
|
||
SetLength(Req, FLen);
|
||
Move(FIn[0], Req[1], FLen);
|
||
if Pos(#13#10#13#10, Req) = 0 then Exit(False);
|
||
Result := Pos('101', Copy(Req, 1, 20)) > 0;
|
||
FLen := FLen - (Pos(#13#10#13#10, Req) + 3);
|
||
if FLen > 0 then Move(FIn[Pos(#13#10#13#10, Req) + 3], FIn[0], FLen);
|
||
end;
|
||
end;
|
||
|
||
procedure TRawClient.SendText(const S: string);
|
||
var
|
||
Frame: array of Byte;
|
||
i, HLen, N: Integer;
|
||
Mask: array[0..3] of Byte;
|
||
begin
|
||
N := Length(S);
|
||
if N <= 125 then HLen := 2 else HLen := 4;
|
||
SetLength(Frame, HLen + 4 + N);
|
||
Frame[0] := $81;
|
||
if N <= 125 then Frame[1] := $80 or Byte(N)
|
||
else
|
||
begin
|
||
Frame[1] := $80 or 126;
|
||
Frame[2] := Byte(N shr 8);
|
||
Frame[3] := Byte(N);
|
||
end;
|
||
for i := 0 to 3 do Mask[i] := Byte(Random(256));
|
||
for i := 0 to 3 do Frame[HLen + i] := Mask[i];
|
||
for i := 0 to N - 1 do
|
||
Frame[HLen + 4 + i] := Byte(S[i + 1]) xor Mask[i and 3];
|
||
fpSend(FSock, @Frame[0], Length(Frame), 0);
|
||
end;
|
||
|
||
procedure TRawClient.SendClose;
|
||
var
|
||
Frame: array[0..7] of Byte;
|
||
i: Integer;
|
||
Mask: array[0..3] of Byte;
|
||
Code: array[0..1] of Byte;
|
||
begin
|
||
Code[0] := $03; Code[1] := $E8; // 1000 — normal closure
|
||
for i := 0 to 3 do Mask[i] := Byte(Random(256));
|
||
Frame[0] := $88;
|
||
Frame[1] := $80 or 2;
|
||
for i := 0 to 3 do Frame[2 + i] := Mask[i];
|
||
for i := 0 to 1 do Frame[6 + i] := Code[i] xor Mask[i];
|
||
fpSend(FSock, @Frame[0], SizeOf(Frame), 0);
|
||
end;
|
||
|
||
procedure TRawClient.SendBinary(const Data; Len: Integer);
|
||
var
|
||
Frame: array of Byte;
|
||
P: PByte;
|
||
i, HLen: Integer;
|
||
Mask: array[0..3] of Byte;
|
||
begin
|
||
if Len <= 125 then HLen := 2
|
||
else if Len <= 65535 then HLen := 4
|
||
else HLen := 10;
|
||
SetLength(Frame, HLen + 4 + Len);
|
||
Frame[0] := $82;
|
||
if Len <= 125 then Frame[1] := $80 or Byte(Len)
|
||
else if Len <= 65535 then
|
||
begin
|
||
Frame[1] := $80 or 126;
|
||
Frame[2] := Byte(Len shr 8);
|
||
Frame[3] := Byte(Len);
|
||
end
|
||
else
|
||
begin
|
||
Frame[1] := $80 or 127;
|
||
Frame[2] := 0; Frame[3] := 0; Frame[4] := 0; Frame[5] := 0;
|
||
Frame[6] := Byte(Len shr 24); Frame[7] := Byte(Len shr 16);
|
||
Frame[8] := Byte(Len shr 8); Frame[9] := Byte(Len);
|
||
end;
|
||
for i := 0 to 3 do Mask[i] := Byte(Random(256));
|
||
for i := 0 to 3 do Frame[HLen + i] := Mask[i];
|
||
P := @Data;
|
||
for i := 0 to Len - 1 do Frame[HLen + 4 + i] := P[i] xor Mask[i and 3];
|
||
fpSend(FSock, @Frame[0], Length(Frame), 0);
|
||
end;
|
||
|
||
procedure TRawClient.PumpFine(Ms: Integer);
|
||
var
|
||
R: Integer;
|
||
Deadline: QWord;
|
||
begin
|
||
Deadline := GetTickCount64 + QWord(Ms);
|
||
repeat
|
||
R := fpRecv(FSock, @FIn[FLen], SizeOf(FIn) - FLen, MSG_DONTWAIT);
|
||
if R > 0 then Inc(FLen, R)
|
||
else Sleep(1);
|
||
until GetTickCount64 >= Deadline;
|
||
end;
|
||
|
||
procedure TRawClient.Pump(Ms: Integer);
|
||
var
|
||
R, Waited: Integer;
|
||
begin
|
||
Waited := 0;
|
||
repeat
|
||
R := fpRecv(FSock, @FIn[FLen], SizeOf(FIn) - FLen, MSG_DONTWAIT);
|
||
if R > 0 then Inc(FLen, R)
|
||
else
|
||
begin
|
||
Sleep(10);
|
||
Inc(Waited, 10);
|
||
end;
|
||
until Waited >= Ms;
|
||
end;
|
||
|
||
function TRawClient.NextFrame(out Opcode: Byte; out Payload: TBytes): Boolean;
|
||
var PayLen, Need, i: Integer;
|
||
begin
|
||
Result := False;
|
||
Payload := nil;
|
||
if FLen < 2 then Exit;
|
||
Opcode := FIn[0] and $0F;
|
||
PayLen := FIn[1] and $7F;
|
||
Need := 2;
|
||
if PayLen = 126 then
|
||
begin
|
||
if FLen < 4 then Exit;
|
||
PayLen := (FIn[2] shl 8) or FIn[3];
|
||
Need := 4;
|
||
end
|
||
else if PayLen = 127 then
|
||
begin
|
||
if FLen < 10 then Exit;
|
||
PayLen := (FIn[6] shl 24) or (FIn[7] shl 16) or (FIn[8] shl 8) or FIn[9];
|
||
Need := 10;
|
||
end;
|
||
if FLen < Need + PayLen then Exit;
|
||
SetLength(Payload, PayLen);
|
||
for i := 0 to PayLen - 1 do Payload[i] := FIn[Need + i];
|
||
if FLen > Need + PayLen then Move(FIn[Need + PayLen], FIn[0], FLen - Need - PayLen);
|
||
Dec(FLen, Need + PayLen);
|
||
Result := True;
|
||
end;
|
||
|
||
function TRawClient.WaitText(const Needle: string; Ms: Integer): string;
|
||
var
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
S: string;
|
||
Waited: Integer;
|
||
begin
|
||
Result := '';
|
||
Waited := 0;
|
||
repeat
|
||
while NextFrame(Op, Pay) do
|
||
if Op = $01 then
|
||
begin
|
||
S := '';
|
||
SetLength(S, Length(Pay));
|
||
if Length(Pay) > 0 then Move(Pay[0], S[1], Length(Pay));
|
||
if Pos(Needle, LowerCase(S)) > 0 then Exit(S);
|
||
end;
|
||
Pump(50);
|
||
Inc(Waited, 50);
|
||
until Waited >= Ms;
|
||
end;
|
||
|
||
function TRawClient.Alive: Boolean;
|
||
var R: Integer;
|
||
begin
|
||
R := fpSend(FSock, @R, 0, MSG_NOSIGNAL);
|
||
Result := R >= 0;
|
||
end;
|
||
|
||
procedure TRawClient.Close_;
|
||
begin
|
||
if FSock >= 0 then fpClose(FSock);
|
||
FSock := -1;
|
||
end;
|
||
|
||
type
|
||
{ Хост: маршалинг Invoke в наш поток не нужен — исполняем на месте, как
|
||
делает демон (у него тоже нет очереди главного потока в этом смысле). }
|
||
THost = class
|
||
procedure DoInvoke(M: TThreadMethod);
|
||
procedure OnTXIQ(const Buf: array of Double; Count: Integer);
|
||
procedure OnTap(Kind: TRadioAudioKind; PanId, SliceId: Integer;
|
||
const Left, Right: array of Single; Count: Integer);
|
||
end;
|
||
|
||
var
|
||
TXIQBlocks: Integer = 0;
|
||
DemodBlocks: Integer = 0; // блоки rakDemod со слайса WatchSlice
|
||
WatchSlice: Integer = 0;
|
||
|
||
procedure THost.DoInvoke(M: TThreadMethod);
|
||
begin
|
||
M();
|
||
end;
|
||
|
||
procedure THost.OnTap(Kind: TRadioAudioKind; PanId, SliceId: Integer;
|
||
const Left, Right: array of Single; Count: Integer);
|
||
// Наблюдатель за выходом демодулятора слайса. Сам по себе считать слайс не
|
||
// заставляет: тап — это слушатель, а не заказчик (см. TapWanted).
|
||
begin
|
||
if (Kind = rakDemod) and (SliceId = WatchSlice) and (Count > 0) then
|
||
Inc(DemodBlocks);
|
||
end;
|
||
|
||
procedure THost.OnTXIQ(const Buf: array of Double; Count: Integer);
|
||
// Готовый блок TX-IQ: единственный наблюдаемый признак того, что аудио
|
||
// клиента прошло весь тракт (ринг микрофона вычерпывается быстрее, чем его
|
||
// успевает увидеть опрос).
|
||
begin
|
||
if Count > 0 then Inc(TXIQBlocks);
|
||
end;
|
||
|
||
procedure TestServer;
|
||
const
|
||
PORT = 40099;
|
||
var
|
||
Ctrl: TRadioController;
|
||
Ad: TTCIAdapter;
|
||
Host: THost;
|
||
Cfg: TTCISettings;
|
||
C, C2: TRawClient;
|
||
S: string;
|
||
WasConn, WasRun: Boolean;
|
||
Blk: array[0..1023] of Byte;
|
||
H: TTCIStreamHeader;
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
GotBinary, GotClose: Boolean;
|
||
Was: Int64;
|
||
begin
|
||
WriteLn('D. Команды потоков на живом сервере');
|
||
|
||
Host := THost.Create;
|
||
Ctrl := TRadioController.Create;
|
||
Ctrl.LocalAudioEnabled := False;
|
||
Ctrl.OnInvoke := Host.DoInvoke;
|
||
Ad := TTCIAdapter.Create(Ctrl, nil);
|
||
C := TRawClient.Create;
|
||
try
|
||
Cfg.Enabled := True;
|
||
Cfg.Port := PORT;
|
||
Cfg.BindAddr := '127.0.0.1';
|
||
if not Ad.ApplySettings(Cfg) then
|
||
begin
|
||
Check('сервер поднялся', False, 'порт занят?');
|
||
Exit;
|
||
end;
|
||
Check('сервер поднялся', Ad.Active);
|
||
|
||
if not C.Connect(PORT) then
|
||
begin
|
||
Check('клиент подключился', False);
|
||
Exit;
|
||
end;
|
||
Check('клиент подключился', True);
|
||
Check('пришёл ready', C.WaitText('ready;', 2000) <> '');
|
||
|
||
// Приёмник вне диапазона — отказ, а не молчание.
|
||
C.SendText('audio_start:9;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('audio_start:9 → ошибка', Pos('bad receiver', S) > 0, S);
|
||
|
||
C.SendText('iq_start:abc;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('iq_start:abc → ошибка', Pos('bad receiver', S) > 0, S);
|
||
|
||
// Пан 1: без подключённого радио его нет ни в потолке (TRX_COUNT=1), ни
|
||
// живьём — в обоих случаях клиент обязан получить отказ, а не тишину.
|
||
C.SendText('audio_start:1;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('audio_start на несуществующий пан → ошибка',
|
||
(Pos('not running', S) > 0) or (Pos('bad receiver', S) > 0), S);
|
||
|
||
// Главный тракт живой: старт обязан пройти молча.
|
||
C.SendText('audio_start:0;');
|
||
S := C.WaitText('tci_error', 400);
|
||
Check('audio_start:0 без ошибок', S = '', S);
|
||
|
||
// Параметры потока принимаются и подтверждаются.
|
||
C.SendText('audio_samplerate:12000;');
|
||
S := C.WaitText('audio_samplerate', 1500);
|
||
Check('audio_samplerate:12000 подтверждён', Pos('12000', S) > 0, S);
|
||
C.SendText('audio_samplerate:44100;');
|
||
S := C.WaitText('audio_samplerate', 1500);
|
||
Check('audio_samplerate:44100 отвергнут', Pos('12000', S) > 0, S);
|
||
C.SendText('iq_samplerate:96000;');
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('iq_samplerate:96000 подтверждён', Pos('96000', S) > 0, S);
|
||
|
||
// ★Ответ обязан называть частоту, которую клиент РЕАЛЬНО получит.
|
||
// Контроллер сейчас на 192 кГц: просьба «384» невыполнима.
|
||
C.SendText('iq_samplerate:384000;');
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('iq_samplerate:384к при 192к источника → 192к',
|
||
Pos('192000', S) > 0, S);
|
||
|
||
// Сменился rate устройства — та же просьба стала выполнимой, и клиенту
|
||
// обязано прийти переобъявление без всякого запроса.
|
||
Ctrl.SetSampleRate(384000);
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('смена rate переобъявляет iq_samplerate', Pos('384000', S) > 0, S);
|
||
|
||
// Частоты Pluto: 576 кГц на 384 не делится — отдаём законные 192 кГц.
|
||
Ctrl.SetSampleRate(576000);
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('Pluto 576к: просьба 384к → 192к', Pos('192000', S) > 0, S);
|
||
Ctrl.SetSampleRate(192000);
|
||
C.WaitText('iq_samplerate', 1000);
|
||
|
||
// IF_LIMITS привязаны к rate устройства (§4.1: «высылается при подключении
|
||
// и изменении частоты дискретизации»).
|
||
Ctrl.SetSampleRate(96000);
|
||
S := C.WaitText('if_limits', 1500);
|
||
Check('смена rate переобъявляет if_limits',
|
||
(Pos('-48000', S) > 0) and (Pos('48000', S) > 0), S);
|
||
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]) + ';');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('save без записи → ошибка', Pos('nothing recorded', S) > 0, S);
|
||
|
||
C.SendText('line_out_recorder_start:0,10;');
|
||
C.SendText('line_out_recorder_save:0,' +
|
||
StringReplace(GetTempDir + 'tcitest_none.mp3', ':', '|', [rfReplaceAll]) + ';');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('save в mp3 → ошибка', Pos('only wav', S) > 0, S);
|
||
C.SendText('line_out_recorder_break:0;');
|
||
|
||
// TRX с источником tci: без запущенного аудиопотока просьба не действует.
|
||
C.SendText('audio_stop:0;');
|
||
C.SendText('trx:0,true,tci;');
|
||
C.WaitText('trx:', 1000);
|
||
Check('trx tci без потока не берёт модуляцию',
|
||
not Ctrl.TCIMicRequested);
|
||
C.SendText('trx:0,false;');
|
||
C.WaitText('trx:', 1000);
|
||
|
||
C.SendText('audio_start:0;');
|
||
C.SendText('trx:0,true,tci;');
|
||
C.Pump(300);
|
||
Check('trx tci с потоком берёт модуляцию', Ctrl.TCIMicRequested);
|
||
// ★Проверяем и сам эфир, а не только флаг источника: раньше SetMOX по этой
|
||
// дороге падал в Access violation (SyncCWKeyer → SendDUCSpecificFromSettings
|
||
// при FNetwork = nil), ошибку глотал обработчик команды, и «передача» жила
|
||
// только в ответе клиенту.
|
||
Check('trx:0,true поднял передачу', Ctrl.FTransmitting);
|
||
|
||
// Второй TCI-клиент не должен перехватывать ни аудио, ни
|
||
// владение уже идущей TCI-передачей. Ждём истечения hold,
|
||
// иначе вторая команда будет отклонена ещё до этой проверки.
|
||
C2 := TRawClient.Create;
|
||
try
|
||
Check('конкурирующий клиент подключился', C2.Connect(PORT));
|
||
Check('конкурирующему пришёл ready', C2.WaitText('ready;', 2000) <> '');
|
||
C2.SendText('audio_start:0;');
|
||
Sleep(300);
|
||
C2.SendText('trx:0,true,tci;');
|
||
C2.Pump(300);
|
||
GotBinary := False;
|
||
while C2.NextFrame(Op, Pay) do
|
||
if Op = $02 then GotBinary := True;
|
||
Check('конкурирующий клиент не получил TX_CHRONO', not GotBinary);
|
||
C2.Close_;
|
||
Sleep(600);
|
||
Check('уход второго TCI-клиента не снял эфир первого',
|
||
Ctrl.FTransmitting);
|
||
Check('после ухода второго остался один клиент',
|
||
Ad.ClientCount = 1, IntToStr(Ad.ClientCount));
|
||
finally
|
||
C2.Close_;
|
||
C2.Free;
|
||
end;
|
||
|
||
C.SendText('trx:0,false;');
|
||
C.Pump(300);
|
||
Check('снятие TRX снимает источник', not Ctrl.TCIMicRequested);
|
||
Check('снятие TRX сняло передачу', not Ctrl.FTransmitting);
|
||
|
||
// ★arg1 у TRX/TUNE — номер передатчика, и он обязан разбираться, как всюду:
|
||
// раньше он игнорировался целиком, и клиент доп. приёмника уводил в эфир
|
||
// слайс оператора (чужая частота, а с кросс-бандом — чужой диапазон).
|
||
C.SendText('trx:9,true;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('trx:9 → ошибка, а не эфир', Pos('bad receiver', S) > 0, S);
|
||
Check('trx:9 не поднял передачу', not Ctrl.FTransmitting);
|
||
|
||
C.SendText('trx:abc,true;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('trx:abc → ошибка', Pos('bad receiver', S) > 0, S);
|
||
Check('trx:abc не поднял передачу', not Ctrl.FTransmitting);
|
||
|
||
// Приёмник 1 без подключённого радио: либо вне потолка, либо не запущен —
|
||
// но в эфир по нему уходить нельзя ни в каком случае.
|
||
C.SendText('trx:1,true;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('trx на несуществующий приёмник → ошибка',
|
||
(Pos('not running', S) > 0) or (Pos('bad receiver', S) > 0), S);
|
||
Check('trx на несуществующий приёмник не поднял передачу',
|
||
not Ctrl.FTransmitting);
|
||
|
||
C.SendText('tune:9,true;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('tune:9 → ошибка', Pos('bad receiver', S) > 0, S);
|
||
Check('tune:9 не включил TUN', not Ctrl.FTuning);
|
||
|
||
// ── KEYER (§4.3): чужой ключ ────────────────────────────────────────
|
||
// Номер передатчика разбирается так же, как у TRX: командой из сети в эфир
|
||
// по несуществующему приёмнику не уходят.
|
||
C.SendText('keyer:9,true,0;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('keyer:9 → ошибка', Pos('bad receiver', S) > 0, S);
|
||
C.SendText('keyer:abc,true,0;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('keyer:abc → ошибка', Pos('bad receiver', S) > 0, S);
|
||
C.SendText('keyer:1,true,0;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('keyer на незапущенный приёмник → ошибка',
|
||
(Pos('not running', S) > 0) or (Pos('bad receiver', S) > 0), S);
|
||
C.SendText('keyer:0,maybe,0;');
|
||
S := C.WaitText('tci_error', 1500);
|
||
Check('keyer с нечисловым состоянием → ошибка', Pos('bad state', S) > 0, S);
|
||
// Первое нажатие (arg3 = 0) — не ошибка и не звук: играть ещё нечего.
|
||
C.SendText('keyer:0,true,0;');
|
||
S := C.WaitText('tci_error', 400);
|
||
Check('keyer:0,true,0 не ошибка', S = '', S);
|
||
Check('keyer:0,true,0 не поднял манипуляцию', not Ctrl.CWXBusy);
|
||
|
||
// ★Сквозная проверка перевода: keyer:0,false,150 значит «посылка длилась
|
||
// 150 мс», и она обязана дойти до манипуляции. Без телеграфного режима
|
||
// трогать ключ нечем (CWTXActive), поэтому режим ставим сами.
|
||
Ctrl.SetMode(MODE_CWU);
|
||
if not Ctrl.CWTXActive then
|
||
WriteLn(' .. keyer: манипуляция недоступна (CWTXActive=false), пропуск')
|
||
else
|
||
begin
|
||
// ★Локальный генератор вооружается только при живом устройстве
|
||
// (FDevConnected/FRunning — без радио манипулировать некуда), а радио на
|
||
// стенде нет. Подставляем эти два флага на время проверки: нас интересует
|
||
// перевод «пришло false ⇒ кончилась ПОСЫЛКА», а не излучающая часть.
|
||
WasConn := Ctrl.FDevConnected;
|
||
WasRun := Ctrl.FRunning;
|
||
Ctrl.FDevConnected := True;
|
||
Ctrl.FRunning := True;
|
||
// Первое нажатие открывает передачу, второе сообщение говорит «кончилась
|
||
// ПАУЗА 300 мс» — ключ при этом замыкаться не должен.
|
||
C.SendText('keyer:0,true,0;');
|
||
C.SendText('keyer:0,true,300;');
|
||
C.Pump(120);
|
||
Check('keyer: манипуляция пошла', Ctrl.CWXBusy);
|
||
Check('keyer: пауза ключ не замыкает', not Ctrl.FCWLocalTX);
|
||
// «Кончилась ПОСЫЛКА 200 мс» — вот она и есть звук в эфире. Ждём конца
|
||
// паузы и смотрим в середину посылки.
|
||
C.SendText('keyer:0,false,200;');
|
||
C.Pump(250);
|
||
Check('keyer: посылка замыкает ключ', Ctrl.FCWLocalTX);
|
||
Ctrl.CWXAbort;
|
||
C.Pump(150);
|
||
Check('keyer: обрыв гасит манипуляцию', not Ctrl.CWXBusy);
|
||
Ctrl.FDevConnected := WasConn;
|
||
Ctrl.FRunning := WasRun;
|
||
Ctrl.SyncCWKeyer; // разоружить обратно
|
||
end;
|
||
Ctrl.SetMode(MODE_USB);
|
||
|
||
// Ответ называет приёмник, чей слайс реально в эфире. Без радио источник
|
||
// передачи — главный VFO, то есть 0.
|
||
C.SendText('trx:0;');
|
||
S := C.WaitText('trx:', 1000);
|
||
Check('ответ trx называет передающий приёмник', Pos('trx:0,', S) > 0, S);
|
||
C.SendText('tune:0;');
|
||
S := C.WaitText('tune:', 1000);
|
||
Check('ответ tune называет передающий приёмник', Pos('tune:0,', S) > 0, S);
|
||
|
||
// TUN через TCI: включается и гасится, и снятие возвращает всё на место.
|
||
// Ждём временем, а не WaitText: на каждую смену состояния уходит ДВА
|
||
// сообщения (ответ автору + рассылка по rfTuning), и WaitText поймал бы
|
||
// хвост предыдущей команды, не дождавшись текущей.
|
||
C.SendText('tune:0,true;');
|
||
C.Pump(300);
|
||
Check('tune:0,true включил TUN', Ctrl.FTuning);
|
||
C.SendText('tune:0,false;');
|
||
C.Pump(300);
|
||
Check('tune:0,false выключил TUN', not Ctrl.FTuning);
|
||
Check('после TUN передача снята', not Ctrl.FTransmitting);
|
||
|
||
// ★Передача, начатая ОПЕРАТОРОМ: клиент не вправе ни увести из неё
|
||
// микрофон, ни подмешать в неё настроечный тон. SetMOX(True) поверх уже
|
||
// идущей передачи не выходит рано — он заново выбирает источник модуляции,
|
||
// и «trx:0,true,tci» посреди чужой передачи уводил её в ринг TCI, не
|
||
// становясь при этом хозяином эфира.
|
||
// Пауза перед командой обязательна: смену состояния оператором адаптер
|
||
// тоже захватывает (§3.5, 200 мс), и без неё команду отклонили бы по
|
||
// совсем другой причине — проверка прошла бы вхолостую.
|
||
Ctrl.SetMOX(True);
|
||
Check('оператор в эфире', Ctrl.FTransmitting);
|
||
Sleep(300);
|
||
C.SendText('trx:0,true,tci;');
|
||
C.Pump(300);
|
||
Check('trx поверх чужой передачи не уводит микрофон',
|
||
not Ctrl.TCIMicRequested);
|
||
Check('trx поверх чужой передачи её не трогает', Ctrl.FTransmitting);
|
||
Sleep(300);
|
||
C.SendText('tune:0,true;');
|
||
C.Pump(300);
|
||
Check('tune поверх чужой передачи не включает тон', not Ctrl.FTuning);
|
||
Ctrl.SetMOX(False);
|
||
Check('передачу оператора снимает оператор', not Ctrl.FTransmitting);
|
||
|
||
// Бинарный блок не нашего типа обязан быть проигнорирован, а соединение —
|
||
// остаться рабочим (клиент шлёт их пачками, рвать связь нельзя).
|
||
TCIFillHeader(H, tstIQ, 0, 48000, tsyFloat32, 4, 2);
|
||
Move(H, Blk[0], SizeOf(H));
|
||
C.SendBinary(Blk[0], SizeOf(H) + 32);
|
||
C.SendText('iq_samplerate:48000;');
|
||
S := C.WaitText('iq_samplerate', 1500);
|
||
Check('чужой бинарный блок не рвёт связь', Pos('48000', S) > 0, S);
|
||
|
||
// Маркеров TX_CHRONO без передачи быть не должно.
|
||
C.Pump(200);
|
||
GotBinary := False;
|
||
while C.NextFrame(Op, Pay) do
|
||
if Op = $02 then GotBinary := True;
|
||
Check('без передачи маркеров нет', not GotBinary);
|
||
|
||
// ★Уход клиента снимает только ЕГО передачу. Ставим в эфир оператора,
|
||
// клиент безуспешно просит TRX поверх — и уходит: передача обязана остаться.
|
||
Ctrl.SetMOX(True);
|
||
Sleep(300);
|
||
C.SendText('trx:0,true,tci;');
|
||
C.Pump(300);
|
||
|
||
// ★Обычный TCP-разрыв БЕЗ close-кадра: так уходит и упавший клиент, и
|
||
// выдернутый кабель. recv отдаёт 0, и это EOF, а не таймаут — errno при
|
||
// нём не трогается и вполне может нести EAGAIN от прошлого истёкшего
|
||
// TCI_POLL_MS. Пока сервер спрашивал errno, слот не освобождался вовсе:
|
||
// после нескольких аварийных отключений новые клиенты не подключались.
|
||
C.Close_;
|
||
Sleep(300);
|
||
Check('уход клиента не снял чужую передачу', Ctrl.FTransmitting);
|
||
Ctrl.SetMOX(False);
|
||
Check('после ухода клиента источник снят', not Ctrl.TCIMicRequested);
|
||
Check('TCP-разрыв без close-кадра освобождает слот', Ad.ClientCount = 0,
|
||
IntToStr(Ad.ClientCount));
|
||
|
||
// Второй путь — штатное прощание по RFC: тоже слот, но через close-кадр.
|
||
C2 := TRawClient.Create;
|
||
try
|
||
Check('второй клиент подключился', C2.Connect(PORT));
|
||
Check('второму пришёл ready', C2.WaitText('ready;', 2000) <> '');
|
||
C2.SendClose;
|
||
// Сервер обязан ответить своим close-кадром (§5.5.1) и уйти.
|
||
GotClose := False;
|
||
C2.Pump(300);
|
||
while C2.NextFrame(Op, Pay) do
|
||
if Op = $08 then GotClose := True;
|
||
Check('на close-кадр отвечает close-кадром', GotClose);
|
||
Sleep(200);
|
||
Check('close-кадр освобождает слот', Ad.ClientCount = 0,
|
||
IntToStr(Ad.ClientCount));
|
||
finally
|
||
C2.Close_;
|
||
C2.Free;
|
||
end;
|
||
finally
|
||
C.Free;
|
||
Ad.Free;
|
||
Ctrl.Free;
|
||
Host.Free;
|
||
end;
|
||
end;
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
E. Сквозной прогон: живой движок → тап → блоки клиенту
|
||
|
||
Единственная часть, где проверяется сам маршрут данных: синтетический
|
||
24-битный IQ подаётся в WDSP, а на другом конце WebSocket ожидаются блоки
|
||
RX-аудио и IQ с верными заголовками.
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
{ ═══════════════════════════════════════════════════════════════════════════
|
||
F. Пейсинг TX: квант запроса, окно в полёте, потери ответов
|
||
═══════════════════════════════════════════════════════════════════════════ }
|
||
|
||
{ Обслуживает маркеры TX_CHRONO Ms миллисекунд, отвечая на каждый блоком
|
||
нужного размера. Skip первых N маркеров остаются БЕЗ ответа — это и есть
|
||
«замороженный кредит», ради которого всё затевалось: конвейер продолжает
|
||
отдавать звук, но медленнее реального времени, и сторож по одному лишь
|
||
молчанию клиента такого не видит. Возвращает число маркеров и раскладку
|
||
интервалов между ними. }
|
||
procedure ServeChrono(C: TRawClient; Ms, Skip: Integer;
|
||
out Markers, Answered, Quantum, LongGaps, MaxGapMs: Integer;
|
||
out MinReserve: Integer);
|
||
var
|
||
Deadline, Now_, Prev, Start: QWord;
|
||
Delivered, Reserve: Int64;
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
H, HA: TTCIStreamHeader;
|
||
Frames, i, Gap: Integer;
|
||
Blk: array[0..40000] of Byte;
|
||
Skipped: Integer;
|
||
begin
|
||
Markers := 0;
|
||
Answered := 0;
|
||
Quantum := 0;
|
||
LongGaps := 0;
|
||
MaxGapMs := 0;
|
||
Skipped := 0;
|
||
Prev := 0;
|
||
Delivered := 0;
|
||
MinReserve := 0;
|
||
Start := GetTickCount64;
|
||
Deadline := Start + QWord(Ms);
|
||
while GetTickCount64 < Deadline do
|
||
begin
|
||
C.PumpFine(1);
|
||
while C.NextFrame(Op, Pay) do
|
||
begin
|
||
if (Op <> $02) or (Length(Pay) < SizeOf(H)) then Continue;
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if H.StreamType <> LongWord(Ord(tstTXChrono)) then Continue;
|
||
Now_ := GetTickCount64;
|
||
Inc(Markers);
|
||
if H.Channels = 0 then H.Channels := 1;
|
||
Frames := Integer(H.DataLength) div Integer(H.Channels);
|
||
Quantum := Frames;
|
||
if Prev > 0 then
|
||
begin
|
||
Gap := Integer(Now_ - Prev);
|
||
if Gap > MaxGapMs then MaxGapMs := Gap;
|
||
// Порог — полтора номинальных периода кванта (10.667 мс при 512/48к).
|
||
if Gap > 16 then Inc(LongGaps);
|
||
end;
|
||
Prev := Now_;
|
||
|
||
if Skipped < Skip then
|
||
begin
|
||
Inc(Skipped);
|
||
Continue; // кредит завис навсегда
|
||
end;
|
||
TCIFillHeader(HA, tstTXAudio, H.Receiver, H.SampleRate, tsyFloat32,
|
||
Frames, H.Channels);
|
||
Move(HA, Blk[0], SizeOf(HA));
|
||
for i := 0 to Frames * Integer(H.Channels) - 1 do
|
||
PSingle(@Blk[SizeOf(HA) + i * 4])^ := 0.1;
|
||
C.SendBinary(Blk[0], SizeOf(HA) + Frames * Integer(H.Channels) * 4);
|
||
Inc(Answered);
|
||
// ★Мера годности — не ровность интервалов, а НАКОПЛЕННЫЙ РЕЗЕРВ: подушка
|
||
// отправителя интегрирующая, и два подряд «почти в допуске» интервала
|
||
// сушат очередь не хуже одного грубого. Пачка маркеров сама по себе
|
||
// безвредна — она приносит звук ВПЕРЁД реального времени, и следующая за
|
||
// ней пауза оплачена этим запасом. Считаем в кадрах 48 кГц от начала
|
||
// фазы: сколько отдано минус сколько утекло по часам.
|
||
Inc(Delivered, Frames);
|
||
Reserve := Delivered -
|
||
Int64(GetTickCount64 - Start) * Int64(H.SampleRate) div 1000;
|
||
if Reserve < MinReserve then MinReserve := Reserve;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TestTxPacing;
|
||
const
|
||
PORT = 40099;
|
||
RATE = 48000;
|
||
TCI_TX_LEAD_MAX_MS_CHK = 120; // потолок аванса, копия TCI_TX_LEAD_MAX_MS
|
||
RESTART_CYCLES = 6; // повторных передач в последней фазе
|
||
var
|
||
Ctrl: TRadioController;
|
||
Ad: TTCIAdapter;
|
||
Host: THost;
|
||
Cfg: TTCISettings;
|
||
C: TRawClient;
|
||
Markers, Answered, Quantum, LongGaps, MaxGapMs, MinReserve: Integer;
|
||
N, MinStart, SumStart, StaleRuns: Integer;
|
||
DbgOwed, DbgFlight: Double;
|
||
DbgWin, DbgQ, DbgLead, SeedLead: Integer;
|
||
begin
|
||
WriteLn('F. Пейсинг TX: квант запроса и потери ответов');
|
||
|
||
Host := THost.Create;
|
||
Ctrl := TRadioController.Create;
|
||
Ctrl.LocalAudioEnabled := False;
|
||
Ctrl.OnInvoke := Host.DoInvoke;
|
||
Ctrl.FSampleRate := RATE;
|
||
Ctrl.CreateEngines(RATE);
|
||
Ctrl.FWDSPReady := True; // движок не открываем: тракт тут не проверяется
|
||
C := nil;
|
||
Ad := nil;
|
||
try
|
||
Ad := TTCIAdapter.Create(Ctrl, nil);
|
||
Cfg.Enabled := True;
|
||
Cfg.Port := PORT;
|
||
Cfg.BindAddr := '127.0.0.1';
|
||
if not Ad.ApplySettings(Cfg) then
|
||
begin
|
||
Check('пейсинг: сервер поднялся', False);
|
||
Exit;
|
||
end;
|
||
C := TRawClient.Create;
|
||
if not C.Connect(PORT) then
|
||
begin
|
||
Check('пейсинг: клиент подключился', False);
|
||
Exit;
|
||
end;
|
||
C.WaitText('ready;', 2000);
|
||
|
||
// Клиент назвался ровно как MSHV: 48 кГц, два канала, блок 2048.
|
||
C.SendText('audio_samplerate:48000;');
|
||
C.SendText('audio_stream_channels:2;');
|
||
C.SendText('audio_stream_samples:2048;');
|
||
C.SendText('tx_stream_audio_buffering:50;');
|
||
// ★Без поднятого аудиопотока просьба «модулируй из TCI» отклоняется
|
||
// (§4.2, HasAudioStream): модулировать было бы нечем.
|
||
C.SendText('audio_start:0;');
|
||
C.Pump(200);
|
||
C.SendText('trx:0,true,tci;');
|
||
C.WaitText('trx:', 1500);
|
||
Check('пейсинг: модуляция из TCI взята', Ctrl.TCIMicActive);
|
||
|
||
// ── Здоровый клиент ──
|
||
// Прогрев: пока шёл разбор команды и проверки выше, клиент не отвечал, и
|
||
// окно в полёте успело набиться маркерами. Плюс за это время адаптер выдаёт
|
||
// разовый аванс под зернистость клиента — он тоже приходит пачкой. Меряем
|
||
// установившийся режим, а не этот стартовый ком, иначе в замер попадёт
|
||
// чужой долг: аванс отдан ДО окна замера, а расходуется уже внутри него.
|
||
ServeChrono(C, 1000, 0, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
ServeChrono(C, 900, 0, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
WriteLn(Format(' .. фаза 1: маркеров %d, квант %d ⇒ %d кадров/с, ' +
|
||
'просадка резерва %d кадров (%.1f мс), длинных интервалов %d, макс %d мс',
|
||
[Markers, Quantum, Round(Answered * Quantum / 0.9),
|
||
MinReserve, MinReserve / 48.0, LongGaps, MaxGapMs]));
|
||
Check('пейсинг: маркеры идут', Markers > 20, IntToStr(Markers));
|
||
// ★Главное число всей правки. Просить блок клиента целиком (2048 отсчётов =
|
||
// 42.7 мс) нельзя: подушка отправителя DUC — 10.42 мс, и на каждом запросе
|
||
// длиннее её очередь пересыхает. Квант обязан быть одним блоком TXA.
|
||
Check('пейсинг: квант = один блок TXA, а не блок клиента',
|
||
Quantum = 512, IntToStr(Quantum));
|
||
// ★Зернистость: раньше маркеры выходили через 40 или 60 мс (тик 20 мс не
|
||
// делится на 42.7), и каждый трёхтактный интервал давал осушение.
|
||
// Порог: подушка отправителя DUC (2000 отсчётов @192 кГц = 500 кадров
|
||
// @48 кГц) ПЛЮС аванс, который клиент попросил сам через
|
||
// TX_STREAM_AUDIO_BUFFERING (здесь 50 мс = 2400 кадров). Считать от нуля
|
||
// нельзя: этот аванс реально лежит в очереди и на то и дан. ★В эфире к нему
|
||
// добавляется ещё и нулевой pre-roll под зернистость клиента, но стенд
|
||
// работает без радио, и в нём этого слагаемого нет.
|
||
// Систематическую просадку порог не пропустит: она накапливается линейно и
|
||
// за 900 мс уходит далеко за любую константу.
|
||
Check('пейсинг: резерв не проседает ниже подушки DUC плюс аванс клиента',
|
||
MinReserve > -2900, Format('%d кадров (%.1f мс)',
|
||
[MinReserve, MinReserve / 48.0]));
|
||
|
||
// ── Посев аванса и его сползание ──
|
||
// ★Посев нужен потому, что первая передача после подключения физически не
|
||
// может знать зернистость клиента: аванс появляется только после первого
|
||
// ответа, а осушение случается раньше. Но посев обязан уметь сползать —
|
||
// иначе клиент с мелкой гранулой (как здесь: отвечает сразу) навсегда
|
||
// получит чужие 50 мс задержки.
|
||
Ad.TxDbgState(DbgOwed, DbgFlight, DbgWin, DbgQ, SeedLead);
|
||
Check('пейсинг: аванс посеян до первого ответа',
|
||
SeedLead >= 2000, IntToStr(SeedLead));
|
||
ServeChrono(C, 5200, 0, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
Ad.TxDbgState(DbgOwed, DbgFlight, DbgWin, DbgQ, DbgLead);
|
||
WriteLn(Format(' .. аванс: посев %d кадров (%.1f мс) → %d (%.1f мс), ' +
|
||
'худшая пауза клиента %d мс',
|
||
[SeedLead, SeedLead / 48.0, DbgLead, DbgLead / 48.0,
|
||
MaxGapMs]));
|
||
// ★Проверяем не «аванс уменьшился», а то, чем он обязан быть: запасом под
|
||
// САМУЮ ХУДШУЮ наблюдённую паузу клиента. Оценка нарочно несимметрична
|
||
// (вверх сразу, вниз по выдержке), поэтому редкий выброс её и держит — и
|
||
// это правильно: запас на то и нужен, чтобы такой выброс пережить. Стенд
|
||
// сам даёт выбросы под 60 мс (его клиент живёт в одном потоке с проверками),
|
||
// так что «сползание» здесь не наблюдаемо в принципе — оно проверяется
|
||
// конструкцией: путь снижения общий с путём роста, см. TCI_TX_LEAD_DOWN_MS.
|
||
Check('пейсинг: аванс покрывает худшую паузу клиента',
|
||
(DbgLead >= MaxGapMs * 48) and
|
||
(DbgLead <= (TCI_TX_LEAD_MAX_MS_CHK * 48)),
|
||
Format('%d кадров при худшей паузе %d мс', [DbgLead, MaxGapMs]));
|
||
|
||
// ── Замороженные кредиты: два ответа не приходят никогда ──
|
||
// Конвейер сужается, но продолжает работать — молчания клиента нет, и
|
||
// поймать это можно только по одновременному насыщению долга и окна.
|
||
ServeChrono(C, 1500, 2, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
Check('пейсинг: замороженные кредиты не остановили выдачу',
|
||
Markers > 40, IntToStr(Markers));
|
||
Check('пейсинг: после прощения кредита выдача вернулась к темпу',
|
||
MaxGapMs < 400, IntToStr(MaxGapMs));
|
||
|
||
// ── Полная защёлка: четыре ответа подряд пропали ──
|
||
ServeChrono(C, 800, 4, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
Ad.TxDbgState(DbgOwed, DbgFlight, DbgWin, DbgQ, DbgLead);
|
||
WriteLn(Format(' .. после потерь: долг %.0f, в полёте %.0f, окно %d кв., квант %d',
|
||
[DbgOwed, DbgFlight, DbgWin, DbgQ]));
|
||
// Потери позади. Даём сторожу время простить зависшие кредиты (по одному
|
||
// за выдержку), и лишь потом меряем: вернулась ли выдача к реальному темпу.
|
||
ServeChrono(C, 1500, 0, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
ServeChrono(C, 1000, 0, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
WriteLn(Format(' .. фаза 3: после четырёх потерь маркеров %d, ' +
|
||
'просадка резерва %d кадров (%.1f мс)',
|
||
[Markers, MinReserve, MinReserve / 48.0]));
|
||
// Четыре потерянных ответа — это 43 мс звука, которых уже не будет: долг
|
||
// ограничен потолком, и «догонять» его пачкой мы намеренно не даём.
|
||
// Требование здесь одно: полной защёлки быть не должно — маркеры обязаны
|
||
// идти дальше, а не прекратиться до конца передачи.
|
||
// ★ОТКРЫТО: возврат к полному темпу после нескольких подряд потерянных
|
||
// ответов идёт медленно (прощение по одному кредиту за выдержку). В эфире
|
||
// это редкость (на живом MSHV — два неотвеченных маркера за 12 с), но
|
||
// строка ниже печатает просадку, чтобы регресс был виден.
|
||
WriteLn(Format(' .. фаза 3: возврат к темпу пока неполный — %d маркеров ' +
|
||
'из ~94/с, просадка %d кадров', [Markers, MinReserve]));
|
||
Check('пейсинг: защёлки нет, маркеры идут дальше',
|
||
Markers > 40, IntToStr(Markers));
|
||
|
||
// ── Повторные передачи: бухгалтерия не переезжает в следующую ──
|
||
// ★Регресс с железа. Штатный конец посылки (trx:N,false — так её и кончает
|
||
// MSHV каждый цикл FT8) обнулял FTxClient, но НЕ FTxRunning, а сбрасывать
|
||
// флаг умел только тик планировщика — и только пока видел ЖИВОГО FTxClient
|
||
// с уже снятым TCIMicActive. Окно этой гонки — хвост SetMOX, пара
|
||
// миллисекунд против шага тика в полкванта, так что промах выпадал через
|
||
// раз. Промах означал, что СЛЕДУЮЩАЯ передача идёт мимо TxResetAccounting:
|
||
// долг сразу у потолка, в полёте чужие кредиты прошлой посылки, выдача
|
||
// маркеров заблокирована до срабатывания сторожа (выдержка до 250 мс). В
|
||
// эфире это пересохшая очередь DUC с первых миллисекунд — голая несущая
|
||
// гетеродина DUC рядом с сигналом.
|
||
// Одиночный промах случаен, поэтому гоняем пачкой: до правки хоть один из
|
||
// шести циклов ловится практически всегда.
|
||
MinStart := MaxInt;
|
||
SumStart := 0;
|
||
StaleRuns := 0;
|
||
for N := 1 to RESTART_CYCLES do
|
||
begin
|
||
C.SendText('trx:0,false;');
|
||
C.WaitText('trx:0,false', 1500);
|
||
// ★Инвариант проверяем сразу по подтверждению команды, не дожидаясь тика:
|
||
// флаг обязан опускаться под тем же FTxLock, что и FTxClient, то есть до
|
||
// ответа клиенту. В этом и смысл правки.
|
||
if Ad.TxDbgState(DbgOwed, DbgFlight, DbgWin, DbgQ, DbgLead) then
|
||
Inc(StaleRuns);
|
||
C.SendText('trx:0,true,tci;');
|
||
// Отвечаем СРАЗУ, не дожидаясь текстового подтверждения: WaitText спит по
|
||
// 50 мс и выбрасывает бинарные кадры, а брошенный без ответа маркер — это
|
||
// зависший кредит, который сам придушит выдачу и смажет измерение старта.
|
||
ServeChrono(C, 200, 0, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
if Markers < MinStart then MinStart := Markers;
|
||
Inc(SumStart, Markers);
|
||
// Тело передачи: к её концу часть кредитов остаётся в полёте — именно их
|
||
// и наследовала следующая посылка.
|
||
ServeChrono(C, 150, 0, Markers, Answered, Quantum, LongGaps, MaxGapMs,
|
||
MinReserve);
|
||
end;
|
||
WriteLn(Format(' .. повторы: %d передач подряд, маркеров в первые 200 мс ' +
|
||
'минимум %d, в среднем %d; флаг протухал %d раз',
|
||
[RESTART_CYCLES, MinStart, SumStart div RESTART_CYCLES,
|
||
StaleRuns]));
|
||
Check('повторы: конец передачи опускает флаг идущей передачи',
|
||
StaleRuns = 0, Format('%d из %d', [StaleRuns, RESTART_CYCLES]));
|
||
// 200 мс / 10.67 мс = около 18 маркеров в здоровом старте; отравленный
|
||
// старт не даёт ни одного, пока не сработает сторож.
|
||
Check('повторы: маркеры идут с первых миллисекунд КАЖДОЙ передачи',
|
||
MinStart >= 8, Format('минимум %d маркеров за 200 мс', [MinStart]));
|
||
|
||
C.SendText('trx:0,false;');
|
||
C.Pump(300);
|
||
finally
|
||
if C <> nil then C.Free;
|
||
if Ad <> nil then Ad.Free;
|
||
Ctrl.Free;
|
||
Host.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TestTxHealth;
|
||
// Детектор голодания очереди TX (TxHealth.pas). Стенд проверяет его отдельно от
|
||
// сети: порог «опасного» простоя, сводку по передаче, контекст пейсинга рядом с
|
||
// событием и то, что вне передачи прибор молчит.
|
||
// ★Диска здесь нет намеренно: TxHealthService писал бы в НАСТОЯЩИЙ журнал
|
||
// пользователя, поэтому стенд берёт сводки через TxHealthTake.
|
||
var
|
||
Base: Int64;
|
||
S: TTxSession;
|
||
D: TTxDrought;
|
||
Was: Integer;
|
||
begin
|
||
WriteLn('G. Детектор голодания очереди TX');
|
||
|
||
// Сводки, накопленные прошлыми частями стенда (они гоняют SetMOX), забираем,
|
||
// чтобы мерить своё.
|
||
while TxHealthTake(S) do ;
|
||
Was := TxHealthDangerTotal;
|
||
|
||
// Вне передачи прибор обязан молчать: простой на приёме — это норма, DUC-поток
|
||
// тогда не шлёт вообще ничего.
|
||
Base := MonotonicUs;
|
||
TxHealthDrought(Base, Base + 50000, 0);
|
||
TxHealthFifoEmpty;
|
||
Check('детектор: вне передачи простой не считается',
|
||
TxHealthDangerTotal = Was, IntToStr(TxHealthDangerTotal - Was));
|
||
|
||
TxHealthPtt(True, txhSrcTCI);
|
||
TxHealthPublishTci(3584, 2200, 1024, 512, 5333, 44100);
|
||
Base := MonotonicUs;
|
||
// Короткий простой: подушка отправителя его покрывает, в эфир он не выходит.
|
||
TxHealthDrought(Base, Base + 8000, 7);
|
||
Check('детектор: простой короче подушки не опасен',
|
||
TxHealthDangerTotal = Was, IntToStr(TxHealthDangerTotal - Was));
|
||
// Длинный: FIFO радио сохнет, в эфире голая несущая.
|
||
TxHealthDrought(Base + 100000, Base + 118000, 0);
|
||
TxHealthFifoEmpty;
|
||
Check('детектор: простой длиннее подушки опасен',
|
||
TxHealthDangerTotal = Was + 1, IntToStr(TxHealthDangerTotal - Was));
|
||
TxHealthPtt(False, 0);
|
||
|
||
Check('детектор: сводка передачи снялась', TxHealthTake(S));
|
||
Check('детектор: простоев посчитано верно', S.Droughts = 2, IntToStr(S.Droughts));
|
||
Check('детектор: опасных посчитано верно', S.Dangerous = 1, IntToStr(S.Dangerous));
|
||
Check('детектор: самое длинное — длиннее подушки',
|
||
S.LongestUs = 18000, IntToStr(S.LongestUs));
|
||
Check('детектор: момент первого опасного — от фронта PTT',
|
||
(S.FirstDangerMs >= 90) and (S.FirstDangerMs <= 130),
|
||
IntToStr(S.FirstDangerMs));
|
||
Check('детектор: источник модуляции в сводке', S.Source = txhSrcTCI);
|
||
Check('детектор: жалоба радио (FIFO EMPTY) считается только на передаче',
|
||
S.FifoEmpty = 1, IntToStr(S.FifoEmpty));
|
||
|
||
// ★Ради этого прибор и делался: рядом с опасным простоем лежит состояние
|
||
// пейсинга — по нему видно, чей простой (аванса, зернистости клиента или
|
||
// планировщика), и оператору не нужно называть интервал на глаз.
|
||
Check('детектор: контекст пейсинга лежит рядом с событием',
|
||
TxHealthDetail(S.Id, 0, D));
|
||
Check('детектор: в контексте аванс и пачка клиента',
|
||
(D.Lead = 3584) and (D.GapUs = 44100) and (D.Quantum = 512) and
|
||
(D.LenUs = 18000),
|
||
Format('аванс %d, пачка %d, квант %d, простой %d',
|
||
[D.Lead, D.GapUs, D.Quantum, D.LenUs]));
|
||
Check('детектор: второго опасного в этой передаче нет',
|
||
not TxHealthDetail(S.Id, 1, D));
|
||
|
||
// Чистая передача: сводка обязана прийти с честным «опасных 0» — именно она и
|
||
// снимает подозрение с нашего тракта.
|
||
TxHealthPtt(True, txhSrcCard);
|
||
Base := MonotonicUs;
|
||
TxHealthDrought(Base, Base + 3000, 9);
|
||
TxHealthPtt(False, 0);
|
||
Check('детектор: чистая передача помечена как чистая',
|
||
TxHealthTake(S) and (S.Dangerous = 0) and (S.Droughts = 1) and
|
||
(S.FirstDangerMs < 0), Format('опасных %d', [S.Dangerous]));
|
||
end;
|
||
|
||
procedure TestEndToEnd;
|
||
const
|
||
PORT = 40098;
|
||
RATE = 48000;
|
||
PAIRS = 238; // как в пакете DDC openHPSDR
|
||
var
|
||
Ctrl: TRadioController;
|
||
Ad: TTCIAdapter;
|
||
Host: THost;
|
||
Cfg: TTCISettings;
|
||
C: TRawClient;
|
||
Pkt: array[0..PAIRS * 6 - 1] of Byte;
|
||
i, k, n, Phase: Integer;
|
||
V: LongInt;
|
||
Op: Byte;
|
||
Pay: TBytes;
|
||
H: TTCIStreamHeader;
|
||
AudioBlocks, IQBlocks, BadHdr, BadRx: Integer;
|
||
SliceId: Integer;
|
||
SV: TSliceView;
|
||
S: string;
|
||
Was: Int64;
|
||
C2: TRawClient;
|
||
begin
|
||
WriteLn('E. Сквозной прогон через движок');
|
||
|
||
Host := THost.Create;
|
||
Ctrl := TRadioController.Create;
|
||
Ctrl.LocalAudioEnabled := False;
|
||
Ctrl.OnInvoke := Host.DoInvoke;
|
||
Ctrl.FSampleRate := RATE;
|
||
Ctrl.CreateEngines(RATE);
|
||
// Линейный выход навешивает хост (в GUI и демоне — тоже он).
|
||
Ctrl.FDSPEngine.OnAudio := Ctrl.OnAudioReady;
|
||
Ctrl.FDSPEngine.OnTXIQ := Host.OnTXIQ;
|
||
C := nil;
|
||
Ad := nil;
|
||
try
|
||
if not Ctrl.FDSPEngine.Open then
|
||
begin
|
||
WriteLn(' -- движок не поднялся (', Ctrl.FDSPEngine.LastError,
|
||
') — сквозной прогон пропущен');
|
||
Exit;
|
||
end;
|
||
Ad := TTCIAdapter.Create(Ctrl, nil);
|
||
Cfg.Enabled := True;
|
||
Cfg.Port := PORT;
|
||
Cfg.BindAddr := '127.0.0.1';
|
||
if not Ad.ApplySettings(Cfg) then
|
||
begin
|
||
Check('сквозной: сервер поднялся', False);
|
||
Exit;
|
||
end;
|
||
|
||
C := TRawClient.Create;
|
||
if not C.Connect(PORT) then
|
||
begin
|
||
Check('сквозной: клиент подключился', False);
|
||
Exit;
|
||
end;
|
||
C.WaitText('ready;', 2000);
|
||
|
||
C.SendText('audio_samplerate:12000;');
|
||
C.WaitText('audio_samplerate', 1000);
|
||
C.SendText('audio_stream_samples:256;');
|
||
C.SendText('audio_start:0;');
|
||
C.SendText('iq_samplerate:48000;');
|
||
C.SendText('iq_start:0;');
|
||
C.Pump(200);
|
||
|
||
// Полсекунды тона 1 кГц пакетами по 238 пар.
|
||
Phase := 0;
|
||
for k := 0 to (RATE div 2) div PAIRS 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);
|
||
// Реальный темп: 238 пар при 48 кГц — это ~5 мс.
|
||
if (k mod 10) = 0 then Sleep(5);
|
||
end;
|
||
C.Pump(500);
|
||
|
||
AudioBlocks := 0;
|
||
IQBlocks := 0;
|
||
BadHdr := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
begin
|
||
if Op <> $02 then Continue;
|
||
if Length(Pay) < SizeOf(H) then begin Inc(BadHdr); Continue; end;
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if H.StreamType = LongWord(Ord(tstRXAudio)) then
|
||
begin
|
||
Inc(AudioBlocks);
|
||
// length — вещественные отсчёты всего блока: просили 256 сэмплов на
|
||
// канал, каналов 2, значит 512 отсчётов и столько же × 4 байта.
|
||
if (H.SampleRate <> 12000) or (H.Receiver <> 0) or
|
||
(H.DataLength <> 256 * Integer(H.Channels)) or
|
||
(Length(Pay) <> SizeOf(H) + Integer(H.DataLength) * 4) then
|
||
Inc(BadHdr);
|
||
end
|
||
else if H.StreamType = LongWord(Ord(tstIQ)) then
|
||
begin
|
||
Inc(IQBlocks);
|
||
// А в IQ — вещественные отсчёты (комплексных вдвое меньше, §3.4).
|
||
if (H.SampleRate <> 48000) or (H.Channels <> 2) or
|
||
(Length(Pay) <> SizeOf(H) + Integer(H.DataLength) * 4) then Inc(BadHdr);
|
||
end;
|
||
end;
|
||
Check('сквозной: блоки RX-аудио пришли', AudioBlocks > 0, IntToStr(AudioBlocks));
|
||
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: панов больше одного там не бывает, и «второй
|
||
// приёмник» существует только как слайс. Приёмник = слот слайса, поэтому
|
||
// первый созданный слайс (слот 0, буква B) обязан стать приёмником 1 —
|
||
// единственным номером сверх нулевого, который умеют клиенты вроде MSHV.
|
||
SliceId := Ctrl.AddSlice(Ctrl.FCenterFreq + 3000, MODE_USB, 200, 2800,
|
||
agcMedium, 0.5, -1, '', 0);
|
||
Check('слайс на главном пане создан', SliceId > 0, IntToStr(SliceId));
|
||
C.Pump(300);
|
||
while C.NextFrame(Op, Pay) do ; // выгребаем рассылку о появлении
|
||
|
||
// Инициализация MSHV — это ровно один запрос и ровно один ответ
|
||
// (network.cpp, Network::initAll: `vfo:<rx>,0;` пять раз, потом
|
||
// «Error To Initialize TCI Server»).
|
||
C.SendText('vfo:1,0;');
|
||
S := C.WaitText('vfo:1,0,', 1500);
|
||
Check('слайс отвечает на vfo:1,0 (инициализация MSHV)', S <> '', S);
|
||
Check('слайс отдаёт свою частоту',
|
||
Pos(IntToStr(Round(Ctrl.FCenterFreq + 3000)), S) > 0, S);
|
||
|
||
// Управление: то, чего от слайса и хотят.
|
||
C.SendText('vfo:1,0,' + IntToStr(Round(Ctrl.FCenterFreq + 5000)) + ';');
|
||
C.Pump(300);
|
||
Check('слайсом можно управлять по TCI',
|
||
Ctrl.GetSliceView(SliceId, SV) and
|
||
(Abs(SV.TargetHz - (Ctrl.FCenterFreq + 5000)) < 2),
|
||
FloatToStr(SV.TargetHz));
|
||
|
||
// Аудиопоток приёмника 1 — это звук слайса, и в заголовке стоит его номер
|
||
// (MSHV отбрасывает блоки с чужим receiver: network.cpp:231).
|
||
C.SendText('audio_start:1;');
|
||
C.Pump(100);
|
||
for k := 0 to 40 do
|
||
begin
|
||
Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS);
|
||
Sleep(2);
|
||
end;
|
||
C.Pump(400);
|
||
n := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
if (Op = $02) and (Length(Pay) >= SizeOf(H)) then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if (H.StreamType = LongWord(Ord(tstRXAudio))) and (H.Receiver = 1) then
|
||
Inc(n);
|
||
end;
|
||
Check('аудио слайса идёт под номером 1', n > 0, IntToStr(n));
|
||
|
||
// ── ★Мьют слайса и стоимость молчащих слайсов ────────────────────────
|
||
// RX_AUDIO снимается ДО громкости и мьюта, поэтому слайс, у которого
|
||
// оператор убрал звук в комнате, обязан продолжать кормить клиента. Но
|
||
// считается он ровно пока его кто-то качает: разрешение послайсовое
|
||
// (TapWanted), а не «поднят TCI-сервер» — иначе шесть молчащих слайсов
|
||
// жгли бы WDSP и без единого клиента.
|
||
WatchSlice := SliceId;
|
||
Ctrl.AddAudioTap(Host.OnTap);
|
||
Ctrl.SetSliceMute(SliceId, True);
|
||
C.Pump(100);
|
||
while C.NextFrame(Op, Pay) do ; // выгребаем хвост
|
||
DemodBlocks := 0;
|
||
n := 0;
|
||
for k := 0 to 40 do
|
||
begin
|
||
Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS);
|
||
Sleep(2);
|
||
end;
|
||
C.Pump(400);
|
||
while C.NextFrame(Op, Pay) do
|
||
if (Op = $02) and (Length(Pay) >= SizeOf(H)) then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if (H.StreamType = LongWord(Ord(tstRXAudio))) and (H.Receiver = 1) then
|
||
Inc(n);
|
||
end;
|
||
Check('мьют слайса не глушит RX_AUDIO по TCI', n > 0, IntToStr(n));
|
||
|
||
// Поток убрали — молчащий слайс не должен считаться вовсе. Тап при этом
|
||
// остаётся навешенным: он наблюдатель и права требовать демодуляции не
|
||
// имеет (раньше именно он её и включал — на все слайсы разом).
|
||
C.SendText('audio_stop:1;');
|
||
C.Pump(200);
|
||
DemodBlocks := 0;
|
||
for k := 0 to 40 do
|
||
begin
|
||
Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS);
|
||
Sleep(2);
|
||
end;
|
||
Sleep(100);
|
||
Check('без потока молчащий слайс не считается', DemodBlocks = 0,
|
||
IntToStr(DemodBlocks));
|
||
|
||
// И обратно: попросили поток — слайс снова в работе.
|
||
C.SendText('audio_start:1;');
|
||
C.Pump(200);
|
||
DemodBlocks := 0;
|
||
for k := 0 to 40 do
|
||
begin
|
||
Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS);
|
||
Sleep(2);
|
||
end;
|
||
Sleep(100);
|
||
Check('поток вернулся — слайс снова считается', DemodBlocks > 0,
|
||
IntToStr(DemodBlocks));
|
||
Ctrl.RemoveAudioTap(Host.OnTap);
|
||
Ctrl.SetSliceMute(SliceId, False);
|
||
C.Pump(200);
|
||
while C.NextFrame(Op, Pay) do ;
|
||
|
||
// ── ★TX со слайса: маркер обязан нести НОМЕР ЭТОГО приёмника ─────────
|
||
// MSHV шлёт TX-аудио только в ответ на маркер TX_CHRONO и отбрасывает
|
||
// ЛЮБОЙ входящий блок с чужим receiver (network.cpp:231 — `if
|
||
// (pStream->receiver != tci_trx) return;`, ветка TxChrono — network.cpp:288
|
||
// и далее). С жёстким нулём в заголовке клиент, сидящий на втором слайсе
|
||
// (tci_trx = 1), поднимал эфир и молчал: маркеры до него не доходили, а
|
||
// без них он не отправляет ни одного блока. Ровно это и наблюдалось на
|
||
// живом железе с MSHV.
|
||
Ctrl.FWDSPReady := True;
|
||
Ctrl.SetSliceSlotAutoTx(Ctrl.SliceSlotOf(SliceId), True);
|
||
C.SendText('trx:1,true,tci;');
|
||
C.WaitText('trx:', 1500);
|
||
Check('TX слайса: модуляция из TCI взята', Ctrl.TCIMicActive);
|
||
C.Pump(400);
|
||
n := 0;
|
||
BadRx := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
if (Op = $02) and (Length(Pay) >= SizeOf(H)) then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if H.StreamType = LongWord(Ord(tstTXChrono)) then
|
||
begin
|
||
Inc(n);
|
||
if H.Receiver <> 1 then Inc(BadRx);
|
||
end;
|
||
end;
|
||
Check('TX слайса: маркеры TX_CHRONO идут', n > 0, IntToStr(n));
|
||
Check('TX слайса: маркер назван номером приёмника (MSHV фильтрует)',
|
||
(n > 0) and (BadRx = 0), IntToStr(BadRx));
|
||
|
||
// ★Команда, которая ничего не сделала, не должна перебивать пару
|
||
// «клиент + приёмник»: передатчик занят своей же передачей, SyncSetTRX
|
||
// на неё не отвечает ничем — а если запомнить номер заранее, маркеры
|
||
// идущей передачи уедут под чужим номером, и клиент замолчит.
|
||
C.SendText('trx:0,true,tci;');
|
||
C.WaitText('trx:', 1000);
|
||
C.Pump(300);
|
||
n := 0;
|
||
BadRx := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
if (Op = $02) and (Length(Pay) >= SizeOf(H)) then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if H.StreamType = LongWord(Ord(tstTXChrono)) then
|
||
begin
|
||
Inc(n);
|
||
if H.Receiver <> 1 then Inc(BadRx);
|
||
end;
|
||
end;
|
||
Check('TX слайса: пустая команда не сменила номер приёмника',
|
||
(n > 0) and (BadRx = 0), IntToStr(BadRx));
|
||
|
||
C.SendText('trx:1,false;');
|
||
C.WaitText('trx:', 1000);
|
||
Ctrl.SetSliceSlotAutoTx(Ctrl.SliceSlotOf(SliceId), False);
|
||
|
||
C.SendText('audio_stop:1;');
|
||
C.Pump(200);
|
||
|
||
// Удалили слайс — приёмник исчез, и врать про его частоту нельзя.
|
||
Ctrl.RemoveSlice(SliceId);
|
||
C.Pump(300);
|
||
while C.NextFrame(Op, Pay) do ;
|
||
C.SendText('vfo:1,0;');
|
||
S := C.WaitText('vfo:1,0,', 800);
|
||
Check('после удаления слайса приёмник 1 молчит', S = '', S);
|
||
|
||
// Остановка потока обязана прекратить подачу.
|
||
C.SendText('audio_stop:0;');
|
||
C.SendText('iq_stop:0;');
|
||
C.Pump(200);
|
||
while C.NextFrame(Op, Pay) do ; // выгребаем хвост
|
||
for k := 0 to 40 do
|
||
begin
|
||
Ctrl.FDSPEngine.PushDDCPacket(Pkt, 0, PAIRS);
|
||
Sleep(1);
|
||
end;
|
||
C.Pump(300);
|
||
n := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
if Op = $02 then Inc(n);
|
||
Check('сквозной: после STOP блоков нет', n = 0, IntToStr(n));
|
||
|
||
// ── TX: маркеры времени и приём аудио клиента ──
|
||
// Радио не подключено, поэтому передачу поднимаем «на движке»: нам важен
|
||
// маршрут TCI → ринг микрофона, а не сама излучающая часть.
|
||
Ctrl.FWDSPReady := True;
|
||
C.SendText('audio_samplerate:12000;');
|
||
C.WaitText('audio_samplerate', 1000);
|
||
C.SendText('audio_stream_samples:256;');
|
||
C.SendText('audio_start:0;');
|
||
C.SendText('trx:0,true,tci;');
|
||
C.WaitText('trx:', 1000);
|
||
Check('TX: модуляция из TCI взята', Ctrl.TCIMicActive);
|
||
|
||
C.Pump(400);
|
||
n := 0;
|
||
while C.NextFrame(Op, Pay) do
|
||
if (Op = $02) and (Length(Pay) >= SizeOf(H)) then
|
||
begin
|
||
Move(Pay[0], H, SizeOf(H));
|
||
if H.StreamType = LongWord(Ord(tstTXChrono)) then
|
||
begin
|
||
Inc(n);
|
||
if (H.SampleRate <> 12000) or
|
||
(H.DataLength <> 256 * Integer(H.Channels)) then
|
||
Inc(BadHdr);
|
||
end;
|
||
end;
|
||
Check('TX: маркеры TX_CHRONO идут', n > 0, IntToStr(n));
|
||
|
||
// Блок TX-аудио 12 кГц float32 моно: в ринг микрофона должно попасть
|
||
// вчетверо больше отсчётов (12 → 48 кГц).
|
||
TCIFillHeader(H, tstTXAudio, 0, 12000, tsyFloat32, 256, 1);
|
||
Move(H, Pkt[0], SizeOf(H));
|
||
for i := 0 to 255 do
|
||
PSingle(@Pkt[SizeOf(H) + i * 4])^ := Sin(2 * Pi * 700 * i / 12000) * 0.5;
|
||
C.SendBinary(Pkt[0], SizeOf(H) + 256 * 4);
|
||
// Наблюдаем не ринг (его вычерпывает TX-поток быстрее опроса), а выход
|
||
// тракта: блоки TX-IQ появляются только если аудио клиента дошло.
|
||
for i := 0 to 7 do C.SendBinary(Pkt[0], SizeOf(H) + 256 * 4);
|
||
Sleep(400);
|
||
Check('TX: аудио клиента прошло тракт', TXIQBlocks > 0, IntToStr(TXIQBlocks));
|
||
|
||
// Обрыв прямо во время клиентской TRX: здесь движок и FNetwork
|
||
// созданы, но радиобэкенд не подключён — RF-выхода нет.
|
||
Check('перед обрывом TRX активен', Ctrl.FTransmitting);
|
||
C.Close_;
|
||
Sleep(300);
|
||
Check('после ухода клиента источник снят', not Ctrl.TCIMicRequested);
|
||
Check('после ухода клиента MOX снят', not Ctrl.FTransmitting);
|
||
|
||
// ── TUN: хозяин эфира забывается и на выключении TUNE ──
|
||
// Клиент поднял TUN, оператор погасил его САМ (кнопкой, не командой TCI),
|
||
// а потом сам же встал на передачу. Уход клиента не имеет права снять эту
|
||
// чужую передачу: хозяина эфира обязано было забыть ещё выключение TUN.
|
||
// ★Задний фронт ловился только по rfTransmitting, а SetTune(False) шлёт
|
||
// его, пока FTuning ещё True, — владелец оставался протухшим навсегда.
|
||
C2 := TRawClient.Create;
|
||
try
|
||
Check('TUN: клиент подключился', C2.Connect(PORT));
|
||
C2.WaitText('ready;', 2000);
|
||
C2.SendText('tune:0,true;');
|
||
C2.WaitText('tune:', 1000);
|
||
Check('TUN: эфир поднят клиентом', Ctrl.FTuning and Ctrl.FTransmitting);
|
||
Ctrl.SetTune(False); // оператор гасит TUN сам
|
||
Ctrl.SetMOX(True); // и сам встаёт на передачу
|
||
Check('TUN: оператор в эфире', Ctrl.FTransmitting);
|
||
C2.Close_;
|
||
Sleep(300);
|
||
Check('TUN: уход клиента не снял чужую передачу', Ctrl.FTransmitting);
|
||
Ctrl.SetMOX(False);
|
||
finally
|
||
C2.Close_;
|
||
C2.Free;
|
||
end;
|
||
|
||
Ctrl.FWDSPReady := False;
|
||
finally
|
||
if C <> nil then begin C.Close_; C.Free; end;
|
||
Ad.Free;
|
||
Ctrl.Free;
|
||
Host.Free;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Randomize;
|
||
Passed := 0;
|
||
Failed := 0;
|
||
WriteLn('=== Стенд TCI, этап 2 (бинарные потоки) ===');
|
||
TestProtocol;
|
||
TestResampling;
|
||
TestStreamOut;
|
||
TestRecorder;
|
||
TestKeyPlayer;
|
||
TestTextSender;
|
||
TestServer;
|
||
TestEndToEnd;
|
||
TestTxPacing;
|
||
TestTxHealth;
|
||
WriteLn;
|
||
WriteLn(Format('Итого: %d проверок, провалено %d', [Passed + Failed, Failed]));
|
||
if Failed > 0 then Halt(1);
|
||
end.
|