restemplate/indy/Protocols/IdMappedTelnet.pas

{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
  Rev 1.4    11/15/04 11:32:50 AM  RLebeau
  Bug fix for OutboundConnect() assigning the IOHandler.ConnectTimeout property
  before the IOHandler has been assigned.

  Rev 1.3    11/14/04 11:40:00 AM  RLebeau
  Removed typecast in OutboundConnect()

  Rev 1.2    2004.02.03 5:45:52 PM  czhower
  Name changes

  Rev 1.1    2/2/2004 4:12:02 PM  JPMugaas
  Should now compile in DotNET.

  Rev 1.0    2/1/2004 4:22:50 AM  JPMugaas
  Components from IdMappedPort are now in their own units.
}

unit IdMappedTelnet;

interface

{$i IdCompilerDefines.inc}

uses
  IdAssignedNumbers,
  IdMappedPortTCP,
  IdTCPServer;

type
  TIdMappedTelnetContext = class(TIdMappedPortContext)
  protected
    FAllowedConnectAttempts: Integer;
    FErrorMsg: String;
    //
    procedure OutboundConnect; override;
  public
    property AllowedConnectAttempts: Integer read FAllowedConnectAttempts;
    property ErrorMsg: String read FErrorMsg;
  end;

  TIdMappedTelnetCheckHostPort = procedure (AContext: TIdMappedPortContext; const AHostPort: String; var VHost, VPort: String) of object;

  TIdCustomMappedTelnet = class (TIdMappedPortTCP)
  protected
    FAllowedConnectAttempts: Integer;
    FOnCheckHostPort: TIdMappedTelnetCheckHostPort;

    procedure DoCheckHostPort (AContext: TIdMappedPortContext; const AHostPort: String; var VHost, VPort: String); virtual;
    procedure SetAllowedConnectAttempts(const Value: Integer);
    procedure ExtractHostAndPortFromLine(AContext: TIdMappedPortContext; const AHostPort: String);
    procedure InitComponent; override;
  public
    //
    property  AllowedConnectAttempts: Integer read FAllowedConnectAttempts write SetAllowedConnectAttempts default -1;
    //
    property  OnCheckHostPort: TIdMappedTelnetCheckHostPort read FOnCheckHostPort write FOnCheckHostPort;
  published
    property  DefaultPort default IdPORT_TELNET;
    property  MappedPort default IdPORT_TELNET;
  end;

  TIdMappedTelnet = class (TIdCustomMappedTelnet)
  published
    property  AllowedConnectAttempts: Integer read FAllowedConnectAttempts write SetAllowedConnectAttempts default -1;
    //
    property  OnCheckHostPort: TIdMappedTelnetCheckHostPort read FOnCheckHostPort write FOnCheckHostPort;
  end;

implementation

uses
  IdGlobal, IdException, IdResourceStringsProtocols,
  IdIOHandlerSocket, IdTCPClient, SysUtils;

const
  NAMESEP = #0+#9+' :'; {do not localize}

{ TIdCustomMappedTelnet }

procedure TIdCustomMappedTelnet.InitComponent;
begin
  inherited InitComponent;
  FAllowedConnectAttempts := -1;
  FContextClass := TIdMappedTelnetContext;
  DefaultPort := IdPORT_TELNET;
  MappedPort := IdPORT_TELNET;
end;

procedure TIdCustomMappedTelnet.DoCheckHostPort(AContext: TIdMappedPortContext;
  const AHostPort: String; var VHost, VPort: String);
Begin
  if Assigned(FOnCheckHostPort) then begin
    FOnCheckHostPort(AContext, AHostPort, VHost, VPort);
  end;
end;

procedure TIdCustomMappedTelnet.ExtractHostAndPortFromLine(AContext: TIdMappedPortContext;
  const AHostPort: String);
var
  LHost, LPort: String;
  i : Integer;
Begin
  LHost := '';    {Do not Localize}
  LPort := '';    {Do not Localize}

  if Length(AHostPort) > 0 then
  begin
    i := 1;
    while (i <= Length(AHostPort)) and (not CharIsInSet(AHostPort, i, NAMESEP)) do
    begin
      LHost := LHost + AHostPort[i];
      Inc(i);
    end;
    Inc(i);
    while (i <= Length(AHostPort)) and (not CharIsInSet(AHostPort, i, NAMESEP)) do
    begin
      LPort := LPort + AHostPort[i];
      Inc(i);
    end;
    LHost := TrimRight(LHost);
    LPort := TrimLeft(LPort);
  end;

  DoCheckHostPort(AContext, AHostPort, LHost, LPort);

  if Length(LHost) > 0 then begin
    TIdTcpClient(AContext.OutboundClient).Host := LHost;
  end;

  if Length(LPort) > 0 then begin
    TIdTcpClient(AContext.OutboundClient).Port := IndyStrToInt(LPort, TIdTcpClient(AContext.OutboundClient).Port);
  end;
end;

procedure TIdMappedTelnetContext.OutboundConnect;
var
  LHostPort: String;
  LServer: TIdCustomMappedTelnet;
  LClient: TIdTCPClient;
begin
  //don`t call inherited, NEW behavior
  LServer := TIdCustomMappedTelnet(Server);
  FOutboundClient := TIdTCPClient.Create(nil);
  LClient := TIdTCPClient(FOutboundClient);

  LClient.Port := LServer.MappedPort;
  LClient.Host := LServer.MappedHost;

  FAllowedConnectAttempts := LServer.AllowedConnectAttempts;
  LServer.DoLocalClientConnect(Self);

  repeat
    if FAllowedConnectAttempts > 0 then begin
      Dec(FAllowedConnectAttempts);
    end;
    try
      LHostPort := Trim(Connection.IOHandler.InputLn); //~telnet input
      LServer.ExtractHostAndPortFromLine(Self, LHostPort);

      if Length(LClient.Host) < 1 then begin
        raise EIdException.Create(RSEmptyHost);
      end;

      LClient.ConnectTimeout := Self.FConnectTimeOut;
      LClient.Connect;
    except
      on E: Exception do // DONE: Handle connect failures
      begin
        FErrorMsg := 'ERROR: ['+E.ClassName+'] ' + E.Message;    {Do not Localize}
        DoException(E);
        Connection.IOHandler.WriteLn(FErrorMsg);
      end;
    end;//trye
  until FOutboundClient.Connected or (FAllowedConnectAttempts = 0);

  if FOutboundClient.Connected then begin
    LServer.DoOutboundClientConnect(Self);
  end else begin
    Connection.Disconnect; //prevent all next work
  end;
end;

procedure TIdCustomMappedTelnet.SetAllowedConnectAttempts(const Value: Integer);
Begin
  if Value >= 0 then begin
    FAllowedConnectAttempts := Value;
  end else begin
    FAllowedConnectAttempts := -1; //unlimited
  end;
end;

end.