From 84c9e60b93c03050ae7d2f4fe3cd64e666dec2d5 Mon Sep 17 00:00:00 2001 From: Uladzimir Karpenka Date: Mon, 17 Aug 2026 16:49:31 +0300 Subject: [PATCH] =?UTF-8?q?fix(tci):=20=D0=B6=D0=B8=D0=B7=D0=BD=D0=B5?= =?UTF-8?q?=D0=BD=D0=BD=D1=8B=D0=B9=20=D1=86=D0=B8=D0=BA=D0=BB,=20=D1=81?= =?UTF-8?q?=D0=B8=D0=BD=D1=85=D1=80=D0=BE=D0=BD=D0=B8=D0=B7=D0=B0=D1=86?= =?UTF-8?q?=D0=B8=D1=8F=20=D1=81=D0=BB=D0=B0=D0=B9=D1=81=D0=BE=D0=B2=20?= =?UTF-8?q?=D0=B8=20WebSocket=20=D0=BF=D0=BE=20RFC?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Разбор ревью ветки. Критичное — четыре отказа жизненного цикла и один пробел синхронизации. Use-after-free стора спотов: FTCIAdapter освобождается ДО FDXStore. Команда SPOT/SPOT_DELETE, пришедшая между их гибелью, обращалась к освобождённой памяти. Bind-адрес: TCIParseIPv4 стал строгим (out + Boolean, ровно четыре октета 0..255). Кривой адрес — отказ поднимать сокет, а не молчаливый INADDR_ANY: авторизации в TCI нет. В UI порт и адрес применяются по уходу фокуса и по Close, а не на каждую букву — набор «127.0.0.1» по дороге проходил через «127.0.0.» и открывал порт наружу. Остановка при висящем Synchronize: флаг Stopping (адаптер не начинает новых Invoke), прокачка CheckSynchronize в цикле ожидания Stop и запрет освобождать клиента, чей поток не вышел. Владение переделано: клиента освобождает только тик-поток (ReapClients), клиентский лишь помечает себя закрытым. Отправка больше не блокирует вызывающего: Send/Broadcast кладут строку в очередь клиента, в сокет пишет тик-поток вне общего лока, склеивая очередь в общие кадры. Медленный клиент морозил UI на таймаут отправки за каждое движение ручки VFO; теперь он просто вылетает. Слайсы: в контроллере появилось rfSliceState (нагрузка — FSliceFreqId), его шлют сами сеттеры слайса; SyncSetVfo зовёт SliceFreqChanged, как CAT. Адаптер разворачивает Id в пару (приёмник, канал) и рассылает состояние именно этого канала, а не канала 0 каждого пана. WebSocket по RFC 6455: маска обязательна, FIN/continuation собираются, RSV и незнакомые opcode рвут соединение, control-кадры ≤125 и только целиком, 64-битная длина не сворачивается в отрицательный Integer, пустой Sec-WebSocket-Key получает 400. Хвост пакета handshake больше не выбрасывается — первая команда не теряется. Клиент после исключения в разборе не остаётся висеть в массиве. Ещё: DSP и squelch доп. приёмников читаются и пишутся из TCtrlSlice (парные сеттеры сохраняли соседние поля значениями главного тракта); параметры потоков — в TTCIClient, они клиентские по спецификации; эхо под своим локом; ApplySettings возвращает результат, отказ старта виден оператору; инициализация объявляет только существующие каналы; SET_IN_FOCUS реализован через OnFocusRequest. Осознанно не сделано и записано в doc/TCI.md §3.1: AGC_GAIN для приёмников >0 (AGC-T один на тракт), цвет спота, KEYER, TX_FOOTSWITCH, арбитраж нескольких клиентов. Co-Authored-By: Claude Opus 5 --- MainForm.pas | 32 ++- RadioController.pas | 21 +- SettingsForm.pas | 31 ++- TCIAdapter.pas | 565 +++++++++++++++++++++++++++++++------------- TCIServer.pas | 501 +++++++++++++++++++++++++++++++-------- doc/TCI.md | 86 ++++++- 6 files changed, 960 insertions(+), 276 deletions(-) diff --git a/MainForm.pas b/MainForm.pas index 4876bad..090d359 100644 --- a/MainForm.pas +++ b/MainForm.pas @@ -844,6 +844,7 @@ type // отдавать клавиатуру). procedure TCIFormActivate(Sender: TObject); procedure TCIFormDeactivate(Sender: TObject); + procedure TCIFocusRequest; procedure ApplyGridParams(RefLevel, Range, GridStep: Double); // Пушит активные grid-параметры (RX или TX в зависимости от FTransmitting) // в FSpecView и сбрасывает кэш сетки. Вызывается при смене RX↔TX и при @@ -1428,6 +1429,11 @@ begin FDXPending := False; FController.FSettings.SaveDXClusterSettings(FDXPendingCfg); end; + // TCI гасим ПЕРЕД базой спотов: его клиенты кладут споты (SPOT/SPOT_DELETE/ + // SPOT_CLEAR) прямо в FDXStore из своих потоков, и команда, пришедшая между + // гибелью стора и гибелью адаптера, обратилась бы к освобождённой памяти. + // Destroy останавливает сервер и дожидается его потоков. + FreeAndNil(FTCIAdapter); for i := 0 to MAX_PANS - 1 do if FPans[i] <> nil then FPans[i].DetachDXSpots; FDXSpotOverlay := nil; @@ -1456,7 +1462,7 @@ begin FreeAndNil(FWebAdapter); // адаптер не владеет сервером — освобождаем после Stop FWebServer.Free; FreeAndNil(FCATAdapter); // его Destroy останавливает+освобождает CAT движок/транспорты - FreeAndNil(FTCIAdapter); // Destroy останавливает TCI-сервер и его потоки + // (TCI освобождён выше — до базы спотов) // Ядро освобождаем последним — его Destroy закрывает и освобождает движки // (FreeEngines) и FSettings. FreeAndNil(FController); @@ -2719,7 +2725,13 @@ begin // InitDXCluster: споты от TCI-клиентов кладутся в тот же стор. FController.FSettings.LoadTCISettings(FTCICfg); FTCIAdapter := TTCIAdapter.Create(FController, FDXStore); - FTCIAdapter.ApplySettings(FTCICfg); + FTCIAdapter.OnFocusRequest := TCIFocusRequest; + // Порт может быть занят (второй экземпляр, чужая программа) — молчать об + // этом нельзя: галка стоит, а сервера нет. + if not FTCIAdapter.ApplySettings(FTCICfg) then + ShowMessage('TCI server failed to start on ' + FTCICfg.BindAddr + ':' + + IntToStr(FTCICfg.Port) + '.' + LineEnding + + 'Port busy or address invalid — check Settings → Advanced.'); OnActivate := TCIFormActivate; OnDeactivate := TCIFormDeactivate; @@ -6576,7 +6588,21 @@ begin FTCICfg.Port := Port; FTCICfg.BindAddr := BindAddr; FController.FSettings.SaveTCISettings(FTCICfg); - if FTCIAdapter <> nil then FTCIAdapter.ApplySettings(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.'); +end; + +// SET_IN_FOCUS от TCI-клиента: логгер просит поднять окно программы. +// Вызывается в UI-потоке (адаптер маршалит через FController.Invoke). +procedure TMainForm.TCIFocusRequest; +begin + if WindowState = wsMinimized then WindowState := wsNormal; + BringToFront; end; procedure TMainForm.TCIFormActivate(Sender: TObject); diff --git a/RadioController.pas b/RadioController.pas index 2232bc1..e4571cf 100644 --- a/RadioController.pas +++ b/RadioController.pas @@ -88,7 +88,8 @@ type rfDevice, // подключённое устройство сменилось rfDeviceList, // список discovered устройств обновился rfPanFreq, // центр доп. пана уехал (ретюн DDC извне) - rfSliceFreq // слайс перестроен извне (CAT); Id — FSliceFreqId + rfSliceFreq, // слайс перестроен извне (CAT); Id — FSliceFreqId + rfSliceState // у слайса сменились мода/фильтр/АРУ/DSP/громкость; Id — FSliceFreqId ); TRadioStateEvent = procedure(Sender: TObject; Field: TRadioField) of object; @@ -907,6 +908,7 @@ type // Уведомление UI «частота слайса пришла извне»: перезалить флаг (цифры + // кромки фильтра), позиция флага и так живая. procedure SliceFreqChanged(Id: Integer); + procedure SliceStateChanged(Id: Integer); // ---- Панадаптеры на аппаратных DDC (этап 3.1; UI/движок — 3.2/3.3) ---- // Создаёт пан PanId (1..MAX_PANS-1) на своём DDC: FreqHz = центр в ВИДИМЫХ @@ -2018,6 +2020,16 @@ begin Changed(rfSliceFreq); end; +procedure TRadioController.SliceStateChanged(Id: Integer); +// У слайса сменилось что-то кроме частоты: режим, фильтр, АРУ, DSP, громкость, +// мьют, шумоподавитель. Зовут сами сеттеры — слайс правят и UI, и CAT, и TCI, а +// узнать об этом должны все фронтенды сразу (у главного тракта для этого есть +// свои поля rfMode/rfFilter/…, у слайсов не было ничего). +begin + FSliceFreqId := Id; + Changed(rfSliceState); +end; + function TRadioController.TuneSliceInBand(Id: Integer; TargetHz: Double): Boolean; // Свобода внешней программы: она двигает слайс куда угодно ВНУТРИ включённого // диапазона (2 м на трансвертере: 144.174 при окне на 145.5 — можно), но сменить @@ -2548,6 +2560,7 @@ begin end; end; if FTxSliceId = Id then SyncCWKeyer; + SliceStateChanged(Id); end; procedure TRadioController.SetSliceFilter(Id, Low, High: Integer); @@ -2558,6 +2571,7 @@ begin FSlices[idx].FilterLo := Low; FSlices[idx].FilterHi := High; if Assigned(FDSPEngine) then FDSPEngine.SetSliceFilter(Id, Low, High); + SliceStateChanged(Id); end; procedure TRadioController.SetSliceAGCMode(Id: Integer; AGC: TWDSPAGCMode); @@ -2567,6 +2581,7 @@ begin if idx < 0 then Exit; FSlices[idx].AGC := AGC; if Assigned(FDSPEngine) then FDSPEngine.SetSliceAGC(Id, AGC); + SliceStateChanged(Id); end; procedure TRadioController.SetSliceVolume(Id: Integer; Vol: Double); @@ -2576,6 +2591,7 @@ begin if idx < 0 then Exit; FSlices[idx].Volume := Vol; if Assigned(FDSPEngine) then FDSPEngine.SetSliceVolume(Id, Vol); + SliceStateChanged(Id); end; procedure TRadioController.SetSliceMute(Id: Integer; Mute: Boolean); @@ -2585,6 +2601,7 @@ begin if idx < 0 then Exit; FSlices[idx].Muted := Mute; if Assigned(FDSPEngine) then FDSPEngine.SetSliceMute(Id, Mute); + SliceStateChanged(Id); end; procedure TRadioController.SetSliceRxMuteOnTx(Id: Integer; On_: Boolean); @@ -2639,6 +2656,7 @@ begin FDSPEngine.SetSliceSNB(Id, SNBOn); FDSPEngine.SetSliceANF(Id, ANFOn); end; + SliceStateChanged(Id); end; procedure TRadioController.SetSliceFMSquelch(Id: Integer; On_: Boolean; Level: Integer); @@ -2650,6 +2668,7 @@ begin FSlices[idx].FMSQLevel := Level; if Assigned(FDSPEngine) then FDSPEngine.SetSliceFMSquelch(Id, On_, Level); + SliceStateChanged(Id); end; function TRadioController.SliceSMeter(Id: Integer): Double; diff --git a/SettingsForm.pas b/SettingsForm.pas index 5b4fed7..2e8abde 100644 --- a/SettingsForm.pas +++ b/SettingsForm.pas @@ -475,6 +475,11 @@ type FChkTCIEnabled: TFlatCheckBox; FEdTCIPort: TFlatSpinEdit; FEdTCIBind: TFlatEdit; + // Последнее применённое: обработчик висит на уходе фокуса и на Close, + // а перезапускать сервер без правки нельзя (порвёт клиентов). + FTCILastEnabled: Boolean; + FTCILastPort: Integer; + FTCILastBind: string; // ---- Close button ---- FBtnClose: TFlatButton; @@ -3478,7 +3483,9 @@ begin Spin.MinValue := 1; Spin.MaxValue := 65535; Spin.Value := 40001; - Spin.OnChange := OnTCIAnyChange; + // Применяем по уходу фокуса, а не на каждое нажатие: набирая «40001», через + // OnChange мы бы подряд перезапустили сервер на портах 4, 40, 400, 4000. + Spin.OnExit := OnTCIAnyChange; FEdTCIPort := Spin; Y := Y + ROW_H; @@ -3490,7 +3497,9 @@ begin Ed.Font.Color := CLR_INPUT_TEXT; Ed.Font.Size := 9; Ed.Text := '127.0.0.1'; - Ed.OnChange := OnTCIAnyChange; + // Тем более адрес: промежуточное «127.0.0.» — не адрес, и раньше это молча + // означало «слушать на всех интерфейсах». Применяем по уходу фокуса. + Ed.OnExit := OnTCIAnyChange; FEdTCIBind := Ed; // Авторизации в протоколе нет: открытый наружу порт = полный доступ к трансиверу. @@ -3749,7 +3758,16 @@ procedure TSettingsForm.OnTCIAnyChange(Sender: TObject); begin if FLoading then Exit; if not Assigned(FOnTCISettingsChange) then Exit; - FOnTCISettingsChange(FChkTCIEnabled.Checked, FEdTCIPort.Value, FEdTCIBind.Text); + // Применение перезапускает сервер и рвёт соединения клиентов, поэтому зовём + // только на РЕАЛЬНОЕ изменение: обработчик висит и на уходе фокуса, и на + // кнопке Close, а они срабатывают и без правок. + if (FChkTCIEnabled.Checked = FTCILastEnabled) and + (FEdTCIPort.Value = FTCILastPort) and + (FEdTCIBind.Text = FTCILastBind) then Exit; + FTCILastEnabled := FChkTCIEnabled.Checked; + FTCILastPort := FEdTCIPort.Value; + FTCILastBind := FEdTCIBind.Text; + FOnTCISettingsChange(FTCILastEnabled, FTCILastPort, FTCILastBind); end; procedure TSettingsForm.LoadTCISettings(Enabled: Boolean; Port: Integer; @@ -3760,6 +3778,9 @@ begin FChkTCIEnabled.Checked := Enabled; FEdTCIPort.Value := EnsureRange(Port, 1, 65535); FEdTCIBind.Text := BindAddr; + FTCILastEnabled := FChkTCIEnabled.Checked; + FTCILastPort := FEdTCIPort.Value; + FTCILastBind := FEdTCIBind.Text; finally FLoading := False; end; @@ -4594,6 +4615,10 @@ end; procedure TSettingsForm.BtnCloseClick(Sender: TObject); begin + // Порт и адрес TCI применяются по уходу фокуса (см. BuildAdvancedTab), а из + // поля, в котором стоит курсор, при закрытии окна фокус может и не уйти — + // дожимаем правку здесь, иначе она молча пропадёт. + OnTCIAnyChange(nil); Close; end; diff --git a/TCIAdapter.pas b/TCIAdapter.pas index 1575f32..81b5cb9 100644 --- a/TCIAdapter.pas +++ b/TCIAdapter.pas @@ -14,7 +14,7 @@ unit TCIAdapter; • Геттеры читают поля контроллера напрямую из потока клиента (атомарное чтение, как в CAT). • Сеттеры пишут параметр в scratch-поля под FLock и зовут - FController.Invoke(SyncXxx) — исполнение в потоке контроллера. + if CanInvoke then FController.Invoke(SyncXxx) — исполнение в потоке контроллера. • Уведомления наружу идут из OnState (поток контроллера) рассылкой всем клиентам: сервер TCI обязан синхронизировать всех подключённых (§3.5). @@ -67,21 +67,17 @@ type FServer: TTCIServer; FLock: TCriticalSection; - // ── Эхо-состояние ── + // ── Эхо-состояние (пишут потоки клиентов ⇒ только под FEchoLock) ── + FEchoLock: TCriticalSection; FEcho: array[0..TCI_MAX_RX-1] of TTCIRxEcho; FDiglOffset: Integer; FDiguOffset: Integer; - FIQRate: Integer; - FAudioRate: Integer; - FAudioSamples: Integer; - FAudioChannels: Integer; - FAudioSampleType: string; - FTxBuffering: Integer; FCwTerminal: Boolean; // ── Кэш для подавления повторов в уведомлениях ── FLastTxFreq: Double; FLastTxEnable: Boolean; + FOnFocusRequest: TThreadMethod; // ── scratch для маршалинга в поток контроллера ── FsFreq: Double; @@ -120,19 +116,28 @@ type procedure SyncSetCWDelay; procedure SyncCWSend; procedure SyncCWStop; + procedure SyncFocus; // ── Помощники модели ── + 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 SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean; function ChanFreq(Rx, Ch: Integer): Double; function ChanCount(Rx: Integer): Integer; function RxCenterHz(Rx: Integer): Double; function RxMode(Rx: Integer): Integer; procedure RxFilter(Rx: Integer; out Lo, Hi: Integer); function RxMuted(Rx: Integer): Boolean; - function RxVolumeDb(Rx: Integer): Double; + function RxVolumeDb(Rx, Ch: Integer): Double; function RxAGCUi(Rx: Integer): Integer; + function RxNROn(Rx: Integer): Boolean; + function RxNBOn(Rx: Integer): Boolean; + function RxANFOn(Rx: Integer): Boolean; + function RxSqlOn(Rx: Integer): Boolean; + function RxSqlLevel(Rx: Integer): Integer; function RxSMeterDbm(Rx, Ch: Integer): Double; function TxEnabled: Boolean; @@ -153,6 +158,12 @@ type function StrSqlEnable(Rx: Integer): string; function StrSqlLevel(Rx: Integer): string; function StrTxEnable(Rx: Integer): string; + function StrRxVolume(Rx, Ch: Integer): string; + function StrNR(Rx: Integer): string; + function StrNB(Rx: Integer): string; + function StrANF(Rx: Integer): string; + { Полный набор строк по приёмнику — рассылка после правки слайса. } + procedure BroadcastRxState(Rx, Ch: Integer); procedure SendInit(Client: TTCIClient); procedure SendState(Client: TTCIClient); @@ -174,8 +185,11 @@ type constructor Create(AController: TRadioController; ASpots: TDXSpotStore = nil); destructor Destroy; override; - { Настройки TCI: включение/порт/адрес. Зовётся при старте и из настроек. } - procedure ApplySettings(const T: TTCISettings); + { Настройки TCI: включение/порт/адрес. Зовётся при старте и из настроек. + False — включить просили, а порт не открылся (занят/нет прав/кривой + адрес): вызывающий обязан сказать это оператору, иначе тот останется с + галкой «включено» и мёртвым сервером. } + function ApplySettings(const T: TTCISettings): Boolean; function Active: Boolean; function ClientCount: Integer; @@ -187,6 +201,9 @@ type procedure NotifyAppFocus(InFocus: Boolean); property Server: TTCIServer read FServer; + { SET_IN_FOCUS (§4.3): клиент просит поднять окно программы. Ставит UI; + вызывается в потоке контроллера. nil — команда игнорируется. } + property OnFocusRequest: TThreadMethod read FOnFocusRequest write FOnFocusRequest; end; implementation @@ -202,6 +219,7 @@ begin FController := AController; FSpots := ASpots; FLock := TCriticalSection.Create; + FEchoLock := TCriticalSection.Create; for i := 0 to TCI_MAX_RX - 1 do begin @@ -210,12 +228,6 @@ begin FEcho[i].NBDuration := 25; for c := 0 to TCI_CHANNELS - 1 do FEcho[i].BalanceDb[c] := 0; end; - FIQRate := 48000; - FAudioRate := 48000; - FAudioSamples := 2048; - FAudioChannels := 2; - FAudioSampleType := 'float32'; - FTxBuffering := 50; FLastTxFreq := 0; FLastTxEnable := True; @@ -239,15 +251,27 @@ begin FreeAndNil(FServer); end; FLock.Free; + FEchoLock.Free; inherited; end; -procedure TTCIAdapter.ApplySettings(const T: TTCISettings); +function TTCIAdapter.ApplySettings(const T: TTCISettings): Boolean; begin FServer.Stop; - if not T.Enabled then Exit; - FServer.Configure(Word(EnsureRange(T.Port, 1, 65535)), T.BindAddr); - FServer.Start; + if not T.Enabled then Exit(True); + // Адрес разбирается ДО открытия сокета: невалидный означает отказ, а не + // «слушаем все интерфейсы» — авторизации в TCI нет (см. TCIParseIPv4). + Result := FServer.Configure(Word(EnsureRange(T.Port, 1, 65535)), T.BindAddr) + and FServer.Start; +end; + +function TTCIAdapter.CanInvoke: Boolean; +// Пока сервер останавливается, новых вызовов в поток контроллера не начинаем: +// останавливает нас как раз он (UI), и Synchronize из потока клиента в него +// уже не вернётся. +begin + Result := (FController <> nil) and + ((FServer = nil) or not FServer.Stopping); end; function TTCIAdapter.Active: Boolean; @@ -295,6 +319,52 @@ begin end; end; +function TTCIAdapter.RxSlice(Rx: Integer; out S: TCtrlSlice): Boolean; +// Слайс, представляющий приёмник Rx как целое (канал A). Для Rx=0 слайса нет: +// главный тракт живёт в полях контроллера. +var Id: Integer; +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); +end; + +function TTCIAdapter.SliceRxCh(Id: Integer; out Rx, Ch: Integer): Boolean; +// Обратное отображение слайс → (приёмник, канал). Нужно уведомлениям: контроллер +// сообщает об изменении Id, а клиенту адресуются номера TCI. +var i, Seen: Integer; 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 + begin + Rx := Pan; + Ch := Seen; + Exit(Seen < TCI_CHANNELS); + end; + Inc(Seen); + end; +end; + function TTCIAdapter.ChanCount(Rx: Integer): Integer; var i: Integer; begin @@ -357,12 +427,13 @@ begin if (Id > 0) and FController.GetSlice(Id, S) then Result := S.Muted; end; -function TTCIAdapter.RxVolumeDb(Rx: Integer): Double; +function TTCIAdapter.RxVolumeDb(Rx, Ch: Integer): Double; +// Громкость в TCI — величина канальная: у доп. пана второй слайс звучит своей. var S: TCtrlSlice; Id: Integer; begin if Rx = 0 then begin Result := TCIVolumeToDb(FController.FVolume); Exit; end; - Result := 0; - Id := SliceIdOf(Rx, 0); + Result := TCI_VOL_MIN_DB; + Id := SliceIdOf(Rx, Ch); if (Id > 0) and FController.GetSlice(Id, S) then Result := TCIVolumeToDb(Round(S.Volume * 100)); end; @@ -377,6 +448,44 @@ begin Result := TRadioController.AGCModeToUI(S.AGC); end; +// DSP и шумоподавитель: у доп. приёмника своё состояние (зеркало в TCtrlSlice). +// Читать тут глобальные поля главного тракта нельзя — клиент увидел бы чужие +// переключатели и, что хуже, записал бы их обратно. +function TTCIAdapter.RxNROn(Rx: Integer): Boolean; +var S: TCtrlSlice; +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; +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; +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; +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; +begin + if Rx = 0 then begin Result := FController.FFMSQLevel; Exit; end; + if RxSlice(Rx, S) then Result := S.FMSQLevel else Result := 0; +end; + function TTCIAdapter.RxSMeterDbm(Rx, Ch: Integer): Double; var Id: Integer; begin @@ -476,13 +585,13 @@ end; function TTCIAdapter.StrSqlEnable(Rx: Integer): string; begin - Result := TCIBuild('sql_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FFMSQOn)]); + Result := TCIBuild('sql_enable', [TCIIntStr(Rx), TCIBoolStr(RxSqlOn(Rx))]); end; function TTCIAdapter.StrSqlLevel(Rx: Integer): string; begin Result := TCIBuild('sql_level', [TCIIntStr(Rx), - TCIIntStr(Round(TCILevelToSql(FController.FFMSQLevel)))]); + TCIIntStr(Round(TCILevelToSql(RxSqlLevel(Rx))))]); end; function TTCIAdapter.StrTxEnable(Rx: Integer): string; @@ -490,6 +599,49 @@ begin Result := TCIBuild('tx_enable', [TCIIntStr(Rx), TCIBoolStr(TxEnabled)]); end; +function TTCIAdapter.StrRxVolume(Rx, Ch: Integer): string; +begin + Result := TCIBuild('rx_volume', [TCIIntStr(Rx), TCIIntStr(Ch), + TCIIntStr(Round(RxVolumeDb(Rx, Ch)))]); +end; + +function TTCIAdapter.StrNR(Rx: Integer): string; +begin + Result := TCIBuild('rx_nr_enable', [TCIIntStr(Rx), TCIBoolStr(RxNROn(Rx))]); +end; + +function TTCIAdapter.StrNB(Rx: Integer): string; +begin + Result := TCIBuild('rx_nb_enable', [TCIIntStr(Rx), TCIBoolStr(RxNBOn(Rx))]); +end; + +function TTCIAdapter.StrANF(Rx: Integer): string; +begin + Result := TCIBuild('rx_anf_enable', [TCIIntStr(Rx), TCIBoolStr(RxANFOn(Rx))]); +end; + +procedure TTCIAdapter.BroadcastRxState(Rx, Ch: Integer); +// Слайс перенастроили (кто угодно: TCI, CAT, оператор мышью) — синхронизируем +// всех клиентов. Канал B доп. пана в протоколе несёт только частоту и +// громкость: вид связи, фильтр, АРУ и шумодавы в TCI — свойства приёмника +// целиком, и относятся к каналу A. +begin + if (FServer = nil) or (FServer.ClientCount = 0) then Exit; + FServer.Broadcast(StrVfo(Rx, Ch)); + FServer.Broadcast(StrIf(Rx, Ch)); + FServer.Broadcast(StrRxVolume(Rx, Ch)); + if Ch <> 0 then Exit; + FServer.Broadcast(StrModulation(Rx)); + FServer.Broadcast(StrFilterBand(Rx)); + FServer.Broadcast(StrAGCMode(Rx)); + FServer.Broadcast(TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))])); + FServer.Broadcast(StrNR(Rx)); + FServer.Broadcast(StrNB(Rx)); + FServer.Broadcast(StrANF(Rx)); + FServer.Broadcast(StrSqlEnable(Rx)); + FServer.Broadcast(StrSqlLevel(Rx)); +end; + { ═══════════════════════════════════════════════════════════════════════════ Подключение клиента: инициализация + текущее состояние ═══════════════════════════════════════════════════════════════════════════ } @@ -530,44 +682,51 @@ end; procedure TTCIAdapter.SendState(Client: TTCIClient); var - Rx, Ch: Integer; + Rx, Ch, Chans: Integer; + E: TTCIRxEcho; begin for Rx := 0 to RxCount - 1 do begin + FEchoLock.Enter; + try E := FEcho[Rx]; finally FEchoLock.Leave; end; + Reply(Client, StrDds(Rx)); - for Ch := 0 to TCI_CHANNELS - 1 do + // Только реально существующие каналы: объявив пану второй канал, которого + // нет, мы отдали бы клиенту vfo:rx,1,0 — и он принял бы ноль за частоту. + Chans := ChanCount(Rx); + if Chans < 1 then Chans := 1; + for Ch := 0 to Chans - 1 do begin Reply(Client, StrVfo(Rx, Ch)); Reply(Client, StrIf(Rx, Ch)); - Reply(Client, TCIBuild('rx_volume', [TCIIntStr(Rx), TCIIntStr(Ch), - TCIIntStr(Round(RxVolumeDb(Rx)))])); + Reply(Client, StrRxVolume(Rx, Ch)); Reply(Client, TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch), - TCIIntStr(FEcho[Rx].BalanceDb[Ch])])); + TCIIntStr(E.BalanceDb[Ch])])); end; Reply(Client, TCIBuild('rx_channel_enable', - [TCIIntStr(Rx), '1', TCIBoolStr((Rx = 0) or (ChanCount(Rx) > 1))])); + [TCIIntStr(Rx), '1', TCIBoolStr(Chans > 1)])); Reply(Client, StrModulation(Rx)); Reply(Client, StrFilterBand(Rx)); Reply(Client, StrAGCMode(Rx)); Reply(Client, StrAGCGain(Rx)); Reply(Client, TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))])); - Reply(Client, TCIBuild('rx_nb_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FNBMode > 0)])); + Reply(Client, StrNB(Rx)); Reply(Client, TCIBuild('rx_nb_param', [TCIIntStr(Rx), - TCIIntStr(FEcho[Rx].NBThreshold), TCIIntStr(FEcho[Rx].NBDuration)])); - Reply(Client, TCIBuild('rx_nr_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FNRMode > 0)])); - Reply(Client, TCIBuild('rx_anf_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FANF)])); - Reply(Client, TCIBuild('rx_bin_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].BinOn)])); - Reply(Client, TCIBuild('rx_anc_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].ANCOn)])); - Reply(Client, TCIBuild('rx_apf_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].APFOn)])); - Reply(Client, TCIBuild('rx_dse_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].DSEOn)])); - Reply(Client, TCIBuild('rx_nf_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].NFOn)])); + TCIIntStr(E.NBThreshold), TCIIntStr(E.NBDuration)])); + Reply(Client, StrNR(Rx)); + Reply(Client, StrANF(Rx)); + Reply(Client, TCIBuild('rx_bin_enable', [TCIIntStr(Rx), TCIBoolStr(E.BinOn)])); + Reply(Client, TCIBuild('rx_anc_enable', [TCIIntStr(Rx), TCIBoolStr(E.ANCOn)])); + Reply(Client, TCIBuild('rx_apf_enable', [TCIIntStr(Rx), TCIBoolStr(E.APFOn)])); + Reply(Client, TCIBuild('rx_dse_enable', [TCIIntStr(Rx), TCIBoolStr(E.DSEOn)])); + Reply(Client, TCIBuild('rx_nf_enable', [TCIIntStr(Rx), TCIBoolStr(E.NFOn)])); Reply(Client, StrLock(Rx)); Reply(Client, StrSqlEnable(Rx)); Reply(Client, StrSqlLevel(Rx)); - Reply(Client, TCIBuild('rit_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].RitOn)])); - Reply(Client, TCIBuild('rit_offset', [TCIIntStr(Rx), TCIIntStr(FEcho[Rx].RitHz)])); - Reply(Client, TCIBuild('xit_enable', [TCIIntStr(Rx), TCIBoolStr(FEcho[Rx].XitOn)])); - Reply(Client, TCIBuild('xit_offset', [TCIIntStr(Rx), TCIIntStr(FEcho[Rx].XitHz)])); + Reply(Client, TCIBuild('rit_enable', [TCIIntStr(Rx), TCIBoolStr(E.RitOn)])); + Reply(Client, TCIBuild('rit_offset', [TCIIntStr(Rx), TCIIntStr(E.RitHz)])); + Reply(Client, TCIBuild('xit_enable', [TCIIntStr(Rx), TCIBoolStr(E.XitOn)])); + Reply(Client, TCIBuild('xit_offset', [TCIIntStr(Rx), TCIIntStr(E.XitHz)])); Reply(Client, StrTxEnable(Rx)); end; @@ -582,10 +741,15 @@ begin Reply(Client, TCIBuild('mon_enable', [TCIBoolStr(not FController.FRxMuteOnTx)])); Reply(Client, TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); Reply(Client, TCIBuild('cw_macros_delay', [TCIIntStr(FController.FCWSettings.RFDelayMS)])); - Reply(Client, TCIBuild('digl_offset', [TCIIntStr(FDiglOffset)])); - Reply(Client, TCIBuild('digu_offset', [TCIIntStr(FDiguOffset)])); - Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(FIQRate)])); - Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(FAudioRate)])); + FEchoLock.Enter; + try + Reply(Client, TCIBuild('digl_offset', [TCIIntStr(FDiglOffset)])); + Reply(Client, TCIBuild('digu_offset', [TCIIntStr(FDiguOffset)])); + finally + FEchoLock.Leave; + end; + Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)])); + Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)])); if FController.FRunning then Reply(Client, TCIBuild('start')) else Reply(Client, TCIBuild('stop')); end; @@ -618,7 +782,13 @@ begin Exit; end; Id := SliceIdOf(FsInt, FsInt2); - if Id > 0 then FController.SetSliceTarget(Id, FsFreq); + if Id > 0 then + begin + FController.SetSliceTarget(Id, FsFreq); + // Уведомление контроллера: без него о перестройке слайса не узнают ни UI + // (флаг остался бы со старыми цифрами), ни остальные клиенты TCI. + FController.SliceFreqChanged(Id); + end; end; procedure TTCIAdapter.SyncSetCenter; @@ -693,7 +863,7 @@ procedure TTCIAdapter.SyncSetRxVolume; var Id: Integer; begin if FsInt = 0 then begin FController.SetVolume(FsInt2); Exit; end; - Id := SliceIdOf(FsInt, 0); + Id := SliceIdOf(FsInt, FsInt3); // FsInt3 — канал: у слайсов громкость своя if Id > 0 then FController.SetSliceVolume(Id, FsInt2 / 100.0); end; @@ -722,8 +892,12 @@ begin FController.SetAGCTop(FsInt); end; +// DSP слайса ставится одной командой на все четыре блока, поэтому остальные три +// берём из САМОГО слайса. Подставлять сюда поля главного тракта (как было) +// значило бы: включил клиент NR на доп. приёмнике — и заодно переписал ему NB, +// SNB и ANF значениями главного. procedure TTCIAdapter.SyncSetNR; -var Id: Integer; +var Id: Integer; S: TCtrlSlice; begin if FsInt = 0 then begin @@ -731,13 +905,12 @@ begin Exit; end; Id := SliceIdOf(FsInt, 0); - if Id > 0 then - FController.SetSliceDSP(Id, Ord(FsBool), FController.FNBMode, - FController.FSNB, FController.FANF); + if (Id > 0) and FController.GetSlice(Id, S) then + FController.SetSliceDSP(Id, Ord(FsBool), S.NBMode, S.SNB, S.ANF); end; procedure TTCIAdapter.SyncSetNB; -var Id: Integer; +var Id: Integer; S: TCtrlSlice; begin if FsInt = 0 then begin @@ -745,19 +918,17 @@ begin Exit; end; Id := SliceIdOf(FsInt, 0); - if Id > 0 then - FController.SetSliceDSP(Id, FController.FNRMode, Ord(FsBool), - FController.FSNB, FController.FANF); + if (Id > 0) and FController.GetSlice(Id, S) then + FController.SetSliceDSP(Id, S.NRMode, Ord(FsBool), S.SNB, S.ANF); end; procedure TTCIAdapter.SyncSetANF; -var Id: Integer; +var Id: Integer; S: TCtrlSlice; begin if FsInt = 0 then begin FController.SetANF(FsBool); Exit; end; Id := SliceIdOf(FsInt, 0); - if Id > 0 then - FController.SetSliceDSP(Id, FController.FNRMode, FController.FNBMode, - FController.FSNB, FsBool); + if (Id > 0) and FController.GetSlice(Id, S) then + FController.SetSliceDSP(Id, S.NRMode, S.NBMode, S.SNB, FsBool); end; procedure TTCIAdapter.SyncSetLock; @@ -765,20 +936,24 @@ begin FController.SetVfoLock(FsBool); end; +// Squelch слайса — тоже парный сеттер: второй параметр берём из слайса, а не +// из главного тракта (иначе правка порога сбрасывала бы включение, и наоборот). procedure TTCIAdapter.SyncSetSql; -var Id: Integer; +var Id: Integer; S: TCtrlSlice; begin if FsInt = 0 then begin FController.SetFMSquelch(FsBool); Exit; end; Id := SliceIdOf(FsInt, 0); - if Id > 0 then FController.SetSliceFMSquelch(Id, FsBool, FController.FFMSQLevel); + if (Id > 0) and FController.GetSlice(Id, S) then + FController.SetSliceFMSquelch(Id, FsBool, S.FMSQLevel); end; procedure TTCIAdapter.SyncSetSqlLevel; -var Id: Integer; +var Id: Integer; S: TCtrlSlice; begin if FsInt = 0 then begin FController.SetFMSquelchLevel(FsInt2); Exit; end; Id := SliceIdOf(FsInt, 0); - if Id > 0 then FController.SetSliceFMSquelch(Id, FController.FFMSQOn, FsInt2); + if (Id > 0) and FController.GetSlice(Id, S) then + FController.SetSliceFMSquelch(Id, S.FMSQOn, FsInt2); end; procedure TTCIAdapter.SyncSetRun; @@ -812,6 +987,13 @@ begin FController.CWXAbort; end; +procedure TTCIAdapter.SyncFocus; +// SET_IN_FOCUS: поднять окно программы. Само окно адаптеру недоступно (он +// равноправный клиент контроллера) — действие ставит UI через OnFocusRequest. +begin + if Assigned(FOnFocusRequest) then FOnFocusRequest; +end; + { ═══════════════════════════════════════════════════════════════════════════ Разбор команд клиента ═══════════════════════════════════════════════════════════════════════════ } @@ -834,7 +1016,7 @@ begin FLock.Enter; try FsInt := Rx; FsInt2 := Ch; FsFreq := Hz; - FController.Invoke(SyncSetVfo); + if CanInvoke then FController.Invoke(SyncSetVfo); finally FLock.Leave; end; @@ -898,7 +1080,7 @@ begin FLock.Enter; try FsStr := Text; - FController.Invoke(SyncCWSend); + if CanInvoke then FController.Invoke(SyncCWSend); finally FLock.Leave; end; @@ -963,13 +1145,13 @@ begin if M.Name = 'START' then begin FLock.Enter; - try FsBool := True; FController.Invoke(SyncSetRun); finally FLock.Leave; end; + try FsBool := True; if CanInvoke then FController.Invoke(SyncSetRun); finally FLock.Leave; end; Exit; end; if M.Name = 'STOP' then begin FLock.Enter; - try FsBool := False; FController.Invoke(SyncSetRun); finally FLock.Leave; end; + try FsBool := False; if CanInvoke then FController.Invoke(SyncSetRun); finally FLock.Leave; end; Exit; end; @@ -987,7 +1169,7 @@ begin FLock.Enter; try FsInt := Rx; FsFreq := D; - FController.Invoke(SyncSetCenter); + if CanInvoke then FController.Invoke(SyncSetCenter); finally FLock.Leave; end; end; Reply(Client, StrDds(Rx)); @@ -1007,7 +1189,7 @@ begin FLock.Enter; try FsInt := Rx; FsInt2 := V; - FController.Invoke(SyncSetMode); + if CanInvoke then FController.Invoke(SyncSetMode); finally FLock.Leave; end; end; end; @@ -1026,7 +1208,7 @@ begin FsInt := Rx; FsInt2 := TCIArgInt(M, 1, 0); FsInt3 := TCIArgInt(M, 2, 0); - FController.Invoke(SyncSetFilter); + if CanInvoke then FController.Invoke(SyncSetFilter); finally FLock.Leave; end; end; Reply(Client, StrFilterBand(Rx)); @@ -1043,7 +1225,7 @@ begin FLock.Enter; try FsBool := TCIArgBool(M, 1, False); - FController.Invoke(SyncSetTRX); + if CanInvoke then FController.Invoke(SyncSetTRX); finally FLock.Leave; end; end; Reply(Client, StrTrx); @@ -1057,7 +1239,7 @@ begin FLock.Enter; try FsBool := TCIArgBool(M, 1, False); - FController.Invoke(SyncSetTune); + if CanInvoke then FController.Invoke(SyncSetTune); finally FLock.Leave; end; end; Reply(Client, StrTune); @@ -1071,7 +1253,7 @@ begin FLock.Enter; try FsInt := EnsureRange(TCIArgInt(M, 1, 0), 0, 100); - FController.Invoke(SyncSetDrive); + if CanInvoke then FController.Invoke(SyncSetDrive); finally FLock.Leave; end; end; Reply(Client, StrDrive); @@ -1085,7 +1267,7 @@ begin FLock.Enter; try FsInt := EnsureRange(TCIArgInt(M, 1, 0), 0, 100); - FController.Invoke(SyncSetTuneDrive); + if CanInvoke then FController.Invoke(SyncSetTuneDrive); finally FLock.Leave; end; end; Reply(Client, TCIBuild('tune_drive', ['0', @@ -1100,7 +1282,7 @@ begin FLock.Enter; try FsBool := TCIArgBool(M, 1, False); - FController.Invoke(SyncSetSplit); + if CanInvoke then FController.Invoke(SyncSetSplit); finally FLock.Leave; end; end; Reply(Client, TCIBuild('split_enable', ['0', TCIBoolStr(FController.FSplitTxB)])); @@ -1115,7 +1297,7 @@ begin FLock.Enter; try FsInt := TCIDbToVolume(TCIArgFloat(M, 0, -60)); - FController.Invoke(SyncSetVolume); + if CanInvoke then FController.Invoke(SyncSetVolume); finally FLock.Leave; end; end; Reply(Client, StrVolume); @@ -1129,7 +1311,7 @@ begin FLock.Enter; try FsBool := TCIArgBool(M, 0, False); - FController.Invoke(SyncSetMute); + if CanInvoke then FController.Invoke(SyncSetMute); finally FLock.Leave; end; end; Reply(Client, StrMute); @@ -1145,7 +1327,7 @@ begin FLock.Enter; try FsInt := Rx; FsBool := TCIArgBool(M, 1, False); - FController.Invoke(SyncSetRxMute); + if CanInvoke then FController.Invoke(SyncSetRxMute); finally FLock.Leave; end; end; Reply(Client, TCIBuild('rx_mute', [TCIIntStr(Rx), TCIBoolStr(RxMuted(Rx))])); @@ -1163,11 +1345,11 @@ begin try FsInt := Rx; FsInt2 := TCIDbToVolume(TCIArgFloat(M, 2, -60)); - FController.Invoke(SyncSetRxVolume); + FsInt3 := Ch; + if CanInvoke then FController.Invoke(SyncSetRxVolume); finally FLock.Leave; end; end; - Reply(Client, TCIBuild('rx_volume', [TCIIntStr(Rx), TCIIntStr(Ch), - TCIIntStr(Round(RxVolumeDb(Rx)))])); + Reply(Client, StrRxVolume(Rx, Ch)); Exit; end; @@ -1177,10 +1359,16 @@ begin Rx := TCIArgInt(M, 0, -1); Ch := EnsureRange(TCIArgInt(M, 1, 0), 0, TCI_CHANNELS - 1); if not ValidRx(Rx) then Exit; - if M.ArgCount >= 3 then - FEcho[Rx].BalanceDb[Ch] := EnsureRange(TCIArgInt(M, 2, 0), -40, 40); + FEchoLock.Enter; + try + if M.ArgCount >= 3 then + FEcho[Rx].BalanceDb[Ch] := EnsureRange(TCIArgInt(M, 2, 0), -40, 40); + V := FEcho[Rx].BalanceDb[Ch]; + finally + FEchoLock.Leave; + end; FServer.Broadcast(TCIBuild('rx_balance', [TCIIntStr(Rx), TCIIntStr(Ch), - TCIIntStr(FEcho[Rx].BalanceDb[Ch])])); + TCIIntStr(V)])); Exit; end; @@ -1191,7 +1379,7 @@ begin FLock.Enter; try FsInt := TCIDbToVolume(TCIArgFloat(M, 0, -60)); - FController.Invoke(SyncSetMonVolume); + if CanInvoke then FController.Invoke(SyncSetMonVolume); finally FLock.Leave; end; end; Reply(Client, TCIBuild('mon_volume', @@ -1206,7 +1394,7 @@ begin FLock.Enter; try FsBool := TCIArgBool(M, 0, False); - FController.Invoke(SyncSetMonEnable); + if CanInvoke then FController.Invoke(SyncSetMonEnable); finally FLock.Leave; end; end; Reply(Client, TCIBuild('mon_enable', [TCIBoolStr(not FController.FRxMuteOnTx)])); @@ -1230,7 +1418,7 @@ begin FLock.Enter; try FsInt := Rx; FsInt2 := V; - FController.Invoke(SyncSetAGCMode); + if CanInvoke then FController.Invoke(SyncSetAGCMode); finally FLock.Leave; end; end; end; @@ -1242,12 +1430,15 @@ begin begin Rx := TCIArgInt(M, 0, -1); if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then + // AGC-T (порог АРУ) в ewsdr один на приёмный тракт: у слайса своего нет. + // Правка от имени доп. приёмника трогала бы главный — не делаем этого, + // просто отвечаем текущим значением (ограничение, см. doc/TCI.md). + if (M.ArgCount >= 2) and (Rx = 0) then begin FLock.Enter; try FsInt := EnsureRange(TCIArgInt(M, 1, 0), TCI_AGC_MIN_DB, TCI_AGC_MAX_DB); - FController.Invoke(SyncSetAGCTop); + if CanInvoke then FController.Invoke(SyncSetAGCTop); finally FLock.Leave; end; end; Reply(Client, StrAGCGain(Rx)); @@ -1265,17 +1456,14 @@ begin FLock.Enter; try FsInt := Rx; FsBool := TCIArgBool(M, 1, False); - if M.Name = 'RX_NR_ENABLE' then FController.Invoke(SyncSetNR) - else if M.Name = 'RX_NB_ENABLE' then FController.Invoke(SyncSetNB) - else FController.Invoke(SyncSetANF); + 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); finally FLock.Leave; end; end; - if M.Name = 'RX_NR_ENABLE' then - Reply(Client, TCIBuild('rx_nr_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FNRMode > 0)])) - else if M.Name = 'RX_NB_ENABLE' then - Reply(Client, TCIBuild('rx_nb_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FNBMode > 0)])) - else - Reply(Client, TCIBuild('rx_anf_enable', [TCIIntStr(Rx), TCIBoolStr(FController.FANF)])); + if M.Name = 'RX_NR_ENABLE' then Reply(Client, StrNR(Rx)) + else if M.Name = 'RX_NB_ENABLE' then Reply(Client, StrNB(Rx)) + else Reply(Client, StrANF(Rx)); Exit; end; @@ -1283,13 +1471,20 @@ begin begin Rx := TCIArgInt(M, 0, -1); if not ValidRx(Rx) then Exit; - 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); + 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); + end; + V := FEcho[Rx].NBThreshold; + Ch := FEcho[Rx].NBDuration; + finally + FEchoLock.Leave; end; - FServer.Broadcast(TCIBuild('rx_nb_param', [TCIIntStr(Rx), - TCIIntStr(FEcho[Rx].NBThreshold), TCIIntStr(FEcho[Rx].NBDuration)])); + FServer.Broadcast(TCIBuild('rx_nb_param', + [TCIIntStr(Rx), TCIIntStr(V), TCIIntStr(Ch)])); Exit; end; @@ -1301,19 +1496,24 @@ begin Rx := TCIArgInt(M, 0, -1); if not ValidRx(Rx) then Exit; B := TCIArgBool(M, 1, False); - if M.ArgCount >= 2 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 - else if M.Name = 'RX_APF_ENABLE' then FEcho[Rx].APFOn := B - else if M.Name = 'RX_DSE_ENABLE' then FEcho[Rx].DSEOn := B - else FEcho[Rx].NFOn := B; + FEchoLock.Enter; + try + if M.ArgCount >= 2 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 + else if M.Name = 'RX_APF_ENABLE' then FEcho[Rx].APFOn := B + else if M.Name = 'RX_DSE_ENABLE' then FEcho[Rx].DSEOn := B + else FEcho[Rx].NFOn := B; + end; + if M.Name = 'RX_BIN_ENABLE' then B := FEcho[Rx].BinOn + else if M.Name = 'RX_ANC_ENABLE' then B := FEcho[Rx].ANCOn + else if M.Name = 'RX_APF_ENABLE' then B := FEcho[Rx].APFOn + else if M.Name = 'RX_DSE_ENABLE' then B := FEcho[Rx].DSEOn + else B := FEcho[Rx].NFOn; + finally + FEchoLock.Leave; end; - if M.Name = 'RX_BIN_ENABLE' then B := FEcho[Rx].BinOn - else if M.Name = 'RX_ANC_ENABLE' then B := FEcho[Rx].ANCOn - else if M.Name = 'RX_APF_ENABLE' then B := FEcho[Rx].APFOn - else if M.Name = 'RX_DSE_ENABLE' then B := FEcho[Rx].DSEOn - else B := FEcho[Rx].NFOn; FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIBoolStr(B)])); Exit; end; @@ -1328,7 +1528,7 @@ begin FLock.Enter; try FsBool := TCIArgBool(M, 1, False); - FController.Invoke(SyncSetLock); + if CanInvoke then FController.Invoke(SyncSetLock); finally FLock.Leave; end; end; Reply(Client, StrLock(Rx)); @@ -1344,7 +1544,7 @@ begin FLock.Enter; try FsInt := Rx; FsBool := TCIArgBool(M, 1, False); - FController.Invoke(SyncSetSql); + if CanInvoke then FController.Invoke(SyncSetSql); finally FLock.Leave; end; end; Reply(Client, StrSqlEnable(Rx)); @@ -1361,7 +1561,7 @@ begin try FsInt := Rx; FsInt2 := TCISqlToLevel(TCIArgFloat(M, 1, -140)); - FController.Invoke(SyncSetSqlLevel); + if CanInvoke then FController.Invoke(SyncSetSqlLevel); finally FLock.Leave; end; end; Reply(Client, StrSqlLevel(Rx)); @@ -1373,12 +1573,17 @@ begin begin Rx := TCIArgInt(M, 0, -1); if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then - begin - if M.Name = 'RIT_ENABLE' then FEcho[Rx].RitOn := TCIArgBool(M, 1, False) - else FEcho[Rx].XitOn := TCIArgBool(M, 1, False); + FEchoLock.Enter; + try + if M.ArgCount >= 2 then + begin + if M.Name = 'RIT_ENABLE' then FEcho[Rx].RitOn := TCIArgBool(M, 1, False) + else FEcho[Rx].XitOn := TCIArgBool(M, 1, False); + end; + if M.Name = 'RIT_ENABLE' then B := FEcho[Rx].RitOn else B := FEcho[Rx].XitOn; + finally + FEchoLock.Leave; end; - if M.Name = 'RIT_ENABLE' then B := FEcho[Rx].RitOn else B := FEcho[Rx].XitOn; FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIBoolStr(B)])); Exit; end; @@ -1387,12 +1592,17 @@ begin begin Rx := TCIArgInt(M, 0, -1); if not ValidRx(Rx) then Exit; - if M.ArgCount >= 2 then - begin - if M.Name = 'RIT_OFFSET' then FEcho[Rx].RitHz := TCIArgInt(M, 1, 0) - else FEcho[Rx].XitHz := TCIArgInt(M, 1, 0); + FEchoLock.Enter; + try + if M.ArgCount >= 2 then + begin + if M.Name = 'RIT_OFFSET' then FEcho[Rx].RitHz := TCIArgInt(M, 1, 0) + else FEcho[Rx].XitHz := TCIArgInt(M, 1, 0); + end; + if M.Name = 'RIT_OFFSET' then V := FEcho[Rx].RitHz else V := FEcho[Rx].XitHz; + finally + FEchoLock.Leave; end; - if M.Name = 'RIT_OFFSET' then V := FEcho[Rx].RitHz else V := FEcho[Rx].XitHz; FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(Rx), TCIIntStr(V)])); Exit; end; @@ -1404,8 +1614,12 @@ begin Rx := TCIArgInt(M, 0, -1); Ch := TCIArgInt(M, 1, 1); if not ValidRx(Rx) then Exit; - if M.ArgCount >= 3 then FEcho[Rx].ChannelBOn := TCIArgBool(M, 2, False); - B := (Rx = 0) or (ChanCount(Rx) > 1); + if M.ArgCount >= 3 then + begin + FEchoLock.Enter; + try FEcho[Rx].ChannelBOn := TCIArgBool(M, 2, False); finally FEchoLock.Leave; end; + end; + B := ChanCount(Rx) > 1; FServer.Broadcast(TCIBuild('rx_channel_enable', [TCIIntStr(Rx), TCIIntStr(Ch), TCIBoolStr(B)])); Exit; @@ -1414,12 +1628,17 @@ begin // ── Смещения цифровых видов (эхо) ── if (M.Name = 'DIGL_OFFSET') or (M.Name = 'DIGU_OFFSET') then begin - if M.ArgCount >= 1 then - begin - V := EnsureRange(TCIArgInt(M, 0, 0), 0, 4000); - if M.Name = 'DIGL_OFFSET' then FDiglOffset := V else FDiguOffset := V; + FEchoLock.Enter; + try + if M.ArgCount >= 1 then + begin + V := EnsureRange(TCIArgInt(M, 0, 0), 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; + finally + FEchoLock.Leave; end; - if M.Name = 'DIGL_OFFSET' then V := FDiglOffset else V := FDiguOffset; FServer.Broadcast(TCIBuild(LowerCase(M.Name), [TCIIntStr(V)])); Exit; end; @@ -1432,7 +1651,7 @@ begin FLock.Enter; try FsInt := EnsureRange(TCIArgInt(M, 0, 20), 5, 60); - FController.Invoke(SyncSetCWSpeed); + if CanInvoke then FController.Invoke(SyncSetCWSpeed); finally FLock.Leave; end; end; Reply(Client, TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); @@ -1446,7 +1665,7 @@ begin FLock.Enter; try FsInt := EnsureRange(FController.FCWSettings.Speed + V, 5, 60); - FController.Invoke(SyncSetCWSpeed); + if CanInvoke then FController.Invoke(SyncSetCWSpeed); finally FLock.Leave; end; FServer.Broadcast(TCIBuild('cw_macros_speed', [TCIIntStr(FController.FCWSettings.Speed)])); Exit; @@ -1459,7 +1678,7 @@ begin FLock.Enter; try FsInt := EnsureRange(TCIArgInt(M, 0, 0), 0, 1000); - FController.Invoke(SyncSetCWDelay); + if CanInvoke then FController.Invoke(SyncSetCWDelay); finally FLock.Leave; end; end; Reply(Client, TCIBuild('cw_macros_delay', [TCIIntStr(FController.FCWSettings.RFDelayMS)])); @@ -1471,13 +1690,19 @@ begin if M.Name = 'CW_MACROS_STOP' then begin FLock.Enter; - try FController.Invoke(SyncCWStop); finally FLock.Leave; end; + try if CanInvoke then FController.Invoke(SyncCWStop); finally FLock.Leave; end; Exit; end; if M.Name = 'CW_TERMINAL' then begin - FCwTerminal := TCIArgBool(M, 0, False); - FServer.Broadcast(TCIBuild('cw_terminal', [TCIBoolStr(FCwTerminal)])); + FEchoLock.Enter; + try + FCwTerminal := TCIArgBool(M, 0, False); + B := FCwTerminal; + finally + FEchoLock.Leave; + end; + FServer.Broadcast(TCIBuild('cw_terminal', [TCIBoolStr(B)])); Exit; end; @@ -1512,37 +1737,49 @@ begin Exit; end; - // ── Параметры потоков: принимаем и подтверждаем, сами потоки — этап 2 ── + // Поднять окно программы (§4.3). Через UI: адаптер до окна не дотягивается. + if M.Name = 'SET_IN_FOCUS' then + begin + FLock.Enter; + try if CanInvoke then FController.Invoke(SyncFocus); finally FLock.Leave; end; + Exit; + end; + + // ── Параметры потоков ── + // Это настройки КЛИЕНТА (§4.3), а не устройства: два логгера вправе просить + // разную частоту дискретизации. Поэтому живут в его объекте, а не в адаптере + // — иначе один клиент перенастраивал бы будущие потоки всем остальным. + // Сами потоки — этап 2, значения только принимаются и подтверждаются. if M.Name = 'IQ_SAMPLERATE' then begin - if M.ArgCount >= 1 then FIQRate := TCIArgInt(M, 0, FIQRate); - Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(FIQRate)])); + if M.ArgCount >= 1 then Client.IQRate := TCIArgInt(M, 0, Client.IQRate); + Reply(Client, TCIBuild('iq_samplerate', [TCIIntStr(Client.IQRate)])); Exit; end; if M.Name = 'AUDIO_SAMPLERATE' then begin - if M.ArgCount >= 1 then FAudioRate := TCIArgInt(M, 0, FAudioRate); - Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(FAudioRate)])); + if M.ArgCount >= 1 then Client.AudioRate := TCIArgInt(M, 0, Client.AudioRate); + Reply(Client, TCIBuild('audio_samplerate', [TCIIntStr(Client.AudioRate)])); Exit; end; if M.Name = 'AUDIO_STREAM_SAMPLES' then begin - FAudioSamples := EnsureRange(TCIArgInt(M, 0, FAudioSamples), 100, 2048); + Client.AudioSamples := EnsureRange(TCIArgInt(M, 0, Client.AudioSamples), 100, 2048); Exit; end; if M.Name = 'AUDIO_STREAM_CHANNELS' then begin - FAudioChannels := EnsureRange(TCIArgInt(M, 0, FAudioChannels), 1, 2); + Client.AudioChannels := EnsureRange(TCIArgInt(M, 0, Client.AudioChannels), 1, 2); Exit; end; if M.Name = 'AUDIO_STREAM_SAMPLE_TYPE' then begin - FAudioSampleType := LowerCase(TCIArg(M, 0)); + Client.AudioSampleType := LowerCase(TCIArg(M, 0)); Exit; end; if M.Name = 'TX_STREAM_AUDIO_BUFFERING' then begin - FTxBuffering := EnsureRange(TCIArgInt(M, 0, FTxBuffering), 50, 500); + Client.TxBuffering := EnsureRange(TCIArgInt(M, 0, Client.TxBuffering), 50, 500); Exit; end; @@ -1606,7 +1843,7 @@ end; procedure TTCIAdapter.OnState(Sender: TObject; Field: TRadioField); var - Rx: Integer; + Rx, Ch: Integer; TxHz: Double; begin if (FServer = nil) or (FServer.ClientCount = 0) then Exit; @@ -1662,11 +1899,19 @@ begin if FController.FRunning then FServer.Broadcast(TCIBuild('start')) else FServer.Broadcast(TCIBuild('stop')); rfPanFreq: + // Центр пана уехал: у его каналов изменилась и IF (она отсчитывается + // от центра), хотя абсолютная частота могла остаться прежней. for Rx := 1 to RxCount - 1 do - if FController.PanDDCActive(Rx) then FServer.Broadcast(StrDds(Rx)); - rfSliceFreq: - for Rx := 1 to RxCount - 1 do - if FController.PanDDCActive(Rx) then FServer.Broadcast(StrVfo(Rx, 0)); + if FController.PanDDCActive(Rx) then + begin + FServer.Broadcast(StrDds(Rx)); + for Ch := 0 to ChanCount(Rx) - 1 do FServer.Broadcast(StrIf(Rx, Ch)); + end; + rfSliceFreq, rfSliceState: + // Кто именно изменился — в FSliceFreqId: рассылать состояние канала 0 + // всех панов (как было) значило бы врать про второй слайс. + if SliceRxCh(FController.FSliceFreqId, Rx, Ch) then + BroadcastRxState(Rx, Ch); rfBand, rfXvtr: begin FServer.Broadcast(StrTxEnable(0)); diff --git a/TCIServer.pas b/TCIServer.pas index 1992579..b6ebb99 100644 --- a/TCIServer.pas +++ b/TCIServer.pas @@ -15,6 +15,16 @@ unit TCIServer; • тикает OnTick (умолчание 20 мс) — по нему адаптер шлёт показания измерителей с индивидуальным для каждого клиента периодом. + Отправка НИКОГДА не блокирует того, кто зовёт Send/Broadcast: строка кладётся + в очередь клиента, а в сокет её пишет тик-поток (FlushClients). Иначе + медленный клиент останавливал бы UI-поток на секунду за раз — уведомления + рождаются в OnState, то есть внутри Changed() контроллера. + + Владение объектом клиента: создаёт accept-поток, освобождает ТОЛЬКО тик-поток + (ReapClients) и только после того, как клиентский поток честно вышел. Никто + больше клиентов не освобождает — поэтому указатель, взятый под FClientLock, + остаётся валидным, пока тик-поток не сделает следующий проход. + Бинарные фреймы (потоки IQ/аудио, §3.4) пока не обрабатываются: этап 2, см. doc/TCI.md. Приходящие от клиента binary-фреймы молча отбрасываются. @@ -43,14 +53,20 @@ const TCI_MAX_CLIENTS = 8; TCI_TICK_MS = 20; // период OnTick (сенсоры троттлятся адаптером) TCI_WS_GUID = '258EAFA5-E914-47DA-95CA-C5AB0DC85B11'; - TCI_SEND_TIMEOUT = 1000; // мс на SockSend, иначе клиент считается мёртвым + TCI_SEND_TIMEOUT = 300; // мс на SockSend, иначе клиент считается мёртвым + TCI_OUT_MAX = 4000; // потолок очереди отправки на клиента (строк) + TCI_OUT_CHUNK = 3800; // склейка очереди в один фрейм, символов + TCI_MSG_MAX = 65536; // потолок собираемого из фрагментов сообщения + TCI_STOP_WAIT_MS = 10000; // сколько ждём выхода клиентских потоков в Stop type TTCIServer = class; - { Один подключённый клиент: WS-сокет + его личные подписки. Подписки на - сенсоры в TCI индивидуальны (RX_SENSORS_ENABLE «отправляется только - клиентом»), поэтому живут здесь, а не в адаптере. } + { Один подключённый клиент: WS-сокет, его личные подписки и очередь + отправки. Подписки на сенсоры в TCI индивидуальны (RX_SENSORS_ENABLE + «отправляется только клиентом»), поэтому живут здесь, а не в адаптере. + Параметры потоков (§4.3) — тоже клиентские, их держит адаптер по ссылке + на этот объект. } TTCIClient = class private FWs: TWsClient; @@ -61,18 +77,45 @@ type FTxSensors: Boolean; FTxSensorsMs: Integer; FTxSensorsAt: QWord; + // Параметры бинарных потоков (§3.4): по спецификации это настройки + // КЛИЕНТА, а не устройства — свои у каждого подключения. + FIQRate: Integer; + FAudioRate: Integer; + FAudioSamples: Integer; + FAudioChannels: Integer; + FAudioSampleType: string; + FTxBuffering: Integer; + // Очередь отправки: пишут любые потоки, читает тик-поток. + FOutLock: TCriticalSection; + FOut: array of string; + FOutCount: Integer; + FDead: Boolean; // сокет уже не пишется — гасим соединение + FKilled: Boolean; // shutdown сокета уже сделан + FClosed: Boolean; // клиентский поток вышел (можно освобождать) public constructor Create(AWs: TWsClient); - { Текстовый фрейм клиенту. False — соединение уже мертво. } - function Send(const S: string): Boolean; + destructor Destroy; override; + { Строку в очередь клиенту. False — соединение уже мертво. Не блокирует. } + function Send(const S: string): Boolean; + { Слить очередь в сокет. Зовёт только тик-поток. False — клиент умер. } + function Flush: Boolean; + { Пометить мёртвым и разбудить его поток (shutdown сокета). } + procedure Kill; property Ws: TWsClient read FWs; property Ready: Boolean read FReady write FReady; + 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; end; TTCIClientEvent = procedure(Client: TTCIClient) of object; @@ -88,6 +131,7 @@ type FTickThread: TThread; FThreadCount: LongInt; // живых клиентских потоков (Interlocked*) FRunning: Boolean; + FStopping: Boolean; FPort: Word; FBindIP: string; FOnCommand: TTCICommandEvent; @@ -95,13 +139,15 @@ type FOnDisconnect: TTCIClientEvent; FOnTick: TThreadMethod; function InitListen: Boolean; - procedure RemoveClient(Client: TTCIClient); + procedure ReapClients; // освободить клиентов, чьи потоки вышли + procedure FlushClients; // слить очереди в сокеты (вне FClientLock) public constructor Create; destructor Destroy; override; - { Настройка слушателя. Применяется при следующем Start. } - procedure Configure(APort: Word; const ABindIP: string); + { Настройка слушателя. Применяется при следующем Start. + False — адрес не разобран (порт не откроется). } + function Configure(APort: Word; const ABindIP: string): Boolean; function Start: Boolean; procedure Stop; @@ -109,10 +155,11 @@ type { Всем клиентам, прошедшим инициализацию. Skip — кого пропустить (обычно автора изменения не пропускаем: сервер отвечает и ему тоже, - это и есть подтверждение установки). } + это и есть подтверждение установки). Только кладёт в очереди. } procedure Broadcast(const S: string; Skip: TTCIClient = nil); - { Обход клиентов под локом — для рассылки с индивидуальным периодом. } + { Обход клиентов под локом — для рассылки с индивидуальным периодом. + Proc обязана быть быстрой: она держит FClientLock. } procedure EnumClients(Proc: TTCIClientEvent); function ClientCount: Integer; @@ -123,14 +170,23 @@ type procedure HandleClient(Client: TTCIClient); procedure ThreadDone; // клиентский поток отработал - property Port: Word read FPort; - property BindIP: string read FBindIP; + property Port: Word read FPort; + property BindIP: string read FBindIP; + { Идёт остановка: адаптер не должен начинать новых вызовов в поток + контроллера — тот, кто нас останавливает, обычно и есть поток + контроллера, и Synchronize из клиентского потока в него не вернётся. } + property Stopping: Boolean read FStopping; property OnCommand: TTCICommandEvent read FOnCommand write FOnCommand; property OnConnect: TTCIClientEvent read FOnConnect write FOnConnect; property OnDisconnect: TTCIClientEvent read FOnDisconnect write FOnDisconnect; property OnTick: TThreadMethod read FOnTick write FOnTick; end; +{ IPv4 из строки в сетевом порядке. Строгий: ровно четыре десятичных октета + 0..255. '' и '0.0.0.0' — это INADDR_ANY (слушать везде), и только они: + «ошибка разбора = слушаем всё» в протоколе без авторизации недопустима. } +function TCIParseIPv4(const S: string; out Addr: LongWord): Boolean; + implementation type @@ -187,36 +243,51 @@ end; procedure TTCIClientThread.Execute; begin try - FServer.HandleClient(FClient); + try + FServer.HandleClient(FClient); + except + // Разбор фрейма рухнул — соединение всё равно закрываем штатно, иначе + // клиент остался бы висеть в массиве до остановки сервера. + end; finally - FServer.ThreadDone; // Stop ждёт обнуления счётчика перед зачисткой + // Освобождать себя нельзя: объект переиспользуется рассылкой из чужих + // потоков. Помечаем «поток вышел» — освободит тик-поток (ReapClients). + FClient.FClosed := True; + FServer.ThreadDone; end; end; -{ IPv4 из строки в сетевом порядке. Свой, потому что WebServer держит такой же - в implementation и наружу не отдаёт. } -function TCIParseIPv4(const S: string): LongWord; +function TCIParseIPv4(const S: string; out Addr: LongWord): Boolean; var Oct: array[0..3] of LongWord; - N, i, Start: Integer; + N, i, Start, V: Integer; Part: string; + c: Char; begin - Result := 0; // INADDR_ANY - if (S = '') or (S = '0.0.0.0') then Exit; + Addr := 0; // INADDR_ANY + Result := False; + if (Trim(S) = '') or (Trim(S) = '0.0.0.0') then Exit(True); + N := 0; Start := 1; for i := 1 to Length(S) + 1 do if (i > Length(S)) or (S[i] = '.') then begin - if N > 3 then Exit; + if N > 3 then Exit(False); Part := Copy(S, Start, i - Start); - Oct[N] := LongWord(StrToIntDef(Part, 0)) and $FF; + if (Part = '') or (Length(Part) > 3) then Exit(False); + for c in Part do + if (c < '0') or (c > '9') then Exit(False); + V := StrToIntDef(Part, -1); + if (V < 0) or (V > 255) then Exit(False); + Oct[N] := LongWord(V); Inc(N); Start := i + 1; end; - if N <> 4 then Exit; + if N <> 4 then Exit(False); // Сетевой порядок байт: первый октет — младший байт in_addr. - Result := Oct[0] or (Oct[1] shl 8) or (Oct[2] shl 16) or (Oct[3] shl 24); + Addr := Oct[0] or (Oct[1] shl 8) or (Oct[2] shl 16) or (Oct[3] shl 24); + Result := True; end; { ═══════════════════════════════════════════════════════════════════════════ @@ -232,11 +303,109 @@ begin FRxSensorsMs := 200; FTxSensors := False; FTxSensorsMs := 200; + FOutLock := TCriticalSection.Create; + FOutCount := 0; + SetLength(FOut, 64); + // Умолчания параметров потоков — как в §4.3 (клиент их обычно переопределяет). + FIQRate := 48000; + FAudioRate := 48000; + FAudioSamples := 2048; + FAudioChannels := 2; + FAudioSampleType := 'float32'; + FTxBuffering := 50; +end; + +destructor TTCIClient.Destroy; +begin + FOutLock.Free; + inherited; end; function TTCIClient.Send(const S: string): Boolean; begin - Result := (FWs <> nil) and (FWs.State = wsOpen) and FWs.SendText(S); + Result := False; + if (S = '') or FDead or (FWs = nil) then Exit; + FOutLock.Enter; + try + if FDead then Exit; + // Очередь переполнилась: клиент не читает сокет быстрее, чем мы пишем. + // Копить дальше нечестно (память + отставшее состояние), рвём соединение. + if FOutCount >= TCI_OUT_MAX then + begin + FDead := True; + Exit; + end; + if FOutCount >= Length(FOut) then SetLength(FOut, Length(FOut) * 2); + FOut[FOutCount] := S; + Inc(FOutCount); + Result := True; + finally + FOutLock.Leave; + end; +end; + +function TTCIClient.Flush: Boolean; +var + Batch: array of string; + N, i: Integer; + Chunk: string; +begin + Result := not FDead; + // Мёртвым клиента могла пометить и очередь (переполнилась в чужом потоке — + // там гасить сокет нельзя, лок чужой). Добиваем здесь: без shutdown его + // поток так и висел бы в recv, а объект никогда бы не освободился. + if FDead then begin Kill; Exit; end; + + FOutLock.Enter; + try + N := FOutCount; + if N > 0 then + begin + SetLength(Batch, N); + for i := 0 to N - 1 do + begin + Batch[i] := FOut[i]; + FOut[i] := ''; + end; + FOutCount := 0; + end; + finally + FOutLock.Leave; + end; + if N = 0 then Exit; + + // Склейка: несколько команд в одном фрейме протокол разрешает (§3.1), а + // syscall'ов и заголовков становится в разы меньше. + Chunk := ''; + for i := 0 to N - 1 do + begin + if (Chunk <> '') and (Length(Chunk) + Length(Batch[i]) > TCI_OUT_CHUNK) then + begin + if not FWs.SendText(Chunk) then begin Kill; Exit(False); end; + Chunk := ''; + end; + Chunk := Chunk + Batch[i]; + end; + if Chunk <> '' then + if not FWs.SendText(Chunk) then begin Kill; Exit(False); end; +end; + +procedure TTCIClient.Kill; +begin + FOutLock.Enter; + try + FDead := True; + FOutCount := 0; + if FKilled then Exit; // shutdown уже был — второй раз незачем + FKilled := True; + finally + FOutLock.Leave; + end; + if FWs <> nil then + begin + FWs.State := wsClosed; + SockShutdown(FWs.Socket); // будим поток клиента, висящий в recv + end; end; { ═══════════════════════════════════════════════════════════════════════════ @@ -269,10 +438,12 @@ begin inherited; end; -procedure TTCIServer.Configure(APort: Word; const ABindIP: string); +function TTCIServer.Configure(APort: Word; const ABindIP: string): Boolean; +var Dummy: LongWord; begin FPort := APort; FBindIP := ABindIP; + Result := (APort <> 0) and TCIParseIPv4(ABindIP, Dummy); end; function TTCIServer.Running: Boolean; @@ -284,8 +455,14 @@ function TTCIServer.InitListen: Boolean; var Addr: {$IFDEF WINDOWS}TSockAddrIn{$ELSE}TInetSockAddr{$ENDIF}; One: Integer; + IP: LongWord; begin Result := False; + // Кривой адрес — отказ. Молча свалиться в INADDR_ANY нельзя: в TCI нет + // авторизации, и открытый наружу порт отдаёт управление передатчиком. + if not TCIParseIPv4(FBindIP, IP) then Exit; + if FPort = 0 then Exit; + {$IFDEF WINDOWS} FListenSock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP); {$ELSE} @@ -299,7 +476,7 @@ begin FillChar(Addr, SizeOf(Addr), 0); Addr.sin_family := AF_INET; Addr.sin_port := htons(FPort); - Addr.sin_addr.S_addr := TCIParseIPv4(FBindIP); + Addr.sin_addr.S_addr := IP; if bind(FListenSock, @Addr, SizeOf(Addr)) = SOCKET_ERROR then Exit; if listen(FListenSock, 5) = SOCKET_ERROR then Exit; {$ELSE} @@ -307,7 +484,7 @@ begin FillChar(Addr, SizeOf(Addr), 0); Addr.sin_family := AF_INET; Addr.sin_port := htons(FPort); - Addr.sin_addr.s_addr := TCIParseIPv4(FBindIP); + Addr.sin_addr.s_addr := IP; if fpBind(FListenSock, @Addr, SizeOf(Addr)) <> 0 then Exit; if fpListen(FListenSock, 5) <> 0 then Exit; {$ENDIF} @@ -327,7 +504,8 @@ begin end; Exit; end; - FRunning := True; + FStopping := False; + FRunning := True; FAcceptThread := TTCIAcceptThread.Create(Self); TTCIAcceptThread(FAcceptThread).Start; FTickThread := TTCITickThread.Create(Self); @@ -339,7 +517,8 @@ procedure TTCIServer.Stop; var i, Waited: Integer; begin if not FRunning then Exit; - FRunning := False; + FStopping := True; // адаптер перестаёт звать Invoke (см. property Stopping) + FRunning := False; // Шаг 1: гасим listen-сокет. SockShutdown обязателен до close — иначе // fpAccept в accept-потоке не разблокируется (см. WebServer.Stop). @@ -354,11 +533,7 @@ begin FClientLock.Enter; try for i := 0 to FClientCount - 1 do - if FClients[i] <> nil then - begin - FClients[i].Ws.State := wsClosed; - SockShutdown(FClients[i].Ws.Socket); - end; + if FClients[i] <> nil then FClients[i].Kill; finally FClientLock.Leave; end; @@ -367,22 +542,24 @@ begin if FAcceptThread <> nil then begin FAcceptThread.WaitFor; FreeAndNil(FAcceptThread); end; if FTickThread <> nil then begin FTickThread.WaitFor; FreeAndNil(FTickThread); end; - // Шаг 4: даём клиентским потокам выйти самим. Освобождает клиента ТОТ, - // кто вынул его из массива (RemoveClient в клиентском потоке), — иначе - // Stop освободил бы объект из-под работающего потока. + // Шаг 4: ждём выхода клиентских потоков. Прокачивая очередь Synchronize: + // Stop зовёт поток контроллера (UI), а клиентский поток может как раз в нём + // висеть на FController.Invoke. Без прокачки это гарантированный взаимный + // клин, а по его истечении — освобождение объекта из-под живого потока. Waited := 0; - while (FThreadCount > 0) and (Waited < 2000) do + while (FThreadCount > 0) and (Waited < TCI_STOP_WAIT_MS) do begin - Sleep(10); - Inc(Waited, 10); + if GetCurrentThreadId = MainThreadID then CheckSynchronize(5) else Sleep(5); + Inc(Waited, 5); end; - // Вырожденный случай: поток завис (не должно случаться — сокеты закрыты). - // Чистим остатки, чтобы не течь; объекты уже никем не используются. + // Шаг 5: зачистка. Если поток всё же не вышел (не должно случаться: сокеты + // закрыты, очередь прокачана), объект НЕ освобождаем — утечка на выходе + // несравнимо дешевле обращения к освобождённой памяти из живого потока. FClientLock.Enter; try for i := 0 to FClientCount - 1 do - if FClients[i] <> nil then + if (FClients[i] <> nil) and FClients[i].FClosed then begin FClients[i].Ws.Free; FreeAndNil(FClients[i]); @@ -404,6 +581,7 @@ var ALen: {$IFDEF WINDOWS}Integer{$ELSE}TSockLen{$ENDIF}; Client: TTCIClient; T: TTCIClientThread; + Full: Boolean; begin while FRunning do begin @@ -418,46 +596,96 @@ begin if FRunning then Sleep(10); Continue; end; - if FClientCount >= TCI_MAX_CLIENTS then + if not FRunning then begin SockClose(CSock); - Continue; + Break; end; + SockSetSndTimeout(CSock, TCI_SEND_TIMEOUT); Client := TTCIClient.Create(TWsClient.Create(CSock)); + Full := False; FClientLock.Enter; try - FClients[FClientCount] := Client; - Inc(FClientCount); + // Слот берём под локом: место в массиве освобождает тик-поток. + if FClientCount >= TCI_MAX_CLIENTS then Full := True + else + begin + FClients[FClientCount] := Client; + Inc(FClientCount); + end; finally FClientLock.Leave; end; + if Full then + begin + Client.Ws.Free; // закрывает сокет + Client.Free; + Continue; + end; + InterLockedIncrement(FThreadCount); T := TTCIClientThread.Create(Self, Client); T.Start; end; end; -procedure TTCIServer.RemoveClient(Client: TTCIClient); -var i, j: Integer; +procedure TTCIServer.ReapClients; +// Освобождение клиентов — единственное место во всей программе. Зовёт только +// тик-поток, поэтому указатель, взятый кем угодно под FClientLock, живёт до +// следующего прохода тика (а вне лока указателей никто не держит). +var + i, j, N: Integer; + Doomed: array[0..TCI_MAX_CLIENTS-1] of TTCIClient; begin - if Client = nil then Exit; - if Assigned(FOnDisconnect) then FOnDisconnect(Client); + N := 0; FClientLock.Enter; try - for i := 0 to FClientCount - 1 do - if FClients[i] = Client then + i := 0; + while i < FClientCount do + if (FClients[i] <> nil) and FClients[i].FClosed then begin + Doomed[N] := FClients[i]; + Inc(N); for j := i to FClientCount - 2 do FClients[j] := FClients[j + 1]; FClients[FClientCount - 1] := nil; Dec(FClientCount); - Break; + end + else + Inc(i); + finally + FClientLock.Leave; + end; + + for i := 0 to N - 1 do + begin + if Assigned(FOnDisconnect) then FOnDisconnect(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; +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; - Client.Ws.Free; // закрывает сокет - Client.Free; + for i := 0 to N - 1 do + Snap[i].Flush; end; { ═══════════════════════════════════════════════════════════════════════════ @@ -470,13 +698,15 @@ var R, HeaderEnd: Integer; Header, HeaderLC, Key, AcceptKey, Response, Text: string; Raw: array[0..4095] of Byte; - RawLen: Integer; + RawLen, Rest: Integer; B0, B1: Byte; - Masked: Boolean; + Masked, Fin, Pending: Boolean; PayLen, Need, i, j, Consumed, KPos, KEnd: Integer; + Hi32: LongWord; Mask: array[0..3] of Byte; Payload: array of Byte; - Opcode: Byte; + Opcode, MsgOp: Byte; + Frag: string; Cmds: TStringList; begin Ws := Client.Ws; @@ -494,12 +724,10 @@ begin HeaderEnd := System.Pos(#13#10#13#10, Header); until (HeaderEnd > 0) or (RawLen >= SizeOf(Raw)); - if (Ws.State = wsClosed) or (HeaderEnd = 0) then - begin - RemoveClient(Client); Exit; - end; + if (Ws.State = wsClosed) or (HeaderEnd = 0) then Exit; - Header := Copy(Header, 1, HeaderEnd + 3); + Consumed := HeaderEnd + 3; // длина заголовков вместе с CRLFCRLF + Header := Copy(Header, 1, Consumed); HeaderLC := LowerCase(Header); // Путь не проверяем: клиенты ходят на '/', но протокол его не оговаривает. @@ -508,7 +736,7 @@ begin Response := 'HTTP/1.1 426 Upgrade Required'#13#10 + 'Content-Length: 0'#13#10'Connection: close'#13#10#13#10; Ws.SendRaw(Response[1], Length(Response)); - RemoveClient(Client); Exit; + Exit; end; Key := ''; @@ -520,37 +748,60 @@ begin if KEnd > 0 then Key := Copy(Key, 1, KEnd - 1); Key := Trim(Key); end; + // Пустой ключ = не WebSocket-клиент (или сломанный): Accept без ключа + // формально считается валидным, и такое «соединение» потом молча висит. + if Key = '' then + begin + Response := 'HTTP/1.1 400 Bad Request'#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 + 'Connection: Upgrade'#13#10 + 'Sec-WebSocket-Accept: ' + AcceptKey + #13#10#13#10; - if not Ws.SendRaw(Response[1], Length(Response)) then - begin - RemoveClient(Client); Exit; - end; + if not Ws.SendRaw(Response[1], Length(Response)) then Exit; Ws.State := wsOpen; + // Хвост первого пакета: клиент вправе прислать первый WS-фрейм в том же + // сегменте, что и заголовки. Выбросить его — потерять первую команду. + Rest := RawLen - Consumed; + if Rest > 0 then Move(Raw[Consumed], Ws.BufData[0], Rest); + Ws.BufLen := Rest; + // Пачка инициализации + текущее состояние (§3.1) — дело адаптера. if Assigned(FOnConnect) then FOnConnect(Client); // ── Цикл WS-сообщений ──────────────────────────────────────────────────── - Cmds := TStringList.Create; + Cmds := TStringList.Create; + Frag := ''; + MsgOp := 0; + Pending := Rest > 0; // хвост handshake разбираем до первого recv try - Ws.BufLen := 0; - while FRunning and (Ws.State = wsOpen) do + while FRunning and (Ws.State = wsOpen) and not Client.Dead do begin - R := Ws.Recv; - if R <= 0 then Break; + if not Pending then + begin + R := Ws.Recv; + if R <= 0 then Break; + end; + Pending := False; while Ws.BufLen >= 2 do begin B0 := Ws.BufData[0]; B1 := Ws.BufData[1]; + Fin := (B0 and $80) <> 0; Opcode := B0 and $0F; Masked := (B1 and $80) <> 0; PayLen := B1 and $7F; + // RSV1..3 без согласованных расширений обязаны быть нулями. + if (B0 and $70) <> 0 then begin Ws.State := wsClosed; Break; end; + Need := 2; if PayLen = 126 then Inc(Need, 2) else if PayLen = 127 then Inc(Need, 8); @@ -565,16 +816,34 @@ begin end else if PayLen = 127 then begin - PayLen := (Ws.BufData[6] shl 24) or (Ws.BufData[7] shl 16) or - (Ws.BufData[8] shl 8) or Ws.BufData[9]; + // 64-битная длина: старшие четыре байта обязаны быть нулём, иначе + // значение не помещается в Integer и превращается в отрицательное. + Hi32 := (LongWord(Ws.BufData[2]) shl 24) or (LongWord(Ws.BufData[3]) shl 16) or + (LongWord(Ws.BufData[4]) shl 8) or LongWord(Ws.BufData[5]); + if Hi32 <> 0 then begin Ws.State := wsClosed; Break; end; + Hi32 := (LongWord(Ws.BufData[6]) shl 24) or (LongWord(Ws.BufData[7]) shl 16) or + (LongWord(Ws.BufData[8]) shl 8) or LongWord(Ws.BufData[9]); + if Hi32 > LongWord(SizeOf(Raw)) then begin Ws.State := wsClosed; Break; end; + PayLen := Integer(Hi32); Inc(i, 8); end; + // Клиент ОБЯЗАН маскировать (RFC 6455 §5.1). Незамаскированный кадр — + // либо не клиент, либо попытка прогнать через нас чужой трафик. + if not Masked then begin Ws.State := wsClosed; Break; end; + + // Управляющие кадры: только короткие и только целиком (§5.5). + if (Opcode >= $08) and ((PayLen > 125) or (not Fin)) then + begin + Ws.State := wsClosed; + Break; + end; + // Фрейм крупнее приёмного буфера TWsClient никогда не соберётся — // BufLen упрётся в потолок и цикл встанет намертво. Рвём соединение: // команд такой длины у TCI нет, а бинарные потоки от клиента (TX-аудио) // мы пока не принимаем. - if Need + PayLen > 4096 then + if Need + PayLen > SizeOf(Raw) then begin Ws.State := wsClosed; Break; @@ -582,20 +851,16 @@ begin if Ws.BufLen < Need + PayLen then Break; - if Masked then - begin - Mask[0] := Ws.BufData[i]; Mask[1] := Ws.BufData[i+1]; - Mask[2] := Ws.BufData[i+2]; Mask[3] := Ws.BufData[i+3]; - Inc(i, 4); - end; + Mask[0] := Ws.BufData[i]; Mask[1] := Ws.BufData[i+1]; + Mask[2] := Ws.BufData[i+2]; Mask[3] := Ws.BufData[i+3]; + Inc(i, 4); SetLength(Payload, PayLen); if PayLen > 0 then begin Move(Ws.BufData[i], Payload[0], PayLen); - if Masked then - for j := 0 to PayLen - 1 do - Payload[j] := Payload[j] xor Mask[j and 3]; + for j := 0 to PayLen - 1 do + Payload[j] := Payload[j] xor Mask[j and 3]; end; Consumed := i + PayLen; @@ -604,18 +869,49 @@ begin Ws.BufLen := Ws.BufLen - Consumed; case Opcode of - $01: // текст — одна или несколько команд в одном фрейме + $00, $01, $02: // данные: продолжение / текст / binary begin - SetLength(Text, PayLen); - if PayLen > 0 then Move(Payload[0], Text[1], PayLen); - if Assigned(FOnCommand) then + if Opcode = $00 then begin - TCISplit(Text, Cmds); - for j := 0 to Cmds.Count - 1 do - FOnCommand(Client, Cmds[j]); + // Продолжение без начала — рассинхрон, дальше читать нечего. + if MsgOp = 0 then begin Ws.State := wsClosed; Break; end; + end + else + begin + // Новое сообщение поверх недособранного — тоже рассинхрон. + if MsgOp <> 0 then begin Ws.State := wsClosed; Break; end; + MsgOp := Opcode; + Frag := ''; + end; + + // Копим только текст: binary — это TX-аудио от клиента, этап 2. + if MsgOp = $01 then + begin + if Length(Frag) + PayLen > TCI_MSG_MAX then + begin + Ws.State := wsClosed; + Break; + end; + if PayLen > 0 then + begin + SetLength(Text, PayLen); + Move(Payload[0], Text[1], PayLen); + Frag := Frag + Text; + end; + end; + + if Fin then + begin + if (MsgOp = $01) and Assigned(FOnCommand) and (Frag <> '') then + begin + TCISplit(Frag, Cmds); + for j := 0 to Cmds.Count - 1 do + FOnCommand(Client, Cmds[j]); + end; + MsgOp := 0; + Frag := ''; end; end; - $02: ; // binary: TX-аудио от клиента — этап 2, пока игнорируем $08: // close begin Ws.State := wsClosed; @@ -624,14 +920,17 @@ begin $09: // ping → pong if PayLen > 0 then Ws.SendWsFrame($0A, Payload[0], PayLen) else Ws.SendWsFrame($0A, PayLen, 0); + $0A: ; // pong — ничего не ждём + else + // Незнакомый opcode: по RFC соединение обязано закрыться. + Ws.State := wsClosed; + Break; end; end; end; finally Cmds.Free; end; - - RemoveClient(Client); end; { ═══════════════════════════════════════════════════════════════════════════ @@ -644,6 +943,8 @@ begin if S = '' then Exit; FClientLock.Enter; try + // Send только кладёт строку в очередь клиента — лок держится микросекунды, + // сколько бы клиент ни тормозил. В сокеты пишет тик-поток. for i := 0 to FClientCount - 1 do if (FClients[i] <> nil) and (FClients[i] <> Skip) and FClients[i].Ready then FClients[i].Send(S); @@ -659,7 +960,7 @@ begin FClientLock.Enter; try for i := 0 to FClientCount - 1 do - if FClients[i] <> nil then Proc(FClients[i]); + if (FClients[i] <> nil) and not FClients[i].FClosed then Proc(FClients[i]); finally FClientLock.Leave; end; @@ -681,7 +982,9 @@ begin begin Sleep(TCI_TICK_MS); if not FRunning then Break; + ReapClients; // отключившиеся — освобождаем только здесь if (FClientCount > 0) and Assigned(FOnTick) then FOnTick; + FlushClients; // очереди → сокеты end; end; diff --git a/doc/TCI.md b/doc/TCI.md index 3ef7a0c..eb3e9f3 100644 --- a/doc/TCI.md +++ b/doc/TCI.md @@ -39,7 +39,30 @@ TCI-клиенты ──WebSocket──► TTCIServer ──► TTCIAdapter ─ подключённым — как того требует §3.5 спецификации. Отвечающий на команду клиент дополнительно получает прямой ответ. -### 1.1 Настройки +### 1.1 Три правила, на которых держится транспорт + +Всё это не украшения, а лечение конкретных отказов — менять с оглядкой. + +1. **Отправка никогда не блокирует вызывающего.** `Send`/`Broadcast` кладут + строку в очередь клиента (микросекунды под его локом), в сокет пишет + тик-поток (`FlushClients`, 20 мс, вне общего лока). Уведомления рождаются + внутри `Changed()` контроллера, то есть в UI-потоке: писать оттуда прямо в + сокет означало бы отдать интерфейс во власть самого медленного клиента + (таймаут отправки × число клиентов на каждое движение ручки VFO). + Переполнилась очередь (`TCI_OUT_MAX`) или не прошла запись — клиент + выбрасывается, а не тормозит остальных. +2. **Объект клиента освобождает только тик-поток** (`ReapClients`) и только + после того, как клиентский поток честно вышел. Поэтому указатель, взятый + кем угодно под `FClientLock`, гарантированно жив внутри лока. +3. **`Stop` прокачивает очередь `Synchronize`.** Останавливает сервер поток + контроллера (UI), а клиентский поток в этот момент может висеть как раз на + `Invoke` в него же. Без прокачки это взаимный клин; по его таймауту сервер + освобождал бы объекты из-под живых потоков. Дополнительно на время + остановки взводится `Stopping`, и адаптер новых `Invoke` уже не начинает. + Если поток всё же не вышел — объект НЕ освобождается: утечка на выходе + дешевле обращения к освобождённой памяти. + +### 1.2 Настройки Секция `tci` в корне `settings.json`: @@ -51,7 +74,19 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт **нет авторизации**: открытый наружу порт означает полный доступ к трансиверу, поэтому умолчание слушает только петлю. -### 1.2 Маппинг модели +Отсюда же два правила вокруг адреса: + +- разбор `bind_addr` строгий (ровно четыре октета 0..255); всё непонятное — + отказ поднимать сервер, а не молчаливый `0.0.0.0`. Пустая строка и явный + `0.0.0.0` — единственные способы попросить «все интерфейсы»; +- порт и адрес применяются по уходу фокуса из поля и по кнопке Close, а не на + каждое нажатие клавиши: иначе набор `127.0.0.1` по дороге проходил бы через + «`127.0.0.`» и сервер успевал перезапуститься на всех интерфейсах. + +Отказ старта (порт занят, адрес не разобран) виден оператору: `ApplySettings` +возвращает результат, MainForm показывает сообщение. + +### 1.3 Маппинг модели | TCI | EWSDR | |---|---| @@ -101,7 +136,7 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт | `RX_MUTE`, `RX_VOLUME` | громкость/мьют слайса | | `MON_VOLUME`, `MON_ENABLE` | `SetTXMonVolume`, `SetRxMuteOnTx` | | `AGC_MODE` | `off`→Off, `fast`→Fast, `normal`→Medium | -| `AGC_GAIN` | `SetAGCTop` (AGC-T) | +| `AGC_GAIN` | `SetAGCTop` (AGC-T) — **только приёмник 0**, см. §3 | | `RX_NR_ENABLE`, `RX_NB_ENABLE`, `RX_ANF_ENABLE` | `SetNR/SetNB/SetANF`, для панов — `SetSliceDSP` | | `LOCK` | `SetVfoLock` | | `SQL_ENABLE`, `SQL_LEVEL` | FM-шумоподавитель; дБ (-140..0) ↔ порог 0..100 | @@ -111,10 +146,14 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт ### 2.3 Однонаправленное управление (§4.3) `TX_ENABLE` (по `BackendCaps.HasTX` + `TXProhibited`), `CW_MACROS_SPEED_UP/DOWN`, +`SET_IN_FOCUS` (поднимает окно программы через `OnFocusRequest` — адаптер до +окна не дотягивается, действие ставит MainForm), `SPOT`, `SPOT_DELETE`, `SPOT_CLEAR` (в `TDXSpotStore`, спот виден на всех панадаптерах), `RX_SENSORS_ENABLE`, `TX_SENSORS_ENABLE` (период — на клиента), `IQ_SAMPLERATE`, `AUDIO_SAMPLERATE`, `AUDIO_STREAM_*`, `TX_STREAM_AUDIO_BUFFERING` -(значения принимаются и подтверждаются; сами потоки — этап 2). +(значения принимаются и подтверждаются; сами потоки — этап 2). Параметры +потоков — настройки **клиента**, а не устройства: живут в `TTCIClient`, и один +клиент не переопределяет их остальным. ### 2.4 Уведомления (§4.4, §4.5) @@ -124,6 +163,16 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт `CLICKED_ON_SPOT` (клик по подписи спота на любом панадаптере), `CALLSIGN_SEND` (после `CW_MSG`). +Отдельная история — **доп. приёмники**. У главного тракта на каждое поле есть +своё `rfXxx`, а у слайсов не было ничего: правка слайса не доходила ни до UI, +ни до остальных клиентов. Поэтому в контроллере появилось `rfSliceState` +(полезная нагрузка — `FSliceFreqId`, как у `rfSliceFreq`), и его шлют сами +сеттеры слайса: `SetSliceMode`, `SetSliceFilter`, `SetSliceAGCMode`, +`SetSliceVolume`, `SetSliceMute`, `SetSliceDSP`, `SetSliceFMSquelch`. +Адаптер разворачивает Id обратно в пару (приёмник, канал) и рассылает +состояние именно этого канала. Частоту слайса, поставленную по TCI, тоже +сопровождает `SliceFreqChanged` — как это делает CAT. + ### 2.5 Телеграф (§3.2) `CW_MACROS`, `CW_MSG`, `CW_MACROS_STOP`, `CW_TERMINAL`. @@ -153,7 +202,17 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт | `RX_BALANCE` | баланса каналов у слайса нет | | `DIGL_OFFSET`, `DIGU_OFFSET` | смещения цифровых мод не реализованы | | `RX_CHANNEL_ENABLE` | канал B главного приёмника — это VFO B, он есть всегда; создание второго слайса на пане по TCI — этап 2 | -| `SET_IN_FOCUS` | окно программы не поднимаем | + +## 3.1 Ограничения, о которых честнее знать заранее + +| Что | Как ведёт себя | +|---|---| +| `AGC_GAIN` у приёмника > 0 | AGC-T в ewsdr один на приёмный тракт, у слайса своего нет. Команда от имени доп. приёмника **игнорируется** (раньше молча правила главный), в ответ уходит текущее значение | +| Цвет спота (`SPOT`, arg4 ARGB) | не читается: `TDXSpot` цвета не хранит, подписи красятся по моде/возрасту | +| `KEYER`, `TX_FOOTSWITCH` | не реализованы: своего ключа-уведомления и опроса педали наружу у контроллера нет | +| Арбитраж клиентов (§3.5, захват параметра ~200 мс) | нет. Команды разных клиентов идут подряд, последняя побеждает. С двумя активными логгерами возможна «перетяжка» частоты или моды | +| Мода, фильтр, АРУ, шумодавы у канала B доп. пана | в TCI это свойства **приёмника**, а не канала: они относятся к каналу A. У канала B по протоколу есть только частота, IF и громкость | +| Команды конфигурации потоков | подтверждаются как принятые, хотя самих потоков нет (этап 2). Клиент по ответу может решить, что функция доступна | Отдельно: у `TX_SENSORS` второй аргумент — уровень микрофона; измерителя микрофона в EWSDR нет, шлём нижнюю границу шкалы (-60 дБм), чтобы клиент не @@ -185,7 +244,11 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт 5. **`LINEOUT_STREAM` + `LINE_OUT_RECORDER_*`** — запись в WAV/MP3. Также в очереди: `RX_CHANNEL_ENABLE` как реальное создание/удаление второго -слайса пана и `SET_IN_FOCUS`. +слайса пана, `KEYER` и арбитраж нескольких клиентов (§3.5). + +Приёмный буфер `TWsClient` — 4 КБ, и сейчас это жёсткий потолок: кадр крупнее +рвёт соединение (команд такой длины у TCI нет). Под TX-аудио его придётся +растить вместе с этапом 2. --- @@ -193,10 +256,13 @@ UI — вкладка **Advanced → TCI Server** (галка, порт, инт Стендом (WS-клиент на сыром сокете, без внешних библиотек): -- **Транспорт:** handshake, маска входящих фреймов, несколько команд в одном - фрейме, регистронезависимость, экранированный текст, ping/pong, игнорирование - бинарных фреймов, рассылка всем клиентам, чистая остановка сервера с живым - клиентом (потоки дренируются, зависаний нет). +- **Транспорт:** строгий разбор bind-адреса и отказ подниматься на кривом; + первый кадр, приклеенный к пакету handshake; сборка фрагментированного + сообщения; несколько команд в одном кадре; отказ от незамаскированных кадров + с разрывом соединения; ping/pong; рассылка двум клиентам; чистая остановка с + живыми клиентами; медленный клиент (5000 рассылок не блокируют вызывающего, + клиент вылетает сам); остановка сервера в тот момент, когда команда клиента + висит в `Synchronize` у потока контроллера. - **Сквозной прогон** с настоящим `TRadioController` (движки созданы, железо не подключено): пачка инициализации из 57 строк со всеми обязательными командами и `READY` в конце; `VFO`, `MODULATION` (`cw` на 7 МГц дал CWL),