[fpc-pascal] fpselect does not work on linux

[Rainer Stratmann]

Am Samstag, 9. Mai 2009 20:25 schrieb dmitry boyarintsev:
> > How can I find out if a socket connection in a nonblocking mode is
> > established?
>
> according to the man page, you're doing correct path:
> http://linux.die.net/man/2/connect
> i did use non-blocking connection for both Linux and OSX, and it did
> work as described: by "selecting" sockets for writting. Thought i used
> infinite wait time.
>
> Anyway, could you provide more code, on how do you actually establish
> a server address (sockaddr structure). I remeber there were some
> differences in Windows sockaddr structure and Linux sockaddr structure
> (IIRC, IP byte order is messed-up).

With nonblocking sockets it works.
Also it works with linux if I call connect again and again (nonblocking) until 
the result from connect says ok, connected.
But I don't know exactly if there is more traffic on the network or internet 
lines when calling connect often.
Windows may produces traffic every time by calling connect I think. But I am 
not sure. This was the reason why I tried with select to find out if a 
connection is ok.
I tested with longer timeouts, but for me there is the same behaviour.
Another way to find out can be to program select in c, put it in a library and 
then call it from fpc.

regards, Rainer

var
 c_connected   : boolean;
 c_socket      : integer;
 inetaddr_client_remote : tsockaddr;

implementation

const port_program = 12021;

procedure memclr( p : pointer ; len : longint );
var x : longint;
begin
 for x := 1 to len do begin
  byte( p^ ) := 0;
  inc( p );
 end;
end;

procedure setsockaddr( var sa : tsockaddr ; adr : string ; port : longint );
begin
 memclr( @sa , sizeof( sa ) );
 sa.sin_family := AF_INET;
 sa.sin_addr   := strtonetaddr( adr );
 sa.sin_port   := htons( port );
end;

function my_connect( s : integer ; var ina : tsockaddr ) : boolean;
var c : longint;
begin
  c := fpconnect( s , @ina , sizeof( ina ) );
  {$ifdef windows}
  if c = SOCKET_ERROR then begin
    if wsagetlasterror = WSAEISCONN then c := 0; // !
  end;
  {$endif}
  result := ( c = 0 );
end;

procedure setnonblockingsocket( s : integer );
var
  nb : dword;
  n : integer;
  arg : longint;
begin
  // nonblocking
  {$ifdef linux}
  arg := fpfcntl( s , F_GETFL );
  if arg >= 0 then begin
   arg := arg or O_NONBLOCK;
   fpfcntl( s , F_SETFL , arg );
  end;
  {$endif}

  {$ifdef windows}
  nb := 1; // 1 = nonblocking, 0 = blocking
  n := winsock2.ioctlsocket( s , FIONBIO , @nb );
  {$endif}
end;

function is_writable_socket( s : integer ; var error : longint ) : boolean;
var
  fds : tfdset;
  tv : timeval;
  valopt : longint = 1;
  vallen : {$ifdef linux} longword {$else} longint {$endif};
begin
  result := false;
  {$ifdef linux}   fpfd_zero( fds ); fpfd_set( s , fds ); {$endif}
  {$ifdef windows}   fd_zero( fds );   fd_set( s , fds ); {$endif}
  tv.tv_sec  := 0;
  tv.tv_usec := 0;
  //               socket+1 , read , write , except , timeout
  {$ifdef linux}
  if fpselect( s + 1 , nil , @fds , nil , @tv ) > 0 then begin
    if fpfd_isset( s , fds ) = 1 then begin
      vallen := sizeof( valopt );
      if fpgetsockopt( s , sol_socket , so_error , @valopt , @vallen ) = 0 
then begin
        error := valopt;
        result := valopt = 0;
      end;
    end;
  end;
  {$else}
  if select( s + 1 , nil , @fds , nil , @tv ) > 0 then begin
    if fd_isset( s , fds ) then begin
      vallen := sizeof( valopt );
      if getsockopt( s , sol_socket , so_error , valopt , vallen ) = 0 then 
begin
        error := valopt;
        result := valopt = 0;
      end;
    end;
  end;
  {$endif}
end;

function ip_client_start_socket( s : string ) : boolean;
begin
 result := false;
 setsockaddr( inetaddr_client_remote , s , port_program );
 c_socket := fpsocket( PF_INET , SOCK_STREAM , 0 );
 if c_socket >= 0 then begin

   setnonblockingsocket( c_socket ); // nonblocking connect call

   result := my_connect( c_socket , inetaddr_client_remote );
 end;
 
// setnonblockingsocket( c_socket ); // blocking connect call, if this is 
executed later

 c_connected := false;
end;

function ip_client_is_connected( var error : longint ) : boolean;
begin
 if not( c_connected ) then c_connected := is_writable_socket( c_socket , 
error );
 result := c_connected;
end;

procedure ip_client_close_socket;
begin
 if c_socket >= 0 then closesocket( c_socket );
 c_socket := -1;
 c_connected := false;
end;



> thanks,
> dmitry
> _______________________________________________
> fpc-pascal maillist  -  fpc-pascal at lists.freepascal.org
> http://lists.freepascal.org/mailman/listinfo/fpc-pascal