THRIFT-4589 HTTP client timeouts are a) incomplete and b) not used at…

… all Client: Delphi Patch: Jens Geyer
apache · Jun 22, 2018 · 20e727e · 20e727e
1 parent 896c206
commit 20e727e
Showing 1 changed file with 84 additions and 35 deletions.
diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas
@@ -118,14 +118,21 @@   TTransportExceptionBadArgs = class (TTransportExceptionSpecialized);
   TTransportExceptionInterrupted = class (TTransportExceptionSpecialized);
 
   IHTTPClient = interface( ITransport )
-    ['{0F5DB8AB-710D-4338-AAC9-46B5734C5057}']
+    ['{BA142D12-8AE6-4B50-9E33-6B7843B21D73}']
+    procedure SetDnsResolveTimeout(const Value: Integer);
+    function GetDnsResolveTimeout: Integer;
     procedure SetConnectionTimeout(const Value: Integer);
     function GetConnectionTimeout: Integer;
+    procedure SetSendTimeout(const Value: Integer);
+    function GetSendTimeout: Integer;
     procedure SetReadTimeout(const Value: Integer);
     function GetReadTimeout: Integer;
     function GetCustomHeaders: IThriftDictionary<string,string>;
     procedure SendRequest;
+
+    property DnsResolveTimeout: Integer read GetDnsResolveTimeout write SetDnsResolveTimeout;
     property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
+    property SendTimeout: Integer read GetSendTimeout write SetSendTimeout;
     property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
     property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
   end;
@@ -135,7 +142,9 @@   THTTPClientImpl = class( TTransportImpl, IHTTPClient)
     FUri : string;
     FInputStream : IThriftStream;
     FOutputStream : IThriftStream;
+    FDnsResolveTimeout : Integer;
     FConnectionTimeout : Integer;
+    FSendTimeout : Integer;
     FReadTimeout : Integer;
     FCustomHeaders : IThriftDictionary<string,string>;
 
@@ -148,13 +157,20 @@   THTTPClientImpl = class( TTransportImpl, IHTTPClient)
     procedure Write( const pBuf : Pointer; off, len : Integer); override;
     procedure Flush; override;
 
+    procedure SetDnsResolveTimeout(const Value: Integer);
+    function GetDnsResolveTimeout: Integer;
     procedure SetConnectionTimeout(const Value: Integer);
     function GetConnectionTimeout: Integer;
+    procedure SetSendTimeout(const Value: Integer);
+    function GetSendTimeout: Integer;
     procedure SetReadTimeout(const Value: Integer);
     function GetReadTimeout: Integer;
+
     function GetCustomHeaders: IThriftDictionary<string,string>;
     procedure SendRequest;
+    property DnsResolveTimeout: Integer read GetDnsResolveTimeout write SetDnsResolveTimeout;
     property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;
+    property SendTimeout: Integer read GetSendTimeout write SetSendTimeout;
     property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;
     property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;
   public
@@ -458,30 +474,36 @@ procedure TTransportImpl.Write( const pBuf : Pointer; len : Integer);
 
 { THTTPClientImpl }
 
-procedure THTTPClientImpl.Close;
-begin
-  FInputStream := nil;
-  FOutputStream := nil;
-end;
-
 constructor THTTPClientImpl.Create(const AUri: string);
 begin
   inherited Create;
   FUri := AUri;
+
+  // defaults according to MSDN
+  FDnsResolveTimeout := 0; // no timeout
+  FConnectionTimeout := 60 * 1000;
+  FSendTimeout       := 30 * 1000;
+  FReadTimeout       := 30 * 1000;
+
   FCustomHeaders := TThriftDictionaryImpl<string,string>.Create;
   FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
 end;
 
 function THTTPClientImpl.CreateRequest: IXMLHTTPRequest;
 var
   pair : TPair<string,string>;
+  srvHttp : IServerXMLHTTPRequest;
 begin
   {$IF CompilerVersion >= 21.0}
-  Result := CoXMLHTTP.Create;
+  Result := CoServerXMLHTTP.Create;
   {$ELSE}
   Result := CoXMLHTTPRequest.Create;
   {$IFEND}
 
+  // setting a timeout value to 0 (zero) means "no timeout" for that setting
+  if Supports( result, IServerXMLHTTPRequest, srvHttp)
+  then srvHttp.setTimeouts( DnsResolveTimeout, ConnectionTimeout, SendTimeout, ReadTimeout);
+
   Result.open('POST', FUri, False, '', '');
   Result.setRequestHeader( 'Content-Type', 'application/x-thrift');
   Result.setRequestHeader( 'Accept', 'application/x-thrift');
@@ -498,21 +520,46 @@ destructor THTTPClientImpl.Destroy;
   inherited;
 end;
 
-procedure THTTPClientImpl.Flush;
+function THTTPClientImpl.GetDnsResolveTimeout: Integer;
 begin
-  try
-    SendRequest;
-  finally
-    FOutputStream := nil;
-    FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
-  end;
+  Result := FDnsResolveTimeout;
+end;
+
+procedure THTTPClientImpl.SetDnsResolveTimeout(const Value: Integer);
+begin
+  FDnsResolveTimeout := Value;
 end;
 
 function THTTPClientImpl.GetConnectionTimeout: Integer;
 begin
   Result := FConnectionTimeout;
 end;
 
+procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer);
+begin
+  FConnectionTimeout := Value;
+end;
+
+function THTTPClientImpl.GetSendTimeout: Integer;
+begin
+  Result := FSendTimeout;
+end;
+
+procedure THTTPClientImpl.SetSendTimeout(const Value: Integer);
+begin
+  FSendTimeout := Value;
+end;
+
+function THTTPClientImpl.GetReadTimeout: Integer;
+begin
+  Result := FReadTimeout;
+end;
+
+procedure THTTPClientImpl.SetReadTimeout(const Value: Integer);
+begin
+  FReadTimeout := Value;
+end;
+
 function THTTPClientImpl.GetCustomHeaders: IThriftDictionary<string,string>;
 begin
   Result := FCustomHeaders;
@@ -523,14 +570,26 @@ function THTTPClientImpl.GetIsOpen: Boolean;
   Result := True;
 end;
 
-function THTTPClientImpl.GetReadTimeout: Integer;
+procedure THTTPClientImpl.Open;
 begin
-  Result := FReadTimeout;
+  FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
 end;
 
-procedure THTTPClientImpl.Open;
+procedure THTTPClientImpl.Close;
 begin
-  // nothing to do
+  FInputStream := nil;
+  FOutputStream := nil;
+end;
+
+procedure THTTPClientImpl.Flush;
+begin
+  try
+    SendRequest;
+  finally
+    FOutputStream := nil;
+    FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);
+    ASSERT( FOutputStream <> nil);
+  end;
 end;
 
 function THTTPClientImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer;
@@ -572,16 +631,6 @@ procedure THTTPClientImpl.SendRequest;
   end;
 end;
 
-procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer);
-begin
-  FConnectionTimeout := Value;
-end;
-
-procedure THTTPClientImpl.SetReadTimeout(const Value: Integer);
-begin
-  FReadTimeout := Value
-end;
-
 procedure THTTPClientImpl.Write( const pBuf : Pointer; off, len : Integer);
 begin
   FOutputStream.Write( pBuf, off, len);
@@ -1038,12 +1087,6 @@ procedure TBufferedStreamImpl.Write( const pBuf : Pointer; offset: Integer; coun
 
 { TStreamTransportImpl }
 
-procedure TStreamTransportImpl.Close;
-begin
-  FInputStream := nil;
-  FOutputStream := nil;
-end;
-
 constructor TStreamTransportImpl.Create( const AInputStream : IThriftStream; const AOutputStream : IThriftStream);
 begin
   inherited Create;
@@ -1058,6 +1101,12 @@ destructor TStreamTransportImpl.Destroy;
   inherited;
 end;
 
+procedure TStreamTransportImpl.Close;
+begin
+  FInputStream := nil;
+  FOutputStream := nil;
+end;
+
 procedure TStreamTransportImpl.Flush;
 begin
   if FOutputStream = nil then begin