paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 09:26:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

* clean up connection timeout logic

Browse Source 
git-svn-id: trunk@39538 -
This commit is contained in:
michael 2018-07-31 08:05:19 +00:00
parent 5eb97ce700
commit c3d1e1559b
1 changed files with 75 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

136
packages/fcl-net/src/ssockets.pp
View File

@ -220,22 +220,23 @@ type
{ TInetSocket } { TInetSocket }
TBlockingMode = (bmBlocking,bmNonBlocking); TBlockingMode = (bmBlocking,bmNonBlocking);
TBlockingModes = Set of TBlockingMode; TBlockingModes = Set of TBlockingMode;
TCheckTimeoutResult = (ctrTimeout,ctrError,ctrOK);
{$if defined(unix) or defined(windows)} {$if defined(unix) or defined(windows)}
{$DEFINE HAVENONBLOCKING} {$DEFINE HAVENONBLOCKING}
{$endif} {$endif}
TInetSocket = Class(TSocketStream) TInetSocket = Class(TSocketStream)
Private Private
FHost : String; FHost : String;
FPort : Word; FPort : Word;
Protected Protected
{$IFDEF HAVENONBLOCKING} {$IFDEF HAVENONBLOCKING}
function SetSocketBlockingMode(ASocket: cint; ABlockMode: TBlockingMode; AFDSPtr: Pointer): Integer; virtual; function SetSocketBlockingMode(ASocket: cint; ABlockMode: TBlockingMode; AFDSPtr: Pointer): boolean; virtual;
function CheckSocketConnectTimeout(ASocket: cint; AFDSPtr: Pointer; ATimeVPtr: Pointer): Integer; virtual; function CheckSocketConnectTimeout(ASocket: cint; AFDSPtr: Pointer; ATimeVPtr: Pointer): TCheckTimeoutResult; virtual;
{$ENDIF} {$ENDIF}
Public Public
Constructor Create(const AHost: String; APort: Word; AHandler : TSocketHandler = Nil); Overload; Constructor Create(const AHost: String; APort: Word; AHandler : TSocketHandler = Nil); Overload;
Constructor Create(const AHost: String; APort: Word; aConnectTimeout : Integer; AHandler : TSocketHandler = Nil); Overload;
Procedure Connect; Virtual; Procedure Connect; Virtual;
Property Host : String Read FHost; Property Host : String Read FHost;
Property Port : Word Read FPort; Property Port : Word Read FPort;
@ -970,12 +971,18 @@ end;
---------------------------------------------------------------------} ---------------------------------------------------------------------}
Constructor TInetSocket.Create(const AHost: String; APort: Word;AHandler : TSocketHandler = Nil); Constructor TInetSocket.Create(const AHost: String; APort: Word;AHandler : TSocketHandler = Nil);
begin
Create(AHost,aPort,0,AHandler);
end;
Constructor TInetSocket.Create(const AHost: String; APort: Word; aConnectTimeout : Integer; AHandler : TSocketHandler = Nil);
Var Var
S : Longint; S : Longint;
begin begin
FHost:=AHost; FHost:=AHost;
FPort:=APort; FPort:=APort;
ConnectTimeout:=aConnectTimeout;
S:=fpSocket(AF_INET,SOCK_STREAM,0); S:=fpSocket(AF_INET,SOCK_STREAM,0);
Inherited Create(S,AHandler); Inherited Create(S,AHandler);
if (AHandler=Nil) then // Backwards compatible behaviour. if (AHandler=Nil) then // Backwards compatible behaviour.
@ -983,7 +990,7 @@ begin
end; end;
{$IFDEF HAVENONBLOCKING} {$IFDEF HAVENONBLOCKING}
function TInetSocket.SetSocketBlockingMode(ASocket: cint; ABlockMode: TBlockingMode; AFDSPtr: Pointer): Integer; function TInetSocket.SetSocketBlockingMode(ASocket: cint; ABlockMode: TBlockingMode; AFDSPtr: Pointer): Boolean;
Const Const
BlockingModes : Array[TBlockingMode] of DWord = BlockingModes : Array[TBlockingMode] of DWord =
@ -1014,20 +1021,21 @@ begin
{$ifdef unix} {$ifdef unix}
flags := FpFcntl(ASocket, F_GetFl, 0); flags := FpFcntl(ASocket, F_GetFl, 0);
if (AblockMode = bmNonBlocking) then if (AblockMode = bmNonBlocking) then
result := FpFcntl(ASocket, F_SetFl, flags or O_NONBLOCK) result := FpFcntl(ASocket, F_SetFl, flags or O_NONBLOCK) = 0
else else
result := FpFcntl(ASocket, F_SetFl, flags and (not O_NONBLOCK)); result := FpFcntl(ASocket, F_SetFl, flags and (not O_NONBLOCK)) = 0;
{$endif} {$endif}
{$ifdef windows} {$ifdef windows}
result := ioctlsocket(ASocket,FIONBIO,@ABlockMode); result := ioctlsocket(ASocket,FIONBIO,@ABlockMode) = 0;
{$endif} {$endif}
end; end;
function TInetSocket.CheckSocketConnectTimeout(ASocket: cint; AFDSPtr: Pointer; ATimeVPtr: Pointer): Integer; // Return true if a timeout happened. Will only be called in case of eWouldBlock.
function TInetSocket.CheckSocketConnectTimeout(ASocket: cint; AFDSPtr: Pointer; ATimeVPtr: Pointer): TCheckTimeoutResult;
var var
Err: LongInt = 1; Err,ErrLen : Longint;
ErrLen: LongInt; Res : LongInt;
locTimeVal: PTimeVal; locTimeVal: PTimeVal;
locFDS: PFDSet; locFDS: PFDSet;
@ -1036,44 +1044,50 @@ begin
locFDS := PFDSet(AFDSPtr); locFDS := PFDSet(AFDSPtr);
locTimeVal^.tv_usec := 0; locTimeVal^.tv_usec := 0;
locTimeVal^.tv_sec := FConnectTimeout div 1000; locTimeVal^.tv_sec := FConnectTimeout div 1000;
Res:=-1;
{$ifdef unix} {$ifdef unix}
Result := fpSelect(ASocket + 1, nil, locFDS, nil, locTimeVal); // 0 -> TimeOut Res:=fpSelect(ASocket + 1, nil, locFDS, nil, locTimeVal); // 0 -> TimeOut
if Result > 0 then {$ENDIF}
begin
ErrLen := SizeOf(Err);
if fpFD_ISSET(ASocket, locFDS^) = 1 then
begin
fpgetsockopt(ASocket, SOL_SOCKET, SO_ERROR, @Err, @ErrLen);
if Err <> 0 then // 0 -> connected
// We are not interested in the real error-code (ESysEAGAIN,
// ESysEINTR etc, which values are positive)
Result := -1;
end;
end;
{$else}
{$ifdef windows} {$ifdef windows}
Result := select(ASocket + 1, nil, locFDS, nil, locTimeVal); // 0 -> TimeOut Res:=select(ASocket + 1, nil, locFDS, nil, locTimeVal); // 0 -> TimeOut
if Result > 0 then {$ENDIF}
begin if (Res=0) then
ErrLen := SizeOf(Err); Result:=ctrTimeout
if FD_ISSET(ASocket, locFDS^) then else if (Res<0) then
begin Result:=ctrError
fpgetsockopt(ASocket, SOL_SOCKET, SO_ERROR, @Err, @ErrLen); else if (Res>0) then
if Err <> 0 then // 0 -> connected begin
Result := Err; Result:=ctrError;
end; ErrLen := SizeOf(Err);
end; {$ifdef unix}
{$endif} if fpFD_ISSET(ASocket, locFDS^)=1 then
{$endif} {$ENDIF}
{$ifdef windows}
if FD_ISSET(ASocket, locFDS^) then
{$ENDIF}
begin
fpGetSockOpt(ASocket, SOL_SOCKET, SO_ERROR, @Err, @ErrLen);
if Err=0 then // 0 -> connected
Result:=ctrOK
end;
end;
end; end;
{$ENDIF HAVENONBLOCKING} {$ENDIF HAVENONBLOCKING}
procedure TInetSocket.Connect; procedure TInetSocket.Connect;
Const
{$IFDEF UNIX}
ErrWouldBlock = ESysEInprogress;
{$ELSE}
ErrWouldBlock = WSAEWOULDBLOCK;
{$ENDIF}
Var Var
A : THostAddr; A : THostAddr;
addr: TInetSockAddr; addr: TInetSockAddr;
Res : Integer; IsError : Boolean;
TimeOutResult : TCheckTimeOutResult;
Err: Integer; Err: Integer;
{$IFDEF HAVENONBLOCKING} {$IFDEF HAVENONBLOCKING}
FDS: TFDSet; FDS: TFDSet;
@ -1097,39 +1111,39 @@ begin
if ConnectTimeOut>0 then if ConnectTimeOut>0 then
SetSocketBlockingMode(Handle, bmNonBlocking, @FDS) ; SetSocketBlockingMode(Handle, bmNonBlocking, @FDS) ;
{$ENDIF} {$ENDIF}
IsError:=True;
TimeOutResult:=ctrError;
{$ifdef unix} {$ifdef unix}
Err:=ESysEINTR; Err:=ESysEINTR;
Res:=-1; While IsError and (Err in [ESysEINTR, ESysEAGAIN]) do
While (Res<0) and (Err in [ESysEINTR, ESysEAGAIN]) do
{$endif} {$endif}
begin begin
Res:=fpConnect(Handle, @addr, sizeof(addr)); IsError:=fpConnect(Handle, @addr, sizeof(addr))<>0;
{$ifdef unix} if IsError then
if Res < 0 then Err:=Socketerror;
Err:=socketerror;
{$else}
Err:=Res;
{$endif}
end; end;
{$IFDEF HAVENONBLOCKING} {$IFDEF HAVENONBLOCKING}
if {(Err=ESysEINPROGRESS) and} (ConnectTimeOut>0) then if (ConnectTimeOut>0) then
begin begin
Res:=CheckSocketConnectTimeout(Handle, @FDS, @TimeV); if IsError and (Err=ESysEINPROGRESS) then
SetSocketBlockingMode(Handle, bmBlocking, @FDS); begin
TimeOutResult:=CheckSocketConnectTimeout(Handle, @FDS, @TimeV);
IsError:=(TimeOutResult<>ctrOK);
end;
SetSocketBlockingMode(Handle, bmBlocking, @FDS);
end; end;
{$ENDIF} {$ENDIF}
If Not (Res<0) then If Not IsError then
if not FHandler.Connect then begin
begin IsError:=Not FHandler.Connect;
if Res<>0 then Res:=-1; if IsError then
CloseSocket(Handle); CloseSocket(Handle);
end; end;
If (Res<0) then If IsError then
Raise ESocketError.Create(seConnectFailed, [Format('%s:%d',[FHost, FPort])]); if TimeoutResult=ctrTimeout then
{$IFDEF HAVENONBLOCKING} Raise ESocketError.Create(seConnectTimeOut, [Format('%s:%d',[FHost, FPort])])
If (Res=0) and (ConnectTimeOut>0) then else
Raise ESocketError.Create(seConnectTimeOut, [Format('%s:%d',[FHost, FPort])]); Raise ESocketError.Create(seConnectFailed, [Format('%s:%d',[FHost, FPort])]);
{$ENDIF}
end; end;
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------