{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence                                   }
{ Team Coherence is Copyright 2002 by Quality Software Components      }
{                                                                      }
{ For further information / comments, visit our WEB site at            }
{ http://www.TeamCoherence.com                                         }
{**********************************************************************}
{}
{ $Log:  11952: IdIOHandlerStack.pas
{
{   Rev 1.39    11/21/2003 12:05:18 AM  BGooijen
{ Terminated isn't public in TThread any more, made it public here now
}
{
{   Rev 1.38    10/28/2003 9:15:44 PM  BGooijen
{ .net
}
{
{   Rev 1.37    10/18/2003 1:42:46 PM  BGooijen
{ Added include
}
{
{   Rev 1.36    2003.10.14 1:26:56 PM  czhower
{ Uupdates + Intercept support
}
{
{   Rev 1.35    2003.10.11 5:48:36 PM  czhower
{ -VCL fixes for servers
{ -Chain suport for servers (Super core)
{ -Scheduler upgrades
{ -Full yarn support
}
{
{   Rev 1.34    10/9/2003 8:09:10 PM  SPerry
{ bug fixes
}
{
{   Rev 1.33    10/5/2003 11:02:36 PM  BGooijen
{ Write buffering
}
{
{   Rev 1.32    05/10/2003 23:01:02  HHariri
{ Fix for connect problem when IP address specified as opposed to host
}
{
{   Rev 1.31    2003.10.02 8:23:42 PM  czhower
{ DotNet Excludes
}
{
{   Rev 1.30    2003.10.02 10:16:28 AM  czhower
{ .Net
}
{
{   Rev 1.29    2003.10.01 9:11:18 PM  czhower
{ .Net
}
{
{   Rev 1.28    2003.10.01 5:05:14 PM  czhower
{ .Net
}
{
{   Rev 1.27    2003.10.01 2:46:38 PM  czhower
{ .Net
}
{
{   Rev 1.26    2003.10.01 2:30:38 PM  czhower
{ .Net
}
{
{   Rev 1.22    10/1/2003 12:14:14 AM  BGooijen
{ DotNet: removing CheckForSocketError
}
{
{   Rev 1.21    2003.10.01 1:37:34 AM  czhower
{ .Net
}
{
{   Rev 1.19    2003.09.30 1:22:58 PM  czhower
{ Stack split for DotNet
}
{
{   Rev 1.18    2003.07.14 1:57:22 PM  czhower
{ -First set of IOCP fixes.
{ -Fixed a threadsafe problem with the stack class.
}
{
{   Rev 1.17    2003.07.14 12:54:32 AM  czhower
{ Fixed graceful close detection if it occurs after connect.
}
{
{   Rev 1.16    2003.07.10 4:34:58 PM  czhower
{ Fixed AV, added some new comments
}
{
{   Rev 1.15    7/4/2003 08:26:46 AM  JPMugaas
{ Optimizations.
}
{
{   Rev 1.14    7/1/2003 03:39:48 PM  JPMugaas
{ Started numeric IP function API calls for more efficiency.
}
{
    Rev 1.13    6/30/2003 10:25:18 AM  BGooijen
  removed unnecessary assignment to FRecvBuffer.Size
}
{
    Rev 1.12    6/29/2003 10:56:28 PM  BGooijen
  Removed .Memory from the buffer, and added some extra methods
}
{
{   Rev 1.11    2003.06.25 4:28:32 PM  czhower
{ Formatting and fixed a short circuit clause.
}
{
    Rev 1.10    6/3/2003 11:43:52 PM  BGooijen
  Elimintated some code
}
{
    Rev 1.9    4/16/2003 3:31:26 PM  BGooijen
  Removed InternalCheckForDisconnect, added .Connected
}
{
    Rev 1.8    4/14/2003 11:44:20 AM  BGooijen
  CheckForDisconnect calls ReadFromSource now
}
{
    Rev 1.7    4/2/2003 3:24:56 PM  BGooijen
  Moved transparantproxy from ..stack to ..socket
}
{
    Rev 1.6    3/5/2003 11:04:32 PM  BGooijen
  Fixed Intercept, but the part in WriteBuffer doesn't look really nice yet
}
{
    Rev 1.5    3/3/2003 11:31:58 PM  BGooijen
  fixed stack overflow in .CheckForDisconnect
}
{
    Rev 1.4    2/26/2003 1:15:40 PM  BGooijen
  FBinding is now freed in IdIOHandlerSocket, instead of in IdIOHandlerStack
}
{
{   Rev 1.3    2003.02.25 1:36:12 AM  czhower
}
{
{   Rev 1.2    2002.12.06 11:49:34 PM  czhower
}
{
{   Rev 1.1    12-6-2002 20:10:18  BGooijen
{ Added IPv6-support
}
{
{   Rev 1.0    11/13/2002 08:45:16 AM  JPMugaas
}
unit IdIOHandlerStack;
{$I IdCompilerDefines.inc}
interface

uses
  Classes,
  IdCoreGlobal, IdSocketHandle, IdIOHandlerSocket, IdException, IdStack;

type
  TIdIOHandlerStack = class(TIdIOHandlerSocket)
  private
    FReadTimeout: Integer;
  protected
    procedure ConnectClient; override;
    // function GetSocksInfo: TIdSocksInfo;
    // procedure SetSocksInfo(ASocks: TIdSocksInfo);
    procedure WriteToDestination(ABuffer: TIdBytes); override;
  public
    procedure CheckForDataOnSource(ATimeout: Integer = 0); override;
    procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean = True;
     AIgnoreBuffer: Boolean = False); override;
    function Connected: Boolean; override;
    function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; override;
    function ReadFromSource(ARaiseExceptionIfDisconnected: Boolean = True;
     ATimeout: Integer = IdTimeoutDefault;
     ARaiseExceptionOnTimeout: Boolean = True): Integer; override;

    // In TIdIOHandlerStack, WriteBytes must be the ONLY call to
    // WriteToDestination - all data goes thru this method
    procedure WriteBytes(ABuffer: TIdBytes;
     AWriteNow: Boolean = False); override;
  published
    property ReadTimeout: Integer read FReadTimeout write FReadTimeout default IdDefTimeout;
    // property SocksInfo: TIdSocksInfo read GetSocksInfo write SetSocksInfo;
  end;

implementation

uses
  IdAntiFreezeBase, IdCoreResourceStrings, IdStackConsts,
  IdTCPConnection, IdComponent, IdIOHandler,
  SysUtils;

type
  TIdConnectThread = class(TThread)
  protected
    FBinding: TIdSocketHandle;
    FExceptionMessage: string;
  public
    procedure Execute; override;
    property Terminated;
  end;

{ TIdIOHandlerStack }

function TIdIOHandlerStack.Connected: Boolean;
begin
  ReadFromSource(False, 0, False);
  Result := inherited Connected;
end;

procedure TIdIOHandlerStack.ConnectClient;

  procedure DoConnectTimeout(ATimeout: Integer);
  var
    LSleepTime: Integer;
    LInfinite: Boolean;
  begin
    LInfinite := ATimeout = IdTimeoutInfinite;
    with TIdConnectThread.Create(True) do try
      FBinding := Binding;
      Resume;
      // Sleep
      if TIdAntiFreezeBase.ShouldUse then begin
        LSleepTime := Min(GAntiFreeze.IdleTimeOut, 125);
      end else begin
        LSleepTime := 125;
      end;

      if LInfinite then begin
        ATimeout := LSleepTime + 1;
      end;

      while ATimeout > LSleepTime do begin
        IdCoreGlobal.Sleep(LSleepTime);
        ATimeout := ATimeout - LSleepTime;

        if LInfinite then begin
          ATimeout := LSleepTime + 1;
        end;

        TIdAntiFreezeBase.DoProcess;
        if Terminated then begin
          ATimeout := 0;
          Break;
        end;
      end;
      IdCoreGlobal.Sleep(ATimeout);
      //
      if Terminated then begin
        if Length(FExceptionMessage) > 0 then begin
          raise EIdConnectException.Create(FExceptionMessage);
        end;
      end else begin
        Terminate;
        Close;
        WaitFor;
        raise EIdConnectTimeout.Create(RSConnectTimeout);
      end;
    finally Free; end;
  end;

var
  LHost: String;
  LPort: Integer;
  LIP: string;
begin
  inherited;
  {$IFNDEF DotNetExclude}
  // Socks support
  // if SocksInfo.Version in [svSocks4, svSocks4A, svSocks5] then begin
  if Assigned(FTransparentProxy) then begin
    if FTransparentProxy.Enabled then begin
      LHost := FTransparentProxy.Host;
      LPort := FTransparentProxy.Port;
    end else begin
      LHost := Host;
      LPort := Port;
    end;
  end else begin
  {$ENDIF}
    LHost := Host;
    LPort := Port;
  {$IFNDEF DotNetExclude}
  end;
  {$ENDIF}

  if not GStack.IsIP(LHost) then begin
    if Assigned(OnStatus) then begin
      DoStatus(hsResolving, [LHost]);
    end;
    LIP := GStack.ResolveHost(LHost);
  end else begin
    LIP := LHost;
  end;
  Binding.SetPeer(LIP, LPort);
  // Connect
  //note for status events, we check specifically for them here
  //so we don't do a string conversion in Binding.PeerIP.
  if Assigned(OnStatus) then begin
    DoStatus(hsConnecting, [Binding.PeerIP]);
  end;

  if ConnectTimeout = 0 then begin
    if TIdAntiFreezeBase.ShouldUse then begin
      DoConnectTimeout(120000); // 2 Min
    end else begin
      Binding.Connect;
    end;
  end else begin
    DoConnectTimeout(ConnectTimeout);
  end;
  {$IFNDEF DotNetExclude}
  if Assigned(FTransparentProxy) then begin
    if FTransparentProxy.Enabled then begin
      FTransparentProxy.Connect(Self, Host, Port);
    end;
  end;
  //SocksInfo.MakeSocksConnection(AHost, APort);
  {$ENDIF}
end;

function TIdIOHandlerStack.Readable(AMSec: integer): boolean;
begin
  Result := Binding.Readable(AMSec);
end;

procedure TIdIOHandlerStack.WriteToDestination(ABuffer: TIdBytes);
var
  LCount: Integer;
  LPos: Integer;
  LSize: Integer;
begin
  InterceptWrite(ABuffer);
  LSize := Length(ABuffer);
  LPos := 0;
  repeat
    LCount := Binding.Send(ABuffer, LPos);
                                                                                          
    // can be called more. Maybe a prop of the connection, MaxSendSize?
    TIdAntiFreezeBase.DoProcess(False);
    FClosedGracefully := LCount = 0;

    // Check if other side disconnected
    CheckForDisconnect;
    DoWork(wmWrite, LCount);
    LPos := LPos + LCount;
  until LPos >= LSize;
end;

{  // All this is to preserve the compatibility with old version
  // In the case when we have SocksInfo as object created in runtime without owner form it is treated as temporary object
  // In the case when the ASocks points to an object with owner it is treated as component on form.

    if Assigned(AProxy) then begin
        if not Assigned(AProxy.Owner) then begin
      if Assigned(FTransparentProxy.Owner) then begin
        FTransparentProxy := nil;
      end;
      FTransparentProxy.Assign(AProxy); // This will construct the default SocksInfo
    end
    else begin
      if Assigned(FTransparentProxy) then begin
        if not Assigned(FTransparentProxy.Owner) then begin
          FreeAndNil(FTransparentProxy);
        end;
      end;
      FTransparentProxy := AProxy;
      FTransparentProxy.FreeNotification(self);
    end;

  //  FTransparentProxy.IOHandler := Self;
  end
  else begin
    FTransparentProxy := AProxy;
  end;
  { if Assigned(ASocks) then begin
    if not Assigned(ASocks.Owner) then begin
      if Assigned(SocksInfo.Owner) then begin
        FSocksInfo := nil;
      end;
      SocksInfo.Assign(ASocks); // This will construct the default SocksInfo
    end
    else begin
      if Assigned(FSocksInfo) then begin
        if not Assigned(FSocksInfo.Owner) then begin
          FreeAndNil(FSocksInfo);
        end;
      end;
      FSocksInfo := ASocks;
      FSocksInfo.FreeNotification(self);
    end;
    FSocksInfo.IOHandler := Self;
  end
  else begin
    FSocksInfo := ASocks;
  end;    }
{end;  }

{function TIdIOHandlerStack.GetSocksInfo: TIdSocksInfo;
begin
  // Necessary at design time for Borland SOAP support
  if not Assigned(FSocksInfo) then begin
    FSocksInfo := TIdSocksInfo.Create(nil);
  end;
  Result := FSocksInfo;
end;  }

function TIdIOHandlerStack.ReadFromSource(
 ARaiseExceptionIfDisconnected: Boolean; ATimeout: Integer;
 ARaiseExceptionOnTimeout: Boolean): Integer;
// Reads any data in tcp/ip buffer and puts it into Indy buffer
// This must be the ONLY raw read from Winsock routine
// This must be the ONLY call to RECV - all data goes thru this method
var
  LByteCount: Integer;
  LBuffer: TIdBytes;
begin
  if ATimeout = IdTimeoutDefault then begin
    if ReadTimeOut = 0 then begin
      ATimeout := IdTimeoutInfinite;
    end else begin
      ATimeout := FReadTimeout;
    end;
  end;
  Result := 0;
  // Check here as this side may have closed the socket
  CheckForDisconnect(ARaiseExceptionIfDisconnected);
  if BindingAllocated then begin
    LByteCount := 0;
    repeat
      if Readable(ATimeout) then begin
        if Assigned(FRecvBuffer) then begin
          // No need to call AntiFreeze, the Readable does that.
          if BindingAllocated then begin
                                                                             
            // be a one time operation per connection.
            SetLength(LBuffer, RecvBufferSize); try
              LByteCount := Binding.Receive(LBuffer);
              SetLength(LBuffer, LByteCount);
              if LByteCount > 0 then begin
                if Intercept <> nil then begin
                  Intercept.Receive(LBuffer);
                  LByteCount := Length(LBuffer);
                end;
    //AsciiFilter - needs to go in TIdIOHandler base class
    //            if ASCIIFilter then begin
    //              for i := 1 to IOHandler.RecvBuffer.Size do begin
    //                PChar(IOHandler.RecvBuffer.Memory)[i] := Chr(Ord(PChar(IOHandler.RecvBuffer.Memory)[i]) and $7F);
    //              end;
    //            end;
                // Pass through LBuffer first so it can go through Intercept
                                                               
                InputBuffer.Write(LBuffer);
              end;
            finally LBuffer := nil; end;
          end else begin
            raise EIdClosedSocket.Create(RSStatusDisconnected);
          end;
        end else begin
          LByteCount := 0;
          if ARaiseExceptionIfDisconnected then begin
            raise EIdException.Create(RSNotConnected);
          end;
        end;
        FClosedGracefully := LByteCount = 0;
        // Check here as other side may have closed connection
        CheckForDisconnect(ARaiseExceptionIfDisconnected);
        Result := LByteCount;
      end else begin
        // Timeout
        if ARaiseExceptionOnTimeout then begin
          raise EIdReadTimeout.Create(RSReadTimeout);
        end;
        Result := -1;
        Break;
      end;
    until (LByteCount <> 0) or (BindingAllocated = False);
  end else begin
    if ARaiseExceptionIfDisconnected then begin
      raise EIdException.Create(RSNotConnected);
    end;
  end;
end;

procedure TIdIOHandlerStack.CheckForDisconnect(
 ARaiseExceptionIfDisconnected: Boolean; AIgnoreBuffer: Boolean);
var
  LDisconnected: Boolean;
begin
  // ClosedGracefully // Server disconnected
  // IOHandler = nil // Client disconnected
  if ClosedGracefully then begin
    if BindingAllocated then begin
      Close;
      // Call event handlers to inform the user that we were disconnected
      DoStatus(hsDisconnected);
      //DoOnDisconnected;
    end;
    LDisconnected := True;
  end else begin
    LDisconnected := not BindingAllocated;
  end;
  // Do not raise unless all data has been read by the user
  if LDisconnected then begin
    if Assigned(FInputBuffer) then begin
      if ((FInputBuffer.Size = 0) or AIgnoreBuffer)
       and ARaiseExceptionIfDisconnected then begin
        RaiseConnClosedGracefully;
      end;
    end;
  end;
end;

procedure TIdIOHandlerStack.CheckForDataOnSource(ATimeout: Integer);
begin
  if Connected then begin
    ReadFromSource(False, ATimeout, False);
  end;
end;

procedure TIdIOHandlerStack.WriteBytes(ABuffer: TIdBytes; AWriteNow: Boolean);
begin
  if Length(ABuffer) > 0 then begin
    // Check if disconnected
    CheckForDisconnect(True, True);
    if BindingAllocated then begin
      if (FWriteBuffer = nil) or AWriteNow then begin
        WriteToDestination(ABuffer);
      // Write Buffering is enabled
      end else begin
        FWriteBuffer.Write(ABuffer);
        if (FWriteBuffer.Size >= WriteBufferThreshhold)
         and (FWriteBufferThreshhold > 0) then begin
                                                                                             
          // That is do at least one physical send.
          WriteBufferFlush(WriteBufferThreshhold);
        end;
      end;
    end else begin
      raise EIdNotConnected.Create(RSNotConnected);
    end;
  end;
end;

{ TIdConnectThread }

procedure TIdConnectThread.Execute;
begin
  try
    try
      FBinding.Connect;
    except on E: EIdSocketError do
      if (E.LastError<>Id_WSAEBADF) and (E.LastError<>Id_WSAENOTSOCK) then begin
        raise E;
      end;
    end;
 except on
    E: Exception do begin
      FExceptionMessage := E.Message;
    end;
  end;
  // Necessary as caller checks this
  Terminate;
end;

initialization
  TIdIOHandlerStack.SetDefaultClass;
end.
