TIdTCPServer访问自定义AContext属性 [英] TIdTCPServer accessing custom AContext properties

问题描述

当我们将自定义属性分配给TIdTCPServer上的连接上下文时，如何以线程安全的方式访问此属性(读/写)?示例:

When we assign custom properties to the Context of a connection on TIdTCPServer, how to access this properties (read/write) in a thread-safe manner? Example:

自定义属性:

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

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

分配它们:

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;

我尝试用此代码实现的是，如果连接是本地(127.0.0.1)，则需要将其重定向到远程连接，这将在下面的代码中进行请求.远程连接到达服务器后，我将执行AssignRemoteTunnel，将local_socket.remote_tunnel属性与远程连接相关联，将remote_socket.local_tunnel与本地连接相关联，这样我就可以在隧道之间透明地通信:

What I try to achieve with this code is, if a connection is local (127.0.0.1), I need to redirect it to a remote connection, that will be requested on the code below. Once the remote connection arrives on server, I AssignRemoteTunnel, correlating the local_socket.remote_tunnel property with the remote connection, and the remote_socket.local_tunnel with the local connection, this way I can transparently communicate between the tunnel:

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;

在这里，我正在监视是否分配了remote_tunnel属性以通过该remote_tunnel发送缓冲区.但是，当我阅读此属性时，也许我正在将它写在AssignRemoteTunnel过程上.这样可以吗?

Here I'm watching if I assigned a remote_tunnel property to send the buffer over this remote_tunnel... But while I read this property, maybe I'm writting it on the AssignRemoteTunnel procedure. Is this OK?

推荐答案

您不能只是将 TIdContext 指针类型转换为另一类类型，除非所指向的对象实际上是该类类型首先. TIdTCPServer 具有 ContextClass 属性，用于指定 TIdContext 对象的类类型，但是您只能为其分配一种类类型，因此您可以有一些使用 Local_Socket 的客户端和一些使用 Remote_Socket 的客户端.您需要将它们合并为一个类.

You can't just type-cast a TIdContext pointer to another class type unless the object being pointed at is actually that class type to begin with. TIdTCPServer has a ContextClass property to specify the class type for TIdContext objects, but you can only assign one class type to it, so you can't have some clients who are using Local_Socket and some clients who are using Remote_Socket instead. You need to merge them into one class.

确保使用 TIdTCPServer.OnDisconnect 事件将Context对象彼此取消关联.

Make sure you use the TIdTCPServer.OnDisconnect event to unassociate your Context objects from each other.

此外，请确保使用 Tunnel 指针的任何代码都是线程安全的，因为 TIdTCPServer 是多线程的，并且TCP连接可以随时断开其他线程仍在访问它.因此，这可能意味着向每个 TMyContext 添加一个 TCriticalSection ，或使用 TMonitor 来在每次您想要读取/写入内容时锁定访问.隧道.

Also, make sure any code that uses the Tunnel pointers is thread-safe, since TIdTCPServer is multi-threaded and a TCP connection can drop out at any time while other threads are still accessing it. So, that likely means adding a TCriticalSection to each TMyContext, or using TMonitor, to lock access every time you want to read/write something over a Tunnel.

尝试更多类似的方法:

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;

这篇关于TIdTCPServer访问自定义AContext属性的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！