mirror of
https://git.vladimir.cc/vladimir/ewsdr.git
synced 2026-08-25 20:27:33 +00:00
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:
+36
-25
@@ -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
@@ -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
File diff suppressed because it is too large
Load Diff
@@ -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
@@ -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
@@ -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
@@ -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).
|
||||||
|
|||||||
Reference in New Issue
Block a user