From 4165cbe9a549d60f3aff3e1b6ebc3fe291ed0801 Mon Sep 17 00:00:00 2001 From: Vladimir Date: Mon, 17 Aug 2026 22:53:32 +0300 Subject: [PATCH] =?UTF-8?q?fix(tci):=20=D1=80=D0=B5=D0=B2=D0=B8=D0=B7?= =?UTF-8?q?=D0=B8=D1=8F=20=E2=80=94=20=D0=BF=D0=BE=D1=82=D0=BE=D0=BA=D0=B8?= =?UTF-8?q?,=20=D0=B2=D0=B0=D0=BB=D0=B8=D0=B4=D0=B0=D1=86=D0=B8=D1=8F,=20?= =?UTF-8?q?=D0=B0=D1=80=D0=B1=D0=B8=D1=82=D1=80=D0=B0=D0=B6=20=D0=B8=20?= =?UTF-8?q?=D1=81=D0=B8=D0=BD=D1=85=D1=80=D0=BE=D0=BD=D0=B8=D0=B7=D0=B0?= =?UTF-8?q?=D1=86=D0=B8=D1=8F=20=D0=BA=D0=BB=D0=B8=D0=B5=D0=BD=D1=82=D0=BE?= =?UTF-8?q?=D0=B2?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Разбор семи проходов ревью ветки. Ниже — по сути, а не по списку. Потоки. Сетевые потоки больше не читают модель контроллера напрямую. Слайсы снимаются в потоке контроллера (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 --- MainForm.pas | 61 ++- RadioController.pas | 154 ++++++- TCIAdapter.pas | 1052 ++++++++++++++++++++++++++++++++----------- TCIProtocol.pas | 64 +++ TCIServer.pas | 516 +++++++++++++++++---- WebUtils.pas | 24 +- doc/TCI.md | 285 ++++++++++-- 7 files changed, 1738 insertions(+), 418 deletions(-) diff --git a/MainForm.pas b/MainForm.pas index 090d359..ea226c0 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -5779,9 +5779,10 @@ begin FController.CapturedSpan(LoHz, HiHz); if NewHz < LoHz then NewHz := LoHz; if NewHz > HiHz then NewHz := HiHz; + // Перезалив флага и раскладку несёт rfSliceFreq из SetSliceTarget — + // одним путём для мыши, CAT и TCI (иначе внешние клиенты о перетаскивании + // не узнавали). FController.SetSliceTarget(FSliceDragId, NewHz); - FPan.PushSliceFlagState(FSliceDragId); // обновить частоту во флаге - FPan.LayoutFlags; FSpectrumDirty := True; // кадр — по таймеру (FPS-гейт, как при drag VFO) end; Exit; @@ -6583,18 +6584,37 @@ end; procedure TMainForm.ApplyTCISettings(Enabled: Boolean; Port: Integer; const BindAddr: string); +// Сначала применяем, и только потом сохраняем. Обратный порядок означал бы: +// занятый порт или опечатка в адресе — и в файле навсегда осталась нерабочая +// конфигурация, с которой программа стартует и в следующий раз. +var Prev, Cfg: TTCISettings; begin - FTCICfg.Enabled := Enabled; - FTCICfg.Port := Port; - FTCICfg.BindAddr := BindAddr; - FController.FSettings.SaveTCISettings(FTCICfg); - if FTCIAdapter = nil then Exit; - // Отказ (порт занят, адрес не разобран) показываем сразу: иначе оператор - // останется с галкой «включено» и мёртвым сервером. - if not FTCIAdapter.ApplySettings(FTCICfg) then - ShowMessage('TCI server failed to start on ' + BindAddr + ':' + - IntToStr(Port) + '.' + LineEnding + - 'Port busy or address invalid.'); + Prev := FTCICfg; + Cfg.Enabled := Enabled; + Cfg.Port := Port; + Cfg.BindAddr := BindAddr; + if FTCIAdapter = nil then + begin + FTCICfg := Cfg; + FController.FSettings.SaveTCISettings(FTCICfg); + Exit; + end; + 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; // SET_IN_FOCUS от TCI-клиента: логгер просит поднять окно программы. @@ -7429,11 +7449,8 @@ begin AddSliceAtFreqPan(P, Hz); Exit; end; - FController.SetSliceTarget(Id, Hz); + FController.SetSliceTarget(Id, Hz); // флаг и раскладку несёт rfSliceFreq FActiveSliceId := Id; - P.PushSliceFlagState(Id); - P.LayoutFlags; - MarkPanDirty(P); end; procedure TMainForm.ApplyPanHeaderTheme(P: TPanafallPanel); @@ -8062,10 +8079,7 @@ begin FController.CapturedSpan(LoHz, HiHz, P.PanId); if NewHz < LoHz then NewHz := LoHz; if NewHz > HiHz then NewHz := HiHz; - FController.SetSliceTarget(FPanSliceDragId, NewHz); - P.PushSliceFlagState(FPanSliceDragId); - P.LayoutFlags; - MarkPanDirty(P); + FController.SetSliceTarget(FPanSliceDragId, NewHz); // флаг — rfSliceFreq end; Exit; end; @@ -9270,10 +9284,7 @@ begin FController.CapturedSpan(SLo, SHi, Sl.PanId); // полоса ЕГО пана if SNew < SLo then SNew := SLo; if SNew > SHi then SNew := SHi; - FController.SetSliceTarget(SliceId, SNew); - SlicePan.PushSliceFlagState(SliceId); - SlicePan.LayoutFlags; - MarkPanDirty(SlicePan); + FController.SetSliceTarget(SliceId, SNew); // флаг — rfSliceFreq FActiveSliceId := SliceId; Handled := True; Exit; diff --git a/RadioController.pas b/RadioController.pas index e4571cf..5b8881f 100644 --- a/RadioController.pas +++ b/RadioController.pas @@ -89,7 +89,9 @@ type rfDeviceList, // список discovered устройств обновился rfPanFreq, // центр доп. пана уехал (ретюн DDC извне) 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; @@ -193,6 +195,29 @@ type DMR: TDMRSliceDecoder; // владеет; nil для не-DMR слайса 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 = class private @@ -795,6 +820,10 @@ type procedure VolumeBy(Delta: Integer); // Громкость self-monitor'а на передаче отдельно от RX-громкости: слайдер // правит её только когда MonitoringTX, а CAT (ZZTM) — в любой момент. + { Адресная громкость ПРИЁМА: правит FVolume независимо от того, идёт ли + передача. Слайдер (SetVolume) правит активную — на self-monitor это + громкость монитора; внешнему клиенту (TCI VOLUME) такой контекст не нужен. } + procedure SetRxVolume(V: Integer); procedure SetTXMonVolume(V: Integer); // True — сейчас звучит self-monitor даунлинка на передаче (TX + DUP + RX MUTE // off). В этом контексте SetVolume/слайдер правят FTxMonVolume, иначе FVolume. @@ -876,6 +905,14 @@ type function ActiveMicInDevName: string; function SliceCount: Integer; 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 и не зависит от того, // создан ли слайс сейчас: на слот вешаются настройки (CAT-порт, Auto TX). class function SliceSlotLetter(Slot: Integer): Char; @@ -2052,8 +2089,7 @@ begin PanId := FSlices[idx].PanId; if SliceFitsCapture(TargetHz, PanId) then begin - SetSliceTarget(Id, TargetHz); - SliceFreqChanged(Id); + SetSliceTarget(Id, TargetHz); // он же шлёт SliceFreqChanged Exit(True); end; @@ -2078,8 +2114,8 @@ begin if Dist > Half * 2 * 0.95 then Exit; NewCenter := (TargetHz + ActiveVfoHz) / 2; SetCenter(NewCenter); // несёт Changed(rfCenterFreq) + сдвиги слайсов - SetSliceTarget(Id, TargetHz); - SliceFreqChanged(Id); // rfCenterFreq флаги не перезаливает — нужен свой + SetSliceTarget(Id, TargetHz); // SliceFreqChanged — внутри: rfCenterFreq + // флаги не перезаливает, нужен свой Result := True; end; end; @@ -2513,10 +2549,11 @@ begin end; procedure TRadioController.SetSliceTarget(Id: Integer; TargetHz: Double); -var idx: Integer; +var idx: Integer; Moved: Boolean; begin idx := FindSliceIndex(Id); if idx < 0 then Exit; + Moved := FSlices[idx].TargetHz <> TargetHz; FSlices[idx].TargetHz := TargetHz; if Assigned(FDSPEngine) then FDSPEngine.SetSliceShift(Id, TargetHz - PanCenterHz(FSlices[idx].PanId)); @@ -2524,6 +2561,10 @@ begin // первый MOX, но в телеграфе ключ замыкает прошивка без всякого MOX: DUC // обязан стоять правильно ВСЕГДА, а не только на передаче. if FTxSliceId = Id then PushNetworkState; + // Уведомление — здесь, а не у каждого вызывающего: слайс двигают мышью, CAT, + // TCI и бэнд-логика, и каждый забывал сказать об этом остальным (TCI-клиенты + // оставались на старой частоте после перетаскивания флага мышью). + if Moved then SliceFreqChanged(Id); end; procedure TRadioController.SetSliceMode(Id, Mode: Integer); @@ -2921,6 +2962,85 @@ begin if Result then S := FSlices[idx]; 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) висят на слоте/букве, а слайс // на слоте может появляться и исчезать. @@ -3216,11 +3336,13 @@ begin end; function TRadioController.ActiveTXFreqHz: Double; -var S: TCtrlSlice; +// Снимок (GetSliceView), а не GetSlice: функцию зовут и внешние фронтенды из +// своих потоков, а копия TCtrlSlice тащит managed-строки слайса. +var S: TSliceView; begin // Мультислайс-TX: если выбран слайс-источник — передаём на его частоте // (слайсы не несут repeater-конфиг, FM-сдвиг не применяем). - if (FTxSliceId > 0) and GetSlice(FTxSliceId, S) then + if (FTxSliceId > 0) and GetSliceView(FTxSliceId, S) then Result := S.TargetHz else begin @@ -4722,9 +4844,20 @@ begin // иначе FVolume. Обе персистятся; слайдер редактирует активную. if MonitoringTX then FTxMonVolume := V else FVolume := V; if FWDSPReady and Assigned(FDSPEngine) then FDSPEngine.SetVolume(ActiveVolume / 100.0); + // rfVolume — для слайдера и оверлея: они показывают ActiveVolume. А вот кто + // именно изменился, слайдеру всё равно, зато не всё равно внешним клиентам: + // у них громкость приёма и громкость монитора — РАЗНЫЕ величины. + if MonitoringTX then Changed(rfMonVolume); Changed(rfVolume); 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); begin SetVolume(ActiveVolume + Delta); end; @@ -4734,6 +4867,7 @@ procedure TRadioController.SetTXMonVolume(V: Integer); begin FTxMonVolume := EnsureRange(V, 0, 100); if MonitoringTX then ApplyActiveVolume; + Changed(rfMonVolume); end; procedure TRadioController.SetMute(On_: Boolean); @@ -6224,6 +6358,10 @@ begin FSettings.SaveCW(FDevMAC, FCWSettings); FSettings.Save; end; + // Телеграф правят и оператор, и CAT, и TCI, а скорость с задержкой макросов — + // величины общие для радио: об их смене обязаны узнать все фронтенды, а не + // только тот, кто её заказал. + Changed(rfCWSettings); end; procedure TRadioController.SyncCWKeyer; diff --git a/TCIAdapter.pas b/TCIAdapter.pas index 81b5cb9..4370b8a 100644 --- a/TCIAdapter.pas +++ b/TCIAdapter.pas @@ -39,12 +39,17 @@ unit TCIAdapter; interface uses - Classes, SysUtils, Math, SyncObjs, + Classes, SysUtils, DateUtils, Math, SyncObjs, RadioController, RadioBackend, WDSPEngine, Settings, DXSpotStore, TCIProtocol, TCIServer; const TCI_MAX_RX = MAX_PANS; // приёмник TCI = панадаптер + // Захват параметра клиентом (§3.5): пока владелец его крутит, остальные + // могут только слушать. Без этого два логгера перетягивают частоту друг у + // друга бесконечно. + TCI_HOLD_MS = 200; + TCI_HOLD_SLOTS = 64; type { Параметры TCI, которым в ewsdr нет соответствия: храним и отражаем. } @@ -60,12 +65,40 @@ type BalanceDb: array[0..TCI_CHANNELS-1] of Integer; end; + { Снимок «железной» части контроллера: всё, ради чего иначе пришлось бы + трогать FNetwork из потока клиента. Backend живёт в UI-потоке и на смене + устройства освобождается — чтение его Caps и имени платы (а это ещё и + строки) из чужого потока даёт обращение к освобождённой памяти. } + TTCIDevSnap = record + DevName: string; // копия, принадлежит адаптеру + LimLoHz: Double; // границы настройки (VFO_LIMITS и проверка команд) + LimHiHz: Double; + MaxPans: Integer; + SampleRate: Integer; + HasTX: Boolean; + end; + + { Запись снимка таблицы слайсов: то, что сетевым потокам разрешено читать. } + TTCISliceSnap = record + Used: Boolean; + V: TSliceView; + end; + + { Захваченный параметр (§3.5): кто им сейчас управляет и когда трогал. + Owner = nil — изменение пришло не от клиента (оператор, CAT, бэнд-логика). } + TTCIHold = record + Key: string; + Owner: TTCIClient; + At: QWord; + end; + TTCIAdapter = class private FController: TRadioController; FSpots: TDXSpotStore; // может быть nil (демон/тесты) FServer: TTCIServer; FLock: TCriticalSection; + FCfg: TTCISettings; // применённая конфигурация (для отката) // ── Эхо-состояние (пишут потоки клиентов ⇒ только под FEchoLock) ── FEchoLock: TCriticalSection; @@ -74,9 +107,25 @@ type FDiguOffset: Integer; FCwTerminal: Boolean; + // ── Снимок железа: пишет поток контроллера, читают сетевые ── + FDevLock: TCriticalSection; + FDevSnap: TTCIDevSnap; + + // ── Снимок слайсов: пишет поток контроллера, читают сетевые ── + FSliceLock: TCriticalSection; + FSliceSnap: array[0..MAX_SLICES-1] of TTCISliceSnap; + + // ── Захват параметров клиентами (§3.5) ── + FHoldLock: TCriticalSection; + FHolds: array[0..TCI_HOLD_SLOTS-1] of TTCIHold; + FHoldCount: Integer; + // ── Кэш для подавления повторов в уведомлениях ── + FLastLimLo: Double; // последние разосланные VFO_LIMITS (поток контроллера) + FLastLimHi: Double; FLastTxFreq: Double; FLastTxEnable: Boolean; + FAppFocus: Boolean; // последнее, что сказал UI (для пачки состояния) FOnFocusRequest: TThreadMethod; // ── scratch для маршалинга в поток контроллера ── @@ -122,9 +171,27 @@ type function CanInvoke: Boolean; function RxCount: Integer; function ValidRx(Rx: Integer): Boolean; - function SliceIdOf(Rx, Ch: Integer): Integer; - function RxSlice(Rx: Integer; out S: TCtrlSlice): Boolean; + function RxActive(Rx: Integer): Boolean; + procedure CalcFreqLimits(out LoHz, HiHz: Double); // живые (поток контроллера) + procedure FreqLimits(out LoHz, HiHz: Double); // из снимка (любой поток) + function FreqSaneLive(Hz: Double): Boolean; // проверка перед установкой + procedure PushVfoLimits; // разослать VFO_LIMITS, если границы уехали + function FreqSane(Hz: Double): Boolean; + procedure RefreshDev; // снимок железа (поток контроллера) + function DevSnap: TTCIDevSnap; + procedure RefreshSlices; // снимок таблицы слайсов (поток контроллера) + function SliceMapSig: string; // «кто где стоит»: для детекта появления/ухода + procedure PushChannelMap; // каналы приёмников появились/исчезли + function SnapSlice(Rx, Ch: Integer; out V: TSliceView): Boolean; + function SliceIdOf(Rx, Ch: Integer): Integer; // из снимка + function SliceIdLive(Rx, Ch: Integer): Integer; // из живой таблицы (Sync*) + function RxSlice(Rx: Integer; out S: TSliceView): Boolean; function SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean; + { Захват параметра (§3.5). True — параметр наш (свободен, наш или отпущен + по таймауту), захват продлевается. False — им сейчас управляет другой. } + function Claim(const Key: string; Owner: TTCIClient): Boolean; + function HoldKey(const Name: string; Rx, Ch: Integer): string; + procedure DropHolds(Owner: TTCIClient); function ChanFreq(Rx, Ch: Integer): Double; function ChanCount(Rx: Integer): Integer; function RxCenterHz(Rx: Integer): Double; @@ -173,6 +240,7 @@ type procedure HandleCommand(Client: TTCIClient; const Cmd: string); procedure DispatchCommand(Client: TTCIClient; const M: TTCIMessage); procedure HandleConnect(Client: TTCIClient); + procedure HandleDisconnect(Client: TTCIClient); procedure HandleTick; procedure PushSensors(Client: TTCIClient); procedure OnState(Sender: TObject; Field: TRadioField); @@ -228,13 +296,28 @@ begin FEcho[i].NBDuration := 25; for c := 0 to TCI_CHANNELS - 1 do FEcho[i].BalanceDb[c] := 0; end; + FLastLimLo := 0; + FLastLimHi := 0; FLastTxFreq := 0; FLastTxEnable := True; + FAppFocus := True; + FDevLock := TCriticalSection.Create; + FSliceLock := TCriticalSection.Create; + FillChar(FSliceSnap, SizeOf(FSliceSnap), 0); + FHoldLock := TCriticalSection.Create; + FHoldCount := 0; FServer := TTCIServer.Create; - FServer.OnCommand := HandleCommand; - FServer.OnConnect := HandleConnect; - FServer.OnTick := HandleTick; + FServer.OnCommand := HandleCommand; + FServer.OnConnect := HandleConnect; + FServer.OnDisconnect := HandleDisconnect; + FServer.OnTick := HandleTick; + + RefreshDev; + // Первый снимок — прямо здесь: конструктор идёт в потоке контроллера, а + // слайсы могли быть восстановлены ещё до появления адаптера (события об их + // создании мы уже не увидим). + RefreshSlices; // Многоадресная подписка: OnStateChanged занят MainForm. FController.AddStateListener(OnState); @@ -252,17 +335,45 @@ begin end; FLock.Free; FEchoLock.Free; + FDevLock.Free; + FSliceLock.Free; + FHoldLock.Free; inherited; end; function TTCIAdapter.ApplySettings(const T: TTCISettings): Boolean; +// Порядок важен: сначала проверяем новую конфигурацию, и только потом гасим +// работающий сервер. Иначе опечатка в адресе или занятый порт оставляли +// оператора вообще без TCI — старый слушатель уже закрыт, новый не открылся. +// Не удалось поднять новый — возвращаемся на прежний. +var + NewPort, OldPort: Word; begin - FServer.Stop; - if not T.Enabled then Exit(True); + RefreshDev; // зовут из потока контроллера — заодно освежаем снимки + RefreshSlices; + NewPort := Word(EnsureRange(T.Port, 1, 65535)); // Адрес разбирается ДО открытия сокета: невалидный означает отказ, а не // «слушаем все интерфейсы» — авторизации в TCI нет (см. TCIParseIPv4). - Result := FServer.Configure(Word(EnsureRange(T.Port, 1, 65535)), T.BindAddr) - and FServer.Start; + if T.Enabled and not TTCIServer.ValidSettings(NewPort, T.BindAddr) then + Exit(False); + + OldPort := FServer.Port; + FServer.Stop; + if not T.Enabled then + begin + FCfg := T; + Exit(True); + end; + + Result := FServer.Configure(NewPort, T.BindAddr) and FServer.Start; + if Result then + begin + FCfg := T; + Exit; + end; + // Порт занят (или отобран правами) — поднимаем то, что работало. + if FCfg.Enabled and TTCIServer.ValidSettings(OldPort, FCfg.BindAddr) then + if FServer.Configure(OldPort, FCfg.BindAddr) then FServer.Start; end; function TTCIAdapter.CanInvoke: Boolean; @@ -290,7 +401,7 @@ end; function TTCIAdapter.RxCount: Integer; begin - Result := FController.BackendCaps.MaxPans; + Result := DevSnap.MaxPans; if Result < 1 then Result := 1; if Result > TCI_MAX_RX then Result := TCI_MAX_RX; end; @@ -300,69 +411,334 @@ begin Result := (Rx >= 0) and (Rx < RxCount); end; -function TTCIAdapter.SliceIdOf(Rx, Ch: Integer): Integer; -// Слайсы пана Rx по порядку в таблице: 0-й = канал A, 1-й = канал B. -var i, Seen: Integer; +function TTCIAdapter.RxActive(Rx: Integer): Boolean; +// Приёмник существует физически. TRX_COUNT в протоколе объявляется один раз и +// равен потолку железа, но пан из этого потолка может быть ещё не создан — +// врать про его частоту нельзя (см. SendState). begin - Result := 0; - if Rx <= 0 then Exit; - Seen := 0; - for i := 0 to MAX_SLICES - 1 do - if FController.FSlices[i].Active and (FController.FSlices[i].PanId = Rx) then - begin - if Seen = Ch then - begin - Result := FController.FSlices[i].Id; - Exit; - end; - Inc(Seen); - end; + if Rx = 0 then Result := True + else Result := ValidRx(Rx) and FController.PanDDCActive(Rx); end; -function TTCIAdapter.RxSlice(Rx: Integer; out S: TCtrlSlice): Boolean; -// Слайс, представляющий приёмник Rx как целое (канал A). Для Rx=0 слайса нет: -// главный тракт живёт в полях контроллера. -var Id: Integer; +procedure TTCIAdapter.CalcFreqLimits(out LoHz, HiHz: Double); +// Живые границы настройки. Только поток контроллера: VisibleFreqBounds смотрит +// в Caps бэкенда. XVTR → диапазон слота; устройства нет — тот же запасной +// диапазон, что уходит в VFO_LIMITS. «Нет устройства = можно всё» недопустимо: +// SetCenter/SetPanDDCFreq ничего не клампят и отдадут число прямо в backend. +begin + FController.VisibleFreqBounds(LoHz, HiHz); + if (not FController.FDevConnected) or (HiHz <= LoHz) then + begin + LoHz := 10000; + HiHz := 30000000; + end; + if LoHz < 1 then LoHz := 1; // нулевой частоты не бывает ни у кого +end; + +function TTCIAdapter.FreqSaneLive(Hz: Double): Boolean; +// Та же проверка, что FreqSane, но по ЖИВЫМ границам и в потоке контроллера. +// Нужна отдельно: команду разбирает поток клиента, а исполняется она позже — +// за это время оператор успевает сменить устройство (Pluto → HPSDR), и снимок, +// по которому частоту пропустили, уже не описывает то радио, куда она уедет. +var LoHz, HiHz: Double; begin Result := False; - FillChar(S, SizeOf(S), 0); - if Rx <= 0 then Exit; - Id := SliceIdOf(Rx, 0); - if Id <= 0 then Exit; - Result := FController.GetSlice(Id, S); + if IsNan(Hz) or IsInfinite(Hz) or (Hz <= 0) then Exit; + CalcFreqLimits(LoHz, HiHz); + Result := (Hz >= LoHz) and (Hz <= HiHz); +end; + +procedure TTCIAdapter.RefreshDev; +// Снимок железа. Только поток контроллера: здесь дёргаются BackendCaps и +// BoardDisplayName, а они смотрят в FNetwork, который UI освобождает на смене +// устройства. Сетевые потоки читают уже готовую копию (DevSnap). +var + D: TTCIDevSnap; + Caps: TBackendCaps; +begin + Caps := FController.BackendCaps; + D.DevName := FController.BoardDisplayName; + D.MaxPans := Caps.MaxPans; + D.HasTX := Caps.HasTX; + D.SampleRate := FController.FSampleRate; + CalcFreqLimits(D.LimLoHz, D.LimHiHz); + + FDevLock.Enter; + try + FDevSnap := D; // строка присваивается ТОЛЬКО здесь и только под локом + finally + FDevLock.Leave; + end; +end; + +function TTCIAdapter.DevSnap: TTCIDevSnap; +begin + FDevLock.Enter; + try Result := FDevSnap; finally FDevLock.Leave; end; +end; + +procedure TTCIAdapter.FreqLimits(out LoHz, HiHz: Double); +// ЕДИНСТВЕННЫЙ источник границ настройки: и для VFO_LIMITS в пачке +// инициализации, и для проверки частоты в командах. Раньше их было два, и они +// расходились: клиенту объявлялись пределы АЦП, а команда под трансвертером +// принимала вообще любое число. +var D: TTCIDevSnap; +begin + D := DevSnap; + LoHz := D.LimLoHz; + HiHz := D.LimHiHz; +end; + +procedure TTCIAdapter.PushVfoLimits; +// Границы настройки не вечны: подключилось устройство, включился или выключился +// трансвертер — и объявленные при подключении VFO_LIMITS начинают врать. Клиент +// узнаёт об этом только от нас: перезапросить их в протоколе нечем. +// Дедуп — по последнему известному значению: rfDevice приходит и на создание +// слайса, и на обновление списка устройств. +// ВАЖНО: кэш ведём всегда, даже когда клиентов нет. Иначе так: клиент видел +// пределы устройства → все отключились → радио отвалилось (кэш бы не заметил) +// → новый клиент получил запасные 10 кГц…30 МГц → радио вернулось → новые +// пределы совпали с давним кэшем, рассылка подавилась, и клиент навсегда остался +// с запасными. +var Lo, Hi: Double; +begin + FreqLimits(Lo, Hi); + if (Lo = FLastLimLo) and (Hi = FLastLimHi) then Exit; + FLastLimLo := Lo; + FLastLimHi := Hi; + if (FServer = nil) or (FServer.ClientCount = 0) then Exit; + FServer.Broadcast(TCIBuild('vfo_limits', + [TCIIntStr(Round(Lo)), TCIIntStr(Round(Hi))])); +end; + +function TTCIAdapter.FreqSane(Hz: Double): Boolean; +// Годится ли частота к установке. Отрицательная и нулевая — точно нет: именно +// такие получались из неразобранных аргументов. +var LoHz, HiHz: Double; +begin + Result := False; + if IsNan(Hz) or IsInfinite(Hz) or (Hz <= 0) then Exit; + FreqLimits(LoHz, HiHz); + Result := (Hz >= LoHz) and (Hz <= HiHz); +end; + +procedure TTCIAdapter.RefreshSlices; +// Снимок таблицы слайсов. Зовётся ТОЛЬКО в потоке контроллера (OnState и +// Invoke при подключении клиента) — там писателей нет, и снимок каждой записи +// получается согласованным. Сетевые потоки читают уже его: прямое чтение +// FSlices из них давало смесь старых и новых полей одного слайса (частота +// новая, мода ещё старая), даже когда managed-строк это не касалось. +var + i, Id: Integer; + Tmp: array[0..MAX_SLICES-1] of TTCISliceSnap; + V: TSliceView; +begin + for i := 0 to MAX_SLICES - 1 do + begin + Tmp[i].Used := False; + FillChar(Tmp[i].V, SizeOf(Tmp[i].V), 0); + Id := FController.SliceIdBySlot(i); // порядок слотов = порядок каналов + if (Id > 0) and FController.GetSliceView(Id, V) then + begin + Tmp[i].Used := True; + Tmp[i].V := V; + end; + end; + FSliceLock.Enter; + try + for i := 0 to MAX_SLICES - 1 do FSliceSnap[i] := Tmp[i]; + finally + FSliceLock.Leave; + end; +end; + +function TTCIAdapter.SliceMapSig: string; +// Слепок расстановки: id и пан каждого слайса по порядку слотов. Меняется и +// когда слайс создали или удалили, и когда из-за удаления первого второй стал +// каналом A. +var i: Integer; +begin + Result := ''; + FSliceLock.Enter; + try + for i := 0 to MAX_SLICES - 1 do + if FSliceSnap[i].Used then + Result := Result + IntToStr(FSliceSnap[i].V.Id) + ':' + + IntToStr(FSliceSnap[i].V.PanId) + ';'; + finally + FSliceLock.Leave; + end; +end; + +procedure TTCIAdapter.PushChannelMap; +// Каналы доп. приёмников появились, исчезли или перенумеровались. Об исчезнувшем +// канале протокол сказать почти ничего не даёт: команды «приёмника больше нет» в +// TCI 2.0 нет вовсе, а про канал B есть только RX_CHANNEL_ENABLE. Поэтому шлём +// полную картину каждого живого приёмника — клиент перезаливает её целиком. +var Rx, Ch, N: Integer; +begin + if (FServer = nil) or (FServer.ClientCount = 0) then Exit; + for Rx := 1 to RxCount - 1 do + begin + if not RxActive(Rx) then Continue; + N := ChanCount(Rx); + for Ch := 0 to N - 1 do BroadcastRxState(Rx, Ch); + FServer.Broadcast(TCIBuild('rx_channel_enable', + [TCIIntStr(Rx), '1', TCIBoolStr(N > 1)])); + end; +end; + +function TTCIAdapter.SnapSlice(Rx, Ch: Integer; out V: TSliceView): Boolean; +// Слайс канала Ch приёмника Rx из снимка. Для Rx=0 слайса нет: главный тракт +// живёт в полях контроллера. +var i, Seen: Integer; +begin + Result := False; + FillChar(V, SizeOf(V), 0); + if (Rx <= 0) or (Ch < 0) then Exit; + Seen := 0; + FSliceLock.Enter; + try + for i := 0 to MAX_SLICES - 1 do + if FSliceSnap[i].Used and (FSliceSnap[i].V.PanId = Rx) then + begin + if Seen = Ch then + begin + V := FSliceSnap[i].V; + Exit(True); + end; + Inc(Seen); + end; + finally + FSliceLock.Leave; + end; +end; + +function TTCIAdapter.SliceIdOf(Rx, Ch: Integer): Integer; +// Слайсы пана Rx по порядку в таблице: 0-й = канал A, 1-й = канал B. +var V: TSliceView; +begin + if SnapSlice(Rx, Ch, V) then Result := V.Id else Result := 0; +end; + +function TTCIAdapter.SliceIdLive(Rx, Ch: Integer): Integer; +// То же, но из живой таблицы. Только для Sync-методов: они идут в потоке +// контроллера, где чтение безопасно, а снимок мог бы отстать на такт — команда +// на установку обязана попасть в тот слайс, который есть сейчас. +begin + if Rx <= 0 then Result := 0 + else Result := FController.PanSliceId(Rx, Ch); +end; + +function TTCIAdapter.RxSlice(Rx: Integer; out S: TSliceView): Boolean; +// Слайс, представляющий приёмник Rx как целое (канал A). +begin + Result := SnapSlice(Rx, 0, S); end; function TTCIAdapter.SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean; // Обратное отображение слайс → (приёмник, канал). Нужно уведомлениям: контроллер // сообщает об изменении Id, а клиенту адресуются номера TCI. -var i, Seen: Integer; Pan: Integer; +var i, Seen, Pan: Integer; begin Result := False; Rx := 0; Ch := 0; if Id <= 0 then Exit; Pan := -1; - for i := 0 to MAX_SLICES - 1 do - if FController.FSlices[i].Active and (FController.FSlices[i].Id = Id) then - begin - Pan := FController.FSlices[i].PanId; - Break; - end; - // Пан 0 в модели TCI — это VFO A/B главного приёмника, а не его слайсы: - // слайсу на главном пане в протоколе места нет. - if (Pan <= 0) or not ValidRx(Pan) then Exit; - - Seen := 0; - for i := 0 to MAX_SLICES - 1 do - if FController.FSlices[i].Active and (FController.FSlices[i].PanId = Pan) then - begin - if FController.FSlices[i].Id = Id then + FSliceLock.Enter; + try + for i := 0 to MAX_SLICES - 1 do + if FSliceSnap[i].Used and (FSliceSnap[i].V.Id = Id) then begin - Rx := Pan; - Ch := Seen; - Exit(Seen < TCI_CHANNELS); + Pan := FSliceSnap[i].V.PanId; + Break; end; - Inc(Seen); + // Пан 0 в модели TCI — это VFO A/B главного приёмника, а не его слайсы: + // слайсу на главном пане в протоколе места нет. + if (Pan <= 0) or not ValidRx(Pan) then Exit; + Seen := 0; + for i := 0 to MAX_SLICES - 1 do + if FSliceSnap[i].Used and (FSliceSnap[i].V.PanId = Pan) then + begin + if FSliceSnap[i].V.Id = Id then + begin + Rx := Pan; + Ch := Seen; + Exit(Seen < TCI_CHANNELS); + end; + Inc(Seen); + end; + finally + FSliceLock.Leave; + end; +end; + +function TTCIAdapter.HoldKey(const Name: string; Rx, Ch: Integer): string; +// Ключ захвата: параметр + адресат. VFO и IF — одно и то же значение с разных +// сторон, поэтому у них общее имя. +begin + Result := Name + '/' + IntToStr(Rx) + '/' + IntToStr(Ch); +end; + +function TTCIAdapter.Claim(const Key: string; Owner: TTCIClient): Boolean; +// §3.5: захвативший параметр держит его 200 мс после последнего изменения. +// Owner = nil — изменение от оператора/CAT: оно тоже захватывает параметр, но +// НЕ отбирает его у клиента, который прямо сейчас им управляет. +var + i, Free_: Integer; + Now_: QWord; +begin + Now_ := GetTickCount64; + FHoldLock.Enter; + try + Free_ := -1; + for i := 0 to FHoldCount - 1 do + begin + if FHolds[i].Key = Key then + begin + if (FHolds[i].Owner <> Owner) and (Now_ - FHolds[i].At < TCI_HOLD_MS) then + Exit(False); + FHolds[i].Owner := Owner; + FHolds[i].At := Now_; + Exit(True); + end; + // Заодно подбираем протухшую запись под переиспользование. + if (Free_ < 0) and (Now_ - FHolds[i].At >= TCI_HOLD_MS) then Free_ := i; end; + if Free_ < 0 then + begin + if FHoldCount >= TCI_HOLD_SLOTS then Exit(True); // мест нет — не мешаем + Free_ := FHoldCount; + Inc(FHoldCount); + end; + FHolds[Free_].Key := Key; + FHolds[Free_].Owner := Owner; + FHolds[Free_].At := Now_; + Result := True; + finally + FHoldLock.Leave; + end; +end; + +procedure TTCIAdapter.DropHolds(Owner: TTCIClient); +// Клиент отключился: его захваты снимаем сразу. Указатели мы только сравниваем +// (разыменовывать нечего), но освободившийся адрес мог бы достаться новому +// клиенту — и тот получил бы чужие захваты в наследство. +var i: Integer; +begin + if Owner = nil then Exit; + FHoldLock.Enter; + try + for i := 0 to FHoldCount - 1 do + if FHolds[i].Owner = Owner then + begin + FHolds[i].Key := ''; + FHolds[i].Owner := nil; + FHolds[i].At := 0; + end; + finally + FHoldLock.Leave; + end; end; function TTCIAdapter.ChanCount(Rx: Integer): Integer; @@ -370,14 +746,22 @@ var i: Integer; begin if Rx = 0 then begin Result := 2; Exit; end; // VFO A/B всегда есть Result := 0; - for i := 0 to MAX_SLICES - 1 do - if FController.FSlices[i].Active and (FController.FSlices[i].PanId = Rx) then - Inc(Result); + FSliceLock.Enter; + try + for i := 0 to MAX_SLICES - 1 do + if FSliceSnap[i].Used and (FSliceSnap[i].V.PanId = Rx) then Inc(Result); + finally + FSliceLock.Leave; + end; if Result > TCI_CHANNELS then Result := TCI_CHANNELS; + // Канал A в TCI выключить нечем: он есть у приёмника всегда. Пока пан жив, но + // слайсов на нём не осталось, показываем канал A на центре пана — иначе после + // удаления последнего слайса клиент навсегда остался бы с его частотой. + if (Result = 0) and RxActive(Rx) then Result := 1; end; function TTCIAdapter.ChanFreq(Rx, Ch: Integer): Double; -var S: TCtrlSlice; Id: Integer; +var S: TSliceView; begin Result := 0; if Rx = 0 then @@ -385,8 +769,9 @@ begin if Ch = 1 then Result := FController.FVfoB else Result := FController.FVfoA; Exit; end; - Id := SliceIdOf(Rx, Ch); - if (Id > 0) and FController.GetSlice(Id, S) then Result := S.TargetHz; + if SnapSlice(Rx, Ch, S) then Exit(S.TargetHz); + // Слайса нет: у живого пана канал A стоит на его центре (см. ChanCount). + if (Ch = 0) and RxActive(Rx) then Result := RxCenterHz(Rx); end; function TTCIAdapter.RxCenterHz(Rx: Integer): Double; @@ -396,22 +781,20 @@ begin end; function TTCIAdapter.RxMode(Rx: Integer): Integer; -var S: TCtrlSlice; Id: Integer; +var S: TSliceView; begin - if Rx = 0 then begin Result := FController.FMode; Exit; end; Result := FController.FMode; - Id := SliceIdOf(Rx, 0); - if (Id > 0) and FController.GetSlice(Id, S) then Result := S.Mode; + if Rx = 0 then Exit; + if SnapSlice(Rx, 0, S) then Result := S.Mode; end; procedure TTCIAdapter.RxFilter(Rx: Integer; out Lo, Hi: Integer); -var S: TCtrlSlice; Id: Integer; +var S: TSliceView; begin Lo := FController.FilterLo; Hi := FController.FilterHi; if Rx = 0 then Exit; - Id := SliceIdOf(Rx, 0); - if (Id > 0) and FController.GetSlice(Id, S) then + if SnapSlice(Rx, 0, S) then begin Lo := S.FilterLo; Hi := S.FilterHi; @@ -419,68 +802,62 @@ begin end; function TTCIAdapter.RxMuted(Rx: Integer): Boolean; -var S: TCtrlSlice; Id: Integer; +var S: TSliceView; begin if Rx = 0 then begin Result := FController.FMuted; Exit; end; - Result := False; - Id := SliceIdOf(Rx, 0); - if (Id > 0) and FController.GetSlice(Id, S) then Result := S.Muted; + Result := SnapSlice(Rx, 0, S) and S.Muted; end; function TTCIAdapter.RxVolumeDb(Rx, Ch: Integer): Double; // Громкость в TCI — величина канальная: у доп. пана второй слайс звучит своей. -var S: TCtrlSlice; Id: Integer; +var S: TSliceView; begin if Rx = 0 then begin Result := TCIVolumeToDb(FController.FVolume); Exit; end; Result := TCI_VOL_MIN_DB; - Id := SliceIdOf(Rx, Ch); - if (Id > 0) and FController.GetSlice(Id, S) then - Result := TCIVolumeToDb(Round(S.Volume * 100)); + if SnapSlice(Rx, Ch, S) then Result := TCIVolumeToDb(Round(S.Volume * 100)); end; function TTCIAdapter.RxAGCUi(Rx: Integer): Integer; -var S: TCtrlSlice; Id: Integer; +var S: TSliceView; begin - if Rx = 0 then begin Result := FController.FAGCMode; Exit; end; Result := FController.FAGCMode; - Id := SliceIdOf(Rx, 0); - if (Id > 0) and FController.GetSlice(Id, S) then - Result := TRadioController.AGCModeToUI(S.AGC); + if Rx = 0 then Exit; + if SnapSlice(Rx, 0, S) then Result := TRadioController.AGCModeToUI(S.AGC); end; // DSP и шумоподавитель: у доп. приёмника своё состояние (зеркало в TCtrlSlice). // Читать тут глобальные поля главного тракта нельзя — клиент увидел бы чужие // переключатели и, что хуже, записал бы их обратно. function TTCIAdapter.RxNROn(Rx: Integer): Boolean; -var S: TCtrlSlice; +var S: TSliceView; begin if Rx = 0 then Result := FController.FNRMode > 0 else Result := RxSlice(Rx, S) and (S.NRMode > 0); end; function TTCIAdapter.RxNBOn(Rx: Integer): Boolean; -var S: TCtrlSlice; +var S: TSliceView; begin if Rx = 0 then Result := FController.FNBMode > 0 else Result := RxSlice(Rx, S) and (S.NBMode > 0); end; function TTCIAdapter.RxANFOn(Rx: Integer): Boolean; -var S: TCtrlSlice; +var S: TSliceView; begin if Rx = 0 then Result := FController.FANF else Result := RxSlice(Rx, S) and S.ANF; end; function TTCIAdapter.RxSqlOn(Rx: Integer): Boolean; -var S: TCtrlSlice; +var S: TSliceView; begin if Rx = 0 then Result := FController.FFMSQOn else Result := RxSlice(Rx, S) and S.FMSQOn; end; function TTCIAdapter.RxSqlLevel(Rx: Integer): Integer; -var S: TCtrlSlice; +var S: TSliceView; begin if Rx = 0 then begin Result := FController.FFMSQLevel; Exit; end; if RxSlice(Rx, S) then Result := S.FMSQLevel else Result := 0; @@ -501,7 +878,7 @@ end; function TTCIAdapter.TxEnabled: Boolean; begin - Result := FController.BackendCaps.HasTX and (not FController.TXProhibited); + Result := DevSnap.HasTX and (not FController.TXProhibited); end; { ═══════════════════════════════════════════════════════════════════════════ @@ -652,30 +1029,30 @@ begin end; procedure TTCIAdapter.SendInit(Client: TTCIClient); +// Исполняется в потоке клиента, поэтому всё «железное» берётся из снимка +// (DevSnap), а не из контроллера: BackendCaps и BoardDisplayName смотрят в +// FNetwork, который UI освобождает на смене устройства. var - Caps: TBackendCaps; - LoHz, HiHz: Double; + D: TTCIDevSnap; Half: Integer; DevName: string; begin - Caps := FController.BackendCaps; + D := DevSnap; - LoHz := Caps.MinFreqHz; - HiHz := Caps.MaxFreqHz; - if HiHz <= LoHz then begin LoHz := 10000; HiHz := 30000000; end; // не подключены - - Half := FController.FSampleRate div 2; + Half := D.SampleRate div 2; if Half <= 0 then Half := 48000; - DevName := FController.BoardDisplayName; - if Trim(DevName) = '' then DevName := TCI_APP_NAME; + DevName := Trim(D.DevName); + if DevName = '' then DevName := TCI_APP_NAME; Reply(Client, TCIBuild('protocol', [TCI_APP_NAME, TCI_VERSION])); Reply(Client, TCIBuild('device', [DevName])); - Reply(Client, TCIBuild('receive_only', [TCIBoolStr(not Caps.HasTX)])); + Reply(Client, TCIBuild('receive_only', [TCIBoolStr(not D.HasTX)])); Reply(Client, TCIBuild('trx_count', [TCIIntStr(RxCount)])); Reply(Client, TCIBuild('channel_count', [TCIIntStr(TCI_CHANNELS)])); - Reply(Client, TCIBuild('vfo_limits', [TCIIntStr(Round(LoHz)), TCIIntStr(Round(HiHz))])); + // Границы — из того же снимка, что и проверка частоты в командах (§2.1). + Reply(Client, TCIBuild('vfo_limits', + [TCIIntStr(Round(D.LimLoHz)), TCIIntStr(Round(D.LimHiHz))])); Reply(Client, TCIBuild('if_limits', [TCIIntStr(-Half), TCIIntStr(Half)])); Reply(Client, TCIBuild('modulations_list', [TCI_MODULATIONS])); end; @@ -687,14 +1064,20 @@ var begin for Rx := 0 to RxCount - 1 do begin + // Приёмника ещё нет (пан не создан): TRX_COUNT объявляет потолок железа, а + // не число живых панов, и раньше на такой номер уходили dds/vfo/if с нулём + // — клиент принимал ноль за настоящую частоту. Молчим до появления пана: + // он придёт с rfPanFreq/rfSliceState. + if not RxActive(Rx) then Continue; + FEchoLock.Enter; try E := FEcho[Rx]; finally FEchoLock.Leave; end; Reply(Client, StrDds(Rx)); // Только реально существующие каналы: объявив пану второй канал, которого // нет, мы отдали бы клиенту vfo:rx,1,0 — и он принял бы ноль за частоту. + // У пана без слайсов каналов нет вовсе — тогда только dds. Chans := ChanCount(Rx); - if Chans < 1 then Chans := 1; for Ch := 0 to Chans - 1 do begin Reply(Client, StrVfo(Rx, Ch)); @@ -702,6 +1085,10 @@ begin Reply(Client, StrRxVolume(Rx, Ch)); Reply(Client, TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch), TCIIntStr(E.BalanceDb[Ch])])); + // VFO_LOCK — уведомление поканальное (§4.5): без него клиент, вошедший + // на запертой ручке, о запрете не знает. + Reply(Client, TCIBuild('vfo_lock', [TCIIntStr(Rx), TCIIntStr(Ch), + TCIBoolStr(FController.FVfoLock)])); end; Reply(Client, TCIBuild('rx_channel_enable', [TCIIntStr(Rx), '1', TCIBoolStr(Chans > 1)])); @@ -750,11 +1137,21 @@ begin end; Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)])); Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)])); + // Частота передачи и фокус окна — состояние, а не только событие: на + // стабильном радио TX_FREQUENCY не придёт ещё очень долго (уведомление шлётся + // по изменению), а логгеру она нужна сразу — особенно в split и на TX-слайсе. + Reply(Client, TCIBuild('tx_frequency', + [TCIIntStr(Round(FController.ActiveTXFreqHz))])); + Reply(Client, TCIBuild('app_focus', [TCIBoolStr(FAppFocus)])); if FController.FRunning then Reply(Client, TCIBuild('start')) else Reply(Client, TCIBuild('stop')); end; procedure TTCIAdapter.HandleConnect(Client: TTCIClient); +// Зовётся сервером под FClientLock: рассылка ждёт, пока пачка не уложена в +// очередь целиком, поэтому изменение, случившееся посреди дампа, приходит +// ПОСЛЕ него, а не теряется. Отсюда запрет: никаких Invoke в поток контроллера +// — он сам может стоять на этом локе внутри Broadcast. begin // Не отдать READY молча нельзя: клиент, ждущий его, повиснет навсегда, — // поэтому дамп состояния под защитой, а READY уходит в любом случае. @@ -769,6 +1166,13 @@ begin Client.Ready := True; end; +procedure TTCIAdapter.HandleDisconnect(Client: TTCIClient); +// Клиент ушёл — снимаем его захваты параметров, иначе следующий, кому достанется +// тот же адрес объекта, унаследовал бы чужие права (§3.5). +begin + DropHolds(Client); +end; + { ═══════════════════════════════════════════════════════════════════════════ Sync-методы: исполняются в потоке контроллера (через Invoke) ═══════════════════════════════════════════════════════════════════════════ } @@ -776,23 +1180,28 @@ end; procedure TTCIAdapter.SyncSetVfo; var Id: Integer; begin + // Окончательная проверка — здесь: см. FreqSaneLive. + if not FreqSaneLive(FsFreq) then Exit; if FsInt = 0 then begin if FsInt2 = 1 then FController.SetVfoB(FsFreq) else FController.SetVfoA(FsFreq); Exit; end; - Id := SliceIdOf(FsInt, FsInt2); - if Id > 0 then - begin - FController.SetSliceTarget(Id, FsFreq); - // Уведомление контроллера: без него о перестройке слайса не узнают ни UI - // (флаг остался бы со старыми цифрами), ни остальные клиенты TCI. - FController.SliceFreqChanged(Id); - end; + Id := SliceIdLive(FsInt, FsInt2); + // Тот же путь, что у CAT-порта слайса: внутри включённого диапазона слайс + // ходит свободно, за захваченную полосу окно DDC переедет само, за границы + // диапазона команда отбрасывается. Прямой SetSliceTarget (как было) уводил + // слайс куда угодно, а для TX-слайса эта частота идёт прямо в DUC — то есть + // в эфир на чужом диапазоне, без переключения антенн и фильтров. + // SliceFreqChanged шлёт сам SetSliceTarget — и для нас, и для UI, и для CAT. + if Id > 0 then FController.TuneSliceInBand(Id, FsFreq); end; procedure TTCIAdapter.SyncSetCenter; begin + // Окончательная проверка — здесь: см. FreqSaneLive. Ни SetCenter, ни + // SetPanDDCFreq границ не клампят, число уходит прямо в backend. + if not FreqSaneLive(FsFreq) then Exit; if FsInt = 0 then FController.SetCenter(FsFreq) else FController.SetPanDDCFreq(FsInt, FsFreq); end; @@ -801,7 +1210,7 @@ procedure TTCIAdapter.SyncSetMode; var Id: Integer; begin if FsInt = 0 then begin FController.SetMode(FsInt2); Exit; end; - Id := SliceIdOf(FsInt, 0); + Id := SliceIdLive(FsInt, 0); if Id > 0 then FController.SetSliceMode(Id, FsInt2); end; @@ -809,7 +1218,7 @@ procedure TTCIAdapter.SyncSetFilter; var Id: Integer; begin if FsInt = 0 then begin FController.SetFilterEdges(FsInt2, FsInt3); Exit; end; - Id := SliceIdOf(FsInt, 0); + Id := SliceIdLive(FsInt, 0); if Id > 0 then FController.SetSliceFilter(Id, FsInt2, FsInt3); end; @@ -842,8 +1251,11 @@ begin end; procedure TTCIAdapter.SyncSetVolume; +// Адресно: SetVolume правит АКТИВНУЮ громкость, и на передаче с самоконтролем +// команда VOLUME уехала бы в громкость монитора, а в ответ клиент получал бы +// нетронутый FVolume. У TCI это разные команды — VOLUME и MON_VOLUME. begin - FController.SetVolume(FsInt); + FController.SetRxVolume(FsInt); end; procedure TTCIAdapter.SyncSetMute; @@ -855,15 +1267,16 @@ procedure TTCIAdapter.SyncSetRxMute; var Id: Integer; begin if FsInt = 0 then begin FController.SetMute(FsBool); Exit; end; - Id := SliceIdOf(FsInt, 0); + Id := SliceIdLive(FsInt, 0); if Id > 0 then FController.SetSliceMute(Id, FsBool); end; procedure TTCIAdapter.SyncSetRxVolume; var Id: Integer; begin - if FsInt = 0 then begin FController.SetVolume(FsInt2); Exit; end; - Id := SliceIdOf(FsInt, FsInt3); // FsInt3 — канал: у слайсов громкость своя + // Тоже адресно (см. SyncSetVolume): RX_VOLUME — про приём, не про монитор. + if FsInt = 0 then begin FController.SetRxVolume(FsInt2); Exit; end; + Id := SliceIdLive(FsInt, FsInt3); // FsInt3 — канал: у слайсов громкость своя if Id > 0 then FController.SetSliceVolume(Id, FsInt2 / 100.0); end; @@ -882,7 +1295,7 @@ procedure TTCIAdapter.SyncSetAGCMode; var Id: Integer; begin if FsInt = 0 then begin FController.SetAGCMode(FsInt2); Exit; end; - Id := SliceIdOf(FsInt, 0); + Id := SliceIdLive(FsInt, 0); if Id > 0 then FController.SetSliceAGCMode(Id, TRadioController.AGCModeFromUI(FsInt2)); end; @@ -897,37 +1310,37 @@ end; // значило бы: включил клиент NR на доп. приёмнике — и заодно переписал ему NB, // SNB и ANF значениями главного. procedure TTCIAdapter.SyncSetNR; -var Id: Integer; S: TCtrlSlice; +var Id: Integer; S: TSliceView; begin if FsInt = 0 then begin if FsBool then FController.SetNR(1) else FController.SetNR(0); Exit; end; - Id := SliceIdOf(FsInt, 0); - if (Id > 0) and FController.GetSlice(Id, S) then + Id := SliceIdLive(FsInt, 0); + if (Id > 0) and FController.GetSliceView(Id, S) then FController.SetSliceDSP(Id, Ord(FsBool), S.NBMode, S.SNB, S.ANF); end; procedure TTCIAdapter.SyncSetNB; -var Id: Integer; S: TCtrlSlice; +var Id: Integer; S: TSliceView; begin if FsInt = 0 then begin if FsBool then FController.SetNB(1) else FController.SetNB(0); Exit; end; - Id := SliceIdOf(FsInt, 0); - if (Id > 0) and FController.GetSlice(Id, S) then + Id := SliceIdLive(FsInt, 0); + if (Id > 0) and FController.GetSliceView(Id, S) then FController.SetSliceDSP(Id, S.NRMode, Ord(FsBool), S.SNB, S.ANF); end; procedure TTCIAdapter.SyncSetANF; -var Id: Integer; S: TCtrlSlice; +var Id: Integer; S: TSliceView; begin if FsInt = 0 then begin FController.SetANF(FsBool); Exit; end; - Id := SliceIdOf(FsInt, 0); - if (Id > 0) and FController.GetSlice(Id, S) then + Id := SliceIdLive(FsInt, 0); + if (Id > 0) and FController.GetSliceView(Id, S) then FController.SetSliceDSP(Id, S.NRMode, S.NBMode, S.SNB, FsBool); end; @@ -939,20 +1352,20 @@ end; // Squelch слайса — тоже парный сеттер: второй параметр берём из слайса, а не // из главного тракта (иначе правка порога сбрасывала бы включение, и наоборот). procedure TTCIAdapter.SyncSetSql; -var Id: Integer; S: TCtrlSlice; +var Id: Integer; S: TSliceView; begin if FsInt = 0 then begin FController.SetFMSquelch(FsBool); Exit; end; - Id := SliceIdOf(FsInt, 0); - if (Id > 0) and FController.GetSlice(Id, S) then + Id := SliceIdLive(FsInt, 0); + if (Id > 0) and FController.GetSliceView(Id, S) then FController.SetSliceFMSquelch(Id, FsBool, S.FMSQLevel); end; procedure TTCIAdapter.SyncSetSqlLevel; -var Id: Integer; S: TCtrlSlice; +var Id: Integer; S: TSliceView; begin if FsInt = 0 then begin FController.SetFMSquelchLevel(FsInt2); Exit; end; - Id := SliceIdOf(FsInt, 0); - if (Id > 0) and FController.GetSlice(Id, S) then + Id := SliceIdLive(FsInt, 0); + if (Id > 0) and FController.GetSliceView(Id, S) then FController.SetSliceFMSquelch(Id, S.FMSQOn, FsInt2); end; @@ -1004,21 +1417,25 @@ var Rx, Ch: Integer; Hz: Double; begin - Rx := TCIArgInt(M, 0, -1); - Ch := TCIArgInt(M, 1, 0); + if not TCITryArgInt(M, 0, Rx) then Exit; + if not TCITryArgInt(M, 1, Ch) then Ch := 0; if not ValidRx(Rx) then Exit; if (Ch < 0) or (Ch >= TCI_CHANNELS) then Exit; - if M.ArgCount >= 3 then + // Частота ставится, только если её удалось разобрать И она годная: «vfo:0,0,abc» + // раньше превращалось в честный ноль и уводило приёмник на 0 Гц. + if (M.ArgCount >= 3) and TCITryArgFloat(M, 2, Hz) then begin - Hz := TCIArgFloat(M, 2, 0); if IsIF then Hz := RxCenterHz(Rx) + Hz; - FLock.Enter; - try - FsInt := Rx; FsInt2 := Ch; FsFreq := Hz; - if CanInvoke then FController.Invoke(SyncSetVfo); - finally - FLock.Leave; + if FreqSane(Hz) and Claim(HoldKey('VFO', Rx, Ch), Client) then + begin + FLock.Enter; + try + FsInt := Rx; FsInt2 := Ch; FsFreq := Hz; + if CanInvoke then FController.Invoke(SyncSetVfo); + finally + FLock.Leave; + end; end; end; @@ -1102,7 +1519,10 @@ begin S.FreqHz := TCIArgFloat(M, 2, 0); S.Comment := TCIUnescape(TCIArg(M, 4)); S.Spotter := 'TCI'; - S.TimeUTC := FormatDateTime('hhnn', Now); + // Поле называется TimeUTC и рисуется рядом со спотами кластера, которые + // приходят в UTC: местное время сдвигало бы подпись на часовой пояс. + // Stamp — наоборот, местное: по нему считается возраст спота (TTL). + S.TimeUTC := FormatDateTime('hhnn', LocalTimeToUniversal(Now)); S.Stamp := Now; S.ModeGuessed := False; S.Mode := DXModeFromComment(TCIArg(M, 1)); @@ -1136,6 +1556,7 @@ end; procedure TTCIAdapter.DispatchCommand(Client: TTCIClient; const M: TTCIMessage); var Rx, Ch, V: Integer; + Lo, Hi: Integer; B: Boolean; D: Double; Name: string; @@ -1161,11 +1582,11 @@ begin if M.Name = 'DDS' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then + if (M.ArgCount >= 2) and TCITryArgFloat(M, 1, D) and FreqSane(D) and + Claim(HoldKey('DDS', Rx, 0), Client) then begin - D := TCIArgFloat(M, 1, 0); FLock.Enter; try FsInt := Rx; FsFreq := D; @@ -1179,12 +1600,12 @@ begin // ── Вид связи и фильтр ── if M.Name = 'MODULATION' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; if M.ArgCount >= 2 then begin V := TCIModeIndex(TCIArg(M, 1), RxMode(Rx), ChanFreq(Rx, 0)); - if V >= 0 then + if (V >= 0) and Claim(HoldKey('MOD', Rx, 0), Client) then begin FLock.Enter; try @@ -1199,15 +1620,18 @@ begin if M.Name = 'RX_FILTER_BAND' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; - if M.ArgCount >= 3 then + // Обе кромки обязаны разобраться, и нижняя обязана быть ниже верхней: + // «rx_filter_band:0,x,y» иначе схлопывал фильтр в 0..0 и приёмник глох. + if (M.ArgCount >= 3) and TCITryArgInt(M, 1, Lo) and TCITryArgInt(M, 2, Hi) and + (Lo < Hi) and Claim(HoldKey('FILT', Rx, 0), Client) then begin FLock.Enter; try FsInt := Rx; - FsInt2 := TCIArgInt(M, 1, 0); - FsInt3 := TCIArgInt(M, 2, 0); + FsInt2 := Lo; + FsInt3 := Hi; if CanInvoke then FController.Invoke(SyncSetFilter); finally FLock.Leave; end; end; @@ -1218,13 +1642,13 @@ begin // ── Передача ── if M.Name = 'TRX' then begin - if M.ArgCount >= 2 then + // arg3 (источник сигнала: tci/mic1/…) игнорируем: аудио по TCI ещё нет, + // модуляция берётся из выбранного в программе входа. + if TCITryArgBool(M, 1, B) and Claim(HoldKey('TRX', 0, 0), Client) then begin - // arg3 (источник сигнала: tci/mic1/…) игнорируем: аудио по TCI ещё нет, - // модуляция берётся из выбранного в программе входа. FLock.Enter; try - FsBool := TCIArgBool(M, 1, False); + FsBool := B; if CanInvoke then FController.Invoke(SyncSetTRX); finally FLock.Leave; end; end; @@ -1234,11 +1658,11 @@ begin if M.Name = 'TUNE' then begin - if M.ArgCount >= 2 then + if TCITryArgBool(M, 1, B) and Claim(HoldKey('TUNE', 0, 0), Client) then begin FLock.Enter; try - FsBool := TCIArgBool(M, 1, False); + FsBool := B; if CanInvoke then FController.Invoke(SyncSetTune); finally FLock.Leave; end; end; @@ -1248,11 +1672,11 @@ begin if M.Name = 'DRIVE' then begin - if M.ArgCount >= 2 then + if TCITryArgInt(M, 1, V) and Claim(HoldKey('DRIVE', 0, 0), Client) then begin FLock.Enter; try - FsInt := EnsureRange(TCIArgInt(M, 1, 0), 0, 100); + FsInt := EnsureRange(V, 0, 100); if CanInvoke then FController.Invoke(SyncSetDrive); finally FLock.Leave; end; end; @@ -1262,41 +1686,46 @@ begin if M.Name = 'TUNE_DRIVE' then begin - if M.ArgCount >= 2 then + if TCITryArgInt(M, 1, V) and Claim(HoldKey('TUNEDRIVE', 0, 0), Client) then begin FLock.Enter; try - FsInt := EnsureRange(TCIArgInt(M, 1, 0), 0, 100); + FsInt := EnsureRange(V, 0, 100); if CanInvoke then FController.Invoke(SyncSetTuneDrive); finally FLock.Leave; end; end; - Reply(Client, TCIBuild('tune_drive', ['0', - TCIIntStr(FController.FTXSettings.TUNLevel)])); + // Уровень TUN — величина общая для радио: отвечать одному автору значило бы + // оставить остальных клиентов со старым числом (Broadcast включает автора). + FServer.Broadcast(TCIBuild('tune_drive', ['0', + TCIIntStr(FController.FTXSettings.TUNLevel)])); Exit; end; if M.Name = 'SPLIT_ENABLE' then begin - if M.ArgCount >= 2 then + if TCITryArgBool(M, 1, B) and Claim(HoldKey('SPLIT', 0, 0), Client) then begin FLock.Enter; try - FsBool := TCIArgBool(M, 1, False); + FsBool := B; if CanInvoke then FController.Invoke(SyncSetSplit); finally FLock.Leave; end; end; - Reply(Client, TCIBuild('split_enable', ['0', TCIBoolStr(FController.FSplitTxB)])); + // Split — свойство радио, а не клиента: остальным о нём узнать больше + // неоткуда (rfActiveVfo несёт его же, но только когда значение сменилось). + FServer.Broadcast(TCIBuild('split_enable', + ['0', TCIBoolStr(FController.FSplitTxB)])); Exit; end; // ── Громкость ── if M.Name = 'VOLUME' then begin - if M.ArgCount >= 1 then + if TCITryArgFloat(M, 0, D) and Claim(HoldKey('VOL', 0, 0), Client) then begin FLock.Enter; try - FsInt := TCIDbToVolume(TCIArgFloat(M, 0, -60)); + FsInt := TCIDbToVolume(D); if CanInvoke then FController.Invoke(SyncSetVolume); finally FLock.Leave; end; end; @@ -1306,11 +1735,11 @@ begin if M.Name = 'MUTE' then begin - if M.ArgCount >= 1 then + if TCITryArgBool(M, 0, B) and Claim(HoldKey('MUTE', 0, 0), Client) then begin FLock.Enter; try - FsBool := TCIArgBool(M, 0, False); + FsBool := B; if CanInvoke then FController.Invoke(SyncSetMute); finally FLock.Leave; end; end; @@ -1320,13 +1749,13 @@ begin if M.Name = 'RX_MUTE' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then + if TCITryArgBool(M, 1, B) and Claim(HoldKey('RXMUTE', Rx, 0), Client) then begin FLock.Enter; try - FsInt := Rx; FsBool := TCIArgBool(M, 1, False); + FsInt := Rx; FsBool := B; if CanInvoke then FController.Invoke(SyncSetRxMute); finally FLock.Leave; end; end; @@ -1336,15 +1765,17 @@ begin if M.Name = 'RX_VOLUME' then begin - Rx := TCIArgInt(M, 0, -1); - Ch := EnsureRange(TCIArgInt(M, 1, 0), 0, TCI_CHANNELS - 1); + if not TCITryArgInt(M, 0, Rx) then Exit; + if not TCITryArgInt(M, 1, Ch) then Ch := 0; + Ch := EnsureRange(Ch, 0, TCI_CHANNELS - 1); if not ValidRx(Rx) then Exit; - if M.ArgCount >= 3 then + if (M.ArgCount >= 3) and TCITryArgFloat(M, 2, D) and + Claim(HoldKey('RXVOL', Rx, Ch), Client) then begin FLock.Enter; try FsInt := Rx; - FsInt2 := TCIDbToVolume(TCIArgFloat(M, 2, -60)); + FsInt2 := TCIDbToVolume(D); FsInt3 := Ch; if CanInvoke then FController.Invoke(SyncSetRxVolume); finally FLock.Leave; end; @@ -1356,13 +1787,14 @@ begin if M.Name = 'RX_BALANCE' then begin // Баланса каналов у нас нет — эхо, чтобы клиенты не расходились. - Rx := TCIArgInt(M, 0, -1); - Ch := EnsureRange(TCIArgInt(M, 1, 0), 0, TCI_CHANNELS - 1); + if not TCITryArgInt(M, 0, Rx) then Exit; + if not TCITryArgInt(M, 1, Ch) then Ch := 0; + Ch := EnsureRange(Ch, 0, TCI_CHANNELS - 1); if not ValidRx(Rx) then Exit; FEchoLock.Enter; try - if M.ArgCount >= 3 then - FEcho[Rx].BalanceDb[Ch] := EnsureRange(TCIArgInt(M, 2, 0), -40, 40); + if (M.ArgCount >= 3) and TCITryArgInt(M, 2, V) then + FEcho[Rx].BalanceDb[Ch] := EnsureRange(V, -40, 40); V := FEcho[Rx].BalanceDb[Ch]; finally FEchoLock.Leave; @@ -1374,11 +1806,11 @@ begin if M.Name = 'MON_VOLUME' then begin - if M.ArgCount >= 1 then + if TCITryArgFloat(M, 0, D) and Claim(HoldKey('MONVOL', 0, 0), Client) then begin FLock.Enter; try - FsInt := TCIDbToVolume(TCIArgFloat(M, 0, -60)); + FsInt := TCIDbToVolume(D); if CanInvoke then FController.Invoke(SyncSetMonVolume); finally FLock.Leave; end; end; @@ -1389,11 +1821,11 @@ begin if M.Name = 'MON_ENABLE' then begin - if M.ArgCount >= 1 then + if TCITryArgBool(M, 0, B) and Claim(HoldKey('MONEN', 0, 0), Client) then begin FLock.Enter; try - FsBool := TCIArgBool(M, 0, False); + FsBool := B; if CanInvoke then FController.Invoke(SyncSetMonEnable); finally FLock.Leave; end; end; @@ -1404,7 +1836,7 @@ begin // ── АРУ ── if M.Name = 'AGC_MODE' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; if M.ArgCount >= 2 then begin @@ -1413,7 +1845,7 @@ begin else if Name = 'fast' then V := 0 else if Name = 'normal' then V := 1 else V := -1; - if V >= 0 then + if (V >= 0) and Claim(HoldKey('AGC', Rx, 0), Client) then begin FLock.Enter; try @@ -1428,16 +1860,16 @@ begin if M.Name = 'AGC_GAIN' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; // AGC-T (порог АРУ) в ewsdr один на приёмный тракт: у слайса своего нет. // Правка от имени доп. приёмника трогала бы главный — не делаем этого, // просто отвечаем текущим значением (ограничение, см. doc/TCI.md). - if (M.ArgCount >= 2) and (Rx = 0) then + if (Rx = 0) and TCITryArgInt(M, 1, V) and Claim(HoldKey('AGCT', 0, 0), Client) then begin FLock.Enter; try - FsInt := EnsureRange(TCIArgInt(M, 1, 0), TCI_AGC_MIN_DB, TCI_AGC_MAX_DB); + FsInt := EnsureRange(V, TCI_AGC_MIN_DB, TCI_AGC_MAX_DB); if CanInvoke then FController.Invoke(SyncSetAGCTop); finally FLock.Leave; end; end; @@ -1449,13 +1881,13 @@ begin if (M.Name = 'RX_NR_ENABLE') or (M.Name = 'RX_NB_ENABLE') or (M.Name = 'RX_ANF_ENABLE') then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then + if TCITryArgBool(M, 1, B) and Claim(HoldKey(M.Name, Rx, 0), Client) then begin FLock.Enter; try - FsInt := Rx; FsBool := TCIArgBool(M, 1, False); + FsInt := Rx; FsBool := B; if M.Name = 'RX_NR_ENABLE' then if CanInvoke then FController.Invoke(SyncSetNR) else if M.Name = 'RX_NB_ENABLE' then if CanInvoke then FController.Invoke(SyncSetNB) else if CanInvoke then FController.Invoke(SyncSetANF); @@ -1469,14 +1901,14 @@ begin if M.Name = 'RX_NB_PARAM' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; FEchoLock.Enter; try if M.ArgCount >= 3 then begin - FEcho[Rx].NBThreshold := EnsureRange(TCIArgInt(M, 1, 50), 1, 100); - FEcho[Rx].NBDuration := EnsureRange(TCIArgInt(M, 2, 25), 1, 300); + if TCITryArgInt(M, 1, V) then FEcho[Rx].NBThreshold := EnsureRange(V, 1, 100); + if TCITryArgInt(M, 2, V) then FEcho[Rx].NBDuration := EnsureRange(V, 1, 300); end; V := FEcho[Rx].NBThreshold; Ch := FEcho[Rx].NBDuration; @@ -1493,12 +1925,11 @@ begin (M.Name = 'RX_APF_ENABLE') or (M.Name = 'RX_DSE_ENABLE') or (M.Name = 'RX_NF_ENABLE') then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; - B := TCIArgBool(M, 1, False); FEchoLock.Enter; try - if M.ArgCount >= 2 then + if TCITryArgBool(M, 1, B) then begin if M.Name = 'RX_BIN_ENABLE' then FEcho[Rx].BinOn := B else if M.Name = 'RX_ANC_ENABLE' then FEcho[Rx].ANCOn := B @@ -1521,13 +1952,13 @@ begin // ── Блокировка, шумоподавитель ── if M.Name = 'LOCK' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then + if TCITryArgBool(M, 1, B) and Claim(HoldKey('LOCK', 0, 0), Client) then begin FLock.Enter; try - FsBool := TCIArgBool(M, 1, False); + FsBool := B; if CanInvoke then FController.Invoke(SyncSetLock); finally FLock.Leave; end; end; @@ -1537,13 +1968,13 @@ begin if M.Name = 'SQL_ENABLE' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then + if TCITryArgBool(M, 1, B) and Claim(HoldKey('SQL', Rx, 0), Client) then begin FLock.Enter; try - FsInt := Rx; FsBool := TCIArgBool(M, 1, False); + FsInt := Rx; FsBool := B; if CanInvoke then FController.Invoke(SyncSetSql); finally FLock.Leave; end; end; @@ -1553,14 +1984,14 @@ begin if M.Name = 'SQL_LEVEL' then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then + if TCITryArgFloat(M, 1, D) and Claim(HoldKey('SQLLEV', Rx, 0), Client) then begin FLock.Enter; try FsInt := Rx; - FsInt2 := TCISqlToLevel(TCIArgFloat(M, 1, -140)); + FsInt2 := TCISqlToLevel(D); if CanInvoke then FController.Invoke(SyncSetSqlLevel); finally FLock.Leave; end; end; @@ -1571,14 +2002,14 @@ begin // ── Расстройка: своего RIT/XIT в ewsdr нет — храним и отражаем ── if (M.Name = 'RIT_ENABLE') or (M.Name = 'XIT_ENABLE') then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; FEchoLock.Enter; try - if M.ArgCount >= 2 then + if TCITryArgBool(M, 1, B) then begin - if M.Name = 'RIT_ENABLE' then FEcho[Rx].RitOn := TCIArgBool(M, 1, False) - else FEcho[Rx].XitOn := TCIArgBool(M, 1, False); + if M.Name = 'RIT_ENABLE' then FEcho[Rx].RitOn := B + else FEcho[Rx].XitOn := B; end; if M.Name = 'RIT_ENABLE' then B := FEcho[Rx].RitOn else B := FEcho[Rx].XitOn; finally @@ -1590,14 +2021,15 @@ begin if (M.Name = 'RIT_OFFSET') or (M.Name = 'XIT_OFFSET') then begin - Rx := TCIArgInt(M, 0, -1); + if not TCITryArgInt(M, 0, Rx) then Exit; if not ValidRx(Rx) then Exit; FEchoLock.Enter; try - if M.ArgCount >= 2 then + if TCITryArgInt(M, 1, V) then begin - if M.Name = 'RIT_OFFSET' then FEcho[Rx].RitHz := TCIArgInt(M, 1, 0) - else FEcho[Rx].XitHz := TCIArgInt(M, 1, 0); + V := EnsureRange(V, -50000, 50000); + if M.Name = 'RIT_OFFSET' then FEcho[Rx].RitHz := V + else FEcho[Rx].XitHz := V; end; if M.Name = 'RIT_OFFSET' then V := FEcho[Rx].RitHz else V := FEcho[Rx].XitHz; finally @@ -1611,13 +2043,13 @@ begin begin // Канал B у главного приёмника — это VFO B, он есть всегда; у доп. панов // вторым каналом был бы второй слайс (создание слайсов по TCI — этап 2). - Rx := TCIArgInt(M, 0, -1); - Ch := TCIArgInt(M, 1, 1); + if not TCITryArgInt(M, 0, Rx) then Exit; + if not TCITryArgInt(M, 1, Ch) then Ch := 1; if not ValidRx(Rx) then Exit; - if M.ArgCount >= 3 then + if TCITryArgBool(M, 2, B) then begin FEchoLock.Enter; - try FEcho[Rx].ChannelBOn := TCIArgBool(M, 2, False); finally FEchoLock.Leave; end; + try FEcho[Rx].ChannelBOn := B; finally FEchoLock.Leave; end; end; B := ChanCount(Rx) > 1; FServer.Broadcast(TCIBuild('rx_channel_enable', @@ -1630,9 +2062,9 @@ begin begin FEchoLock.Enter; try - if M.ArgCount >= 1 then + if TCITryArgInt(M, 0, V) then begin - V := EnsureRange(TCIArgInt(M, 0, 0), 0, 4000); + V := EnsureRange(V, 0, 4000); if M.Name = 'DIGL_OFFSET' then FDiglOffset := V else FDiguOffset := V; end; if M.Name = 'DIGL_OFFSET' then V := FDiglOffset else V := FDiguOffset; @@ -1646,42 +2078,47 @@ begin // ── Телеграф ── if (M.Name = 'CW_MACROS_SPEED') or (M.Name = 'CW_KEYER_SPEED') then begin - if M.ArgCount >= 1 then + if TCITryArgInt(M, 0, V) and Claim(HoldKey('CWSPEED', 0, 0), Client) then begin FLock.Enter; try - FsInt := EnsureRange(TCIArgInt(M, 0, 20), 5, 60); + FsInt := EnsureRange(V, 5, 60); if CanInvoke then FController.Invoke(SyncSetCWSpeed); finally FLock.Leave; end; end; - Reply(Client, TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); + FServer.Broadcast(TCIBuild('cw_macros_speed', + [TCIIntStr(FController.FCWSettings.Speed)])); Exit; end; if (M.Name = 'CW_MACROS_SPEED_UP') or (M.Name = 'CW_MACROS_SPEED_DOWN') then begin - V := TCIArgInt(M, 0, 0); + if not TCITryArgInt(M, 0, V) then Exit; if M.Name = 'CW_MACROS_SPEED_DOWN' then V := -V; - FLock.Enter; - try - FsInt := EnsureRange(FController.FCWSettings.Speed + V, 5, 60); - if CanInvoke then FController.Invoke(SyncSetCWSpeed); - finally FLock.Leave; end; + if Claim(HoldKey('CWSPEED', 0, 0), Client) then + begin + FLock.Enter; + try + FsInt := EnsureRange(FController.FCWSettings.Speed + V, 5, 60); + if CanInvoke then FController.Invoke(SyncSetCWSpeed); + finally FLock.Leave; end; + end; FServer.Broadcast(TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); Exit; end; if M.Name = 'CW_MACROS_DELAY' then begin - if M.ArgCount >= 1 then + if TCITryArgInt(M, 0, V) and Claim(HoldKey('CWDELAY', 0, 0), Client) then begin FLock.Enter; try - FsInt := EnsureRange(TCIArgInt(M, 0, 0), 0, 1000); + FsInt := EnsureRange(V, 0, 1000); if CanInvoke then FController.Invoke(SyncSetCWDelay); finally FLock.Leave; end; end; - Reply(Client, TCIBuild('cw_macros_delay', [TCIIntStr(FController.FCWSettings.RFDelayMS)])); + FServer.Broadcast(TCIBuild('cw_macros_delay', + [TCIIntStr(FController.FCWSettings.RFDelayMS)])); Exit; end; @@ -1697,7 +2134,7 @@ begin begin FEchoLock.Enter; try - FCwTerminal := TCIArgBool(M, 0, False); + if TCITryArgBool(M, 0, B) then FCwTerminal := B; B := FCwTerminal; finally FEchoLock.Leave; @@ -1720,20 +2157,22 @@ begin end; // ── Измерители ── + // Период ставится ДО включения: иначе тик-поток успел бы отправить первую + // пачку со старым периодом. if M.Name = 'RX_SENSORS_ENABLE' then begin - Client.RxSensors := TCIArgBool(M, 0, False); - if M.ArgCount >= 2 then - Client.RxSensorsMs := EnsureRange(TCIArgInt(M, 1, 200), - TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS); + if not TCITryArgBool(M, 0, B) then Exit; + if TCITryArgInt(M, 1, V) then + Client.SetRxSensorsMs(EnsureRange(V, TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS)); + Client.SetRxSensors(B); Exit; end; if M.Name = 'TX_SENSORS_ENABLE' then begin - Client.TxSensors := TCIArgBool(M, 0, False); - if M.ArgCount >= 2 then - Client.TxSensorsMs := EnsureRange(TCIArgInt(M, 1, 200), - TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS); + if not TCITryArgBool(M, 0, B) then Exit; + if TCITryArgInt(M, 1, V) then + Client.SetTxSensorsMs(EnsureRange(V, TCI_SENSOR_MIN_MS, TCI_SENSOR_MAX_MS)); + Client.SetTxSensors(B); Exit; end; @@ -1752,39 +2191,58 @@ begin // Сами потоки — этап 2, значения только принимаются и подтверждаются. if M.Name = 'IQ_SAMPLERATE' then begin - if M.ArgCount >= 1 then Client.IQRate := TCIArgInt(M, 0, Client.IQRate); + // Набор частот оговорён протоколом; чужое значение отвергаем, а в ответе + // отдаём действующее — клиент увидит, что его не приняли. + if TCITryArgInt(M, 0, V) and TCIValidIQRate(V) then Client.IQRate := V; Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)])); Exit; end; if M.Name = 'AUDIO_SAMPLERATE' then begin - if M.ArgCount >= 1 then Client.AudioRate := TCIArgInt(M, 0, Client.AudioRate); + if TCITryArgInt(M, 0, V) and TCIValidAudioRate(V) then Client.AudioRate := V; Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)])); Exit; end; if M.Name = 'AUDIO_STREAM_SAMPLES' then begin - Client.AudioSamples := EnsureRange(TCIArgInt(M, 0, Client.AudioSamples), 100, 2048); + if TCITryArgInt(M, 0, V) then + Client.AudioSamples := EnsureRange(V, 100, 2048); Exit; end; if M.Name = 'AUDIO_STREAM_CHANNELS' then begin - Client.AudioChannels := EnsureRange(TCIArgInt(M, 0, Client.AudioChannels), 1, 2); + if TCITryArgInt(M, 0, V) then + Client.AudioChannels := EnsureRange(V, 1, 2); Exit; end; if M.Name = 'AUDIO_STREAM_SAMPLE_TYPE' then begin - Client.AudioSampleType := LowerCase(TCIArg(M, 0)); + Name := LowerCase(Trim(TCIArg(M, 0))); + if TCIValidSampleType(Name) then Client.AudioSampleType := Name; Exit; end; if M.Name = 'TX_STREAM_AUDIO_BUFFERING' then begin - Client.TxBuffering := EnsureRange(TCIArgInt(M, 0, Client.TxBuffering), 50, 500); + if TCITryArgInt(M, 0, V) then + Client.TxBuffering := EnsureRange(V, 50, 500); Exit; end; - // IQ_START/STOP, AUDIO_START/STOP, LINE_OUT_* — потоки этапа 2. Молча - // игнорируем: протокол разрешает игнорировать команды, которых не понимаем. + // Запуск потоков (§3.4) — этап 2. Молчать нельзя: клиент решил бы, что поток + // пошёл, и ждал бы данных бесконечно. Отвечаем ошибкой на конкретную команду. + if (M.Name = 'IQ_START') or (M.Name = 'IQ_STOP') or + (M.Name = 'AUDIO_START') or (M.Name = 'AUDIO_STOP') or + (M.Name = 'LINE_OUT_START') or (M.Name = 'LINE_OUT_STOP') or + (M.Name = 'LINE_OUT_RECORDER_START') or + (M.Name = 'LINE_OUT_RECORDER_SAVE') or + (M.Name = 'LINE_OUT_RECORDER_BREAK') then + begin + Reply(Client, TCIBuild('tci_error', [LowerCase(M.Name), + 'binary streams are not implemented'])); + Exit; + end; + + // Всё прочее незнакомое протокол разрешает игнорировать (§3.1). end; { ═══════════════════════════════════════════════════════════════════════════ @@ -1800,11 +2258,13 @@ begin if not Client.Ready then Exit; Now_ := GetTickCount64; - if Client.RxSensors and (Now_ - Client.RxSensorsAt >= QWord(Client.RxSensorsMs)) then + // Набор {включено, период, время последней отправки} проверяется и обновляется + // одним шагом под локом клиента: пишет его поток, читает этот. + if Client.DueRxSensors(Now_) then begin - Client.RxSensorsAt := Now_; for Rx := 0 to RxCount - 1 do begin + if not RxActive(Rx) then Continue; // несуществующий пан молчит, а не «-140» for Ch := 0 to ChanCount(Rx) - 1 do Client.Send(TCIBuild('rx_channel_sensors', [TCIIntStr(Rx), TCIIntStr(Ch), TCIFloatStr(RxSMeterDbm(Rx, Ch), 1)])); @@ -1814,9 +2274,8 @@ begin end; end; - if Client.TxSensors and (Now_ - Client.TxSensorsAt >= QWord(Client.TxSensorsMs)) then + if Client.DueTxSensors(Now_) then begin - Client.TxSensorsAt := Now_; Snap := FController.GetSnapshot; // arg2 — уровень микрофона: измерителя микрофона в ewsdr нет, отдаём // нижнюю границу шкалы, чтобы клиент не рисовал случайные значения. @@ -1845,9 +2304,58 @@ procedure TTCIAdapter.OnState(Sender: TObject; Field: TRadioField); var Rx, Ch: Integer; TxHz: Double; + MapChanged: Boolean; + Sig: string; begin + // Снимок слайсов обновляем ДО всего остального и НЕЗАВИСИМО от того, есть ли + // клиенты: подключившийся читает уже готовый снимок, а не заставляет поток + // контроллера сниматься по требованию (Invoke из потока клиента ждал бы UI). + // Все правки слайсов приходят сюда: сеттеры шлют rfSliceFreq/rfSliceState, + // создание и удаление — rfDevice. + // Снимок железа — первым: от него зависят и границы частоты, и всё, что + // сетевые потоки читают о плате. + if Field in [rfDevice, rfConnected, rfDeviceList, rfXvtr, rfBand, rfSampleRate] then + RefreshDev; + + MapChanged := False; + if Field in [rfSliceFreq, rfSliceState, rfDevice, rfPanFreq, rfSampleRate, + rfBand, rfXvtr, rfCenterFreq] then + begin + Sig := SliceMapSig; + RefreshSlices; + MapChanged := Sig <> SliceMapSig; + end; + + // Границы настройки — тоже до гейта по клиентам: их кэш обязан пережить + // время, когда не подключён никто (см. PushVfoLimits). + if Field in [rfDevice, rfXvtr, rfBand] then PushVfoLimits; + if (FServer = nil) or (FServer.ClientCount = 0) then Exit; + // §3.5: инициатор изменения захватывает параметр на 200 мс. Здесь инициатор — + // не клиент (оператор, CAT, бэнд-логика), поэтому владелец nil. Если параметр + // прямо сейчас крутит клиент, Claim его не отберёт — в том числе когда это + // изменение и есть эхо его собственной команды. + case Field of + rfVfoA: Claim(HoldKey('VFO', 0, 0), nil); + rfVfoB: Claim(HoldKey('VFO', 0, 1), nil); + rfMode: Claim(HoldKey('MOD', 0, 0), nil); + rfFilter, + rfFilterBW: Claim(HoldKey('FILT', 0, 0), nil); + rfAGCMode: Claim(HoldKey('AGC', 0, 0), nil); + rfAGCTop: Claim(HoldKey('AGCT', 0, 0), nil); + rfVolume: Claim(HoldKey('VOL', 0, 0), nil); + rfMute: Claim(HoldKey('MUTE', 0, 0), nil); + rfDrive: Claim(HoldKey('DRIVE', 0, 0), nil); + rfTransmitting: Claim(HoldKey('TRX', 0, 0), nil); + rfTuning: Claim(HoldKey('TUNE', 0, 0), nil); + rfVfoLock: Claim(HoldKey('LOCK', 0, 0), nil); + rfCenterFreq: Claim(HoldKey('DDS', 0, 0), nil); + rfSliceFreq: + if SliceRxCh(FController.FSliceFreqId, Rx, Ch) then + Claim(HoldKey('VFO', Rx, Ch), nil); + end; + case Field of rfVfoA: begin @@ -1875,8 +2383,9 @@ begin rfVfoLock: begin FServer.Broadcast(StrLock(0)); - FServer.Broadcast(TCIBuild('vfo_lock', - ['0', '0', TCIBoolStr(FController.FVfoLock)])); + for Ch := 0 to TCI_CHANNELS - 1 do + FServer.Broadcast(TCIBuild('vfo_lock', + ['0', TCIIntStr(Ch), TCIBoolStr(FController.FVfoLock)])); end; rfNR: FServer.Broadcast(TCIBuild('rx_nr_enable', ['0', TCIBoolStr(FController.FNRMode > 0)])); rfNB: FServer.Broadcast(TCIBuild('rx_nb_enable', ['0', TCIBoolStr(FController.FNBMode > 0)])); @@ -1917,8 +2426,34 @@ begin FServer.Broadcast(StrTxEnable(0)); FServer.Broadcast(StrVfo(0, 0)); end; + rfActiveVfo: + // Сюда же приходит смена split (SetSplit шлёт rfActiveVfo): без этого + // переключение TX-VFO из окна программы мимо клиентов проходило молча. + FServer.Broadcast(TCIBuild('split_enable', + ['0', TCIBoolStr(FController.FSplitTxB)])); + rfMonVolume: + // Громкость самоконтроля — отдельная величина: раньше её правка уезжала + // клиентам как обычный volume, то есть враньём. + FServer.Broadcast(TCIBuild('mon_volume', + [TCIIntStr(Round(TCIVolumeToDb(FController.FTxMonVolume)))])); + rfTXProfile: + // Уровень TUN живёт в TX-настройках: сменил его оператор или профиль — + // клиентам об этом больше узнать неоткуда. + FServer.Broadcast(TCIBuild('tune_drive', ['0', + TCIIntStr(FController.FTXSettings.TUNLevel)])); + rfCWSettings: + begin + FServer.Broadcast(TCIBuild('cw_macros_speed', + [TCIIntStr(FController.FCWSettings.Speed)])); + FServer.Broadcast(TCIBuild('cw_macros_delay', + [TCIIntStr(FController.FCWSettings.RFDelayMS)])); + end; end; + // Слайс создали или удалили (rfDevice) — у приёмника изменился набор каналов, + // и клиент, подключённый до этого, о новом канале не узнает никак. + if MapChanged then PushChannelMap; + // Частота передачи — отдельным уведомлением, но только когда она реально // изменилась: поле дёргается на каждый шаг ручки. if Field in [rfVfoA, rfVfoB, rfActiveVfo, rfBand, rfXvtr, rfTransmitting] then @@ -1954,6 +2489,9 @@ end; procedure TTCIAdapter.NotifyAppFocus(InFocus: Boolean); begin + // Значение помним всегда: подключившемуся клиенту фокус уходит в пачке + // состояния, а не только по следующей активации окна. + FAppFocus := InFocus; if (FServer = nil) or (FServer.ClientCount = 0) then Exit; FServer.Broadcast(TCIBuild('app_focus', [TCIBoolStr(InFocus)])); end; diff --git a/TCIProtocol.pas b/TCIProtocol.pas index f2223eb..d2d2dd3 100644 --- a/TCIProtocol.pas +++ b/TCIProtocol.pas @@ -91,6 +91,19 @@ function TCIArgInt(const M: TTCIMessage; Idx, Def: Integer): Integer; function TCIArgFloat(const M: TTCIMessage; Idx: Integer; Def: Double): Double; 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; @@ -226,6 +239,57 @@ begin else Result := Def; 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; + { ═══════════════════════════════════════════════════════════════════════════ Сборка ═══════════════════════════════════════════════════════════════════════════ } diff --git a/TCIServer.pas b/TCIServer.pas index b6ebb99..e2e4d74 100644 --- a/TCIServer.pas +++ b/TCIServer.pas @@ -16,14 +16,22 @@ unit TCIServer; измерителей с индивидуальным для каждого клиента периодом. Отправка НИКОГДА не блокирует того, кто зовёт Send/Broadcast: строка кладётся - в очередь клиента, а в сокет её пишет тик-поток (FlushClients). Иначе - медленный клиент останавливал бы UI-поток на секунду за раз — уведомления - рождаются в OnState, то есть внутри Changed() контроллера. + в очередь клиента, а в сокет её пишет ЕГО СОБСТВЕННЫЙ поток (Flush в цикле + HandleClient, recv просыпается каждые TCI_POLL_MS). Иначе медленный клиент + останавливал бы UI-поток на секунду за раз — уведомления рождаются в OnState, + то есть внутри Changed() контроллера, — а общий поток отправки задерживал бы + на его таймаут ещё и всех остальных клиентов. Владение объектом клиента: создаёт accept-поток, освобождает ТОЛЬКО тик-поток (ReapClients) и только после того, как клиентский поток честно вышел. Никто больше клиентов не освобождает — поэтому указатель, взятый под FClientLock, - остаётся валидным, пока тик-поток не сделает следующий проход. + остаётся валидным, пока тик-поток не сделает следующий проход. На остановке + освобождает Stop, но лишь дождавшись выхода ВСЕХ клиентских потоков. + + Два счёта соединений. Слот из TCI_MAX_CLIENTS занимает только клиент, + прошедший handshake (Up); сокет до handshake живёт в общем массиве + (TCI_MAX_SOCKETS) и убивается по таймауту TCI_HANDSHAKE_MS. Иначе восемь + молчащих TCP-соединений навсегда закрывали дверь настоящим клиентам. Бинарные фреймы (потоки IQ/аудио, §3.4) пока не обрабатываются: этап 2, см. doc/TCI.md. Приходящие от клиента binary-фреймы молча отбрасываются. @@ -34,6 +42,8 @@ unit TCIServer; Авторизации у TCI нет by design. Порт слушается там, где сказано в настройках; умолчание — 127.0.0.1, чтобы наружу он не торчал без спроса. + Отсюда же отказ браузерным клиентам (заголовок Origin): страница, открытая + в браузере, иначе дотянулась бы до петлевого порта и до передатчика. } {$IFDEF FPC} @@ -50,14 +60,17 @@ uses SyncObjs; // ← после платформенных юнитов (конфликт идентификатора Create) const - TCI_MAX_CLIENTS = 8; + TCI_MAX_CLIENTS = 8; // прошедших handshake (слоты протокола) + TCI_MAX_SOCKETS = 32; // всего сокетов, включая ещё не поднявшиеся TCI_TICK_MS = 20; // период OnTick (сенсоры троттлятся адаптером) TCI_WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; TCI_SEND_TIMEOUT = 300; // мс на SockSend, иначе клиент считается мёртвым + TCI_HANDSHAKE_MS = 5000; // мс на HTTP-запрос от подключившегося + TCI_POLL_MS = 20; // на столько recv клиента засыпает между кадрами TCI_OUT_MAX = 4000; // потолок очереди отправки на клиента (строк) TCI_OUT_CHUNK = 3800; // склейка очереди в один фрейм, символов TCI_MSG_MAX = 65536; // потолок собираемого из фрагментов сообщения - TCI_STOP_WAIT_MS = 10000; // сколько ждём выхода клиентских потоков в Stop + TCI_STOP_KILL_MS = 500; // как часто добиваем клиентов, ожидая их выхода type TTCIServer = class; @@ -65,12 +78,17 @@ type { Один подключённый клиент: WS-сокет, его личные подписки и очередь отправки. Подписки на сенсоры в TCI индивидуальны (RX_SENSORS_ENABLE «отправляется только клиентом»), поэтому живут здесь, а не в адаптере. - Параметры потоков (§4.3) — тоже клиентские, их держит адаптер по ссылке - на этот объект. } + Параметры потоков (§4.3) — тоже клиентские. + + Подписки и параметры потоков пишет поток клиента, а читает тик-поток, + поэтому и те и другие ходят через FStateLock: набор «включено + период + + последняя отправка» обязан меняться и читаться целиком. } TTCIClient = class private FWs: TWsClient; + FUp: Boolean; // handshake прошёл: клиент занимает слот FReady: Boolean; // пачка инициализации отправлена + FStateLock: TCriticalSection; FRxSensors: Boolean; FRxSensorsMs: Integer; FRxSensorsAt: QWord; // тик последней отправки @@ -92,30 +110,46 @@ type FDead: Boolean; // сокет уже не пишется — гасим соединение FKilled: Boolean; // shutdown сокета уже сделан 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 constructor Create(AWs: TWsClient); destructor Destroy; override; { Строку в очередь клиенту. False — соединение уже мертво. Не блокирует. } function Send(const S: string): Boolean; - { Слить очередь в сокет. Зовёт только тик-поток. False — клиент умер. } + { Слить очередь в сокет. Зовёт ТОЛЬКО собственный поток клиента: запись + может ждать до TCI_SEND_TIMEOUT, и общий поток на этом задерживал бы + всех остальных. False — клиент умер. } function Flush: Boolean; { Пометить мёртвым и разбудить его поток (shutdown сокета). } 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 Ready: Boolean read FReady write FReady; + property Up: Boolean read FUp; + property Ready: Boolean read GetReady write SetReady; property Dead: Boolean read FDead; - property RxSensors: Boolean read FRxSensors write FRxSensors; - property RxSensorsMs: Integer read FRxSensorsMs write FRxSensorsMs; - property RxSensorsAt: QWord read FRxSensorsAt write FRxSensorsAt; - property TxSensors: Boolean read FTxSensors write FTxSensors; - property TxSensorsMs: Integer read FTxSensorsMs write FTxSensorsMs; - property TxSensorsAt: QWord read FTxSensorsAt write FTxSensorsAt; - 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; + property IQRate: Integer read GetIQRate write SetIQRate; + property AudioRate: Integer read GetAudioRate write SetAudioRate; + property AudioSamples: Integer read GetAudioSamples write SetAudioSamples; + property AudioChannels: Integer read GetAudioChannels write SetAudioChannels; + property AudioSampleType: string read GetAudioSampleType write SetAudioSampleType; + property TxBuffering: Integer read GetTxBuffering write SetTxBuffering; end; TTCIClientEvent = procedure(Client: TTCIClient) of object; @@ -124,8 +158,9 @@ type TTCIServer = class private FListenSock: TSocket; - FClients: array[0..TCI_MAX_CLIENTS-1] of TTCIClient; - FClientCount: Integer; + FClients: array[0..TCI_MAX_SOCKETS-1] of TTCIClient; + FClientCount: Integer; // всего сокетов в массиве (с не поднявшимися) + FUpCount: LongInt; // прошедших handshake (Interlocked*) FClientLock: TCriticalSection; FAcceptThread: TThread; FTickThread: TThread; @@ -140,11 +175,16 @@ type FOnTick: TThreadMethod; function InitListen: Boolean; procedure ReapClients; // освободить клиентов, чьи потоки вышли - procedure FlushClients; // слить очереди в сокеты (вне FClientLock) + procedure KillAll; + procedure Disconnected(Client: TTCIClient); // OnDisconnect, единая точка public constructor Create; destructor Destroy; override; + { Проверка настроек без побочных эффектов: можно ли вообще открыть такой + слушатель. Зовётся ДО остановки работающего сервера. } + class function ValidSettings(APort: Word; const ABindIP: string): Boolean; + { Настройка слушателя. Применяется при следующем Start. False — адрес не разобран (порт не откроется). } function Configure(APort: Word; const ABindIP: string): Boolean; @@ -168,6 +208,7 @@ type procedure AcceptLoop; procedure TickLoop; procedure HandleClient(Client: TTCIClient); + function Promote(Client: TTCIClient): Boolean; // handshake прошёл procedure ThreadDone; // клиентский поток отработал property Port: Word read FPort; @@ -187,6 +228,16 @@ type «ошибка разбора = слушаем всё» в протоколе без авторизации недопустима. } 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 type @@ -251,7 +302,8 @@ begin end; finally // Освобождать себя нельзя: объект переиспользуется рассылкой из чужих - // потоков. Помечаем «поток вышел» — освободит тик-поток (ReapClients). + // потоков. Помечаем «поток вышел» — освободит тик-поток (ReapClients) + // или Stop, который ждёт именно этого. FClient.FClosed := True; FServer.ThreadDone; end; @@ -290,6 +342,57 @@ begin Result := True; 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 ═══════════════════════════════════════════════════════════════════════════ } @@ -298,7 +401,9 @@ constructor TTCIClient.Create(AWs: TWsClient); begin inherited Create; FWs := AWs; + FUp := False; FReady := False; + FStateLock := TCriticalSection.Create; FRxSensors := False; FRxSensorsMs := 200; FTxSensors := False; @@ -318,9 +423,150 @@ end; destructor TTCIClient.Destroy; begin FOutLock.Free; + FStateLock.Free; inherited; 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; begin Result := False; @@ -423,6 +669,7 @@ begin {$ENDIF} FListenSock := SOCK_INVALID; FClientCount := 0; + FUpCount := 0; FClientLock := TCriticalSection.Create; FPort := TCI_DEFAULT_PORT; FBindIP := '127.0.0.1'; @@ -438,12 +685,17 @@ begin inherited; end; -function TTCIServer.Configure(APort: Word; const ABindIP: string): Boolean; +class function TTCIServer.ValidSettings(APort: Word; const ABindIP: string): Boolean; var Dummy: LongWord; +begin + Result := (APort <> 0) and TCIParseIPv4(ABindIP, Dummy); +end; + +function TTCIServer.Configure(APort: Word; const ABindIP: string): Boolean; begin FPort := APort; FBindIP := ABindIP; - Result := (APort <> 0) and TCIParseIPv4(ABindIP, Dummy); + Result := ValidSettings(APort, ABindIP); end; function TTCIServer.Running: Boolean; @@ -513,6 +765,18 @@ begin Result := True; 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; var i, Waited: Integer; begin @@ -529,42 +793,40 @@ begin FListenSock := SOCK_INVALID; end; - // Шаг 2: будим клиентские потоки, висящие в recv. - FClientLock.Enter; - try - for i := 0 to FClientCount - 1 do - if FClients[i] <> nil then FClients[i].Kill; - finally - FClientLock.Leave; - end; - - // Шаг 3: свои потоки (клиентские — FreeOnTerminate, ждём их отдельно). + // Шаг 2: дожидаемся accept-потока — после него новых клиентов не появится. if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end; - if FTickThread <> nil then begin FTickThread.WaitFor; FreeAndNil(FTickThread); end; - // Шаг 4: ждём выхода клиентских потоков. Прокачивая очередь Synchronize: - // Stop зовёт поток контроллера (UI), а клиентский поток может как раз в нём - // висеть на FController.Invoke. Без прокачки это гарантированный взаимный - // клин, а по его истечении — освобождение объекта из-под живого потока. + // Шаг 3: будим клиентские потоки, висящие в recv, и останавливаем тик. + KillAll; + if FTickThread <> nil then begin FTickThread.WaitFor; FreeAndNil(FTickThread); end; + + // Шаг 4: ждём выхода клиентских потоков — БЕЗ таймаута. Прокачивая очередь + // Synchronize: Stop зовёт поток контроллера (UI), а клиентский поток может + // как раз в нём висеть на FController.Invoke; без прокачки это взаимный + // клин. Выйти отсюда по таймауту нельзя: следом освобождаются и клиенты, и + // сам сервер с адаптером, а живой поток вернулся бы в эту память. Waited := 0; - while (FThreadCount > 0) and (Waited < TCI_STOP_WAIT_MS) do + while FThreadCount > 0 do begin if GetCurrentThreadId = MainThreadID then CheckSynchronize(5) else Sleep(5); Inc(Waited, 5); + // Повторный shutdown: клиент мог быть принят между шагом 2 и шагом 3 + // (accept уже вернул сокет, поток стартовал позже) и Kill его не застал. + if (Waited mod TCI_STOP_KILL_MS) = 0 then KillAll; end; - // Шаг 5: зачистка. Если поток всё же не вышел (не должно случаться: сокеты - // закрыты, очередь прокачана), объект НЕ освобождаем — утечка на выходе - // несравнимо дешевле обращения к освобождённой памяти из живого потока. + // Шаг 5: зачистка. Потоков больше нет — освобождать безопасно. FClientLock.Enter; try for i := 0 to FClientCount - 1 do - if (FClients[i] <> nil) and FClients[i].FClosed then + if FClients[i] <> nil then begin + Disconnected(FClients[i]); // и на остановке тоже: захваты снимаются FClients[i].Ws.Free; FreeAndNil(FClients[i]); end; FClientCount := 0; + FUpCount := 0; finally FClientLock.Leave; end; @@ -603,12 +865,16 @@ begin end; SockSetSndTimeout(CSock, TCI_SEND_TIMEOUT); + // До конца handshake сокет не должен молчать вечно: иначе горстка пустых + // соединений держала бы место, ничего не сказав. + SockSetRcvTimeout(CSock, TCI_HANDSHAKE_MS); Client := TTCIClient.Create(TWsClient.Create(CSock)); Full := False; FClientLock.Enter; try - // Слот берём под локом: место в массиве освобождает тик-поток. - if FClientCount >= TCI_MAX_CLIENTS then Full := True + // Место в массиве освобождает тик-поток; слот протокола (Up) клиент + // получит позже — после успешного Upgrade (см. Promote). + if FClientCount >= TCI_MAX_SOCKETS then Full := True else begin FClients[FClientCount] := Client; @@ -630,13 +896,34 @@ begin 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; -// Освобождение клиентов — единственное место во всей программе. Зовёт только +// Освобождение клиентов — единственное место, кроме Stop. Зовёт только // тик-поток, поэтому указатель, взятый кем угодно под FClientLock, живёт до // следующего прохода тика (а вне лока указателей никто не держит). var i, j, N: Integer; - Doomed: array[0..TCI_MAX_CLIENTS-1] of TTCIClient; + Doomed: array[0..TCI_MAX_SOCKETS-1] of TTCIClient; begin N := 0; FClientLock.Enter; @@ -645,6 +932,7 @@ begin while i < FClientCount do if (FClients[i] <> nil) and FClients[i].FClosed then begin + if FClients[i].FUp then InterLockedDecrement(FUpCount); Doomed[N] := FClients[i]; Inc(N); for j := i to FClientCount - 2 do FClients[j] := FClients[j + 1]; @@ -659,33 +947,18 @@ begin for i := 0 to N - 1 do begin - if Assigned(FOnDisconnect) then FOnDisconnect(Doomed[i]); + Disconnected(Doomed[i]); Doomed[i].Ws.Free; // закрывает сокет Doomed[i].Free; end; end; -procedure TTCIServer.FlushClients; -// Запись в сокеты — вне FClientLock: медленный клиент не должен держать лок, -// иначе Broadcast из потока контроллера снова начнёт ждать сеть. -var - Snap: array[0..TCI_MAX_CLIENTS-1] of TTCIClient; - i, N: Integer; +procedure TTCIServer.Disconnected(Client: TTCIClient); +// Единственное место, где наверх уходит «клиент ушёл»: и обычное отключение +// (ReapClients), и остановка сервера. Иначе после Stop у адаптера оставались +// висеть захваты параметров ушедших клиентов (§3.5). begin - N := 0; - 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; + if (Client <> nil) and Assigned(FOnDisconnect) then FOnDisconnect(Client); end; { ═══════════════════════════════════════════════════════════════════════════ @@ -696,12 +969,12 @@ procedure TTCIServer.HandleClient(Client: TTCIClient); var Ws: TWsClient; R, HeaderEnd: Integer; - Header, HeaderLC, Key, AcceptKey, Response, Text: string; + Header, Key, AcceptKey, Response, Text: string; Raw: array[0..4095] of Byte; RawLen, Rest: Integer; B0, B1: Byte; Masked, Fin, Pending: Boolean; - PayLen, Need, i, j, Consumed, KPos, KEnd: Integer; + PayLen, Need, i, j, Consumed: Integer; Hi32: LongWord; Mask: array[0..3] of Byte; Payload: array of Byte; @@ -717,6 +990,8 @@ begin HeaderEnd := 0; repeat 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; Inc(RawLen, R); SetLength(Header, RawLen); @@ -728,10 +1003,10 @@ begin Consumed := HeaderEnd + 3; // длина заголовков вместе с CRLFCRLF 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 Response := 'HTTP/1.1 426 Upgrade Required'#13#10 + 'Content-Length: 0'#13#10'Connection: close'#13#10#13#10; @@ -739,15 +1014,20 @@ begin Exit; end; - Key := ''; - KPos := System.Pos('sec-websocket-key: ', HeaderLC); - if KPos > 0 then + // Браузерный клиент. Origin шлют только браузеры, и он — единственный + // признак, отличающий страницу от нативной программы. Авторизации в TCI + // нет: без этой проверки открытая вкладка с чужого сайта дотянулась бы по + // ws://127.0.0.1:40001 до TRX/TUNE/VFO. Своим web-страницам нужен явный + // прокси, а не дыра по умолчанию. + if TCIHttpHeader(Header, 'origin') <> '' then begin - Key := Copy(Header, KPos + 19, 100); - KEnd := System.Pos(#13, Key); - if KEnd > 0 then Key := Copy(Key, 1, KEnd - 1); - Key := Trim(Key); + Response := 'HTTP/1.1 403 Forbidden'#13#10 + + 'Content-Length: 0'#13#10'Connection: close'#13#10#13#10; + Ws.SendRaw(Response[1], Length(Response)); + Exit; end; + + Key := TCIHttpHeader(Header, 'sec-websocket-key'); // Пустой ключ = не WebSocket-клиент (или сломанный): Accept без ключа // формально считается валидным, и такое «соединение» потом молча висит. if Key = '' then @@ -758,6 +1038,16 @@ begin Exit; 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); Response := 'HTTP/1.1 101 Switching Protocols'#13#10 + 'Upgrade: websocket'#13#10 + @@ -765,6 +1055,9 @@ begin 'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10; if not Ws.SendRaw(Response[1], Length(Response)) then Exit; Ws.State := wsOpen; + // Дальше клиент вправе молчать сколько угодно, но просыпаться нам надо: + // на этом же потоке уходит его очередь отправки (Flush). + SockSetRcvTimeout(Ws.Socket, TCI_POLL_MS); // Хвост первого пакета: клиент вправе прислать первый WS-фрейм в том же // сегменте, что и заголовки. Выбросить его — потерять первую команду. @@ -772,8 +1065,22 @@ begin if Rest > 0 then Move(Raw[Consumed], Ws.BufData[0], Rest); Ws.BufLen := Rest; - // Пачка инициализации + текущее состояние (§3.1) — дело адаптера. - if Assigned(FOnConnect) then FOnConnect(Client); + // Пачка инициализации + текущее состояние (§3.1) — дело адаптера. Под + // FClientLock: пока она набирается, рассылка обязана ждать. Иначе изменение, + // случившееся после строки снимка, но до Ready=True, пропадало навсегда — + // Broadcast пропускает не-Ready клиента, и тот оставался со старым значением, + // считая инициализацию завершённой. Лок держится только на укладку строк в + // очередь (сеть тут не пишется), но обработчик OnConnect по этой же причине + // НЕ имеет права звать Invoke в поток контроллера: тот может ждать этот лок. + if Assigned(FOnConnect) then + begin + FClientLock.Enter; + try + FOnConnect(Client); + finally + FClientLock.Leave; + end; + end; // ── Цикл WS-сообщений ──────────────────────────────────────────────────── Cmds := TStringList.Create; @@ -786,7 +1093,9 @@ begin if not Pending then begin R := Ws.Recv; - if R <= 0 then Break; + // R <= 0 — либо разрыв, либо просто истёк TCI_POLL_MS. Второе штатно: + // просыпаемся, чтобы отдать накопившуюся очередь. + if (R <= 0) and not SockRecvTimedOut then Break; end; Pending := False; @@ -902,6 +1211,14 @@ begin if Fin then 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 begin TCISplit(Frag, Cmds); @@ -912,8 +1229,15 @@ begin Frag := ''; end; end; - $08: // close + $08: // close: RFC 6455 §5.5.1 требует ответить своим close-кадром 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; Break; end; @@ -927,6 +1251,11 @@ begin Break; end; end; + + // Очередь — в сокет здесь же, на потоке этого клиента: ответы на только + // что разобранные команды уходят сразу, а медленный клиент задерживает + // только себя (тик-поток очереди лишь наполняет). + if not Client.Flush then Break; end; finally Cmds.Free; @@ -960,7 +1289,8 @@ begin FClientLock.Enter; try 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 FClientLock.Leave; end; @@ -973,7 +1303,7 @@ end; function TTCIServer.ClientCount: Integer; begin - Result := FClientCount; + Result := FUpCount; end; procedure TTCIServer.TickLoop; @@ -983,8 +1313,10 @@ begin Sleep(TCI_TICK_MS); if not FRunning then Break; ReapClients; // отключившиеся — освобождаем только здесь - if (FClientCount > 0) and Assigned(FOnTick) then FOnTick; - FlushClients; // очереди → сокеты + if (FUpCount > 0) and Assigned(FOnTick) then FOnTick; + // В сокеты пишет каждый клиент сам, на своём потоке (см. HandleClient): + // общий поток отправки означал бы, что один медленный клиент задерживает + // очередь всех остальных на свой таймаут записи. end; end; diff --git a/WebUtils.pas b/WebUtils.pas index 07dbd47..45ee581 100644 --- a/WebUtils.pas +++ b/WebUtils.pas @@ -64,6 +64,11 @@ procedure SockSetSndTimeout(S: TSocket; Ms: Integer); накопившиеся команды): recv возвращает -1 по таймауту, соединение живо. } procedure SockSetRcvTimeout(S: TSocket; Ms: Integer); +{ SockRecvTimedOut — последняя ошибка SockRecv означает «данных пока нет» + (истёк SO_RCVTIMEO или сигнал), а не разрыв. Без этой проверки поток, + просыпающийся по таймауту, не отличит тишину от закрытого сокета. } +function SockRecvTimedOut: Boolean; + { ── SHA-1 ─────────────────────────────────────────────────────────────────── } type @@ -135,6 +140,13 @@ begin setsockopt(S, SOL_SOCKET, SO_RCVTIMEO, @T, SizeOf(T)); end; +function SockRecvTimedOut: Boolean; +var E: Integer; +begin + E := WSAGetLastError; + Result := (E = WSAETIMEDOUT) or (E = WSAEWOULDBLOCK) or (E = WSAEINTR); +end; + {$ELSE} function SockClose(S: TSocket): Integer; @@ -157,7 +169,10 @@ end; function SockSend(S: TSocket; Buf: Pointer; Len, Flags: Integer): Integer; begin - Result := fpSend(S, Buf, Len, Flags); + // MSG_NOSIGNAL обязателен: запись в сокет, который клиент уже закрыл, иначе + // приходит SIGPIPE, а он по умолчанию убивает процесс целиком. С ним send + // просто возвращает -1/EPIPE, и вызывающий штатно выбрасывает клиента. + Result := fpSend(S, Buf, Len, Flags or MSG_NOSIGNAL); end; procedure SockSetNonBlock(S: TSocket; NB: Boolean); @@ -185,6 +200,13 @@ begin fpSetSockOpt(S, SOL_SOCKET, SO_RCVTIMEO, @TV, SizeOf(TV)); end; +function SockRecvTimedOut: Boolean; +var E: Integer; +begin + E := fpgeterrno; + Result := (E = ESysEAGAIN) or (E = ESysEWOULDBLOCK) or (E = ESysEINTR); +end; + {$ENDIF} { ═══════════════════════════════════════════════════════════════════════════ diff --git a/doc/TCI.md b/doc/TCI.md index eb3e9f3..3ab8305 100644 --- a/doc/TCI.md +++ b/doc/TCI.md @@ -21,8 +21,8 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─ | Файл | Назначение | |---|---| | `TCIProtocol.pas` (~380 строк) | Чистый слой протокола: разбор `имя:арг1,арг2;`, сборка строк, экранирование `^ ~ *`, словарь видов связи, пересчёт громкости/порога в дБ. Зависит только от RTL + `RadioModes`. | -| `TCIServer.pas` (~660 строк) | WebSocket-сервер: accept-поток, поток на клиента, HTTP-Upgrade, разбор фреймов, рассылка, тик 20 мс. Сокеты и фреймы переиспользованы из веб-подсистемы (`WebUtils`, `WsClient`). | -| `TCIAdapter.pas` (~1100 строк) | Мост к `TRadioController`: реализация команд, пачка инициализации, уведомления об изменениях состояния, измерители. | +| `TCIServer.pas` (~1250 строк) | WebSocket-сервер: accept-поток, поток на клиента, HTTP-Upgrade, разбор фреймов, рассылка, тик 20 мс. Сокеты и фреймы переиспользованы из веб-подсистемы (`WebUtils`, `WsClient`). | +| `TCIAdapter.pas` (~2100 строк) | Мост к `TRadioController`: реализация команд, пачка инициализации, уведомления об изменениях состояния, измерители, захват параметров (§3.5). | Принципы те же, что у CAT (см. `doc/CAT_STATUS.md`): @@ -34,33 +34,82 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─ сеттеры пишут параметр в scratch-поля под `FLock` и зовут `FController.Invoke(SyncXxx)` — исполнение в потоке контроллера (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`) и рассылается всем подключённым — как того требует §3.5 спецификации. Отвечающий на команду клиент дополнительно получает прямой ответ. -### 1.1 Три правила, на которых держится транспорт +### 1.1 Правила, на которых держится транспорт Всё это не украшения, а лечение конкретных отказов — менять с оглядкой. -1. **Отправка никогда не блокирует вызывающего.** `Send`/`Broadcast` кладут - строку в очередь клиента (микросекунды под его локом), в сокет пишет - тик-поток (`FlushClients`, 20 мс, вне общего лока). Уведомления рождаются - внутри `Changed()` контроллера, то есть в UI-потоке: писать оттуда прямо в - сокет означало бы отдать интерфейс во власть самого медленного клиента - (таймаут отправки × число клиентов на каждое движение ручки VFO). - Переполнилась очередь (`TCI_OUT_MAX`) или не прошла запись — клиент - выбрасывается, а не тормозит остальных. +1. **Отправка никогда не блокирует ни вызывающего, ни соседей.** + `Send`/`Broadcast` кладут строку в очередь клиента (микросекунды под его + локом), а в сокет её пишет **собственный поток клиента**: его `recv` + просыпается каждые `TCI_POLL_MS` (20 мс) и сливает очередь. Уведомления + рождаются внутри `Changed()` контроллера, то есть в UI-потоке — писать + оттуда прямо в сокет означало бы отдать интерфейс во власть самого + медленного клиента. Общий поток отправки был лишь половиной решения: один + `SockSend` ждёт до `TCI_SEND_TIMEOUT` (300 мс), и восемь клиентов давали + секунды задержки всем остальным. Теперь медленный клиент задерживает только + себя; переполнилась его очередь (`TCI_OUT_MAX`) или не прошла запись — он + выбрасывается. 2. **Объект клиента освобождает только тик-поток** (`ReapClients`) и только после того, как клиентский поток честно вышел. Поэтому указатель, взятый - кем угодно под `FClientLock`, гарантированно жив внутри лока. -3. **`Stop` прокачивает очередь `Synchronize`.** Останавливает сервер поток - контроллера (UI), а клиентский поток в этот момент может висеть как раз на - `Invoke` в него же. Без прокачки это взаимный клин; по его таймауту сервер - освобождал бы объекты из-под живых потоков. Дополнительно на время - остановки взводится `Stopping`, и адаптер новых `Invoke` уже не начинает. - Если поток всё же не вышел — объект НЕ освобождается: утечка на выходе - дешевле обращения к освобождённой памяти. + кем угодно под `FClientLock`, гарантированно жив внутри лока. Единственное + исключение — `Stop`, но он к этому моменту уже дождался всех потоков. И в + том и в другом случае наверх уходит `OnDisconnect` (единая точка + `Disconnected`): иначе после остановки у адаптера оставались висеть захваты + параметров ушедших клиентов. +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 Настройки @@ -74,7 +123,7 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт **нет авторизации**: открытый наружу порт означает полный доступ к трансиверу, поэтому умолчание слушает только петлю. -Отсюда же два правила вокруг адреса: +Отсюда же правила вокруг адреса: - разбор `bind_addr` строгий (ровно четыре октета 0..255); всё непонятное — отказ поднимать сервер, а не молчаливый `0.0.0.0`. Пустая строка и явный @@ -83,8 +132,12 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт каждое нажатие клавиши: иначе набор `127.0.0.1` по дороге проходил бы через «`127.0.0.`» и сервер успевал перезапуститься на всех интерфейсах. -Отказ старта (порт занят, адрес не разобран) виден оператору: `ApplySettings` -возвращает результат, MainForm показывает сообщение. +**Сначала применяем, потом сохраняем.** `ApplySettings` проверяет новую +конфигурацию ДО остановки работающего сервера, а если новый слушатель не +поднялся (порт занят) — возвращает прежний. `MainForm.ApplyTCISettings` пишет +`settings.json` только после успеха и на отказе возвращает поля окна к тому, +что реально работает. Иначе занятый порт оставлял оператора вообще без TCI, да +ещё и с нерабочей конфигурацией на следующий запуск. ### 1.3 Маппинг модели @@ -107,9 +160,46 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт `VFO_LIMITS`, `IF_LIMITS`, `MODULATIONS_LIST`, `READY`. `READY` шлётся **после** полного дампа состояния: клиент, дождавшийся его, -уже знает всё. Границы частот берутся из `BackendCaps`; пока устройство не -подключено — 10 кГц…30 МГц. `IF_LIMITS` = ±sample rate/2, пересылается при -смене частоты дискретизации. +уже знает всё. `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`. `dmr`/`fmraw` — наше расширение (протокол расширяемый, §1.4). `CWL`/`CWU` @@ -118,13 +208,39 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт ### 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` | | `DDS` | `SetCenter` / `SetPanDDCFreq` | -| `IF`, `VFO` | `SetVfoA/B`, `SetSliceTarget` | +| `IF`, `VFO` | `SetVfoA/B`, `TuneSliceInBand` | | `MODULATION` | `SetMode` / `SetSliceMode` | | `TRX` | `SetMOX` | | `TUNE` | `SetTune` | @@ -132,9 +248,18 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт | `TUNE_DRIVE` | `FTXSettings.TUNLevel` через `SetTXSettings` | | `SPLIT_ENABLE` | `SetSplit` | | `RX_FILTER_BAND` | `SetFilterEdges` / `SetSliceFilter` | -| `VOLUME`, `MUTE` | `SetVolume`, `SetMute` (дБ ↔ 0..100) | +| `VOLUME`, `MUTE` | `SetRxVolume`, `SetMute` (дБ ↔ 0..100) | | `RX_MUTE`, `RX_VOLUME` | громкость/мьют слайса | | `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_GAIN` | `SetAGCTop` (AGC-T) — **только приёмник 0**, см. §3 | | `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` — адаптер до окна не дотягивается, действие ставит MainForm), `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` (значения принимаются и подтверждаются; сами потоки — этап 2). Параметры потоков — настройки **клиента**, а не устройства: живут в `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) @@ -163,6 +299,31 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт `CLICKED_ON_SPOT` (клик по подписи спота на любом панадаптере), `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, ни до остальных клиентов. Поэтому в контроллере появилось `rfSliceState` @@ -170,8 +331,14 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт сеттеры слайса: `SetSliceMode`, `SetSliceFilter`, `SetSliceAGCMode`, `SetSliceVolume`, `SetSliceMute`, `SetSliceDSP`, `SetSliceFMSquelch`. Адаптер разворачивает Id обратно в пару (приёмник, канал) и рассылает -состояние именно этого канала. Частоту слайса, поставленную по TCI, тоже -сопровождает `SliceFreqChanged` — как это делает CAT. +состояние именно этого канала. + +Частоту слайса объявляет сам `SetSliceTarget`: `SliceFreqChanged` живёт +**внутри** него, а не у каждого вызывающего. Раньше об этом помнили CAT и TCI, +но не UI — перетаскивание флага мышью обновляло только свой пан, и TCI-клиенты +оставались на старой частоте. Дублирующие вызовы у вызывающих (в том числе +ручные `PushSliceFlagState`/`LayoutFlags` в MainForm) убраны: теперь один +путь на всех — мышь, колесо, CAT, TCI, бэнд-логика. ### 2.5 Телеграф (§3.2) @@ -210,9 +377,10 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт | `AGC_GAIN` у приёмника > 0 | AGC-T в ewsdr один на приёмный тракт, у слайса своего нет. Команда от имени доп. приёмника **игнорируется** (раньше молча правила главный), в ответ уходит текущее значение | | Цвет спота (`SPOT`, arg4 ARGB) | не читается: `TDXSpot` цвета не хранит, подписи красятся по моде/возрасту | | `KEYER`, `TX_FOOTSWITCH` | не реализованы: своего ключа-уведомления и опроса педали наружу у контроллера нет | -| Арбитраж клиентов (§3.5, захват параметра ~200 мс) | нет. Команды разных клиентов идут подряд, последняя побеждает. С двумя активными логгерами возможна «перетяжка» частоты или моды | | Мода, фильтр, АРУ, шумодавы у канала 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` второй аргумент — уровень микрофона; измерителя микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не @@ -244,7 +412,7 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт 5. **`LINEOUT_STREAM` + `LINE_OUT_RECORDER_*`** — запись в WAV/MP3. Также в очереди: `RX_CHANNEL_ENABLE` как реальное создание/удаление второго -слайса пана, `KEYER` и арбитраж нескольких клиентов (§3.5). +слайса пана и `KEYER`. Приёмный буфер `TWsClient` — 4 КБ, и сейчас это жёсткий потолок: кадр крупнее рвёт соединение (команд такой длины у TCI нет). Под TX-аудио его придётся @@ -264,7 +432,7 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт клиент вылетает сам); остановка сервера в тот момент, когда команда клиента висит в `Synchronize` у потока контроллера. - **Сквозной прогон** с настоящим `TRadioController` (движки созданы, железо не - подключено): пачка инициализации из 57 строк со всеми обязательными + подключено): пачка инициализации со всеми обязательными командами и `READY` в конце; `VFO`, `MODULATION` (`cw` на 7 МГц дал CWL), `RX_FILTER_BAND`, `DRIVE`, `VOLUME`, `MUTE`, `AGC_GAIN`, `LOCK`, `CW_MACROS_SPEED`, `SPOT`, `RIT_*` — состояние контроллера после прогона @@ -275,6 +443,53 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт работать (проверено на контроллере без движков, где `SetMode`/`SetCWSettings` падают с 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` (демон собирается, TCI в его граф пока не заведён — юниты LCL-free, подключается одной строкой в `ewsdrd.lpr`, как web).