unit usockettimedconnect;
interface
// rch@enero2012

uses
  {$IFDEF LINUX}
    ctypes,
    sockets,
    baseunix,
    unix,
    linux,
  {$ELSE}
    winsock,
  {$ENDIF}
  syncobjs,
  Classes, SysUtils;


function socketTimedConnect(s: TSocket; var name: TSockAddr; namelen: Integer; timeout_ms: cardinal ): boolean;

implementation

function socketTimedConnect(s: TSocket; var name: TSockAddr; namelen: Integer; timeout_ms: cardinal ): boolean;
var
    //fdse, fdsr: TFDSet;
    fdsw: TFDSet;
    resSelect: Integer;
    iMode: integer;
    timeOut: TimeVal;
    res: boolean;

begin
  res:= false;

  if timeOut_ms = 0 then
  begin
    {$IFDEF LINUX}
    if  fpConnect(s, @name, sizeOf( name )) = 0    then
    {$ELSE}
    if  Connect(s, name, sizeOf( name )) = 0   then
    {$ENDIF}
      res:= true
  end
  else
  begin
  timeOut.tv_sec:= timeOut_ms div 1000;
  timeOut.tv_usec:= 0;

{$IFDEF WINDOWS}
  // pongo el socket en modo NO bloqueante
  iMode:=1;
  ioctlsocket( s , FIONBIO, iMode );
{$ENDIF}

(*
  FD_ZERO( fdse );
  FD_SET( s, fdse );
  FD_ZERO( fdsr );
  FD_SET( s, fdsr );
  *)

{$IFDEF WINDOWS}
  FD_ZERO( fdsw );
  FD_SET( s, fdsw );
{$ELSE}
  fpFD_ZERO( fdsw );
  fpFD_SET( s, fdsw );
{$ENDIF}

  writeln( 'Intentando conectar ...' );
  {$IFDEF LINUX}
  if  fpConnect(s, @name, sizeOf( name )) =0   then
  {$ELSE}
  if  Connect(s, name, sizeOf( name )) = 0   then
  {$ENDIF}
    res:= true
  else
  begin
(* OJO no borrar esto hasta probar en linux, capaz que hay que recurrir
al control del fdse -- no está claro en al documentación de los sockets

    resSelect:= select(  s+1, @fdsr, @fdsw, @fdse, @timeOut );
    writeln('resSelect: '+IntToStr( resSelect ) );
    res:= resSelect = 1;
    if (FD_ISSET( s, fdsr )) then
      writeln( 'fdsr' );
    if (FD_ISSET( s, fdsw )) then
      writeln( 'fdsw' );
    if (FD_ISSET( s, fdse )) then
      writeln( 'fdse' );
      *)

{$IFDEF WINDOWS}
    resSelect:= select(  s+1, nil, @fdsw, nil, @timeOut );
    res:=  ( resSelect > 0 ) and FD_ISSET( s, fdsw );
{$ELSE}
    resSelect:= fpSelect(  s+1, nil, @fdsw, nil, @timeOut );
    res:=  ( resSelect > 0 ) and ( fpFD_ISSET( s, fdsw ) <> 0 );
{$ENDIF}
  end;



(*
  FD_CLR( s, fdsr ); // eliminar del conjunto maestro
  FD_CLR( s, fdse ); // eliminar del conjunto maestro
  *)

{$IFDEF WINDOWS}
  FD_CLR( s, fdsw ); // eliminar del conjunto maestro
{$ELSE}
  fpFD_CLR( s, fdsw ); // eliminar del conjunto maestro
{$ENDIF}

{$IFDEF WINDOWS}
  iMode:=0; // lo vuelvo a modo bloqueante
  ioctlsocket( s , FIONBIO, iMode );
{$ENDIF}
  end;
  result:= res;
end;

(***

Esto es otra prueba que hice que es crear un Thread aparte para hace la acción y en el Thread
principal programa una espera con timeout por la finalización.
Se me complicó esta opción para lograr MATAR el socket que estaba tratando de hacer el connect
para poder matarlo tuve que ponerlo en modo NO_BLOCKING pero entonces hay que poner un select
y entonces funciona el timeout directamente sobre el select y no es necesario crear un thread
auxiliar.

Type
    TConnectThread = class(TThread)
       protected
         procedure Execute; override;
       public
         res: boolean;
         sock: TSocket;
         to_EVent: TEVent;
         addr: TSockAddr;
         constructor Create( socket: TSocket; var addr: TSockAddr; to_Event: TEvent );
       end;

      constructor TConnectThread.Create( socket: TSocket; var addr: TSockAddr; to_Event: TEvent );
      begin
        FreeOnTerminate := false;
        inherited Create( true );
        res:= false;
        self.sock:= socket;
        self.addr:= addr;
        self.to_EVent:= to_Event;
      end;

     procedure TConnectThread.Execute;
     var
         fds: TFDSet;
         resSelect: Integer;
       begin

        FD_ZERO( fds );
        FD_SET( sock, fds );

       writeln( 'Intentando conectar ...' );
       {$IFDEF LINUX}
       if  Connect(sock, addr, sizeOf( addr ))    then
       {$ELSE}
       if  Connect(sock, addr, sizeOf( addr )) = 0   then
       {$ENDIF}
         res:= true;

       while (not terminated) and ( not res ) do
       begin
         resSelect:= select(  sock+1, @fds, nil, nil, nil);
         writeln('resSelect: '+IntToStr( resSelect ) );
         sleep( 1 );
       end;
       FD_CLR( sock, master); // eliminar del conjunto maestro

       writeln( 'Salí del connect ... ' );
       if not terminated then
       begin
         to_Event.SetEvent;
       end;
     end;


function socketTimedConnect(s: TSocket; var name: TSockAddr; namelen: Integer; timeout_ms: cardinal ): boolean;

var
  WaitForB: TSimpleEvent;
  reswf: TWaitResult;
  action_thread: TConnectThread;
  res: boolean;
  iMode: u_long;

begin
writeln('saco el socket de modo bloqueante y le doy close');
      iMode:=1;
      ioctlsocket( s , FIONBIO, iMode );
      WaitForB:= TSimpleEvent.create;
      action_thread:= TConnectThread.Create( s, name, WaitForB );
      action_thread.Resume;
      writeln('Voy waitfor:' );
      reswf:= WaitForB.WaitFor( timeout_ms );
      writeln('Hola volví del WaitForB reswf:'+INtToStr( ord( reswf ) ));
      if (reswf = wrSignaled) then
      begin
        res:= action_thread.res;
        iMode:=0; // lo vuelvo a modo bloqueante
        ioctlsocket( s , FIONBIO, iMode );
      end
      else
      begin
writeln('le doy close al socket');
        closesocket( s );
        action_thread.Terminate;
        action_thread.waitfor;
writeln('volví del waitfor del thread');
        res:= false;
      end;
      WaitForB.destroy;
      action_thread.Free;
      result:= res;
end;





****)
end.

