TIdTCPServer 访问自定义 AContext 属性

Question

当我们将自定义属性分配给 TIdTCPServer 上的连接的 Context 时，如何以线程安全的方式访问这些属性（读/写）？示例：

自定义属性：

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)，我需要将其重定向到远程连接，这将在下面的代码中请求。远程连接到达服务器后，我分配RemoteTunnel，将local_socket.remote_tunnel 属性与远程连接关联，将remote_socket.local_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 过程中。这样可以吗？

Answer 1

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

确保您使用 TIdTCPServer.OnDisconnect 事件来取消您的 Context 对象彼此之间的关联。

此外，请确保任何使用Tunnel 指针的代码都是线程安全的，因为TIdTCPServer 是多线程的，并且当其他线程仍在访问它时，TCP 连接可能随时断开。因此，这可能意味着在每个TMyContext 中添加TCriticalSection，或者使用TMonitor，以在每次您想通过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;