restemplate/indy/Core/IdSimpleServer.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.17    7/13/04 6:46:36 PM  RLebeau
 Added support for BoundPortMin/Max propeties
}
{
   Rev 1.16    6/6/2004 12:49:40 PM  JPMugaas
 Removed old todo's for things that have already been done.
}
{
   Rev 1.15    5/6/2004 6:04:44 PM  JPMugaas
 Attempt to reenable TransparentProxy.Bind.
}
{
   Rev 1.14    5/5/2004 2:08:40 PM  JPMugaas
 Reenabled Socks Listen for TIdSimpleServer.
}
{
   Rev 1.13    2004.02.03 4:16:52 PM  czhower
 For unit name changes.
}
{
   Rev 1.12    2004.01.20 10:03:34 PM  czhower
 InitComponent
}
{
   Rev 1.11    1/2/2004 12:02:16 AM  BGooijen
 added OnBeforeBind/OnAfterBind
}
{
   Rev 1.10    1/1/2004 10:57:58 PM  BGooijen
 Added IPv6 support
}
{
   Rev 1.9    10/26/2003 10:08:44 PM  BGooijen
 Compiles in DotNet
}
{
   Rev 1.8    10/20/2003 03:04:56 PM  JPMugaas
 Should now work without Transparant Proxy.  That still needs to be enabled.
}
{
   Rev 1.7    2003.10.14 9:57:42 PM  czhower
 Compile todos
}
{
   Rev 1.6    2003.10.11 5:50:12 PM  czhower
 -VCL fixes for servers
 -Chain suport for servers (Super core)
 -Scheduler upgrades
 -Full yarn support
}
{
   Rev 1.5    2003.09.30 1:23:02 PM  czhower
 Stack split for DotNet
}
{
    Rev 1.4    5/16/2003 9:25:36 AM  BGooijen
  TransparentProxy support
}
{
    Rev 1.3    3/29/2003 5:55:04 PM  BGooijen
  now calls AfterAccept
}
{
    Rev 1.2    3/23/2003 11:24:46 PM  BGooijen
  changed cast from TIdIOHandlerStack to TIdIOHandlerSocket
}
{
   Rev 1.1    1-6-2003 21:39:00  BGooijen
 The handle to the listening socket was not closed when accepting a
 connection. This is fixed by merging the responsible code from 9.00.11

  Rev 1.0    11/13/2002 08:58:40 AM  JPMugaas
}
unit IdSimpleServer;

interface

{$i IdCompilerDefines.inc}

uses
  Classes,
  IdException,
  IdGlobal,
  IdSocketHandle,
  IdTCPConnection,
  IdStackConsts,
  IdIOHandler;

const
  ID_ACCEPT_WAIT = 1000;

type
  TIdSimpleServer = class(TIdTCPConnection)
  protected
    FAbortedRequested: Boolean;
    FAcceptWait: Integer;
    FBoundIP: String;
    FBoundPort: TIdPort;
    FBoundPortMin: TIdPort;
    FBoundPortMax: TIdPort;
    FIPVersion: TIdIPVersion;
    FListenHandle: TIdStackSocketHandle;
    FListening: Boolean;
    FOnBeforeBind: TNotifyEvent;
    FOnAfterBind: TNotifyEvent;
    //
    procedure Bind;
    procedure DoBeforeBind; virtual;
    procedure DoAfterBind; virtual;
    function GetBinding: TIdSocketHandle;
    procedure InitComponent; override;
    procedure SetIOHandler(AValue: TIdIOHandler); override;
    procedure SetIPVersion(const AValue: TIdIPVersion);
  public
    procedure Abort; virtual;
    procedure BeginListen; virtual;
    procedure CreateBinding;
    procedure EndListen; virtual;
    procedure Listen(ATimeout: Integer = IdTimeoutDefault); virtual;
    //
    property AcceptWait: Integer read FAcceptWait write FAcceptWait default ID_ACCEPT_WAIT;
  published
    property BoundIP: string read FBoundIP write FBoundIP;
    property BoundPort: TIdPort read FBoundPort write FBoundPort;
    property BoundPortMin: TIdPort read FBoundPortMin write FBoundPortMin;
    property BoundPortMax: TIdPort read FBoundPortMax write FBoundPortMax;
    property Binding: TIdSocketHandle read GetBinding;
    property IPVersion: TIdIPVersion read FIPVersion write SetIPVersion;

    property OnBeforeBind: TNotifyEvent read FOnBeforeBind write FOnBeforeBind;
    property OnAfterBind: TNotifyEvent read FOnAfterBind write FOnAfterBind;
  end;

  EIdCannotUseNonSocketIOHandler = class(EIdException);

implementation

uses
  IdExceptionCore,
  IdIOHandlerStack,
  IdIOHandlerSocket,
  IdResourceStringsCore,
  IdStack;

{ TIdSimpleServer }

procedure TIdSimpleServer.Abort;
begin
  FAbortedRequested := True;
end;

procedure TIdSimpleServer.BeginListen;
begin
  // Must be before IOHandler as it resets it
  EndListen;
  CreateBinding;
  if Socket.TransparentProxy.Enabled then begin
    Socket.Binding.IP := BoundIP;
    Socket.TransparentProxy.Bind(FIOHandler, BoundPort);
  end else begin
    Bind;
    Binding.Listen(1);
  end;
  FListening := True;
end;

procedure TIdSimpleServer.Bind;
var
  LBinding: TIdSocketHandle;
begin
  LBinding := Binding;
  try
    DoBeforeBind;
    LBinding.IPVersion := FIPVersion;  // needs to be before AllocateSocket, because AllocateSocket uses this
    LBinding.AllocateSocket;
    FListenHandle := LBinding.Handle;
    LBinding.IP := BoundIP;
    LBinding.Port := BoundPort;
    LBinding.ClientPortMin := BoundPortMin;
    LBinding.ClientPortMax := BoundPortMax;
    LBinding.Bind;
    DoAfterBind;
  except
    FListenHandle := Id_INVALID_SOCKET;
    raise;
  end;
end;

procedure TIdSimpleServer.CreateBinding;
begin
  if not Assigned(IOHandler) then begin
    CreateIOHandler();
  end;
  IOHandler.Open;
end;

procedure TIdSimpleServer.DoBeforeBind;
begin
  if Assigned(FOnBeforeBind) then begin
    FOnBeforeBind(self);
  end;
end;

procedure TIdSimpleServer.DoAfterBind;
begin
  if Assigned(FOnAfterBind) then begin
    FOnAfterBind(self);
  end;
end;

procedure TIdSimpleServer.EndListen;
begin
  FAbortedRequested := False;
  FListening := False;
end;

function TIdSimpleServer.GetBinding: TIdSocketHandle;
begin
  if Assigned(Socket) then begin
    Result := Socket.Binding;
  end else begin
    Result := nil;
  end;
end;

procedure TIdSimpleServer.SetIOHandler(AValue: TIdIOHandler);
begin
  if Assigned(AValue) then begin
    if not (AValue is TIdIOHandlerSocket) then begin
      raise EIdCannotUseNonSocketIOHandler.Create(RSCannotUseNonSocketIOHandler);
    end;
  end;
  inherited SetIOHandler(AValue);
end;

procedure TIdSimpleServer.SetIPVersion(const AValue: TIdIPVersion);
begin
  FIPVersion := AValue;
  if Assigned(Socket) then begin
    Socket.IPVersion := AValue;
  end;
end;

procedure TIdSimpleServer.Listen(ATimeout: Integer = IdTimeoutDefault);
var
  LAccepted: Boolean;
  
  function DoListenTimeout(ALTimeout: Integer; AUseProxy: Boolean): Boolean;
  var
    LSleepTime: Integer;
  begin
    LSleepTime := AcceptWait;

    if ALTimeout = IdTimeoutDefault then begin
      ALTimeout := IdTimeoutInfinite;
    end;

    if ALTimeout = IdTimeoutInfinite then begin
      repeat
        if AUseProxy then begin
          Result := Socket.TransparentProxy.Listen(IOHandler, LSleepTime);
        end else begin
          Result := Binding.Select(LSleepTime);
        end;
      until Result or FAbortedRequested;
      Exit;
    end;

    while ALTimeout > LSleepTime do begin
      if AUseProxy then begin
        Result := Socket.TransparentProxy.Listen(IOHandler, LSleepTime);
      end else begin
        Result := Binding.Select(LSleepTime);
      end;

      if Result or FAbortedRequested then begin
        Exit;
      end;

      Dec(ALTimeout, LSleepTime);
    end;

    if AUseProxy then begin
      Result := Socket.TransparentProxy.Listen(IOHandler, ALTimeout);
    end else begin
      Result := Binding.Select(ALTimeout);
    end;
  end;

begin
  if not FListening then begin
    BeginListen;
  end;

  if Socket.TransparentProxy.Enabled then begin
    LAccepted := DoListenTimeout(ATimeout, True);
  end else
  begin
    LAccepted := DoListenTimeout(ATimeout, False);
    if LAccepted then begin
      if Binding.Accept(Binding.Handle) then begin
        IOHandler.AfterAccept;
      end;
    end;

// This is now protected. Disconnect replaces it - but it also calls shutdown.
// Im not sure we want to call shutdown here? Need to investigate before fixing
// this.
    GStack.Disconnect(FListenHandle);
    FListenHandle := Id_INVALID_SOCKET;
  end;
  
  if not LAccepted then begin
    raise EIdAcceptTimeout.Create(RSAcceptTimeout);
  end;
end;

procedure TIdSimpleServer.InitComponent;
begin
  inherited InitComponent;
  FAcceptWait := ID_ACCEPT_WAIT;
  FListenHandle := Id_INVALID_SOCKET;
end;

end.