カスタムAContextプロパティにアクセスするTIdTCPServer

Question

TIdTCPServer上の接続のコンテキストにカスタムプロパティを割り当てると、スレッドセーフな方法でこのプロパティにアクセスするにはどうすればよいですか？例：

カスタムプロパティ：

type 
    Local_Socket = class(TIdContext) 
    public 
    Tunnel_Requested: bool; 
    Remote_Tunnel: TIdContext; 
    end; 

type 
    Remote_Socket = class(TIdContext) 
    public 
    Local_Tunnel: TIdContext; 
    end; 

それらの割り当て：接続がローカル（127.0.0.1）であれば、私はこのコードで実現しようと何

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext); 
begin 
     if AContext.Binding.PeerIP = '127.0.0.1' then 
     begin 
     Local_Socket(AContext).Tunnel_Requested:= false; 
     Local_Socket(AContext).Remote_Tunnel:= Nil; 
     end 
     else 
     begin 
     AssignRemoteTunnel(AContext); 
     end; 
end; 

procedure TForm1.AssignRemoteTunnel(AContext: TIdContext); 
var 
    iContext: integer; 
    List: TIdContextList; 
    Assigned: bool; 
begin 
    Assigned:= false; 
    List:= IdTCPServer1.Contexts.LockList; 
    try 
    for iContext:= 0 to List.Count - 1 do 
    begin 
     if (TIdContext(List[iContext]).Binding.PeerIP = '127.0.0.1') and 
     (Local_Socket(List[iContext]).Remote_Tunnel = Nil) then 
     begin 
     Local_Socket(List[iContext]).Remote_Tunnel:= AContext; 
     Remote_Socket(AContext).Local_Tunnel:= TIdContext(List[iContext]); 
     Assigned:= true; 
     end; 
    end; 
    if Assigned = false then 
     AContext.Connection.Disconnect; 
    finally 
    IdTCPServer1.Contexts.UnlockList; 
    end; 
end; 

は、ですが、私は必要これをリモート接続にリダイレクトするには、以下のコードで要求されます。ここで

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext); 
var 
    Buffer: TIdBytes; 
begin 
     if AContext.Binding.PeerIP = '127.0.0.1' then 
     begin 
      if Local_Socket(AContext).Tunnel_Requested = false then 
      begin 
      TunnelSocket.Connection.IOHandler.Write(REQ_TUNNEL); 
      Local_Socket(AContext).Tunnel_Requested:= true; 
      end; 
      if (Local_Socket(AContext).Remote_Tunnel <> Nil) and 
      (Local_Socket(AContext).Remote_Tunnel.Connection.Connected) then 
      begin 
      AContext.Connection.IOHandler.CheckForDataOnSource(500); 
      if not AContext.Connection.IOHandler.InputBufferIsEmpty then 
      begin 
       AContext.Connection.IOHandler.InputBuffer.ExtractToBytes(Buffer); 
       Local_Socket(AContext).Remote_Tunnel.Connection.IOHandler.Write(Buffer); 
      end; 
end; 

：リモート接続がサーバーに到着したら、私はリモート接続とlocal_socket.remote_tunnel性、ローカル接続とremote_socket.local_tunnel、私は透過的にトンネルの間で通信することができ、このように相関する、AssignRemoteTunnel私はremote_tunnelプロパティを割り当ててこのremote_tunnelを介してバッファを送信するかどうかを見ています...しかし、私はこのプロパティを読んでいる間、多分私はAssignRemoteTunnelプロシージャにそれを書いています。これでいい？

Answer 1

TIdContextポインターを他のクラスタイプにタイプキャストすることはできません。指されているオブジェクトが実際にそのクラスタイプで始まる場合を除きます。 TIdTCPServerにはTIdContextオブジェクトのクラスタイプを指定するContextClassプロパティがありますが、クラスタイプを1つしか割り当てることができないため、Local_Socketを使用しているクライアントとRemote_Socketを使用しているクライアントを持つことができません。それらを1つのクラスにマージする必要があります。

TIdTCPServer.OnDisconnectイベントを使用して、コンテキストオブジェクトの相互の関連付けを解除する必要があります。

また、TIdTCPServerはマルチスレッドであり、他のスレッドがそれにアクセスしている間はいつでもTCP接続が切断される可能性があるため、Tunnelポインタを使用するコードがスレッドセーフであることを確認してください。したがって、Tunnelで何かを読み書きするたびに、アクセスをロックするために、にTCriticalSectionを追加するか、またはTMonitorを使用してアクセスをロックすることを意味します。

より、このような何か試してみてください：

type 
    TMyContext = class(TIdServerContext) // <-- must derive from TIdServerContext, not TIdContext itself 
    public 
    IsLocal: Boolean; 
    Tunnel: TIdContext; 
    WaitingForTunnel: Boolean; 
    end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    IdTCPServer1.ContextClass := TMyContext; // <-- must be done BEFORE the server is activated! 
    IdTCPServer1.Active := True; 
end; 

procedure TForm1.IdTCPServer1Connect(AContext: TIdContext); 
var 
    Ctx: TMyContext; 
    PeerIP: string; 
    LocalIPs: TIdStackLocalAddressList; 
begin 
    Ctx := TMyContext(AContext); 

    // Note: unless your server is listening specifically on 127.0.0.1 only, 
    // you should match the connected PeerIP to all IPs reported by 
    // GStack.GetLocalAddressList(), not just 127.0.0.1, since the client 
    // could be connecting from any local adapter/interface... 
    // 
    PeerIP := AContext.Binding.PeerIP; 
    Ctx.IsLocal := (PeerIP = '127.0.0.1') or (PeerIP = '0:0:0:0:0:0:0:1') or (PeerIP = '::1'); 
    if not Ctx.IsLocal then 
    begin 
    LocalIPs := TIdStackLocalAddressList.Create; 
    try 
     GStack.GetLocalAddressList(LocalIPs); 
     Ctx.IsLocal := (LocalIPs.IndexOfIP(PeerIP) <> -1); 
    finally 
     LocalIPs.Free; 
    end; 
    end; 
    if Ctx.IsLocal then 
    begin 
    Ctx.WaitingForTunnel := True; 

    // NOTE: unless REQ_TUNNEL is a single Byte, you need to serialize 
    // access to TunnelSocket.Connection.IOHandler.Write() so that multiple 
    // requests cannot overlap on top of each other, corrupting the 
    // communications on that connection! 
    // 
    TMonitor.Enter(TunnelSocket); 
    try 
     TunnelSocket.Connection.IOHandler.Write(REQ_TUNNEL); 
    finally 
     TMonitor.Leave(TunnelSocket); 
    end; 
    end 
    else 
    AssignRemoteTunnel(AContext); 
end; 

procedure TForm1.IdTCPServer1Disconnect(AContext: TIdContext); 
var 
    i: integer; 
    List: TIdContextList; 
    Ctx: TIdContext; 
begin 
    List := IdTCPServer1.Contexts.LockList; 
    try 
    for I := 0 to List.Count - 1 do 
    begin 
     Ctx := TIdContext(List[i]); 
     if Ctx <> AContext then 
     begin 
     TMonitor.Enter(Ctx); 
     try 
      if Ctx.Tunnel = AContext then 
      begin 
      Ctx.Tunnel := nil; 
      Exit; 
      end; 
     finally 
      TMonitor.Leave(Ctx); 
     end; 
     end; 
    end; 
    finally 
    IdTCPServer1.Contexts.UnlockList; 
    end; 
end; 

procedure TForm1.AssignRemoteTunnel(AContext: TIdContext); 
var 
    i: integer; 
    List: TIdContextList; 
    Ctx: TIdContext; 
begin 
    Assigned := False; 
    List := IdTCPServer1.Contexts.LockList; 
    try 
    for I := 0 to List.Count - 1 do 
    begin 
     Ctx := TIdContext(List[i]); 
     if (Ctx <> AContext) and Ctx.IsLocal and Ctx.WaitingForTunnel then 
     begin 
     TMonitor.Enter(Ctx); 
     try 
      Ctx.Tunnel := AContext; 
      Ctx.WaitingForTunnel := False; 
     finally 
      TMonitor.Leave(Ctx); 
     end; 
     TMonitor.Enter(AContext); 
     try 
      TMyContext(AContext).Tunnel := Ctx; 
     finally 
      TMonitor.Leave(AContext); 
     end; 
     Exit; 
     end; 
    end; 
    finally 
    IdTCPServer1.Contexts.UnlockList; 
    end; 
    AContext.Connection.Disconnect; 
end; 

procedure TForm1.IdTCPServer1Execute(AContext: TIdContext); 
var 
    Ctx: TMyContext; 
    Buffer: TIdBytes; 
begin 
    Ctx := TMyContext(AContext); 
    if Ctx.Tunnel = nil then 
    begin 
    if Ctx.IsLocal and Ctx.WaitingForTunnel then 
     IndySleep(50) 
    else 
     AContext.Connection.Disconnect; 
    Exit; 
    end; 
    if AContext.Connection.IOHandler.InputBufferIsEmpty then 
    begin 
    AContext.Connection.IOHandler.CheckForDataOnSource(500); 
    if AContext.Connection.IOHandler.InputBufferIsEmpty then Exit; 
    end; 
    AContext.Connection.IOHandler.InputBuffer.ExtractToBytes(Buffer); 
    TMonitor.Enter(Ctx); 
    try 
    if Ctx.Tunnel <> nil then 
     Ctx.Tunnel.Connection.IOHandler.Write(Buffer); 
    finally 
    TMonitor.Leave(Ctx); 
    end; 
end;