fix(tci): ревизия — потоки, валидация, арбитраж и синхронизация клиентов

Разбор семи проходов ревью ветки. Ниже — по сути, а не по списку.

Потоки. Сетевые потоки больше не читают модель контроллера напрямую. Слайсы
снимаются в потоке контроллера (RefreshSlices → FSliceSnap, на событиях
rfSliceFreq/rfSliceState/rfDevice/…), железо — тоже (RefreshDev → TTCIDevSnap:
имя платы, границы, число панов, HasTX). Копия TCtrlSlice из чужого потока
портила счётчик ссылок managed-строк, а BackendCaps и BoardDisplayName смотрят
в FNetwork, который UI освобождает на смене устройства. По той же причине
ActiveTXFreqHz переведён на GetSliceView. Sync-методы читают живую таблицу: они
уже в потоке контроллера.

Жизненный цикл. Stop ждёт выхода клиентских потоков БЕЗ таймаута, прокачивая
очередь Synchronize: выйти по таймауту нельзя — следом освобождаются и клиенты,
и сам сервер. OnDisconnect зовётся и при остановке (иначе захваты параметров
ушедших клиентов доживали до следующего запуска). Отправка переехала на поток
самого клиента (recv с TCI_POLL_MS): общий поток задерживал всех на таймаут
записи в один медленный сокет. WebUtils.SockSend шлёт с MSG_NOSIGNAL — SIGPIPE
убивал headless-процесс.

Транспорт. Слот протокола выдаётся только после Upgrade, а сокет до него живёт
по таймауту handshake: восемь молчащих соединений закрывали дверь настоящим
клиентам. Handshake с заголовком Origin получает 403 — авторизации в TCI нет, и
без этого открытая вкладка браузера дотягивалась до TRX и VFO. Заголовки
разбираются построчно, текстовые кадры проверяются на UTF-8, close длиной один
байт отвергается, на close отвечаем close.

Валидация. Все установки ходят через TCITryArg* — «vfo^0~0~abc» больше не
превращается в честный ноль. Частота проверяется дважды: в потоке клиента по
снимку и в SyncSetVfo/SyncSetCenter по живым границам (устройство успевают
сменить между разбором и исполнением). Границы теперь из ОДНОГО источника
(FreqLimits поверх VisibleFreqBounds) — тот же, что уходит в VFO_LIMITS; сами
VFO_LIMITS переобъявляются при смене железа, и их кэш ведётся независимо от
того, подключён ли кто-то. Слайс двигается только TuneSliceInBand, как у CAT:
прямой SetSliceTarget уводил TX-слайс в DUC на чужой диапазон без антенн и
фильтров. Параметры потоков сверяются со списками спецификации, а IQ_START и
прочие запуски честно отвечают ошибкой вместо молчания.

Синхронизация клиентов (§3.5). Появился захват параметра на 200 мс: два логгера
больше не перетягивают частоту. Пачка инициализации уходит под FClientLock —
изменение между строкой снимка и READY терялось навсегда. Глобальные величины
(tune_drive, cw_macros_*, split_enable, mon_volume) рассылаются всем, а правки
оператора приходят событиями: rfTXProfile, rfActiveVfo, rfMonVolume и новый
rfCWSettings. Создание и удаление слайса рассылается по rfDevice (сравнение
расстановки), у живого пана без слайсов канал A показывает центр — иначе клиент
навсегда оставался с частотой удалённого слайса.

Прочее. SliceFreqChanged переехал внутрь SetSliceTarget — один путь для мыши,
CAT и TCI (перетаскивание флага мимо клиентов проходило молча). VOLUME и
MON_VOLUME развели: SetVolume правит АКТИВНУЮ громкость, поэтому команда на
DUP-передаче уезжала в монитор — добавлен адресный SetRxVolume. Настройки
сохраняются только после успешного применения, при отказе поднимается прежний
слушатель. Время спота — UTC. Подписки на измерители читаются и пишутся под
локом клиента.

Проверено стендом (сырой WS-клиент + живой TRadioController без железа):
73 проверки, включая изоляцию медленного клиента, остановку под Synchronize,
арбитраж до и после 200 мс, отбраковку по живым границам и переобъявление
VFO_LIMITS. На реальном железе и с реальным клиентом по-прежнему не гонялось.

Co-Authored-By: Claude Opus 5 <noreply@anthropic.com>
This commit is contained in:
2026-08-17 22:53:32 +03:00
co-authored by Claude Opus 5
parent 84c9e60b93
commit 4165cbe9a5
7 changed files with 1738 additions and 418 deletions
+36 -25
View File
@@ -5779,9 +5779,10 @@ begin
FController.CapturedSpan(LoHz, HiHz); FController.CapturedSpan(LoHz, HiHz);
if NewHz < LoHz then NewHz := LoHz; if NewHz < LoHz then NewHz := LoHz;
if NewHz > HiHz then NewHz := HiHz; if NewHz > HiHz then NewHz := HiHz;
// Перезалив флага и раскладку несёт rfSliceFreq из SetSliceTarget —
// одним путём для мыши, CAT и TCI (иначе внешние клиенты о перетаскивании
// не узнавали).
FController.SetSliceTarget(FSliceDragId, NewHz); FController.SetSliceTarget(FSliceDragId, NewHz);
FPan.PushSliceFlagState(FSliceDragId); // обновить частоту во флаге
FPan.LayoutFlags;
FSpectrumDirty := True; // кадр — по таймеру (FPS-гейт, как при drag VFO) FSpectrumDirty := True; // кадр — по таймеру (FPS-гейт, как при drag VFO)
end; end;
Exit; Exit;
@@ -6583,18 +6584,37 @@ end;
procedure TMainForm.ApplyTCISettings(Enabled: Boolean; Port: Integer; procedure TMainForm.ApplyTCISettings(Enabled: Boolean; Port: Integer;
const BindAddr: string); const BindAddr: string);
// Сначала применяем, и только потом сохраняем. Обратный порядок означал бы:
// занятый порт или опечатка в адресе — и в файле навсегда осталась нерабочая
// конфигурация, с которой программа стартует и в следующий раз.
var Prev, Cfg: TTCISettings;
begin begin
FTCICfg.Enabled := Enabled; Prev := FTCICfg;
FTCICfg.Port := Port; Cfg.Enabled := Enabled;
FTCICfg.BindAddr := BindAddr; Cfg.Port := Port;
FController.FSettings.SaveTCISettings(FTCICfg); Cfg.BindAddr := BindAddr;
if FTCIAdapter = nil then Exit; if FTCIAdapter = nil then
// Отказ (порт занят, адрес не разобран) показываем сразу: иначе оператор begin
// останется с галкой «включено» и мёртвым сервером. FTCICfg := Cfg;
if not FTCIAdapter.ApplySettings(FTCICfg) then FController.FSettings.SaveTCISettings(FTCICfg);
ShowMessage('TCI server failed to start on ' + BindAddr + ':' + Exit;
IntToStr(Port) + '.' + LineEnding + end;
'Port busy or address invalid.'); if FTCIAdapter.ApplySettings(Cfg) then
begin
FTCICfg := Cfg;
FController.FSettings.SaveTCISettings(FTCICfg);
Exit;
end;
// Отказ: адаптер откатился на прежний слушатель — вернём туда же и настройки
// с их отражением в окне, иначе оператор остаётся с галкой «включено» при
// мёртвом сервере.
FTCICfg := Prev;
if (FSettingsForm <> nil) and TSettingsForm(FSettingsForm).Visible then
TSettingsForm(FSettingsForm).LoadTCISettings(FTCICfg.Enabled, FTCICfg.Port,
FTCICfg.BindAddr);
ShowMessage('TCI server failed to start on ' + BindAddr + ':' +
IntToStr(Port) + '.' + LineEnding +
'Port busy or address invalid — settings not saved.');
end; end;
// SET_IN_FOCUS от TCI-клиента: логгер просит поднять окно программы. // SET_IN_FOCUS от TCI-клиента: логгер просит поднять окно программы.
@@ -7429,11 +7449,8 @@ begin
AddSliceAtFreqPan(P, Hz); AddSliceAtFreqPan(P, Hz);
Exit; Exit;
end; end;
FController.SetSliceTarget(Id, Hz); FController.SetSliceTarget(Id, Hz); // флаг и раскладку несёт rfSliceFreq
FActiveSliceId := Id; FActiveSliceId := Id;
P.PushSliceFlagState(Id);
P.LayoutFlags;
MarkPanDirty(P);
end; end;
procedure TMainForm.ApplyPanHeaderTheme(P: TPanafallPanel); procedure TMainForm.ApplyPanHeaderTheme(P: TPanafallPanel);
@@ -8062,10 +8079,7 @@ begin
FController.CapturedSpan(LoHz, HiHz, P.PanId); FController.CapturedSpan(LoHz, HiHz, P.PanId);
if NewHz < LoHz then NewHz := LoHz; if NewHz < LoHz then NewHz := LoHz;
if NewHz > HiHz then NewHz := HiHz; if NewHz > HiHz then NewHz := HiHz;
FController.SetSliceTarget(FPanSliceDragId, NewHz); FController.SetSliceTarget(FPanSliceDragId, NewHz); // флаг — rfSliceFreq
P.PushSliceFlagState(FPanSliceDragId);
P.LayoutFlags;
MarkPanDirty(P);
end; end;
Exit; Exit;
end; end;
@@ -9270,10 +9284,7 @@ begin
FController.CapturedSpan(SLo, SHi, Sl.PanId); // полоса ЕГО пана FController.CapturedSpan(SLo, SHi, Sl.PanId); // полоса ЕГО пана
if SNew < SLo then SNew := SLo; if SNew < SLo then SNew := SLo;
if SNew > SHi then SNew := SHi; if SNew > SHi then SNew := SHi;
FController.SetSliceTarget(SliceId, SNew); FController.SetSliceTarget(SliceId, SNew); // флаг — rfSliceFreq
SlicePan.PushSliceFlagState(SliceId);
SlicePan.LayoutFlags;
MarkPanDirty(SlicePan);
FActiveSliceId := SliceId; FActiveSliceId := SliceId;
Handled := True; Handled := True;
Exit; Exit;
+146 -8
View File
@@ -89,7 +89,9 @@ type
rfDeviceList, // список discovered устройств обновился rfDeviceList, // список discovered устройств обновился
rfPanFreq, // центр доп. пана уехал (ретюн DDC извне) rfPanFreq, // центр доп. пана уехал (ретюн DDC извне)
rfSliceFreq, // слайс перестроен извне (CAT); Id — FSliceFreqId rfSliceFreq, // слайс перестроен извне (CAT); Id — FSliceFreqId
rfSliceState // у слайса сменились мода/фильтр/АРУ/DSP/громкость; Id — FSliceFreqId rfSliceState, // у слайса сменились мода/фильтр/АРУ/DSP/громкость; Id — FSliceFreqId
rfCWSettings, // правка телеграфа (скорость, задержка, pitch…)
rfMonVolume // громкость self-monitor'а (TX), отдельно от rfVolume
); );
TRadioStateEvent = procedure(Sender: TObject; Field: TRadioField) of object; TRadioStateEvent = procedure(Sender: TObject; Field: TRadioField) of object;
@@ -193,6 +195,29 @@ type
DMR: TDMRSliceDecoder; // владеет; nil для не-DMR слайса DMR: TDMRSliceDecoder; // владеет; nil для не-DMR слайса
end; end;
// POD-снимок слайса для фронтендов, которые читают модель из своих потоков
// (TCI-сервер: команда исполняется в потоке клиента). Только скаляры: копия
// TCtrlSlice тащит за собой managed-поля (DevName/InDevName) и объекты, а
// копирование строки из чужого потока, пока UI-поток её же переписывает,
// портит счётчик ссылок — это уже не рассинхрон, а порча кучи.
TSliceView = record
Id: Integer;
PanId: Integer;
TargetHz: Double;
Mode: Integer;
FilterLo: Integer;
FilterHi: Integer;
AGC: TWDSPAGCMode;
Volume: Double;
Muted: Boolean;
FMSQOn: Boolean;
FMSQLevel: Integer;
NRMode: Integer;
NBMode: Integer;
SNB: Boolean;
ANF: Boolean;
end;
{ TRadioController } { TRadioController }
TRadioController = class TRadioController = class
private private
@@ -795,6 +820,10 @@ type
procedure VolumeBy(Delta: Integer); procedure VolumeBy(Delta: Integer);
// Громкость self-monitor'а на передаче отдельно от RX-громкости: слайдер // Громкость self-monitor'а на передаче отдельно от RX-громкости: слайдер
// правит её только когда MonitoringTX, а CAT (ZZTM) — в любой момент. // правит её только когда MonitoringTX, а CAT (ZZTM) — в любой момент.
{ Адресная громкость ПРИЁМА: правит FVolume независимо от того, идёт ли
передача. Слайдер (SetVolume) правит активную на self-monitor это
громкость монитора; внешнему клиенту (TCI VOLUME) такой контекст не нужен. }
procedure SetRxVolume(V: Integer);
procedure SetTXMonVolume(V: Integer); procedure SetTXMonVolume(V: Integer);
// True — сейчас звучит self-monitor даунлинка на передаче (TX + DUP + RX MUTE // True — сейчас звучит self-monitor даунлинка на передаче (TX + DUP + RX MUTE
// off). В этом контексте SetVolume/слайдер правят FTxMonVolume, иначе FVolume. // off). В этом контексте SetVolume/слайдер правят FTxMonVolume, иначе FVolume.
@@ -876,6 +905,14 @@ type
function ActiveMicInDevName: string; function ActiveMicInDevName: string;
function SliceCount: Integer; function SliceCount: Integer;
function GetSlice(Id: Integer; out S: TCtrlSlice): Boolean; function GetSlice(Id: Integer; out S: TCtrlSlice): Boolean;
// Снимок слайса для фронтендов, читающих модель из СВОИХ потоков (TCI).
// См. TSliceView: копировать целиком TCtrlSlice оттуда нельзя.
function GetSliceView(Id: Integer; out V: TSliceView): Boolean;
// Слайсы пана по порядку (0-й = «канал A» пана): та же нумерация, что у
// флагов. Нужны TCI, где приёмник — это пан, а канал — слайс на нём.
function PanSliceCount(PanId: Integer): Integer;
function PanSliceId(PanId, Index: Integer): Integer; // 0 = нет такого
function SlicePanIndex(Id: Integer; out PanId, Index: Integer): Boolean;
// Слот ↔ слайс. Слот 0..MAX_SLICES-1 = буква B..G и не зависит от того, // Слот ↔ слайс. Слот 0..MAX_SLICES-1 = буква B..G и не зависит от того,
// создан ли слайс сейчас: на слот вешаются настройки (CAT-порт, Auto TX). // создан ли слайс сейчас: на слот вешаются настройки (CAT-порт, Auto TX).
class function SliceSlotLetter(Slot: Integer): Char; class function SliceSlotLetter(Slot: Integer): Char;
@@ -2052,8 +2089,7 @@ begin
PanId := FSlices[idx].PanId; PanId := FSlices[idx].PanId;
if SliceFitsCapture(TargetHz, PanId) then if SliceFitsCapture(TargetHz, PanId) then
begin begin
SetSliceTarget(Id, TargetHz); SetSliceTarget(Id, TargetHz); // он же шлёт SliceFreqChanged
SliceFreqChanged(Id);
Exit(True); Exit(True);
end; end;
@@ -2078,8 +2114,8 @@ begin
if Dist > Half * 2 * 0.95 then Exit; if Dist > Half * 2 * 0.95 then Exit;
NewCenter := (TargetHz + ActiveVfoHz) / 2; NewCenter := (TargetHz + ActiveVfoHz) / 2;
SetCenter(NewCenter); // несёт Changed(rfCenterFreq) + сдвиги слайсов SetCenter(NewCenter); // несёт Changed(rfCenterFreq) + сдвиги слайсов
SetSliceTarget(Id, TargetHz); SetSliceTarget(Id, TargetHz); // SliceFreqChanged — внутри: rfCenterFreq
SliceFreqChanged(Id); // rfCenterFreq флаги не перезаливает нужен свой // флаги не перезаливает, нужен свой
Result := True; Result := True;
end; end;
end; end;
@@ -2513,10 +2549,11 @@ begin
end; end;
procedure TRadioController.SetSliceTarget(Id: Integer; TargetHz: Double); procedure TRadioController.SetSliceTarget(Id: Integer; TargetHz: Double);
var idx: Integer; var idx: Integer; Moved: Boolean;
begin begin
idx := FindSliceIndex(Id); idx := FindSliceIndex(Id);
if idx < 0 then Exit; if idx < 0 then Exit;
Moved := FSlices[idx].TargetHz <> TargetHz;
FSlices[idx].TargetHz := TargetHz; FSlices[idx].TargetHz := TargetHz;
if Assigned(FDSPEngine) then if Assigned(FDSPEngine) then
FDSPEngine.SetSliceShift(Id, TargetHz - PanCenterHz(FSlices[idx].PanId)); FDSPEngine.SetSliceShift(Id, TargetHz - PanCenterHz(FSlices[idx].PanId));
@@ -2524,6 +2561,10 @@ begin
// первый MOX, но в телеграфе ключ замыкает прошивка без всякого MOX: DUC // первый MOX, но в телеграфе ключ замыкает прошивка без всякого MOX: DUC
// обязан стоять правильно ВСЕГДА, а не только на передаче. // обязан стоять правильно ВСЕГДА, а не только на передаче.
if FTxSliceId = Id then PushNetworkState; if FTxSliceId = Id then PushNetworkState;
// Уведомление — здесь, а не у каждого вызывающего: слайс двигают мышью, CAT,
// TCI и бэнд-логика, и каждый забывал сказать об этом остальным (TCI-клиенты
// оставались на старой частоте после перетаскивания флага мышью).
if Moved then SliceFreqChanged(Id);
end; end;
procedure TRadioController.SetSliceMode(Id, Mode: Integer); procedure TRadioController.SetSliceMode(Id, Mode: Integer);
@@ -2921,6 +2962,85 @@ begin
if Result then S := FSlices[idx]; if Result then S := FSlices[idx];
end; end;
function TRadioController.GetSliceView(Id: Integer; out V: TSliceView): Boolean;
// Читается из чужих потоков (TCI), поэтому — поле за полем и только скаляры.
// Active перечитывается после копирования: слайс могли удалить прямо во время
// снятия снимка, и тогда честнее вернуть False, чем полуживую запись.
var idx: Integer;
begin
FillChar(V, SizeOf(V), 0);
Result := False;
idx := FindSliceIndex(Id);
if idx < 0 then Exit;
V.Id := FSlices[idx].Id;
V.PanId := FSlices[idx].PanId;
V.TargetHz := FSlices[idx].TargetHz;
V.Mode := FSlices[idx].Mode;
V.FilterLo := FSlices[idx].FilterLo;
V.FilterHi := FSlices[idx].FilterHi;
V.AGC := FSlices[idx].AGC;
V.Volume := FSlices[idx].Volume;
V.Muted := FSlices[idx].Muted;
V.FMSQOn := FSlices[idx].FMSQOn;
V.FMSQLevel := FSlices[idx].FMSQLevel;
V.NRMode := FSlices[idx].NRMode;
V.NBMode := FSlices[idx].NBMode;
V.SNB := FSlices[idx].SNB;
V.ANF := FSlices[idx].ANF;
Result := FSlices[idx].Active and (FSlices[idx].Id = Id);
end;
function TRadioController.PanSliceCount(PanId: Integer): Integer;
var i: Integer;
begin
Result := 0;
for i := 0 to MAX_SLICES - 1 do
if FSlices[i].Active and (FSlices[i].PanId = PanId) then Inc(Result);
end;
function TRadioController.PanSliceId(PanId, Index: Integer): Integer;
var i, Seen: Integer;
begin
Result := 0;
if Index < 0 then Exit;
Seen := 0;
for i := 0 to MAX_SLICES - 1 do
if FSlices[i].Active and (FSlices[i].PanId = PanId) then
begin
if Seen = Index then Exit(FSlices[i].Id);
Inc(Seen);
end;
end;
function TRadioController.SlicePanIndex(Id: Integer; out PanId, Index: Integer): Boolean;
var i, Seen, Pan: Integer;
begin
Result := False;
PanId := 0; Index := 0;
if Id <= 0 then Exit;
Pan := -1;
for i := 0 to MAX_SLICES - 1 do
if FSlices[i].Active and (FSlices[i].Id = Id) then
begin
Pan := FSlices[i].PanId;
Break;
end;
if Pan < 0 then Exit;
Seen := 0;
for i := 0 to MAX_SLICES - 1 do
if FSlices[i].Active and (FSlices[i].PanId = Pan) then
begin
if FSlices[i].Id = Id then
begin
PanId := Pan;
Index := Seen;
Exit(True);
end;
Inc(Seen);
end;
end;
// --------------------------------------------------------------------------- // ---------------------------------------------------------------------------
// Слоты слайсов: настройки (CAT-порт, Auto TX) висят на слоте/букве, а слайс // Слоты слайсов: настройки (CAT-порт, Auto TX) висят на слоте/букве, а слайс
// на слоте может появляться и исчезать. // на слоте может появляться и исчезать.
@@ -3216,11 +3336,13 @@ begin
end; end;
function TRadioController.ActiveTXFreqHz: Double; function TRadioController.ActiveTXFreqHz: Double;
var S: TCtrlSlice; // Снимок (GetSliceView), а не GetSlice: функцию зовут и внешние фронтенды из
// своих потоков, а копия TCtrlSlice тащит managed-строки слайса.
var S: TSliceView;
begin begin
// Мультислайс-TX: если выбран слайс-источник — передаём на его частоте // Мультислайс-TX: если выбран слайс-источник — передаём на его частоте
// (слайсы не несут repeater-конфиг, FM-сдвиг не применяем). // (слайсы не несут repeater-конфиг, FM-сдвиг не применяем).
if (FTxSliceId > 0) and GetSlice(FTxSliceId, S) then if (FTxSliceId > 0) and GetSliceView(FTxSliceId, S) then
Result := S.TargetHz Result := S.TargetHz
else else
begin begin
@@ -4722,9 +4844,20 @@ begin
// иначе FVolume. Обе персистятся; слайдер редактирует активную. // иначе FVolume. Обе персистятся; слайдер редактирует активную.
if MonitoringTX then FTxMonVolume := V else FVolume := V; if MonitoringTX then FTxMonVolume := V else FVolume := V;
if FWDSPReady and Assigned(FDSPEngine) then FDSPEngine.SetVolume(ActiveVolume / 100.0); if FWDSPReady and Assigned(FDSPEngine) then FDSPEngine.SetVolume(ActiveVolume / 100.0);
// rfVolume — для слайдера и оверлея: они показывают ActiveVolume. А вот кто
// именно изменился, слайдеру всё равно, зато не всё равно внешним клиентам:
// у них громкость приёма и громкость монитора — РАЗНЫЕ величины.
if MonitoringTX then Changed(rfMonVolume);
Changed(rfVolume); Changed(rfVolume);
end; end;
procedure TRadioController.SetRxVolume(V: Integer);
begin
FVolume := EnsureRange(V, 0, 100);
if MonitoringTX then Changed(rfVolume) // звучит монитор — трогать тракт нечем
else ApplyActiveVolume; // он же несёт Changed(rfVolume)
end;
procedure TRadioController.VolumeBy(Delta: Integer); procedure TRadioController.VolumeBy(Delta: Integer);
begin SetVolume(ActiveVolume + Delta); end; begin SetVolume(ActiveVolume + Delta); end;
@@ -4734,6 +4867,7 @@ procedure TRadioController.SetTXMonVolume(V: Integer);
begin begin
FTxMonVolume := EnsureRange(V, 0, 100); FTxMonVolume := EnsureRange(V, 0, 100);
if MonitoringTX then ApplyActiveVolume; if MonitoringTX then ApplyActiveVolume;
Changed(rfMonVolume);
end; end;
procedure TRadioController.SetMute(On_: Boolean); procedure TRadioController.SetMute(On_: Boolean);
@@ -6224,6 +6358,10 @@ begin
FSettings.SaveCW(FDevMAC, FCWSettings); FSettings.SaveCW(FDevMAC, FCWSettings);
FSettings.Save; FSettings.Save;
end; end;
// Телеграф правят и оператор, и CAT, и TCI, а скорость с задержкой макросов —
// величины общие для радио: об их смене обязаны узнать все фронтенды, а не
// только тот, кто её заказал.
Changed(rfCWSettings);
end; end;
procedure TRadioController.SyncCWKeyer; procedure TRadioController.SyncCWKeyer;
+795 -257
View File
File diff suppressed because it is too large Load Diff
+64
View File
@@ -91,6 +91,19 @@ function TCIArgInt(const M: TTCIMessage; Idx, Def: Integer): Integer;
function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double; function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double;
function TCIArgBool(const M: TTCIMessage; Idx: Integer; Def: Boolean): Boolean; function TCIArgBool(const M: TTCIMessage; Idx: Integer; Def: Boolean): Boolean;
{ Строгий разбор аргумента: False аргумента нет или он не число/не Boolean.
Всё, что ставит параметр радио, обязано ходить через эти функции: варианты с
умолчанием превращали «vfo^0~0~abc;» в честный ноль и перестраивали приёмник
на 0 Гц. Умолчания остаются только там, где значение необязательно. }
function TCITryArgInt(const M: TTCIMessage; Idx: Integer; out V: Integer): Boolean;
function TCITryArgFloat(const M: TTCIMessage; Idx: Integer; out V: Double): Boolean;
function TCITryArgBool(const M: TTCIMessage; Idx: Integer; out V: Boolean): Boolean;
{ Наборы значений, оговорённые протоколом для параметров потоков (§4.3). }
function TCIValidIQRate(V: Integer): Boolean; // 48/96/192/384 кГц
function TCIValidAudioRate(V: Integer): Boolean; // 8/12/24/48 кГц
function TCIValidSampleType(const S: string): Boolean; // int16/int24/int32/float32
{ ── Сборка ─────────────────────────────────────────────────────────────── } { ── Сборка ─────────────────────────────────────────────────────────────── }
function TCIBuild(const Name: string): string; overload; function TCIBuild(const Name: string): string; overload;
@@ -226,6 +239,57 @@ begin
else Result := Def; else Result := Def;
end; end;
function TCITryArgFloat(const M: TTCIMessage; Idx: Integer; out V: Double): Boolean;
var S: string;
begin
V := 0;
S := Trim(TCIArg(M, Idx));
if S = '' then Exit(False);
Result := TryStrToFloat(StringReplace(S, ',', '.', [rfReplaceAll]), V,
TCIFormatSettings);
end;
function TCITryArgInt(const M: TTCIMessage; Idx: Integer; out V: Integer): Boolean;
var D: Double;
begin
V := 0;
Result := TCITryArgFloat(M, Idx, D);
// Величины протокола целочисленные, но клиенты шлют и «100.0»; за пределами
// Integer округлять нечего — это не значение, а мусор.
if Result then
begin
Result := (D >= -2147483648.0) and (D <= 2147483647.0);
if Result then V := Round(D);
end;
end;
function TCITryArgBool(const M: TTCIMessage; Idx: Integer; out V: Boolean): Boolean;
var S: string;
begin
V := False;
S := LowerCase(Trim(TCIArg(M, Idx)));
if (S = 'true') or (S = '1') then begin V := True; Result := True; end
else if (S = 'false') or (S = '0') then begin V := False; Result := True; end
else Result := False;
end;
function TCIValidIQRate(V: Integer): Boolean;
begin
Result := (V = 48000) or (V = 96000) or (V = 192000) or (V = 384000);
end;
function TCIValidAudioRate(V: Integer): Boolean;
begin
Result := (V = 8000) or (V = 12000) or (V = 24000) or (V = 48000);
end;
function TCIValidSampleType(const S: string): Boolean;
var T: string;
begin
T := LowerCase(Trim(S));
Result := (T = 'int16') or (T = 'int24') or (T = 'int32') or (T = 'float32');
end;
{ ═══════════════════════════════════════════════════════════════════════════ { ═══════════════════════════════════════════════════════════════════════════
Сборка Сборка
═══════════════════════════════════════════════════════════════════════════ } ═══════════════════════════════════════════════════════════════════════════ }
+424 -92
View File
@@ -16,14 +16,22 @@ unit TCIServer;
измерителей с индивидуальным для каждого клиента периодом. измерителей с индивидуальным для каждого клиента периодом.
Отправка НИКОГДА не блокирует того, кто зовёт Send/Broadcast: строка кладётся Отправка НИКОГДА не блокирует того, кто зовёт Send/Broadcast: строка кладётся
в очередь клиента, а в сокет её пишет тик-поток (FlushClients). Иначе в очередь клиента, а в сокет её пишет ЕГО СОБСТВЕННЫЙ поток (Flush в цикле
медленный клиент останавливал бы UI-поток на секунду за раз уведомления HandleClient, recv просыпается каждые TCI_POLL_MS). Иначе медленный клиент
рождаются в OnState, то есть внутри Changed() контроллера. останавливал бы UI-поток на секунду за раз уведомления рождаются в OnState,
то есть внутри Changed() контроллера, а общий поток отправки задерживал бы
на его таймаут ещё и всех остальных клиентов.
Владение объектом клиента: создаёт accept-поток, освобождает ТОЛЬКО тик-поток Владение объектом клиента: создаёт accept-поток, освобождает ТОЛЬКО тик-поток
(ReapClients) и только после того, как клиентский поток честно вышел. Никто (ReapClients) и только после того, как клиентский поток честно вышел. Никто
больше клиентов не освобождает поэтому указатель, взятый под FClientLock, больше клиентов не освобождает поэтому указатель, взятый под FClientLock,
остаётся валидным, пока тик-поток не сделает следующий проход. остаётся валидным, пока тик-поток не сделает следующий проход. На остановке
освобождает Stop, но лишь дождавшись выхода ВСЕХ клиентских потоков.
Два счёта соединений. Слот из TCI_MAX_CLIENTS занимает только клиент,
прошедший handshake (Up); сокет до handshake живёт в общем массиве
(TCI_MAX_SOCKETS) и убивается по таймауту TCI_HANDSHAKE_MS. Иначе восемь
молчащих TCP-соединений навсегда закрывали дверь настоящим клиентам.
Бинарные фреймы (потоки IQ/аудио, §3.4) пока не обрабатываются: этап 2, Бинарные фреймы (потоки IQ/аудио, §3.4) пока не обрабатываются: этап 2,
см. doc/TCI.md. Приходящие от клиента binary-фреймы молча отбрасываются. см. doc/TCI.md. Приходящие от клиента binary-фреймы молча отбрасываются.
@@ -34,6 +42,8 @@ unit TCIServer;
Авторизации у TCI нет by design. Порт слушается там, где сказано в Авторизации у TCI нет by design. Порт слушается там, где сказано в
настройках; умолчание 127.0.0.1, чтобы наружу он не торчал без спроса. настройках; умолчание 127.0.0.1, чтобы наружу он не торчал без спроса.
Отсюда же отказ браузерным клиентам (заголовок Origin): страница, открытая
в браузере, иначе дотянулась бы до петлевого порта и до передатчика.
} }
{$IFDEF FPC} {$IFDEF FPC}
@@ -50,14 +60,17 @@ uses
SyncObjs; // ← после платформенных юнитов (конфликт идентификатора Create) SyncObjs; // ← после платформенных юнитов (конфликт идентификатора Create)
const const
TCI_MAX_CLIENTS = 8; TCI_MAX_CLIENTS = 8; // прошедших handshake (слоты протокола)
TCI_MAX_SOCKETS = 32; // всего сокетов, включая ещё не поднявшиеся
TCI_TICK_MS = 20; // период OnTick (сенсоры троттлятся адаптером) TCI_TICK_MS = 20; // период OnTick (сенсоры троттлятся адаптером)
TCI_WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; TCI_WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11';
TCI_SEND_TIMEOUT = 300; // мс на SockSend, иначе клиент считается мёртвым TCI_SEND_TIMEOUT = 300; // мс на SockSend, иначе клиент считается мёртвым
TCI_HANDSHAKE_MS = 5000; // мс на HTTP-запрос от подключившегося
TCI_POLL_MS = 20; // на столько recv клиента засыпает между кадрами
TCI_OUT_MAX = 4000; // потолок очереди отправки на клиента (строк) TCI_OUT_MAX = 4000; // потолок очереди отправки на клиента (строк)
TCI_OUT_CHUNK = 3800; // склейка очереди в один фрейм, символов TCI_OUT_CHUNK = 3800; // склейка очереди в один фрейм, символов
TCI_MSG_MAX = 65536; // потолок собираемого из фрагментов сообщения TCI_MSG_MAX = 65536; // потолок собираемого из фрагментов сообщения
TCI_STOP_WAIT_MS = 10000; // сколько ждём выхода клиентских потоков в Stop TCI_STOP_KILL_MS = 500; // как часто добиваем клиентов, ожидая их выхода
type type
TTCIServer = class; TTCIServer = class;
@@ -65,12 +78,17 @@ type
{ Один подключённый клиент: WS-сокет, его личные подписки и очередь { Один подключённый клиент: WS-сокет, его личные подписки и очередь
отправки. Подписки на сенсоры в TCI индивидуальны (RX_SENSORS_ENABLE отправки. Подписки на сенсоры в TCI индивидуальны (RX_SENSORS_ENABLE
«отправляется только клиентом»), поэтому живут здесь, а не в адаптере. «отправляется только клиентом»), поэтому живут здесь, а не в адаптере.
Параметры потоков (§4.3) тоже клиентские, их держит адаптер по ссылке Параметры потоков (§4.3) тоже клиентские.
на этот объект. }
Подписки и параметры потоков пишет поток клиента, а читает тик-поток,
поэтому и те и другие ходят через FStateLock: набор «включено + период +
последняя отправка» обязан меняться и читаться целиком. }
TTCIClient = class TTCIClient = class
private private
FWs: TWsClient; FWs: TWsClient;
FUp: Boolean; // handshake прошёл: клиент занимает слот
FReady: Boolean; // пачка инициализации отправлена FReady: Boolean; // пачка инициализации отправлена
FStateLock: TCriticalSection;
FRxSensors: Boolean; FRxSensors: Boolean;
FRxSensorsMs: Integer; FRxSensorsMs: Integer;
FRxSensorsAt: QWord; // тик последней отправки FRxSensorsAt: QWord; // тик последней отправки
@@ -92,30 +110,46 @@ type
FDead: Boolean; // сокет уже не пишется — гасим соединение FDead: Boolean; // сокет уже не пишется — гасим соединение
FKilled: Boolean; // shutdown сокета уже сделан FKilled: Boolean; // shutdown сокета уже сделан
FClosed: Boolean; // клиентский поток вышел (можно освобождать) FClosed: Boolean; // клиентский поток вышел (можно освобождать)
function GetReady: Boolean;
procedure SetReady(V: Boolean);
function GetIQRate: Integer; procedure SetIQRate(V: Integer);
function GetAudioRate: Integer; procedure SetAudioRate(V: Integer);
function GetAudioSamples: Integer; procedure SetAudioSamples(V: Integer);
function GetAudioChannels: Integer; procedure SetAudioChannels(V: Integer);
function GetAudioSampleType: string; procedure SetAudioSampleType(const V: string);
function GetTxBuffering: Integer; procedure SetTxBuffering(V: Integer);
public public
constructor Create(AWs: TWsClient); constructor Create(AWs: TWsClient);
destructor Destroy; override; destructor Destroy; override;
{ Строку в очередь клиенту. False — соединение уже мертво. Не блокирует. } { Строку в очередь клиенту. False — соединение уже мертво. Не блокирует. }
function Send(const S: string): Boolean; function Send(const S: string): Boolean;
{ Слить очередь в сокет. Зовёт только тик-поток. False — клиент умер. } { Слить очередь в сокет. Зовёт ТОЛЬКО собственный поток клиента: запись
может ждать до TCI_SEND_TIMEOUT, и общий поток на этом задерживал бы
всех остальных. False клиент умер. }
function Flush: Boolean; function Flush: Boolean;
{ Пометить мёртвым и разбудить его поток (shutdown сокета). } { Пометить мёртвым и разбудить его поток (shutdown сокета). }
procedure Kill; procedure Kill;
{ Подписки на измерители — целиком под локом. }
procedure SetRxSensors(On_: Boolean);
procedure SetRxSensorsMs(Ms: Integer);
procedure SetTxSensors(On_: Boolean);
procedure SetTxSensorsMs(Ms: Integer);
{ Пора ли слать измеритель: проверка периода и отметка отправки один
атомарный шаг, иначе тик-поток и клиентский расходятся в наборе. }
function DueRxSensors(Now_: QWord): Boolean;
function DueTxSensors(Now_: QWord): Boolean;
property Ws: TWsClient read FWs; property Ws: TWsClient read FWs;
property Ready: Boolean read FReady write FReady; property Up: Boolean read FUp;
property Ready: Boolean read GetReady write SetReady;
property Dead: Boolean read FDead; property Dead: Boolean read FDead;
property RxSensors: Boolean read FRxSensors write FRxSensors; property IQRate: Integer read GetIQRate write SetIQRate;
property RxSensorsMs: Integer read FRxSensorsMs write FRxSensorsMs; property AudioRate: Integer read GetAudioRate write SetAudioRate;
property RxSensorsAt: QWord read FRxSensorsAt write FRxSensorsAt; property AudioSamples: Integer read GetAudioSamples write SetAudioSamples;
property TxSensors: Boolean read FTxSensors write FTxSensors; property AudioChannels: Integer read GetAudioChannels write SetAudioChannels;
property TxSensorsMs: Integer read FTxSensorsMs write FTxSensorsMs; property AudioSampleType: string read GetAudioSampleType write SetAudioSampleType;
property TxSensorsAt: QWord read FTxSensorsAt write FTxSensorsAt; property TxBuffering: Integer read GetTxBuffering write SetTxBuffering;
property IQRate: Integer read FIQRate write FIQRate;
property AudioRate: Integer read FAudioRate write FAudioRate;
property AudioSamples: Integer read FAudioSamples write FAudioSamples;
property AudioChannels: Integer read FAudioChannels write FAudioChannels;
property AudioSampleType: string read FAudioSampleType write FAudioSampleType;
property TxBuffering: Integer read FTxBuffering write FTxBuffering;
end; end;
TTCIClientEvent = procedure(Client: TTCIClient) of object; TTCIClientEvent = procedure(Client: TTCIClient) of object;
@@ -124,8 +158,9 @@ type
TTCIServer = class TTCIServer = class
private private
FListenSock: TSocket; FListenSock: TSocket;
FClients: array[0..TCI_MAX_CLIENTS-1] of TTCIClient; FClients: array[0..TCI_MAX_SOCKETS-1] of TTCIClient;
FClientCount: Integer; FClientCount: Integer; // всего сокетов в массиве (с не поднявшимися)
FUpCount: LongInt; // прошедших handshake (Interlocked*)
FClientLock: TCriticalSection; FClientLock: TCriticalSection;
FAcceptThread: TThread; FAcceptThread: TThread;
FTickThread: TThread; FTickThread: TThread;
@@ -140,11 +175,16 @@ type
FOnTick: TThreadMethod; FOnTick: TThreadMethod;
function InitListen: Boolean; function InitListen: Boolean;
procedure ReapClients; // освободить клиентов, чьи потоки вышли procedure ReapClients; // освободить клиентов, чьи потоки вышли
procedure FlushClients; // слить очереди в сокеты (вне FClientLock) procedure KillAll;
procedure Disconnected(Client: TTCIClient); // OnDisconnect, единая точка
public public
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
{ Проверка настроек без побочных эффектов: можно ли вообще открыть такой
слушатель. Зовётся ДО остановки работающего сервера. }
class function ValidSettings(APort: Word; const ABindIP: string): Boolean;
{ Настройка слушателя. Применяется при следующем Start. { Настройка слушателя. Применяется при следующем Start.
False адрес не разобран (порт не откроется). } False адрес не разобран (порт не откроется). }
function Configure(APort: Word; const ABindIP: string): Boolean; function Configure(APort: Word; const ABindIP: string): Boolean;
@@ -168,6 +208,7 @@ type
procedure AcceptLoop; procedure AcceptLoop;
procedure TickLoop; procedure TickLoop;
procedure HandleClient(Client: TTCIClient); procedure HandleClient(Client: TTCIClient);
function Promote(Client: TTCIClient): Boolean; // handshake прошёл
procedure ThreadDone; // клиентский поток отработал procedure ThreadDone; // клиентский поток отработал
property Port: Word read FPort; property Port: Word read FPort;
@@ -187,6 +228,16 @@ type
«ошибка разбора = слушаем всё» в протоколе без авторизации недопустима. } «ошибка разбора = слушаем всё» в протоколе без авторизации недопустима. }
function TCIParseIPv4(const S: string; out Addr: LongWord): Boolean; function TCIParseIPv4(const S: string; out Addr: LongWord): Boolean;
{ Значение HTTP-заголовка (Name в нижнем регистре, без ':'). Разбор
построчный: точное сравнение подстроки «upgrade: websocket» отвергало
валидные запросы с табуляцией или без пробела после двоеточия. }
function TCIHttpHeader(const Header, Name: string): string;
{ Проверка UTF-8: текстовые кадры WebSocket обязаны быть корректным UTF-8
(RFC 6455 §5.6). Отвергает и оборванные последовательности, и избыточно
длинные формы, и суррогаты, и всё выше U+10FFFF. }
function TCIValidUTF8(const S: string): Boolean;
implementation implementation
type type
@@ -251,7 +302,8 @@ begin
end; end;
finally finally
// Освобождать себя нельзя: объект переиспользуется рассылкой из чужих // Освобождать себя нельзя: объект переиспользуется рассылкой из чужих
// потоков. Помечаем «поток вышел» — освободит тик-поток (ReapClients). // потоков. Помечаем «поток вышел» — освободит тик-поток (ReapClients)
// или Stop, который ждёт именно этого.
FClient.FClosed := True; FClient.FClosed := True;
FServer.ThreadDone; FServer.ThreadDone;
end; end;
@@ -290,6 +342,57 @@ begin
Result := True; Result := True;
end; end;
function TCIHttpHeader(const Header, Name: string): string;
var
i, Start, P: Integer;
Line, LName: string;
begin
Result := '';
Start := 1;
for i := 1 to Length(Header) + 1 do
if (i > Length(Header)) or (Header[i] = #10) then
begin
Line := Trim(Copy(Header, Start, i - Start)); // Trim снимет и #13
Start := i + 1;
P := Pos(':', Line);
if P <= 1 then Continue;
LName := LowerCase(Trim(Copy(Line, 1, P - 1)));
if LName = Name then
Exit(Trim(Copy(Line, P + 1, MaxInt)));
end;
end;
function TCIValidUTF8(const S: string): Boolean;
var
i, k, N, Len: Integer;
B: Byte;
Cp: LongWord;
begin
i := 1;
Len := Length(S);
while i <= Len do
begin
B := Byte(S[i]);
if B < $80 then begin Inc(i); Continue; end
else if (B >= $C2) and (B <= $DF) then begin N := 1; Cp := B and $1F; end
else if (B >= $E0) and (B <= $EF) then begin N := 2; Cp := B and $0F; end
else if (B >= $F0) and (B <= $F4) then begin N := 3; Cp := B and $07; end
else Exit(False); // $80..$C1 и $F5.. началом последовательности не бывают
if i + N > Len then Exit(False); // оборвано на середине символа
for k := 1 to N do
begin
if (Byte(S[i + k]) and $C0) <> $80 then Exit(False);
Cp := (Cp shl 6) or (Byte(S[i + k]) and $3F);
end;
// Избыточно длинная форма, суррогатная пара и выход за U+10FFFF.
if ((N = 2) and (Cp < $800)) or ((N = 3) and (Cp < $10000)) or
((Cp >= $D800) and (Cp <= $DFFF)) or (Cp > $10FFFF) then Exit(False);
Inc(i, N + 1);
end;
Result := True;
end;
{ ═══════════════════════════════════════════════════════════════════════════ { ═══════════════════════════════════════════════════════════════════════════
TTCIClient TTCIClient
═══════════════════════════════════════════════════════════════════════════ } ═══════════════════════════════════════════════════════════════════════════ }
@@ -298,7 +401,9 @@ constructor TTCIClient.Create(AWs: TWsClient);
begin begin
inherited Create; inherited Create;
FWs := AWs; FWs := AWs;
FUp := False;
FReady := False; FReady := False;
FStateLock := TCriticalSection.Create;
FRxSensors := False; FRxSensors := False;
FRxSensorsMs := 200; FRxSensorsMs := 200;
FTxSensors := False; FTxSensors := False;
@@ -318,9 +423,150 @@ end;
destructor TTCIClient.Destroy; destructor TTCIClient.Destroy;
begin begin
FOutLock.Free; FOutLock.Free;
FStateLock.Free;
inherited; inherited;
end; end;
function TTCIClient.GetReady: Boolean;
begin
FStateLock.Enter;
try Result := FReady; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetReady(V: Boolean);
begin
FStateLock.Enter;
try FReady := V; finally FStateLock.Leave; end;
end;
function TTCIClient.GetIQRate: Integer;
begin
FStateLock.Enter;
try Result := FIQRate; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetIQRate(V: Integer);
begin
FStateLock.Enter;
try FIQRate := V; finally FStateLock.Leave; end;
end;
function TTCIClient.GetAudioRate: Integer;
begin
FStateLock.Enter;
try Result := FAudioRate; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetAudioRate(V: Integer);
begin
FStateLock.Enter;
try FAudioRate := V; finally FStateLock.Leave; end;
end;
function TTCIClient.GetAudioSamples: Integer;
begin
FStateLock.Enter;
try Result := FAudioSamples; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetAudioSamples(V: Integer);
begin
FStateLock.Enter;
try FAudioSamples := V; finally FStateLock.Leave; end;
end;
function TTCIClient.GetAudioChannels: Integer;
begin
FStateLock.Enter;
try Result := FAudioChannels; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetAudioChannels(V: Integer);
begin
FStateLock.Enter;
try FAudioChannels := V; finally FStateLock.Leave; end;
end;
function TTCIClient.GetAudioSampleType: string;
begin
FStateLock.Enter;
try Result := FAudioSampleType; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetAudioSampleType(const V: string);
begin
FStateLock.Enter;
try FAudioSampleType := V; finally FStateLock.Leave; end;
end;
function TTCIClient.GetTxBuffering: Integer;
begin
FStateLock.Enter;
try Result := FTxBuffering; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetTxBuffering(V: Integer);
begin
FStateLock.Enter;
try FTxBuffering := V; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetRxSensors(On_: Boolean);
begin
FStateLock.Enter;
try
FRxSensors := On_;
if On_ then FRxSensorsAt := 0; // первую посылку не ждём период
finally
FStateLock.Leave;
end;
end;
procedure TTCIClient.SetRxSensorsMs(Ms: Integer);
begin
FStateLock.Enter;
try FRxSensorsMs := Ms; finally FStateLock.Leave; end;
end;
procedure TTCIClient.SetTxSensors(On_: Boolean);
begin
FStateLock.Enter;
try
FTxSensors := On_;
if On_ then FTxSensorsAt := 0;
finally
FStateLock.Leave;
end;
end;
procedure TTCIClient.SetTxSensorsMs(Ms: Integer);
begin
FStateLock.Enter;
try FTxSensorsMs := Ms; finally FStateLock.Leave; end;
end;
function TTCIClient.DueRxSensors(Now_: QWord): Boolean;
begin
FStateLock.Enter;
try
Result := FRxSensors and (Now_ - FRxSensorsAt >= QWord(FRxSensorsMs));
if Result then FRxSensorsAt := Now_;
finally
FStateLock.Leave;
end;
end;
function TTCIClient.DueTxSensors(Now_: QWord): Boolean;
begin
FStateLock.Enter;
try
Result := FTxSensors and (Now_ - FTxSensorsAt >= QWord(FTxSensorsMs));
if Result then FTxSensorsAt := Now_;
finally
FStateLock.Leave;
end;
end;
function TTCIClient.Send(const S: string): Boolean; function TTCIClient.Send(const S: string): Boolean;
begin begin
Result := False; Result := False;
@@ -423,6 +669,7 @@ begin
{$ENDIF} {$ENDIF}
FListenSock := SOCK_INVALID; FListenSock := SOCK_INVALID;
FClientCount := 0; FClientCount := 0;
FUpCount := 0;
FClientLock := TCriticalSection.Create; FClientLock := TCriticalSection.Create;
FPort := TCI_DEFAULT_PORT; FPort := TCI_DEFAULT_PORT;
FBindIP := '127.0.0.1'; FBindIP := '127.0.0.1';
@@ -438,12 +685,17 @@ begin
inherited; inherited;
end; end;
function TTCIServer.Configure(APort: Word; const ABindIP: string): Boolean; class function TTCIServer.ValidSettings(APort: Word; const ABindIP: string): Boolean;
var Dummy: LongWord; var Dummy: LongWord;
begin
Result := (APort <> 0) and TCIParseIPv4(ABindIP, Dummy);
end;
function TTCIServer.Configure(APort: Word; const ABindIP: string): Boolean;
begin begin
FPort := APort; FPort := APort;
FBindIP := ABindIP; FBindIP := ABindIP;
Result := (APort <> 0) and TCIParseIPv4(ABindIP, Dummy); Result := ValidSettings(APort, ABindIP);
end; end;
function TTCIServer.Running: Boolean; function TTCIServer.Running: Boolean;
@@ -513,6 +765,18 @@ begin
Result := True; Result := True;
end; end;
procedure TTCIServer.KillAll;
var i: Integer;
begin
FClientLock.Enter;
try
for i := 0 to FClientCount - 1 do
if FClients[i] <> nil then FClients[i].Kill;
finally
FClientLock.Leave;
end;
end;
procedure TTCIServer.Stop; procedure TTCIServer.Stop;
var i, Waited: Integer; var i, Waited: Integer;
begin begin
@@ -529,42 +793,40 @@ begin
FListenSock := SOCK_INVALID; FListenSock := SOCK_INVALID;
end; end;
// Шаг 2: будим клиентские потоки, висящие в recv. // Шаг 2: дожидаемся accept-потока — после него новых клиентов не появится.
FClientLock.Enter;
try
for i := 0 to FClientCount - 1 do
if FClients[i] <> nil then FClients[i].Kill;
finally
FClientLock.Leave;
end;
// Шаг 3: свои потоки (клиентские — FreeOnTerminate, ждём их отдельно).
if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end; if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end;
if FTickThread <> nil then begin FTickThread.WaitFor; FreeAndNil(FTickThread); end;
// Шаг 4: ждём выхода клиентских потоков. Прокачивая очередь Synchronize: // Шаг 3: будим клиентские потоки, висящие в recv, и останавливаем тик.
// Stop зовёт поток контроллера (UI), а клиентский поток может как раз в нём KillAll;
// висеть на FController.Invoke. Без прокачки это гарантированный взаимный if FTickThread <> nil then begin FTickThread.WaitFor; FreeAndNil(FTickThread); end;
// клин, а по его истечении — освобождение объекта из-под живого потока.
// Шаг 4: ждём выхода клиентских потоков — БЕЗ таймаута. Прокачивая очередь
// Synchronize: Stop зовёт поток контроллера (UI), а клиентский поток может
// как раз в нём висеть на FController.Invoke; без прокачки это взаимный
// клин. Выйти отсюда по таймауту нельзя: следом освобождаются и клиенты, и
// сам сервер с адаптером, а живой поток вернулся бы в эту память.
Waited := 0; Waited := 0;
while (FThreadCount > 0) and (Waited < TCI_STOP_WAIT_MS) do while FThreadCount > 0 do
begin begin
if GetCurrentThreadId = MainThreadID then CheckSynchronize(5) else Sleep(5); if GetCurrentThreadId = MainThreadID then CheckSynchronize(5) else Sleep(5);
Inc(Waited, 5); Inc(Waited, 5);
// Повторный shutdown: клиент мог быть принят между шагом 2 и шагом 3
// (accept уже вернул сокет, поток стартовал позже) и Kill его не застал.
if (Waited mod TCI_STOP_KILL_MS) = 0 then KillAll;
end; end;
// Шаг 5: зачистка. Если поток всё же не вышел (не должно случаться: сокеты // Шаг 5: зачистка. Потоков больше нет — освобождать безопасно.
// закрыты, очередь прокачана), объект НЕ освобождаем — утечка на выходе
// несравнимо дешевле обращения к освобождённой памяти из живого потока.
FClientLock.Enter; FClientLock.Enter;
try try
for i := 0 to FClientCount - 1 do for i := 0 to FClientCount - 1 do
if (FClients[i] <> nil) and FClients[i].FClosed then if FClients[i] <> nil then
begin begin
Disconnected(FClients[i]); // и на остановке тоже: захваты снимаются
FClients[i].Ws.Free; FClients[i].Ws.Free;
FreeAndNil(FClients[i]); FreeAndNil(FClients[i]);
end; end;
FClientCount := 0; FClientCount := 0;
FUpCount := 0;
finally finally
FClientLock.Leave; FClientLock.Leave;
end; end;
@@ -603,12 +865,16 @@ begin
end; end;
SockSetSndTimeout(CSock, TCI_SEND_TIMEOUT); SockSetSndTimeout(CSock, TCI_SEND_TIMEOUT);
// До конца handshake сокет не должен молчать вечно: иначе горстка пустых
// соединений держала бы место, ничего не сказав.
SockSetRcvTimeout(CSock, TCI_HANDSHAKE_MS);
Client := TTCIClient.Create(TWsClient.Create(CSock)); Client := TTCIClient.Create(TWsClient.Create(CSock));
Full := False; Full := False;
FClientLock.Enter; FClientLock.Enter;
try try
// Слот берём под локом: место в массиве освобождает тик-поток. // Место в массиве освобождает тик-поток; слот протокола (Up) клиент
if FClientCount >= TCI_MAX_CLIENTS then Full := True // получит позже — после успешного Upgrade (см. Promote).
if FClientCount >= TCI_MAX_SOCKETS then Full := True
else else
begin begin
FClients[FClientCount] := Client; FClients[FClientCount] := Client;
@@ -630,13 +896,34 @@ begin
end; end;
end; end;
function TTCIServer.Promote(Client: TTCIClient): Boolean;
// Слот протокола выдаётся ТОЛЬКО тут — после разбора HTTP-запроса и до ответа
// 101. Считаем поднявшихся: молчащие сокеты слотов не занимают.
var i, N: Integer;
begin
Result := False;
if not FRunning then Exit;
FClientLock.Enter;
try
N := 0;
for i := 0 to FClientCount - 1 do
if (FClients[i] <> nil) and FClients[i].FUp then Inc(N);
if N >= TCI_MAX_CLIENTS then Exit;
Client.FUp := True;
InterLockedIncrement(FUpCount);
Result := True;
finally
FClientLock.Leave;
end;
end;
procedure TTCIServer.ReapClients; procedure TTCIServer.ReapClients;
// Освобождение клиентов — единственное место во всей программе. Зовёт только // Освобождение клиентов — единственное место, кроме Stop. Зовёт только
// тик-поток, поэтому указатель, взятый кем угодно под FClientLock, живёт до // тик-поток, поэтому указатель, взятый кем угодно под FClientLock, живёт до
// следующего прохода тика (а вне лока указателей никто не держит). // следующего прохода тика (а вне лока указателей никто не держит).
var var
i, j, N: Integer; i, j, N: Integer;
Doomed: array[0..TCI_MAX_CLIENTS-1] of TTCIClient; Doomed: array[0..TCI_MAX_SOCKETS-1] of TTCIClient;
begin begin
N := 0; N := 0;
FClientLock.Enter; FClientLock.Enter;
@@ -645,6 +932,7 @@ begin
while i < FClientCount do while i < FClientCount do
if (FClients[i] <> nil) and FClients[i].FClosed then if (FClients[i] <> nil) and FClients[i].FClosed then
begin begin
if FClients[i].FUp then InterLockedDecrement(FUpCount);
Doomed[N] := FClients[i]; Doomed[N] := FClients[i];
Inc(N); Inc(N);
for j := i to FClientCount - 2 do FClients[j] := FClients[j + 1]; for j := i to FClientCount - 2 do FClients[j] := FClients[j + 1];
@@ -659,33 +947,18 @@ begin
for i := 0 to N - 1 do for i := 0 to N - 1 do
begin begin
if Assigned(FOnDisconnect) then FOnDisconnect(Doomed[i]); Disconnected(Doomed[i]);
Doomed[i].Ws.Free; // закрывает сокет Doomed[i].Ws.Free; // закрывает сокет
Doomed[i].Free; Doomed[i].Free;
end; end;
end; end;
procedure TTCIServer.FlushClients; procedure TTCIServer.Disconnected(Client: TTCIClient);
// Запись в сокеты — вне FClientLock: медленный клиент не должен держать лок, // Единственное место, где наверх уходит «клиент ушёл»: и обычное отключение
// иначе Broadcast из потока контроллера снова начнёт ждать сеть. // (ReapClients), и остановка сервера. Иначе после Stop у адаптера оставались
var // висеть захваты параметров ушедших клиентов (§3.5).
Snap: array[0..TCI_MAX_CLIENTS-1] of TTCIClient;
i, N: Integer;
begin begin
N := 0; if (Client <> nil) and Assigned(FOnDisconnect) then FOnDisconnect(Client);
FClientLock.Enter;
try
for i := 0 to FClientCount - 1 do
if (FClients[i] <> nil) and not FClients[i].FClosed then
begin
Snap[N] := FClients[i];
Inc(N);
end;
finally
FClientLock.Leave;
end;
for i := 0 to N - 1 do
Snap[i].Flush;
end; end;
{ ═══════════════════════════════════════════════════════════════════════════ { ═══════════════════════════════════════════════════════════════════════════
@@ -696,12 +969,12 @@ procedure TTCIServer.HandleClient(Client: TTCIClient);
var var
Ws: TWsClient; Ws: TWsClient;
R, HeaderEnd: Integer; R, HeaderEnd: Integer;
Header, HeaderLC, Key, AcceptKey, Response, Text: string; Header, Key, AcceptKey, Response, Text: string;
Raw: array[0..4095] of Byte; Raw: array[0..4095] of Byte;
RawLen, Rest: Integer; RawLen, Rest: Integer;
B0, B1: Byte; B0, B1: Byte;
Masked, Fin, Pending: Boolean; Masked, Fin, Pending: Boolean;
PayLen, Need, i, j, Consumed, KPos, KEnd: Integer; PayLen, Need, i, j, Consumed: Integer;
Hi32: LongWord; Hi32: LongWord;
Mask: array[0..3] of Byte; Mask: array[0..3] of Byte;
Payload: array of Byte; Payload: array of Byte;
@@ -717,6 +990,8 @@ begin
HeaderEnd := 0; HeaderEnd := 0;
repeat repeat
R := SockRecv(Ws.Socket, @Raw[RawLen], SizeOf(Raw) - RawLen, 0); R := SockRecv(Ws.Socket, @Raw[RawLen], SizeOf(Raw) - RawLen, 0);
// R <= 0 здесь — это и разрыв, и истёкший TCI_HANDSHAKE_MS: молчащее
// соединение уходит само, не занимая место.
if R <= 0 then begin Ws.State := wsClosed; Break; end; if R <= 0 then begin Ws.State := wsClosed; Break; end;
Inc(RawLen, R); Inc(RawLen, R);
SetLength(Header, RawLen); SetLength(Header, RawLen);
@@ -728,10 +1003,10 @@ begin
Consumed := HeaderEnd + 3; // длина заголовков вместе с CRLFCRLF Consumed := HeaderEnd + 3; // длина заголовков вместе с CRLFCRLF
Header := Copy(Header, 1, Consumed); Header := Copy(Header, 1, Consumed);
HeaderLC := LowerCase(Header);
// Путь не проверяем: клиенты ходят на '/', но протокол его не оговаривает. // Путь не проверяем: клиенты ходят на '/', но протокол его не оговаривает.
if System.Pos('upgrade: websocket', HeaderLC) = 0 then if (Pos('websocket', LowerCase(TCIHttpHeader(Header, 'upgrade'))) = 0) or
(Pos('upgrade', LowerCase(TCIHttpHeader(Header, 'connection'))) = 0) then
begin begin
Response := 'HTTP/1.1 426 Upgrade Required'#13#10 + Response := 'HTTP/1.1 426 Upgrade Required'#13#10 +
'Content-Length: 0'#13#10'Connection: close'#13#10#13#10; 'Content-Length: 0'#13#10'Connection: close'#13#10#13#10;
@@ -739,15 +1014,20 @@ begin
Exit; Exit;
end; end;
Key := ''; // Браузерный клиент. Origin шлют только браузеры, и он — единственный
KPos := System.Pos('sec-websocket-key: ', HeaderLC); // признак, отличающий страницу от нативной программы. Авторизации в TCI
if KPos > 0 then // нет: без этой проверки открытая вкладка с чужого сайта дотянулась бы по
// ws://127.0.0.1:40001 до TRX/TUNE/VFO. Своим web-страницам нужен явный
// прокси, а не дыра по умолчанию.
if TCIHttpHeader(Header, 'origin') <> '' then
begin begin
Key := Copy(Header, KPos + 19, 100); Response := 'HTTP/1.1 403 Forbidden'#13#10 +
KEnd := System.Pos(#13, Key); 'Content-Length: 0'#13#10'Connection: close'#13#10#13#10;
if KEnd > 0 then Key := Copy(Key, 1, KEnd - 1); Ws.SendRaw(Response[1], Length(Response));
Key := Trim(Key); Exit;
end; end;
Key := TCIHttpHeader(Header, 'sec-websocket-key');
// Пустой ключ = не WebSocket-клиент (или сломанный): Accept без ключа // Пустой ключ = не WebSocket-клиент (или сломанный): Accept без ключа
// формально считается валидным, и такое «соединение» потом молча висит. // формально считается валидным, и такое «соединение» потом молча висит.
if Key = '' then if Key = '' then
@@ -758,6 +1038,16 @@ begin
Exit; Exit;
end; end;
// Слот протокола — до ответа 101: отказать после «Switching Protocols» уже
// некрасиво, клиент считал бы себя подключённым.
if not Promote(Client) then
begin
Response := 'HTTP/1.1 503 Service Unavailable'#13#10 +
'Content-Length: 0'#13#10'Connection: close'#13#10#13#10;
Ws.SendRaw(Response[1], Length(Response));
Exit;
end;
AcceptKey := Base64EncodeBytes(SHA1(Key + TCI_WS_GUID), 20); AcceptKey := Base64EncodeBytes(SHA1(Key + TCI_WS_GUID), 20);
Response := 'HTTP/1.1 101 Switching Protocols'#13#10 + Response := 'HTTP/1.1 101 Switching Protocols'#13#10 +
'Upgrade: websocket'#13#10 + 'Upgrade: websocket'#13#10 +
@@ -765,6 +1055,9 @@ begin
'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10; 'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10;
if not Ws.SendRaw(Response[1], Length(Response)) then Exit; if not Ws.SendRaw(Response[1], Length(Response)) then Exit;
Ws.State := wsOpen; Ws.State := wsOpen;
// Дальше клиент вправе молчать сколько угодно, но просыпаться нам надо:
// на этом же потоке уходит его очередь отправки (Flush).
SockSetRcvTimeout(Ws.Socket, TCI_POLL_MS);
// Хвост первого пакета: клиент вправе прислать первый WS-фрейм в том же // Хвост первого пакета: клиент вправе прислать первый WS-фрейм в том же
// сегменте, что и заголовки. Выбросить его — потерять первую команду. // сегменте, что и заголовки. Выбросить его — потерять первую команду.
@@ -772,8 +1065,22 @@ begin
if Rest > 0 then Move(Raw[Consumed], Ws.BufData[0], Rest); if Rest > 0 then Move(Raw[Consumed], Ws.BufData[0], Rest);
Ws.BufLen := Rest; Ws.BufLen := Rest;
// Пачка инициализации + текущее состояние (§3.1) — дело адаптера. // Пачка инициализации + текущее состояние (§3.1) — дело адаптера. Под
if Assigned(FOnConnect) then FOnConnect(Client); // FClientLock: пока она набирается, рассылка обязана ждать. Иначе изменение,
// случившееся после строки снимка, но до Ready=True, пропадало навсегда —
// Broadcast пропускает не-Ready клиента, и тот оставался со старым значением,
// считая инициализацию завершённой. Лок держится только на укладку строк в
// очередь (сеть тут не пишется), но обработчик OnConnect по этой же причине
// НЕ имеет права звать Invoke в поток контроллера: тот может ждать этот лок.
if Assigned(FOnConnect) then
begin
FClientLock.Enter;
try
FOnConnect(Client);
finally
FClientLock.Leave;
end;
end;
// ── Цикл WS-сообщений ──────────────────────────────────────────────────── // ── Цикл WS-сообщений ────────────────────────────────────────────────────
Cmds := TStringList.Create; Cmds := TStringList.Create;
@@ -786,7 +1093,9 @@ begin
if not Pending then if not Pending then
begin begin
R := Ws.Recv; R := Ws.Recv;
if R <= 0 then Break; // R <= 0 — либо разрыв, либо просто истёк TCI_POLL_MS. Второе штатно:
// просыпаемся, чтобы отдать накопившуюся очередь.
if (R <= 0) and not SockRecvTimedOut then Break;
end; end;
Pending := False; Pending := False;
@@ -902,6 +1211,14 @@ begin
if Fin then if Fin then
begin begin
// Текстовое сообщение обязано быть валидным UTF-8 (§5.6);
// битую последовательность RFC велит закрывать, а не молча
// скармливать разбору команд.
if (MsgOp = $01) and not TCIValidUTF8(Frag) then
begin
Ws.State := wsClosed;
Break;
end;
if (MsgOp = $01) and Assigned(FOnCommand) and (Frag <> '') then if (MsgOp = $01) and Assigned(FOnCommand) and (Frag <> '') then
begin begin
TCISplit(Frag, Cmds); TCISplit(Frag, Cmds);
@@ -912,8 +1229,15 @@ begin
Frag := ''; Frag := '';
end; end;
end; end;
$08: // close $08: // close: RFC 6455 §5.5.1 требует ответить своим close-кадром
begin begin
// Полезная нагрузка close — либо пустая, либо код (2 байта) плюс
// причина. Ровно один байт невалиден: отвечать на такое нечем.
if PayLen = 1 then begin Ws.State := wsClosed; Break; end;
// В ответе — только код: причину повторять не обязаны (§5.5.1),
// а чужой текст мы наружу не пересылаем.
if PayLen >= 2 then Ws.SendWsFrame($08, Payload[0], 2)
else Ws.SendWsFrame($08, PayLen, 0);
Ws.State := wsClosed; Ws.State := wsClosed;
Break; Break;
end; end;
@@ -927,6 +1251,11 @@ begin
Break; Break;
end; end;
end; end;
// Очередь — в сокет здесь же, на потоке этого клиента: ответы на только
// что разобранные команды уходят сразу, а медленный клиент задерживает
// только себя (тик-поток очереди лишь наполняет).
if not Client.Flush then Break;
end; end;
finally finally
Cmds.Free; Cmds.Free;
@@ -960,7 +1289,8 @@ begin
FClientLock.Enter; FClientLock.Enter;
try try
for i := 0 to FClientCount - 1 do for i := 0 to FClientCount - 1 do
if (FClients[i] <> nil) and not FClients[i].FClosed then Proc(FClients[i]); if (FClients[i] <> nil) and FClients[i].FUp and not FClients[i].FClosed then
Proc(FClients[i]);
finally finally
FClientLock.Leave; FClientLock.Leave;
end; end;
@@ -973,7 +1303,7 @@ end;
function TTCIServer.ClientCount: Integer; function TTCIServer.ClientCount: Integer;
begin begin
Result := FClientCount; Result := FUpCount;
end; end;
procedure TTCIServer.TickLoop; procedure TTCIServer.TickLoop;
@@ -983,8 +1313,10 @@ begin
Sleep(TCI_TICK_MS); Sleep(TCI_TICK_MS);
if not FRunning then Break; if not FRunning then Break;
ReapClients; // отключившиеся — освобождаем только здесь ReapClients; // отключившиеся — освобождаем только здесь
if (FClientCount > 0) and Assigned(FOnTick) then FOnTick; if (FUpCount > 0) and Assigned(FOnTick) then FOnTick;
FlushClients; // очереди → сокеты // В сокеты пишет каждый клиент сам, на своём потоке (см. HandleClient):
// общий поток отправки означал бы, что один медленный клиент задерживает
// очередь всех остальных на свой таймаут записи.
end; end;
end; end;
+23 -1
View File
@@ -64,6 +64,11 @@ procedure SockSetSndTimeout(S: TSocket; Ms: Integer);
накопившиеся команды): recv возвращает -1 по таймауту, соединение живо. } накопившиеся команды): recv возвращает -1 по таймауту, соединение живо. }
procedure SockSetRcvTimeout(S: TSocket; Ms: Integer); procedure SockSetRcvTimeout(S: TSocket; Ms: Integer);
{ SockRecvTimedOut последняя ошибка SockRecv означает «данных пока нет»
(истёк SO_RCVTIMEO или сигнал), а не разрыв. Без этой проверки поток,
просыпающийся по таймауту, не отличит тишину от закрытого сокета. }
function SockRecvTimedOut: Boolean;
{ ── SHA-1 ─────────────────────────────────────────────────────────────────── } { ── SHA-1 ─────────────────────────────────────────────────────────────────── }
type type
@@ -135,6 +140,13 @@ begin
setsockopt(S, SOL_SOCKET, SO_RCVTIMEO, @T, SizeOf(T)); setsockopt(S, SOL_SOCKET, SO_RCVTIMEO, @T, SizeOf(T));
end; end;
function SockRecvTimedOut: Boolean;
var E: Integer;
begin
E := WSAGetLastError;
Result := (E = WSAETIMEDOUT) or (E = WSAEWOULDBLOCK) or (E = WSAEINTR);
end;
{$ELSE} {$ELSE}
function SockClose(S: TSocket): Integer; function SockClose(S: TSocket): Integer;
@@ -157,7 +169,10 @@ end;
function SockSend(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer; function SockSend(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer;
begin begin
Result := fpSend(S, Buf, Len, Flags); // MSG_NOSIGNAL обязателен: запись в сокет, который клиент уже закрыл, иначе
// приходит SIGPIPE, а он по умолчанию убивает процесс целиком. С ним send
// просто возвращает -1/EPIPE, и вызывающий штатно выбрасывает клиента.
Result := fpSend(S, Buf, Len, Flags or MSG_NOSIGNAL);
end; end;
procedure SockSetNonBlock(S: TSocket; NB: Boolean); procedure SockSetNonBlock(S: TSocket; NB: Boolean);
@@ -185,6 +200,13 @@ begin
fpSetSockOpt(S, SOL_SOCKET, SO_RCVTIMEO, @TV, SizeOf(TV)); fpSetSockOpt(S, SOL_SOCKET, SO_RCVTIMEO, @TV, SizeOf(TV));
end; end;
function SockRecvTimedOut: Boolean;
var E: Integer;
begin
E := fpgeterrno;
Result := (E = ESysEAGAIN) or (E = ESysEWOULDBLOCK) or (E = ESysEINTR);
end;
{$ENDIF} {$ENDIF}
{ ═══════════════════════════════════════════════════════════════════════════ { ═══════════════════════════════════════════════════════════════════════════
+250 -35
View File
@@ -21,8 +21,8 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─
| Файл | Назначение | | Файл | Назначение |
|---|---| |---|---|
| `TCIProtocol.pas` (~380 строк) | Чистый слой протокола: разбор `имя:арг1,арг2;`, сборка строк, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости/порога в дБ. Зависит только от RTL + `RadioModes`. | | `TCIProtocol.pas` (~380 строк) | Чистый слой протокола: разбор `имя:арг1,арг2;`, сборка строк, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости/порога в дБ. Зависит только от RTL + `RadioModes`. |
| `TCIServer.pas` (~660 строк) | WebSocket-сервер: accept-поток, поток на клиента, HTTP-Upgrade, разбор фреймов, рассылка, тик 20 мс. Сокеты и фреймы переиспользованы из веб-подсистемы (`WebUtils`, `WsClient`). | | `TCIServer.pas` (~1250 строк) | WebSocket-сервер: accept-поток, поток на клиента, HTTP-Upgrade, разбор фреймов, рассылка, тик 20 мс. Сокеты и фреймы переиспользованы из веб-подсистемы (`WebUtils`, `WsClient`). |
| `TCIAdapter.pas` (~1100 строк) | Мост к `TRadioController`: реализация команд, пачка инициализации, уведомления об изменениях состояния, измерители. | | `TCIAdapter.pas` (~2100 строк) | Мост к `TRadioController`: реализация команд, пачка инициализации, уведомления об изменениях состояния, измерители, захват параметров (§3.5). |
Принципы те же, что у CAT (см. `doc/CAT_STATUS.md`): Принципы те же, что у CAT (см. `doc/CAT_STATUS.md`):
@@ -34,33 +34,82 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─
сеттеры пишут параметр в scratch-поля под `FLock` и зовут сеттеры пишут параметр в scratch-поля под `FLock` и зовут
`FController.Invoke(SyncXxx)` — исполнение в потоке контроллера `FController.Invoke(SyncXxx)` — исполнение в потоке контроллера
(GUI = `TThread.Synchronize`). (GUI = `TThread.Synchronize`).
- **Железо сетевые потоки не читают вовсе.** `BackendCaps` и
`BoardDisplayName` смотрят в `FNetwork`, а его UI освобождает при смене типа
устройства — обращение туда из потока клиента (да ещё и с копированием
строки имени платы) означало бы чтение освобождённой памяти прямо во время
подключения TCI-клиента. Поэтому адаптер держит снимок `TTCIDevSnap` (имя
платы, границы настройки, число панов, наличие TX, sample rate), который
обновляет **поток контроллера** (`RefreshDev`: конструктор, `ApplySettings`,
`OnState` на `rfDevice`/`rfConnected`/`rfDeviceList`/`rfXvtr`/`rfBand`/
`rfSampleRate`). Строка имени принадлежит адаптеру и присваивается только под
`FDevLock`. По той же причине `TRadioController.ActiveTXFreqHz` перешёл на
`GetSliceView`: он тоже вызывается снаружи и раньше копировал `TCtrlSlice`.
- **Слайсы сетевые потоки не читают вовсе.** Снимок таблицы
(`RefreshSlices``FSliceSnap`) делает **поток контроллера**: в конструкторе
адаптера, в `ApplySettings` и в `OnState` на каждое событие, которое слайсов
касается (`rfSliceFreq`, `rfSliceState`, `rfDevice`, `rfPanFreq`,
`rfSampleRate`, `rfBand`, `rfXvtr`, `rfCenterFreq`) — там писателей нет, и
каждая запись снимается целиком. Команды и измерители читают уже снимок под
`FSliceLock`. Прямое чтение `FSlices` из чужого потока давало не только порчу
managed-строк (`DevName`/`InDevName`), но и смесь полей одного слайса:
частота новая, мода ещё старая. Единственная оставшаяся цена — снимок может
отставать на такт. `Sync`-методы (они уже в потоке контроллера) читают живую
таблицу: команда на установку обязана попасть в тот слайс, который есть
сейчас.
- **Синхронизация клиентов.** Изменение любого поля контроллера приходит в - **Синхронизация клиентов.** Изменение любого поля контроллера приходит в
`OnState` (multicast-подписка `AddStateListener`) и рассылается всем `OnState` (multicast-подписка `AddStateListener`) и рассылается всем
подключённым — как того требует §3.5 спецификации. Отвечающий на команду подключённым — как того требует §3.5 спецификации. Отвечающий на команду
клиент дополнительно получает прямой ответ. клиент дополнительно получает прямой ответ.
### 1.1 Три правила, на которых держится транспорт ### 1.1 Правила, на которых держится транспорт
Всё это не украшения, а лечение конкретных отказов — менять с оглядкой. Всё это не украшения, а лечение конкретных отказов — менять с оглядкой.
1. **Отправка никогда не блокирует вызывающего.** `Send`/`Broadcast` кладут 1. **Отправка никогда не блокирует ни вызывающего, ни соседей.**
строку в очередь клиента (микросекунды под его локом), в сокет пишет `Send`/`Broadcast` кладут строку в очередь клиента (микросекунды под его
тик-поток (`FlushClients`, 20 мс, вне общего лока). Уведомления рождаются локом), а в сокет её пишет **собственный поток клиента**: его `recv`
внутри `Changed()` контроллера, то есть в UI-потоке: писать оттуда прямо в просыпается каждые `TCI_POLL_MS` (20 мс) и сливает очередь. Уведомления
сокет означало бы отдать интерфейс во власть самого медленного клиента рождаются внутри `Changed()` контроллера, то есть в UI-потоке — писать
(таймаут отправки × число клиентов на каждое движение ручки VFO). оттуда прямо в сокет означало бы отдать интерфейс во власть самого
Переполнилась очередь (`TCI_OUT_MAX`) или не прошла запись — клиент медленного клиента. Общий поток отправки был лишь половиной решения: один
выбрасывается, а не тормозит остальных. `SockSend` ждёт до `TCI_SEND_TIMEOUT` (300 мс), и восемь клиентов давали
секунды задержки всем остальным. Теперь медленный клиент задерживает только
себя; переполнилась его очередь (`TCI_OUT_MAX`) или не прошла запись — он
выбрасывается.
2. **Объект клиента освобождает только тик-поток** (`ReapClients`) и только 2. **Объект клиента освобождает только тик-поток** (`ReapClients`) и только
после того, как клиентский поток честно вышел. Поэтому указатель, взятый после того, как клиентский поток честно вышел. Поэтому указатель, взятый
кем угодно под `FClientLock`, гарантированно жив внутри лока. кем угодно под `FClientLock`, гарантированно жив внутри лока. Единственное
3. **`Stop` прокачивает очередь `Synchronize`.** Останавливает сервер поток исключение — `Stop`, но он к этому моменту уже дождался всех потоков. И в
контроллера (UI), а клиентский поток в этот момент может висеть как раз на том и в другом случае наверх уходит `OnDisconnect` (единая точка
`Invoke` в него же. Без прокачки это взаимный клин; по его таймауту сервер `Disconnected`): иначе после остановки у адаптера оставались висеть захваты
освобождал бы объекты из-под живых потоков. Дополнительно на время параметров ушедших клиентов.
остановки взводится `Stopping`, и адаптер новых `Invoke` уже не начинает. 3. **`Stop` ждёт выхода клиентских потоков без таймаута** и прокачивает при
Если поток всё же не вышел — объект НЕ освобождается: утечка на выходе этом очередь `Synchronize`. Останавливает сервер поток контроллера (UI), а
дешевле обращения к освобождённой памяти. клиентский поток в этот момент может висеть как раз на `Invoke` в него же:
без прокачки это взаимный клин. Выйти по таймауту нельзя — следом
освобождаются и клиенты, и сам сервер с адаптером, а не вышедший поток
вернулся бы в эту память. Поэтому: `Stopping` (адаптер новых `Invoke` не
начинает) + закрытые сокеты + повторный `shutdown` раз в полсекунды, и
ожидание гарантированно конечно.
4. **Слот протокола выдаётся только после handshake.** Соединение до
`Upgrade` живёт в общем массиве (`TCI_MAX_SOCKETS` = 32) и обязано
уложиться в `TCI_HANDSHAKE_MS` (5 с), иначе закрывается по таймауту сокета;
восемь слотов `TCI_MAX_CLIENTS` считаются только среди поднявшихся. Раньше
восемь молчащих TCP-соединений навсегда закрывали дверь настоящим клиентам.
5. **Браузерные клиенты не пускаются.** Handshake с заголовком `Origin`
получает 403. Origin шлёт только браузер, а авторизации в TCI нет: без этой
проверки любая открытая вкладка дотягивалась бы по `ws://127.0.0.1:40001`
до `TRX`, `TUNE` и `VFO`. Своей web-странице нужен явный прокси, а не дыра
по умолчанию.
Разбор HTTP — построчный (`TCIHttpHeader`), а не поиском подстроки
«`upgrade: websocket`»: заголовок с табуляцией или без пробела после
двоеточия валиден. Close-кадр подтверждается ответным close с тем же кодом
(RFC 6455 §5.5.1); полезная нагрузка close длиной ровно один байт невалидна и
рвёт соединение. Текстовые сообщения проверяются на UTF-8 (`TCIValidUTF8`,
§5.6): обрыв последовательности, избыточно длинная форма, суррогаты и всё
выше U+10FFFF закрывают соединение, а не уходят в разбор команд.
### 1.2 Настройки ### 1.2 Настройки
@@ -74,7 +123,7 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
**нет авторизации**: открытый наружу порт означает полный доступ к трансиверу, **нет авторизации**: открытый наружу порт означает полный доступ к трансиверу,
поэтому умолчание слушает только петлю. поэтому умолчание слушает только петлю.
Отсюда же два правила вокруг адреса: Отсюда же правила вокруг адреса:
- разбор `bind_addr` строгий (ровно четыре октета 0..255); всё непонятное — - разбор `bind_addr` строгий (ровно четыре октета 0..255); всё непонятное —
отказ поднимать сервер, а не молчаливый `0.0.0.0`. Пустая строка и явный отказ поднимать сервер, а не молчаливый `0.0.0.0`. Пустая строка и явный
@@ -83,8 +132,12 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
каждое нажатие клавиши: иначе набор `127.0.0.1` по дороге проходил бы через каждое нажатие клавиши: иначе набор `127.0.0.1` по дороге проходил бы через
«`127.0.0.`» и сервер успевал перезапуститься на всех интерфейсах. «`127.0.0.`» и сервер успевал перезапуститься на всех интерфейсах.
Отказ старта (порт занят, адрес не разобран) виден оператору: `ApplySettings` **Сначала применяем, потом сохраняем.** `ApplySettings` проверяет новую
возвращает результат, MainForm показывает сообщение. конфигурацию ДО остановки работающего сервера, а если новый слушатель не
поднялся (порт занят) — возвращает прежний. `MainForm.ApplyTCISettings` пишет
`settings.json` только после успеха и на отказе возвращает поля окна к тому,
что реально работает. Иначе занятый порт оставлял оператора вообще без TCI, да
ещё и с нерабочей конфигурацией на следующий запуск.
### 1.3 Маппинг модели ### 1.3 Маппинг модели
@@ -107,9 +160,46 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
`VFO_LIMITS`, `IF_LIMITS`, `MODULATIONS_LIST`, `READY`. `VFO_LIMITS`, `IF_LIMITS`, `MODULATIONS_LIST`, `READY`.
`READY` шлётся **после** полного дампа состояния: клиент, дождавшийся его, `READY` шлётся **после** полного дампа состояния: клиент, дождавшийся его,
уже знает всё. Границы частот берутся из `BackendCaps`; пока устройство не уже знает всё. `IF_LIMITS` = ±sample rate/2, пересылается при смене частоты
подключено — 10 кГц…30 МГц. `IF_LIMITS` = ±sample rate/2, пересылается при дискретизации.
смене частоты дискретизации.
`VFO_LIMITS` **переобъявляются на лету**: при `rfDevice`/`rfXvtr`/`rfBand`
адаптер пересчитывает границы и, если они изменились, рассылает `vfo_limits`
заново (дедуп по последнему известному значению — `rfDevice` приходит и на
создание слайса). Кэш границ ведётся **независимо от того, есть ли клиенты**:
иначе радио, отвалившееся в момент, когда не подключён никто, осталось бы для
кэша незамеченным, и после его возвращения рассылка подавилась бы — новый
клиент навсегда остался бы с запасным диапазоном из своей пачки инициализации. Перезапросить границы клиент не может, а сценарий обычный: логгер
подключился до радио и получил запасные 10 кГц…30 МГц, потом появился Pluto
или включился трансвертер — и его представление о пределах устарело, хотя
команды уже отбраковываются по новым.
`VFO_LIMITS` и проверка частоты в командах берутся из **одного** источника —
`FreqLimits` поверх `VisibleFreqBounds`: под трансвертером это диапазон его
слота, иначе пределы устройства, а пока устройства нет — объявленный запасной
диапазон 10 кГц…30 МГц. Раньше источников было два, и они расходились: клиенту
объявлялись пределы АЦП, а команда под трансвертером принимала любое число.
Для `DDS` это опаснее, чем для `VFO`: `SetCenter`/`SetPanDDCFreq` ничего не
клампят и отдают частоту прямо в backend.
В дампе состояния есть и то, что иначе клиент не получил бы часами:
`TX_FREQUENCY` (уведомление шлётся по изменению, а на стабильном радио его нет
— особенно важно при split и TX-слайсе), текущий `APP_FOCUS` и `VFO_LOCK` на
каждый канал.
**У живого пана канал A есть всегда.** Выключить канал A в TCI нечем — он
существует по определению, поэтому пан без слайсов показывает канал A на своём
центре (`DDS`), а не хранит частоту удалённого слайса. Команды на такой канал
игнорируются: слайса под ним нет. Как только слайс появится, канал станет
настоящим.
**Приёмники, которых ещё нет, молчат.** `TRX_COUNT` объявляет потолок железа
(`BackendCaps.MaxPans`) один раз и навсегда, а пан из этого потолка может быть
не создан. Для несуществующего пана не шлётся ничего (раньше уходили
`dds`/`vfo`/`if` с нулём, и клиент принимал ноль за настоящую частоту);
состояние приходит, когда пан появится — с `rfPanFreq`/`rfSliceState`. У
существующего пана без слайсов есть только `DDS`. Показания измерителей для
таких приёмников тоже не отправляются.
Список видов связи: `am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw`. Список видов связи: `am,sam,dsb,lsb,usb,cw,nfm,wfm,digl,digu,dmr,fmraw`.
`dmr`/`fmraw` — наше расширение (протокол расширяемый, §1.4). `CWL`/`CWU` `dmr`/`fmraw` — наше расширение (протокол расширяемый, §1.4). `CWL`/`CWU`
@@ -118,13 +208,39 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
### 2.2 Двунаправленное управление (§4.2) ### 2.2 Двунаправленное управление (§4.2)
Общее для всех установок:
- **аргумент разбирается строго** (`TCITryArgInt/Float/Bool`). Не разобрался —
параметр не трогаем и отвечаем текущим значением. Раньше `vfo:0,0,abc;`
превращалось в честный ноль и уводило приёмник на 0 Гц, а любой мусор в
Boolean-командах читался как `false`;
- **частота проверяется дважды**. В потоке клиента — `FreqSane` по тем же
границам, что объявлены в `VFO_LIMITS` (см. §2.1): ноль и отрицательные —
отказ. И ещё раз в потоке контроллера, уже по живым границам (`FreqSaneLive`
в `SyncSetVfo`/`SyncSetCenter`): между разбором команды и её исполнением
оператор успевает сменить устройство, и снимок, по которому частоту
пропустили, описывает уже не то радио, куда она уедет. Ни `SetVfoA`, ни
`SetCenter`, ни `SetPanDDCFreq` границ не клампят — число уходит прямо в
backend. Кромки фильтра обязаны разбираться обе и идти по возрастанию;
- **слайс перестраивается только `TuneSliceInBand`** — тем же путём, что у
CAT-порта слайса: внутри включённого диапазона он ходит свободно, за
захваченную полосу окно DDC переедет само, а за границы диапазона команда
отбрасывается. Прямой `SetSliceTarget` (как было) уводил слайс куда угодно, и
для TX-слайса эта частота попадала прямо в DUC — то есть в эфир на чужом
диапазоне, без переключения антенн и фильтров. Смена диапазона остаётся
решением оператора, а не управляющего ПО;
- **параметр захватывается на 200 мс** (§3.5, `Claim`). Пока клиент крутит
частоту, второй логгер её не перебьёт; изменение от оператора захватывает
параметр так же, но у клиента, который им прямо сейчас управляет, не
отбирает. Захваты клиента снимаются при его отключении.
Полностью проведено в контроллер: Полностью проведено в контроллер:
| Команда | Куда легло | | Команда | Куда легло |
|---|---| |---|---|
| `START` / `STOP` | `SetRun` | | `START` / `STOP` | `SetRun` |
| `DDS` | `SetCenter` / `SetPanDDCFreq` | | `DDS` | `SetCenter` / `SetPanDDCFreq` |
| `IF`, `VFO` | `SetVfoA/B`, `SetSliceTarget` | | `IF`, `VFO` | `SetVfoA/B`, `TuneSliceInBand` |
| `MODULATION` | `SetMode` / `SetSliceMode` | | `MODULATION` | `SetMode` / `SetSliceMode` |
| `TRX` | `SetMOX` | | `TRX` | `SetMOX` |
| `TUNE` | `SetTune` | | `TUNE` | `SetTune` |
@@ -132,9 +248,18 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
| `TUNE_DRIVE` | `FTXSettings.TUNLevel` через `SetTXSettings` | | `TUNE_DRIVE` | `FTXSettings.TUNLevel` через `SetTXSettings` |
| `SPLIT_ENABLE` | `SetSplit` | | `SPLIT_ENABLE` | `SetSplit` |
| `RX_FILTER_BAND` | `SetFilterEdges` / `SetSliceFilter` | | `RX_FILTER_BAND` | `SetFilterEdges` / `SetSliceFilter` |
| `VOLUME`, `MUTE` | `SetVolume`, `SetMute` (дБ ↔ 0..100) | | `VOLUME`, `MUTE` | `SetRxVolume`, `SetMute` (дБ ↔ 0..100) |
| `RX_MUTE`, `RX_VOLUME` | громкость/мьют слайса | | `RX_MUTE`, `RX_VOLUME` | громкость/мьют слайса |
| `MON_VOLUME`, `MON_ENABLE` | `SetTXMonVolume`, `SetRxMuteOnTx` | | `MON_VOLUME`, `MON_ENABLE` | `SetTXMonVolume`, `SetRxMuteOnTx` |
Громкость приёма и громкость самоконтроля — **разные** величины, и в TCI это
разные команды. У слайдера программы они одна: `SetVolume` правит ту, что
сейчас звучит (на передаче в DUP с выключенным RX MUTE — монитор). Поэтому
`VOLUME` и `RX_VOLUME` ходят через адресный `SetRxVolume`: иначе команда,
пришедшая на передаче, уезжала бы в громкость монитора, а в ответ клиент
получал бы нетронутый `FVolume`. Обратный путь тоже разделён — у монитора
появилось своё событие `rfMonVolume`, раньше его правка рассылалась клиентам
как обычный `volume`.
| `AGC_MODE` | `off`→Off, `fast`→Fast, `normal`→Medium | | `AGC_MODE` | `off`→Off, `fast`→Fast, `normal`→Medium |
| `AGC_GAIN` | `SetAGCTop` (AGC-T) — **только приёмник 0**, см. §3 | | `AGC_GAIN` | `SetAGCTop` (AGC-T) — **только приёмник 0**, см. §3 |
| `RX_NR_ENABLE`, `RX_NB_ENABLE`, `RX_ANF_ENABLE` | `SetNR/SetNB/SetANF`, для панов — `SetSliceDSP` | | `RX_NR_ENABLE`, `RX_NB_ENABLE`, `RX_ANF_ENABLE` | `SetNR/SetNB/SetANF`, для панов — `SetSliceDSP` |
@@ -149,11 +274,22 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
`SET_IN_FOCUS` (поднимает окно программы через `OnFocusRequest` — адаптер до `SET_IN_FOCUS` (поднимает окно программы через `OnFocusRequest` — адаптер до
окна не дотягивается, действие ставит MainForm), окна не дотягивается, действие ставит MainForm),
`SPOT`, `SPOT_DELETE`, `SPOT_CLEAR``TDXSpotStore`, спот виден на всех `SPOT`, `SPOT_DELETE`, `SPOT_CLEAR``TDXSpotStore`, спот виден на всех
панадаптерах), `RX_SENSORS_ENABLE`, `TX_SENSORS_ENABLE` (период — на клиента), панадаптерах; время спота — UTC, как у кластера, а не местное),
`RX_SENSORS_ENABLE`, `TX_SENSORS_ENABLE` (период — на клиента),
`IQ_SAMPLERATE`, `AUDIO_SAMPLERATE`, `AUDIO_STREAM_*`, `TX_STREAM_AUDIO_BUFFERING` `IQ_SAMPLERATE`, `AUDIO_SAMPLERATE`, `AUDIO_STREAM_*`, `TX_STREAM_AUDIO_BUFFERING`
(значения принимаются и подтверждаются; сами потоки — этап 2). Параметры (значения принимаются и подтверждаются; сами потоки — этап 2). Параметры
потоков — настройки **клиента**, а не устройства: живут в `TTCIClient`, и один потоков — настройки **клиента**, а не устройства: живут в `TTCIClient`, и один
клиент не переопределяет их остальным. клиент не переопределяет их остальным; подписки и параметры читаются/пишутся
под локом клиента, потому что пишет их его поток, а читает тик-поток.
Значения сверяются со списками протокола: `IQ_SAMPLERATE` — 48/96/192/384 кГц,
`AUDIO_SAMPLERATE` — 8/12/24/48 кГц, `AUDIO_STREAM_SAMPLE_TYPE`
int16/int24/int32/float32. Чужое значение не принимается, в ответе уходит
действующее.
Команды **запуска** потоков (`IQ_START`/`IQ_STOP`, `AUDIO_START`/`AUDIO_STOP`,
`LINE_OUT_*`) отвечают `tci_error:<команда>,binary streams are not implemented`.
Молчать нельзя: клиент решил бы, что поток пошёл, и ждал бы данных бесконечно.
### 2.4 Уведомления (§4.4, §4.5) ### 2.4 Уведомления (§4.4, §4.5)
@@ -163,6 +299,31 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
`CLICKED_ON_SPOT` (клик по подписи спота на любом панадаптере), `CLICKED_ON_SPOT` (клик по подписи спота на любом панадаптере),
`CALLSIGN_SEND` (после `CW_MSG`). `CALLSIGN_SEND` (после `CW_MSG`).
**Пачка инициализации уходит одним куском.** Сервер зовёт `OnConnect` под
`FClientLock`, то есть рассылка ждёт, пока весь дамп не уложен в очередь
клиента. Без этого изменение, случившееся после строки снимка, но до
`Ready = True`, пропадало навсегда: `Broadcast` пропускает не-Ready клиента, а
тот считал инициализацию завершённой и оставался со старым значением. Отсюда
запрет для `HandleConnect`: никаких `Invoke` в поток контроллера — он сам может
стоять на этом локе внутри `Broadcast`.
**Создание и удаление слайса.** `AddSlice`/`RemoveSlice` шлют только `rfDevice`,
и по нему адаптер сравнивает расстановку до и после (`SliceMapSig`: id и пан
каждого слайса по порядку слотов). Изменилась — уходит полная картина каналов
каждого живого доп. приёмника (`PushChannelMap`). Иначе подключённый клиент не
узнавал ни о появлении канала, ни о его исчезновении, а при удалении первого
слайса второй молча становился каналом A. Сказать «приёмника больше нет» в
TCI 2.0 нечем — про канал B есть `RX_CHANNEL_ENABLE`, про сам приёмник ничего;
это ограничение протокола, а не наше упрощение.
**Глобальные величины рассылаются всем.** `TUNE_DRIVE`, `CW_MACROS_SPEED`,
`CW_MACROS_DELAY` и `SPLIT_ENABLE` — свойства радио, а не клиента, поэтому
команда отвечает `Broadcast`, а не `Reply` (автор входит в рассылку). Правки от
оператора приходят событиями: `rfTXProfile` для уровня TUN, `rfActiveVfo` для
split, `rfMonVolume` для громкости самоконтроля и новый `rfCWSettings`, который
теперь шлёт `SetCWSettings` — своего события у телеграфа не было вовсе, и
клиенты о смене скорости из окна настроек не узнавали.
Отдельная история — **доп. приёмники**. У главного тракта на каждое поле есть Отдельная история — **доп. приёмники**. У главного тракта на каждое поле есть
своё `rfXxx`, а у слайсов не было ничего: правка слайса не доходила ни до UI, своё `rfXxx`, а у слайсов не было ничего: правка слайса не доходила ни до UI,
ни до остальных клиентов. Поэтому в контроллере появилось `rfSliceState` ни до остальных клиентов. Поэтому в контроллере появилось `rfSliceState`
@@ -170,8 +331,14 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
сеттеры слайса: `SetSliceMode`, `SetSliceFilter`, `SetSliceAGCMode`, сеттеры слайса: `SetSliceMode`, `SetSliceFilter`, `SetSliceAGCMode`,
`SetSliceVolume`, `SetSliceMute`, `SetSliceDSP`, `SetSliceFMSquelch`. `SetSliceVolume`, `SetSliceMute`, `SetSliceDSP`, `SetSliceFMSquelch`.
Адаптер разворачивает Id обратно в пару (приёмник, канал) и рассылает Адаптер разворачивает Id обратно в пару (приёмник, канал) и рассылает
состояние именно этого канала. Частоту слайса, поставленную по TCI, тоже состояние именно этого канала.
сопровождает `SliceFreqChanged` — как это делает CAT.
Частоту слайса объявляет сам `SetSliceTarget`: `SliceFreqChanged` живёт
**внутри** него, а не у каждого вызывающего. Раньше об этом помнили CAT и TCI,
но не UI — перетаскивание флага мышью обновляло только свой пан, и TCI-клиенты
оставались на старой частоте. Дублирующие вызовы у вызывающих (в том числе
ручные `PushSliceFlagState`/`LayoutFlags` в MainForm) убраны: теперь один
путь на всех — мышь, колесо, CAT, TCI, бэнд-логика.
### 2.5 Телеграф (§3.2) ### 2.5 Телеграф (§3.2)
@@ -210,9 +377,10 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
| `AGC_GAIN` у приёмника > 0 | AGC-T в ewsdr один на приёмный тракт, у слайса своего нет. Команда от имени доп. приёмника **игнорируется** (раньше молча правила главный), в ответ уходит текущее значение | | `AGC_GAIN` у приёмника > 0 | AGC-T в ewsdr один на приёмный тракт, у слайса своего нет. Команда от имени доп. приёмника **игнорируется** (раньше молча правила главный), в ответ уходит текущее значение |
| Цвет спота (`SPOT`, arg4 ARGB) | не читается: `TDXSpot` цвета не хранит, подписи красятся по моде/возрасту | | Цвет спота (`SPOT`, arg4 ARGB) | не читается: `TDXSpot` цвета не хранит, подписи красятся по моде/возрасту |
| `KEYER`, `TX_FOOTSWITCH` | не реализованы: своего ключа-уведомления и опроса педали наружу у контроллера нет | | `KEYER`, `TX_FOOTSWITCH` | не реализованы: своего ключа-уведомления и опроса педали наружу у контроллера нет |
| Арбитраж клиентов (§3.5, захват параметра ~200 мс) | нет. Команды разных клиентов идут подряд, последняя побеждает. С двумя активными логгерами возможна «перетяжка» частоты или моды |
| Мода, фильтр, АРУ, шумодавы у канала B доп. пана | в TCI это свойства **приёмника**, а не канала: они относятся к каналу A. У канала B по протоколу есть только частота, IF и громкость | | Мода, фильтр, АРУ, шумодавы у канала B доп. пана | в TCI это свойства **приёмника**, а не канала: они относятся к каналу A. У канала B по протоколу есть только частота, IF и громкость |
| Команды конфигурации потоков | подтверждаются как принятые, хотя самих потоков нет (этап 2). Клиент по ответу может решить, что функция доступна | | Захват параметра (§3.5) | реализован для того, что клиенты действительно перетягивают (частота, DDS, мода, фильтр, TRX/TUNE/DRIVE, split, громкости, АРУ, шумодавы, squelch, скорость CW). Эхо-параметры (RIT/XIT, BIN/ANC/…) не захватываются: на радио они не влияют |
| Браузерные клиенты | отвергаются по `Origin` (403), см. §1.1. Web-интерфейсу ewsdr TCI не нужен — у него свой канал |
| `TRX_COUNT` | равен `BackendCaps.MaxPans`, а не числу живых панов: протокол объявляет его один раз. Про несуществующий приёмник просто ничего не шлётся (§2.1) |
Отдельно: у `TX_SENSORS` второй аргумент — уровень микрофона; измерителя Отдельно: у `TX_SENSORS` второй аргумент — уровень микрофона; измерителя
микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не
@@ -244,7 +412,7 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
5. **`LINEOUT_STREAM` + `LINE_OUT_RECORDER_*`** — запись в WAV/MP3. 5. **`LINEOUT_STREAM` + `LINE_OUT_RECORDER_*`** — запись в WAV/MP3.
Также в очереди: `RX_CHANNEL_ENABLE` как реальное создание/удаление второго Также в очереди: `RX_CHANNEL_ENABLE` как реальное создание/удаление второго
слайса пана, `KEYER` и арбитраж нескольких клиентов (§3.5). слайса пана и `KEYER`.
Приёмный буфер `TWsClient` — 4 КБ, и сейчас это жёсткий потолок: кадр крупнее Приёмный буфер `TWsClient` — 4 КБ, и сейчас это жёсткий потолок: кадр крупнее
рвёт соединение (команд такой длины у TCI нет). Под TX-аудио его придётся рвёт соединение (команд такой длины у TCI нет). Под TX-аудио его придётся
@@ -264,7 +432,7 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
клиент вылетает сам); остановка сервера в тот момент, когда команда клиента клиент вылетает сам); остановка сервера в тот момент, когда команда клиента
висит в `Synchronize` у потока контроллера. висит в `Synchronize` у потока контроллера.
- **Сквозной прогон** с настоящим `TRadioController` (движки созданы, железо не - **Сквозной прогон** с настоящим `TRadioController` (движки созданы, железо не
подключено): пачка инициализации из 57 строк со всеми обязательными подключено): пачка инициализации со всеми обязательными
командами и `READY` в конце; `VFO`, `MODULATION` (`cw` на 7 МГц дал CWL), командами и `READY` в конце; `VFO`, `MODULATION` (`cw` на 7 МГц дал CWL),
`RX_FILTER_BAND`, `DRIVE`, `VOLUME`, `MUTE`, `AGC_GAIN`, `LOCK`, `RX_FILTER_BAND`, `DRIVE`, `VOLUME`, `MUTE`, `AGC_GAIN`, `LOCK`,
`CW_MACROS_SPEED`, `SPOT`, `RIT_*` — состояние контроллера после прогона `CW_MACROS_SPEED`, `SPOT`, `RIT_*` — состояние контроллера после прогона
@@ -275,6 +443,53 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт
работать (проверено на контроллере без движков, где `SetMode`/`SetCWSettings` работать (проверено на контроллере без движков, где `SetMode`/`SetCWSettings`
падают с AV на неинициализированном `FNetwork`). падают с AV на неинициализированном `FNetwork`).
Прогон после ревизии (49 проверок, все зелёные):
- **Протокол:** строгий разбор (`abc`, пустой аргумент, переполнение Integer,
дробная запись), списки частот потоков и форматов сэмплов, построчный разбор
HTTP-заголовков.
- **Транспорт:** 101 на заголовки с табуляцией и без пробела после двоеточия;
отказ 403 при `Origin`; ровно восемь поднявшихся клиентов и 503 девятому;
освобождение слотов после отключения; молчащий сокет уходит по таймауту
handshake; ответный close-кадр; `Stop` с живым клиентом.
- **Адаптер:** `vfo:0,0,abc`, `vfo:0,0,-1`, `dds:0,broken`,
`rx_filter_band:0,x,y` не меняют ничего, а годная частота проходит; захват
параметра (второй клиент не перебивает первого раньше 200 мс и перебивает
позже); `iq_samplerate:44100` отвергается, `iq_start` отвечает ошибкой;
в пачке состояния есть `tx_frequency`, `app_focus`, поканальный `vfo_lock`
и нет частот несуществующего пана; отказ применения настроек (кривой адрес,
занятый порт) возвращает прежний работающий слушатель.
- **Остановка под `Synchronize`:** команда клиента висит в очереди главного
потока, `Ad.Free` в этот момент — сервер прокачивает очередь, команда
доисполняется, зависания нет.
Прогон после второй ревизии (60 проверок, все зелёные) добавил к этому:
проверку UTF-8 (обрыв, избыточная форма, суррогат — и то же кадром в эфире),
отказ на однобайтовый close, `OnDisconnect` при остановке сервера, отбраковку
частоты за пределами `VFO_LIMITS` (в том числе `DDS`), переобъявление
`vfo_limits` после появления устройства (в том числе когда радио пропадало и
возвращалось, пока клиентов не было) и изоляцию медленного клиента: четыре
тысячи рассылок в молчащий сокет не мешают соседу получить ответ быстрее
секунды. Всего 73 проверки — добавились отбраковка частоты и центра живыми
границами, когда снимок ещё разрешает (устройство «пропало» без событий),
рассылка `tune_drive`, `mon_volume` и
`split_enable` соседнему клиенту, адресность `VOLUME` на передаче с
самоконтролем, устойчивость к падению сеттера CW (на стенде `SetCWSettings` без
движков и сети валится с AV — клиент получает `tci_error`, соединение живо) и
неразрывность пачки инициализации под крутящейся ручкой.
Чего стенд не проверяет: поведение пана без слайсов и рассылку каналов при
создании/удалении слайса — для них нужен живой DSP-движок, которого на стенде
нет. Остаётся и известное окно: показания измерителей читают `FDSPEngine` из
тик-потока, и смена устройства в этот момент теоретически может застать его уже
освобождённым (та же схема, что у web- и CAT-подсистем).
Попутно стенд поймал ещё одно: запись в сокет, закрытый клиентом, приносила
SIGPIPE, а он по умолчанию убивает процесс (в GUI сигнал гасит виджетсет, а
демону гасить некому). `WebUtils.SockSend` теперь шлёт с `MSG_NOSIGNAL`
send просто возвращает EPIPE, и клиент выбрасывается штатно. Правка общая
с web-подсистемой: пишет в сокеты клиентов она тем же вызовом.
Сборка: `lazbuild -B --ws=qt6 ewsdr.lpr` и `./build-ewsdrd.sh` (демон собирается, Сборка: `lazbuild -B --ws=qt6 ewsdr.lpr` и `./build-ewsdrd.sh` (демон собирается,
TCI в его граф пока не заведён — юниты LCL-free, подключается одной строкой в TCI в его граф пока не заведён — юниты LCL-free, подключается одной строкой в
`ewsdrd.lpr`, как web). `ewsdrd.lpr`, как web).