Francois Gouget : testbot/TestAgent: Add a minimum interval between connection attempts.

[Alexandre Julliard]

Module: tools
Branch: master
Commit: 81f6422814b5cfa30af6aad6a77411059603609d
URL:    http://source.winehq.org/git/tools.git/?a=commit;h=81f6422814b5cfa30af6aad6a...

Author: Francois Gouget 
Date:   Tue Oct 24 15:47:43 2017 +0200

testbot/TestAgent: Add a minimum interval between connection attempts.

This can be used to ensure the remote host has enough time to boot
before TestAgent gives up, or to paper over very short network outages.

Signed-off-by: Francois Gouget 
Signed-off-by: Alexandre Julliard

---

testbot/lib/WineTestBot/TestAgent.pm | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/testbot/lib/WineTestBot/TestAgent.pm b/testbot/lib/WineTestBot/TestAgent.pm
index e4d655c..255c1a1 100644
--- a/testbot/lib/WineTestBot/TestAgent.pm
+++ b/testbot/lib/WineTestBot/TestAgent.pm
@@ -106,6 +106,7 @@ sub new($$$;$)
     connection => "$Hostname:$Port",
     ctimeout   => 20,
     cattempts  => 3,
+    cinterval  => 0,
     timeout    => 0,
     fd         => undef,
     deadline   => undef,
@@ -147,9 +148,9 @@ sub Disconnect($)
   $self->{agentversion} = undef;
 }

-sub SetConnectTimeout($$;$)
+sub SetConnectTimeout($$;$$)
 {
-  my ($self, $Timeout, $Attempts) = @_;
+  my ($self, $Timeout, $Attempts, $Interval) = @_;
   my @Ret;
   if (defined $Timeout)
   {
@@ -161,6 +162,11 @@ sub SetConnectTimeout($$;$)
     push @Ret, $self->{cattempts};
     $self->{cattempts} = $Attempts;
   }
+  if (defined $Interval)
+  {
+    push @Ret, $self->{cinterval};
+    $self->{cinterval} = $Interval;
+  }
   return @Ret;
 }

@@ -891,7 +897,8 @@ sub _Connect($)
   $self->{rpc} = ($self->{rpc} ? "$self->{rpc}/" : "") ."connect";

my $Step;
-  foreach my $Dummy (1..$self->{cattempts})
+  my $Start = time();
+  foreach my $Attempt (1..$self->{cattempts})
   {
     my $Step = "initializing";
     eval
@@ -1026,7 +1033,8 @@ sub _Connect($)
     }
     # Ideally we should probably check the error and not retry if it is likely
     # permanent, like a hostname that does not resolve.
-    sleep(1);
+    my $Remaining = $Attempt * $self->{cinterval} - (time() - $Start);
+    sleep($Remaining) if ($Remaining > 0);
   }
   $self->{rpc} = $OldRPC;
   return undef;