Indy 10.6 с помощью tcpserver в системе Linux с правами администратора бросает Gtk-WARNING, когда клиент отключается

Question

Я настраиваю новую систему с использованием Indy 10.6 tcpserver на малиновый PI с загруженным Raspbian. Я запускаю приложение с рабочего стола GUI через терминал bash с помощью sudo. Все работает нормально, пока клиент не подключится, а затем, когда он отключится, я получаю Gtk-WARNING, а иногда и Gtk-CRITICALs, и я не знаю почему. Вот мой код, он позволяет только одно соединение клиента в то время, то он отключает сервер и перезапускает его после того, как каждое соединение сделано:

Procedure TFK20Elevator.ASpeedBtn1Click(Sender: TObject); 
Begin //start the server 
    Server.Active := False; 
    Server.Bindings.Clear; 
    Server.Bindings.Add.IPVersion := Id_IPv4; 
    Server.Bindings.Add.IP := LIP; 
    Server.Bindings.Add.Port := DefPort + StrToIntDef(UnitID, 0); 
    Try 
    Server.Active := True; 
    Except 
    On E: Exception Do 
     Memo1.Lines.Add(E.Message); 
    End; 
    If Not Server.Active Then 
    Exit; 
    ASpeedBtn1.Enabled := False; 
    ASpeedBtn2.Enabled := True; 
    AStatus1.SimpleText := 'Server bound to ' + LIP + ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)); 
End; 

Procedure TFK20Elevator.ServerConnect(AContext: TIdContext); 
Begin 
    If Connected Then 
    Begin 
     Abort(); 
     Exit; 
    End; 
    AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' - Authenticating...'; 
    Memo1.Lines.Clear; 
    Manager := False; 
    EncDecSIdx := 1; 
    RetryTimer.Enabled := False; 
    RetryTimer.Interval := 3000; 
    Authenticating := True; 
    AuthTimer.Enabled := True; 
    StayAlive.Enabled := True; 
End; 

Procedure TFK20Elevator.ServerException(AContext: TIdContext; AException: Exception); 
Begin 
    If AnsiContainsText(AException.Message, 'Gracefully') Then 
    AStatus1.SimpleText := 'Server bound to ' + LIP + ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) //closed gracefully message 
    Else 
    Begin //show the exception 
     Memo1.Lines.Add('An exception happend! - ' + AException.Message); 
     RetryTimer.Enabled := True; 
    End; 
    Manager := False; 
    Authenticating := False; 
End; 

Procedure TFK20Elevator.ServerExecute(AContext: TIdContext); 
//EncStr and DecStr simply encode/decode, respectively, a standard 
// string into/from a key encrypted hex string, i.e. '00' to 'FF' 
// for each character in the string 
Var 
    S, UserName, Password: String; 
    I, N: Integer; 
Begin 
    S := AContext.Connection.IOHandler.ReadLn(IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault); //get the data 
    If S = Heart Then //if message is the client heart beat, return to client 
    Begin //just a heart beat, reset timer 
     StayAlive.Enabled := False; 
     AContext.Connection.IOHandler.WriteLn(Heart, IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault); 
     StayAlive.Enabled := True; 
     Exit; 
    End; 
    S := PCommon.DecStr(S, EncDecStr, EncDecSIdx); //not heart beat, decompress 
    If Authenticating Then 
    Begin //test log in 
     If Length(S) > 3 Then 
     Begin 
      I := Pos('|', S); 
      If (I > 1) And (Length(S) > I) Then 
      Begin 
       UserName := Copy(S, 1, I - 1); 
       Password := Copy(S, I + 1, Length(S) - I); 
       If UserName = ManUser Then 
       Begin 
        If Password = ManPass Then 
        Begin 
         AuthTimer.Enabled := False; 
         Manager := True; 
         Authenticating := False; 
         AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP + 
                  ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) + 'M', 
                  EncDecStr, EncDecSIdx), IndyTextEncoding_OSDefault, 
                  IndyTextEncoding_OSDefault); 
         AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' as Manager'; 
         Connected := True; 
        End 
        Else 
        AuthTimerTimer(Self); 
       End 
       Else If UserName = GenUser Then 
       Begin 
        If Password = GenPass Then 
        Begin 
         AuthTimer.Enabled := False; 
         Authenticating := False; 
         AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP + 
                  ':' + IntToStr(DefPort + StrToIntDef(UnitID, 0)) + 'U', 
                  EncDecStr, EncDecSIdx), IndyTextEncoding_OSDefault, 
                  IndyTextEncoding_OSDefault); 
         AStatus1.SimpleText := 'Connecting to> ' + AContext.Binding.PeerIP + ' as General User'; 
         Connected := True; 
        End 
        Else 
        AuthTimerTimer(Self); 
       End 
       Else 
       AuthTimerTimer(Self); 
      End 
      Else 
      AuthTimerTimer(Self); 
     End 
     Else 
     AuthTimerTimer(Self); 
    End 
    Else 
    Begin //test for commands 
     If Copy(S, 1, Length(AssignID)) = AssignID Then 
     Begin //command to assign a new unit id 
      NewLoc := DefLocation; 
      NewUnit := DefUnitNum; 
      I := Pos('-', S, 1); 
      If (I > 0) And (I < Length(S)) Then 
      Begin 
       N := Pos('-', S, I + 1); 
       If (N > 0) And (N < Length(S)) Then 
       Begin 
        NewLoc := Copy(S, I + 1, N - I - 1); 
        NewUnit := Copy(S, N + 1, Length(S) - N); 
       End; 
      End; 
      Label15.Caption := NewLoc; 
      Label16.Caption := NewUnit; 
      FmtStr(LIP, '%.3d', [StrToInt(NewUnit)]); 
      LIP := '192.168.6' + Copy(LIP, 1, 1) + '.' + Copy(LIP, 2, 2); //wifi ip 
      Memo1.Lines.Add('--> ' + S + '-' + LIP); 
      AContext.Connection.IOHandler.WriteLn(PCommon.EncStr(Rebooting, EncDecStr, EncDecSIdx), 
               IndyTextEncoding_OSDefault, IndyTextEncoding_OSDefault); 
      Memo1.Lines.Add('<-- ' + Rebooting); 
      TestTimer.Enabled := True; 
     End; 
    End; 
End; 

Procedure TFK20Elevator.ASpeedBtn2Click(Sender: TObject); 
Begin //shut down the server with optional restart if not rebooting 
    AuthTimer.Enabled := False; 
    RetryTimer.Enabled := False; 
    StayAlive.Enabled := False; 
    TestTimer.Enabled := False; 
    DropClient; 
    Try 
    Server.Active := False; 
    Except 
    On E: Exception Do 
     Memo1.Lines.Add('Error disconnecting server - ' + E.Message); 
    End; 
    If Server.Active Then 
    Exit; 
    ASpeedBtn1.Enabled := True; 
    ASpeedBtn2.Enabled := False; 
    AStatus1.SimpleText := 'Server not running...'; 
    Manager := False; 
    Authenticating := False; 
    Connected := False; 
    RetryTimer.Enabled := Not SysReboot; 
End; 

Procedure TFK20Elevator.ServerDisconnect(AContext: TIdContext); 
Begin 
    StayAlive.Enabled := False; 
    RetryTimer.Enabled := False; 
    DropClient; 
    AStatus1.SimpleText := 'Client disconnected...'; 
    Manager := False; 
    Authenticating := False; 
    Connected := False; 
    RetryTimer.Enabled := Not SysReboot; 
End; 

Procedure TFK20Elevator.DropClient; //make sure buffers are cleared 
Var 
    I: Integer; 
    SC: TIdContext; 
Begin 
    If Server.Active Then 
    Begin 
     Application.ProcessMessages; 
     With Server.Contexts.LockList Do 
     Try 
      Memo1.Lines.Add('Disconnecting...'); 
      For I := Count - 1 DownTo 0 Do 
      Begin 
       SC := TIdContext(Items[I]); 
       If SC = Nil Then 
       Continue; 
       SC.Connection.IOHandler.WriteBufferClear; 
       SC.Connection.IOHandler.InputBuffer.Clear; 
       SC.Connection.IOHandler.Close; 
       If SC.Connection.Connected Then 
       SC.Connection.Disconnect; 
       Memo1.Lines.Add('Disconnecting client ' + IntToStr(I + 1) + ' of ' + IntToStr(Count)); 
      End; 
     Finally 
      Server.Contexts.UnlockList; 
      Memo1.Lines.Add('Disconnected'); 
     End; 
    End; 
End; 

Procedure TFK20Elevator.StayAliveTimer(Sender: TObject); 
Begin //server reset timer if client stops sending heart beat 
    StayAlive.Enabled := False; 
    AStatus1.SimpleText := 'Client timed out!'; 
    If ASpeedBtn2.Enabled Then 
    ASpeedBtn2Click(Self); 
End; 

Procedure TFK20Elevator.AuthTimerTimer(Sender: TObject); 
Begin //login authorization timeout timer 
    AuthTimer.Enabled := False; 
    ASpeedBtn2Click(Self); 
    Application.ProcessMessages; 
    ASpeedBtn1Click(Self); 
End; 

Answer 1

Server.Bindings.Add.IPVersion := Id_IPv4; 
Server.Bindings.Add.IP := LIP; 
Server.Bindings.Add.Port := DefPort + StrToIntDef(UnitID, 0); 

Это ошибка в коде. Вы не открываете только 1 гнездо для прослушивания, вы фактически открываете 3 гнезда для прослушивания! Каждый вызов Bindings.Add() сообщает TIdTCPServer для создания отдельного прослушивающего сокета, и каждый объект привязки имеет свои собственные настройки IP/Port.

То, что вы действительно делаете с выше код:

1. создание IPv4 Binding на IP 0.0.0.0 порт TIdTCPServer.DefaultPort.

2. создания другого связывания на IP LIP порт TIdTCPServer.DefaultPort с версией IP по умолчанию Инди (что случается быть IPv4, если вы не перекомпилировать Инди с IdIPv6, определенной в IdCompilerDefines.inc).

3. создание еще одного связывания по IP 0.0.0.0 или ::1 на порту DefPort+UnitID в зависимости от версии IP по умолчанию Indy.

За то, что вы пытаетесь сделать, вам нужно позвонить Bindings.Add()один раз только, например:

var 
    Binding : TIdSocketHandle; 

Binding := Server.Bindings.Add; 
Binding.IPVersion := Id_IPv4; 
Binding.IP := LIP; 
Binding.Port := DefPort + StrToIntDef(UnitID, 0); 

Это, как говорится, TIdTCPServer является многопоточной компонентом. Его различные события (OnConnect, OnDisconnect, OnExecute, OnException и OnListenException) увольняются в контексте рабочих потоков, созданных внутри, на TIdTCPServer. Обработчики событий напрямую получают доступ к элементам пользовательского интерфейса вне контекста основного потока пользовательского интерфейса. Это вызывает всевозможные проблемы и никогда не должно быть сделано.

Если обработчики событий необходимо получить доступ к UI, они должны синхронизировать с основным потоком пользовательского интерфейса, такие как с TThread.Synchronize() или TThread.Queue() или Инди собственной TIdSync или TIdNotify класса, или любого другого межпоточной Synching механизма по вашему выбору.

Кроме того, когда вы переходите вручную сбрасывать клиентов с DropClient(), это делает вещи в контекстах, которые не имеют бизнеса. Вам даже не нужно бросать клиентов вручную, так как TIdTCPServer обрабатывает это для вас, пока он деактивирован.

Со всем, что сказал, попробовать что-то больше, как это:

interface 

uses 
    Classes, Form, SysUtils, StdCtrls, ExtCtrls, Buttons, IdTCPServer, IdContext; 

type 
    TFK20Elevator = class(TForm) 
    Server: TIdTCPServer; 
    ASpeedBtn1: TSpeedButton; 
    ASpeedBtn2: TSpeedButton; 
    Memo1: TMemo; 
    AStatus1: TStatusBar; 
    AuthTimer: TTimer; 
    RetryTimer: TTimer; 
    StayAlive: TTimer; 
    TestTimer: TTimer; 
    ... 
    procedure ASpeedBtn1Click(Sender: TObject); 
    procedure ASpeedBtn2Click(Sender: TObject); 
    procedure StayAliveTimer(Sender: TObject); 
    procedure AuthTimerTimer(Sender: TObject); 
    procedure ServerConnect(AContext: TIdContext); 
    procedure ServerDisconnect(AContext: TIdContext); 
    procedure ServerException(AContext: TIdContext; AException: Exception); 
    procedure ServerExecute(AContext: TIdContext); 
    ... 
    private 
    DefPort: Integer; 
    UnitID: string; 
    Manager: Boolean; 
    Authenticating: Boolean; 
    EncDecSIdx: Integer; 
    ... 
    procedure DropClient; 
    procedure ConnectedNotify(const APeerIP: string); 
    procedure DisconnectedNotify; 
    procedure ErrorNotify(const AMessage: string); 
    procedure HeartNotify; 
    procedure ManagerLoggedInNotify(const APeerIP: string); 
    procedure GeneralUserLoggedInNotify(const APeerIP: string); 
    procedure FailedAuthNotify; 
    procedure RebootNotify(const Data: string); 
    ... 
    end; 

var 
    FK20Elevator: TFK20Elevator; 

implementation 

uses 
    IdGlobal, IdSync; 

const 
    Heart: string = ...; 
    AssignID: string = ...; 
    ... 

procedure TFK20Elevator.ASpeedBtn1Click(Sender: TObject); 
var 
    Binding: TIdSocketHandle; 
begin 
    //start the server 

    Server.Active := False; 
    Server.Bindings.Clear; 
    Binding := Server.Bindings.Add; 
    Binding.IPVersion := Id_IPv4; 
    Binding.IP := LIP; 
    Binding.Port := DefPort + StrToIntDef(UnitID, 0); 
    Server.MaxConnections := 1; 

    try 
    Server.Active := True; 
    except 
    on E: Exception do 
    begin 
     Memo1.Lines.Add('Error activating server - ' + E.Message); 
     Exit; 
    end; 
    end; 

    AStatus1.SimpleText := 'Server bound to ' + Binding.IP + ':' + IntToStr(Binding.Port); 

    ASpeedBtn1.Enabled := False; 
    ASpeedBtn2.Enabled := True; 
end; 

procedure TFK20Elevator.ASpeedBtn2Click(Sender: TObject); 
begin 
    //shut down the server with optional restart if not rebooting 

    AuthTimer.Enabled := False; 
    RetryTimer.Enabled := False; 
    StayAlive.Enabled := False; 
    TestTimer.Enabled := False; 

    try 
    Server.Active := False; 
    except 
    on E: Exception do 
    begin 
     Memo1.Lines.Add('Error deactivating server - ' + E.Message); 
     Exit; 
    end; 
    end; 

    Manager := False; 
    Authenticating := False; 

    AStatus1.SimpleText := 'Server not running...'; 
    ASpeedBtn1.Enabled := True; 
    ASpeedBtn2.Enabled := False; 

    RetryTimer.Enabled := not SysReboot; 
end; 

procedure TFK20Elevator.StayAliveTimer(Sender: TObject); 
begin 
    //client stopped sending heart beats 
    StayAlive.Enabled := False; 
    Memo1.Lines.Add('Client timed out!'); 
    DropClient; 
end; 

procedure TFK20Elevator.AuthTimerTimer(Sender: TObject); 
begin 
    //login authorization timeout 
    AuthTimer.Enabled := False; 
    Memo1.Lines.Add('Authentication timed out!'); 
    DropClient; 
end; 

procedure TFK20Elevator.DropClient; 
begin 
    with Server.Contexts.LockList do 
    try 
    if Count > 0 then 
     TIdContext(Items[0]).Connection.Disconnect;   
    finally 
    Server.Contexts.UnlockList; 
    end; 
end; 

type 
    TMyNotifyMethod = procedure(const AStr: string) of object; 

    TMyNotify = class(TIdNotify) 
    protected 
    FMethod: TMyNotifyMethod; 
    FStr: string; 
    procedure DoNotify; override; 
    public 
    class procedure NotifyStr(AMethod: TMyNotifyMethod; const AStr: string); 
    end; 

procedure TMyNotify.DoNotify; 
begin 
    FMethod(FStr); 
end; 

class procedure TMyNotify.NotifyStr(AMethod: TMyNotifyMethod; const AStr: string); 
begin 
    with Create do 
    begin 
    FMethod := AMethod; 
    FStr := AStr; 
    Notify; 
    end; 
end; 

procedure TFK20Elevator.ConnectedNotify(const APeerIP: string); 
begin 
    if not Server.Active then Exit; 
    AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' - Authenticating...'; 
    Memo1.Lines.Clear; 
    RetryTimer.Enabled := False; 
    RetryTimer.Interval := 3000; 
    AuthTimer.Enabled := True; 
    StayAlive.Enabled := True; 
end; 

procedure TFK20Elevator.DisconnectedNotify; 
begin 
    StayAlive.Enabled := False; 
    RetryTimer.Enabled := False; 

    if Server.Active then 
    begin 
    with Server.Bindings[0] do 
     AStatus1.SimpleText := 'Client Disconnected. Server bound to ' + IP + ':' + IntToStr(Port); 
    end; 

    RetryTimer.Enabled := Not SysReboot; 
end; 

procedure TFK20Elevator.ErrorNotify(const AMessage: string); 
begin 
    Memo1.Lines.Add('An exception happened! - ' + AMessage); 
    RetryTimer.Enabled := True; 
end; 

procedure TFK20Elevator.HeartNotify; 
begin 
    StayAlive.Enabled := False; 
    StayAlive.Enabled := True; 
end; 

procedure TFK20Elevator.ManagerLoggedInNotify(const APeerIP: string); 
begin 
    AuthTimer.Enabled := False; 
    AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' as Manager'; 
end; 

procedure TFK20Elevator.GeneralUserLoggedInNotify(const APeerIP: string); 
begin 
    AuthTimer.Enabled := False; 
    AStatus1.SimpleText := 'Connecting to> ' + APeerIP + ' as General User'; 
end; 

procedure TFK20Elevator.FailedAuthNotify; 
begin 
    //login authorization failed 
    AuthTimer.Enabled := False; 
end; 

procedure TFK20Elevator.RebootNotify(const Data: string); 
var 
    Tmp, S, NewLoc, NewUnit, LIP: string; 
begin 
    Tmp := Data; 

    S := Fetch(Tmp, #10); 
    NewLoc := Fetch(Tmp, #10); 
    NewUnit := Tmp; 

    Label15.Caption := NewLoc; 
    Label16.Caption := NewUnit; 

    FmtStr(LIP, '%.3d', [StrToInt(NewUnit)]); 
    LIP := '192.168.6' + Copy(LIP, 1, 1) + '.' + Copy(LIP, 2, 2); //wifi ip 

    Memo1.Lines.Add('--> ' + S + '-' + LIP); 
    Memo1.Lines.Add('<-- ' + Rebooting); 

    TestTimer.Enabled := True; 
end; 

procedure TFK20Elevator.ServerConnect(AContext: TIdContext); 
begin 
    Manager := False; 
    Authenticating := True; 
    EncDecSIdx := 1; 

    TMyNotify.NotifyStr(@ConnectedNotify, AContext.Binding.PeerIP); 

    // Note: OSDefault is platform-specific. On Linux, it is UTF-8, so 
    // you should use UTF-8 explicitly instead, so as to provide 
    // better compatibility across platforms, especially if you ever 
    // move this server code to another platform in the future... 
    // 
    AContext.Connection.IOHandler.DefStringEncoding := IndyTextEncoding_OSDefault; // IndyTextEncoding_UTF8 
    AContext.Connection.IOHandler.DefAnsiEncoding := IndyTextEncoding_OSDefault; // IndyTextEncoding_UTF8 
end; 

procedure TFK20Elevator.ServerDisconnect(AContext: TIdContext); 
begin 
    Manager := False; 
    Authenticating := False; 
    TIdNotify.NotifyMethod(@DisconnectedNotify); 
end; 

procedure TFK20Elevator.ServerException(AContext: TIdContext; AException: Exception); 
begin 
    if not (AException is EIdConnClosedGracefully) then 
    TMyNotify.NotifyStr(@ErrorNotify, AException.Message); 
end; 

procedure TFK20Elevator.ServerExecute(AContext: TIdContext); 
var 
    S, Tmp, UserName, Password: String; 
begin 
    S := AContext.Connection.IOHandler.ReadLn; //get the data 
    if S = Heart then 
    begin 
    //just a heart beat, return to client and reset timer 
    AContext.Connection.IOHandler.WriteLn(Heart); 
    TIdNotify.NotifyMethod(@HeartNotify); 
    Exit; 
    end; 

    //not heart beat, decompress 
    //EncStr and DecStr simply encode/decode, respectively, a standard 
    // string into/from a key encrypted hex string, i.e. '00' to 'FF' 
    // for each character in the string 

    S := PCommon.DecStr(S, EncDecStr, EncDecSIdx); 

    if Authenticating then 
    begin 
    //test log in 
    UserName := Fetch(S, '|'); 
    Password := S; 

    if (UserName = ManUser) and (Password = ManPass) then 
    begin 
     Authenticating := False; 
     Manager := True; 
     AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port) + 'M', EncDecStr, EncDecSIdx)); 
     TMyNotify.NotifyStr(@ManagerLoggedInNotify, AContext.Binding.PeerIP); 
    end 
    else if (UserName = GenUser) and (Password = GenPass) then 
    begin 
     Authenticating := False; 
     AContext.Connection.IOHandler.WriteLn(EncStr(AContext.Binding.PeerIP + ':' + IntToStr(AContext.Binding.Port) + 'U', EncDecStr, EncDecSIdx)); 
     TMyNotify.NotifyStr(@GeneralUserLoggedInNotify, AContext.Binding.PeerIP); 
    end else 
    begin 
     TIdNotify.NotifyMethod(@FailedAuthNotify); 
     AContext.Connection.Disconnect; 
    end; 
    Exit; 
    end; 

    //test for commands 
    if TextStartsWith(S, AssignID) then 
    begin 
    //command to assign a new unit id 

    Tmp := S; 
    Fetch(Tmp, '-'); 
    NewLoc := Fetch(Tmp, '-'); 
    NewUnit := Tmp; 

    if (NewLoc = '') or (NewUnit = '') then 
    begin 
     NewLoc := DefLocation; 
     NewUnit := DefUnitNum; 
    end; 

    AContext.Connection.IOHandler.WriteLn(PCommon.EncStr(Rebooting, EncDecStr, EncDecSIdx)); 

    TMyNotify.NotifyStr(@RebootNotify, S + #10 + NewLoc + #10 + NewUnit); 
    end; 
end; 

Наконец, я хотел бы предложить вам рассмотреть возможность избавиться от всех глобальных переменных и таймеров сердцебиения/аутентификации от основного потока пользовательского интерфейса.Выполняйте обработку тайм-аута внутри самого события OnExecute, например, используя свойство ReadTimeout клиента и/или CheckForDataOnSource(). Используйте свойство TIdContext.Data (или выведите новый класс из TIdServerContext и назначьте его свойству TIdTCPServer.ContextClass), чтобы отслеживать значения для каждого соединения, например, в последний раз, когда принималось сердцебиение или был ли клиент еще аутентифицирован (на самом деле, вы должны обрабатывать аутентификацию в OnConnect до того, как OnExecute даже начнет работать), или будет ли клиент зарегистрирован как менеджер и т. д. Это уменьшит количество вещей, которые необходимо синхронизировать с основным потоком пользовательского интерфейса, и избегать любых проблем времени, задержки в обработке синхронизации.