TIdTCPServer访问自定义AContext属性

时间:2017-01-16 13:40:57

标签: delphi indy

当我们将自定义属性分配给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),我需要将其重定向到远程连接,这将在下面的代码中请求。一旦远程连接到达服务器,我就是AssignRemoteTunnel,将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过程中写入它。这样好吗?

1 个答案:

答案 0 :(得分:2)

除非指向的对象实际上是该类类型,否则不能只将TIdContext指针类型转换为另一个类类型。 TIdTCPServer具有ContextClass属性来指定TIdContext个对象的类类型,但是您只能为其指定一个类类型,因此您不能让某些客户端使用Local_Socket对象。 1}}和一些使用Remote_Socket的客户。您需要将它们合并为一个类。

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

此外,请确保使用Tunnel指针的任何代码都是线程安全的,因为TIdTCPServer是多线程的,并且TCP连接可以随时丢失,而其他线程仍在访问它。因此,这可能意味着为每个TCriticalSectionTMyContext添加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;