[2/2] testbot/TestAgent: Make it possible to tunnel the TestAgent connection through SSH.
Francois Gouget
fgouget at codeweavers.com
Tue Dec 4 22:38:43 CST 2012
---
testbot/doc/INSTALL.txt | 1 +
testbot/lib/WineTestBot/TestAgent.pm | 93 ++++++++++++++++++++++++++++++++--
testbot/lib/WineTestBot/VMs.pm | 32 ++++++++++--
testbot/scripts/TestAgent | 25 ++++++++-
4 files changed, 140 insertions(+), 11 deletions(-)
diff --git a/testbot/doc/INSTALL.txt b/testbot/doc/INSTALL.txt
index b01aa48..95b2a08 100644
--- a/testbot/doc/INSTALL.txt
+++ b/testbot/doc/INSTALL.txt
@@ -9,6 +9,7 @@ Dependencies:
- Sys::Virt (libsys-virt-perl, see http://libvirt.org/)
- Image::Magick (perlmagick)
- Optional: IO::Socket::IP (for IPv6, libio-socket-ip-perl)
+- Optional: Net::SSH2 (for SSH tunneling, libnet-ssh2-perl)
MySQL setup:
- Create a new 'winetestbot' database and its tables using the
diff --git a/testbot/lib/WineTestBot/TestAgent.pm b/testbot/lib/WineTestBot/TestAgent.pm
index a5f8083..e0066c5 100644
--- a/testbot/lib/WineTestBot/TestAgent.pm
+++ b/testbot/lib/WineTestBot/TestAgent.pm
@@ -51,19 +51,28 @@ sub debug(@)
print STDERR @_ if ($Debug);
}
-sub new($$$)
+sub new($$$;$)
{
- my ($class, $Hostname, $Port) = @_;
+ my ($class, $Hostname, $Port, $Tunnel) = @_;
my $self = {
agenthost => $Hostname,
+ host => $Hostname,
agentport => $Port,
+ port => $Port,
connection => "$Hostname:$Port",
ctimeout => 30,
timeout => 0,
fd => undef,
deadline => undef,
err => undef};
+ if ($Tunnel)
+ {
+ $self->{host} = $Tunnel->{sshhost} || $Hostname;
+ $self->{port} = $Tunnel->{sshport} || 22;
+ $self->{connection} = "$self->{host}:$self->{port}:$self->{connection}";
+ $self->{tunnel} = $Tunnel;
+ }
$self = bless $self, $class;
return $self;
@@ -73,6 +82,18 @@ sub Disconnect($)
{
my ($self) = @_;
+ if ($self->{ssh})
+ {
+ # This may close the SSH channel ($self->{fd}) as a side-effect,
+ # which will avoid undue delays.
+ $self->{ssh}->disconnect();
+ $self->{ssh} = undef;
+ }
+ if ($self->{sshfd})
+ {
+ close($self->{sshfd});
+ $self->{sshfd} = undef;
+ }
if ($self->{fd})
{
close($self->{fd});
@@ -717,6 +738,13 @@ if ($@)
$create_socket = \&create_inet_socket;
}
+sub _ssherror($)
+{
+ my ($self) = @_;
+ my @List = $self->{ssh}->error();
+ return $List[2];
+}
+
sub _Connect($)
{
my ($self) = @_;
@@ -730,8 +758,8 @@ sub _Connect($)
while (1)
{
- $self->{fd} = &$create_socket(PeerHost => $self->{agenthost},
- PeerPort => $self->{agentport},
+ $self->{fd} = &$create_socket(PeerHost => $self->{host},
+ PeerPort => $self->{port},
Type => SOCK_STREAM);
last if ($self->{fd});
$Err = $!;
@@ -750,6 +778,63 @@ sub _Connect($)
return undef;
}
+ if ($self->{tunnel})
+ {
+ # We are in fact connected to the SSH server.
+ # Now forward that connection to the TestAgent server.
+ $self->{sshfd} = $self->{fd};
+ $self->{fd} = undef;
+
+ require Net::SSH2;
+ $self->{ssh} = Net::SSH2->new();
+ $self->{ssh}->debug(1) if ($Debug > 2);
+ if (!$self->{ssh}->connect($self->{sshfd}))
+ {
+ $self->_SetError($FATAL, "Unable to connect to the SSH server: " . $self->_ssherror());
+ return undef;
+ }
+
+ # Authenticate ourselves
+ my $Tunnel = $self->{tunnel};
+ my %AuthOptions=(username => $Tunnel->{username} || $ENV{USER});
+ foreach my $Key ("username", "password", "publickey", "privatekey",
+ "hostname", "local_username", "interact")
+ {
+ $AuthOptions{$Key} = $Tunnel->{$Key} if (exists $Tunnel->{$Key});
+ }
+ # Interactive authentication makes no sense with automatic reconnects
+ $AuthOptions{interact} = 0;
+ if (!$self->{ssh}->auth(%AuthOptions))
+ {
+ # auth() returns no error of any sort :-(
+ $self->_SetError($FATAL, "Unable to authenticate to the SSH server");
+ return undef;
+ }
+
+ $self->{fd} = $self->{ssh}->channel();
+ if (!$self->{fd})
+ {
+ $self->_SetError($FATAL, "Unable to create the SSH channel: " . $self->_ssherror());
+ return undef;
+ }
+
+ # Check that the agent hostname and port won't mess with quoting.
+ if ($self->{agenthost} !~ /^[-a-zA-Z0-9.]*$/ or
+ $self->{agentport} !~ /^[a-zA-Z0-9]*$/)
+ {
+ $self->_SetError($FATAL, "The agent hostname or port is invalid");
+ return undef;
+ }
+
+ # Use netcat to forward the connection from the SSH server to the TestAgent
+ # server. Note that we won't know about netcat errors at this point.
+ if (!$self->{fd}->exec("nc '$self->{agenthost}' '$self->{agentport}'"))
+ {
+ $self->_SetError($FATAL, "Unable to start netcat: " . $self->_ssherror());
+ return undef;
+ }
+ }
+
# Get the protocol version supported by the server.
# This also lets us verify that the connection really works.
$self->{agentversion} = $self->_RecvString();
diff --git a/testbot/lib/WineTestBot/VMs.pm b/testbot/lib/WineTestBot/VMs.pm
index 0a2ce64..74e8efa 100644
--- a/testbot/lib/WineTestBot/VMs.pm
+++ b/testbot/lib/WineTestBot/VMs.pm
@@ -37,6 +37,8 @@ This class caches these objects so only one is created per URI.
=cut
+use URI;
+
use WineTestBot::Config;
use vars qw (@ISA @EXPORT_OK);
@@ -344,11 +346,31 @@ sub PowerOff
return $self->UpdateStatus($Domain);
}
+sub _GetTunnel($)
+{
+ my ($self) = @_;
+
+ # Auto-detect the SSH settings based on the libvirt URI
+ my $VirtURI = $self->VirtURI;
+ if ($VirtURI =~ s/^[a-z]+\+(?:ssh|libssh2):/ssh:/)
+ {
+ my $URI = URI->new($VirtURI);
+ my $TunnelInfo = {
+ sshhost => $URI->host,
+ sshport => $URI->port,
+ username => $URI->userinfo,
+ };
+ return $TunnelInfo;
+ }
+
+ return undef;
+}
+
sub WaitForToolsInGuest($$)
{
my ($self, $Timeout) = @_;
- my $TA = TestAgent->new($self->Hostname, $AgentPort);
+ my $TA = TestAgent->new($self->Hostname, $AgentPort, $self->_GetTunnel());
$TA->SetConnectTimeout($Timeout);
my $Success = $TA->Ping();
$TA->Disconnect();
@@ -358,7 +380,7 @@ sub WaitForToolsInGuest($$)
sub CopyFileFromHostToGuest($$$)
{
my ($self, $HostPathName, $GuestPathName) = @_;
- my $TA = TestAgent->new($self->Hostname, $AgentPort);
+ my $TA = TestAgent->new($self->Hostname, $AgentPort, $self->_GetTunnel());
my $Success = $TA->SendFile($HostPathName, $GuestPathName);
$TA->Disconnect();
return $Success ? undef : $TA->GetLastError();
@@ -367,8 +389,8 @@ sub CopyFileFromHostToGuest($$$)
sub CopyFileFromGuestToHost($$$)
{
my ($self, $GuestPathName, $HostPathName) = @_;
- my $TA = TestAgent->new($self->Hostname, $AgentPort);
- my $Err = $TA->GetFile($GuestPathName, $HostPathName);
+ my $TA = TestAgent->new($self->Hostname, $AgentPort, $self->_GetTunnel());
+ my $Success = $TA->GetFile($GuestPathName, $HostPathName);
$TA->Disconnect();
return $Success ? undef : $TA->GetLastError();
}
@@ -376,7 +398,7 @@ sub CopyFileFromGuestToHost($$$)
sub RunScriptInGuestTimeout($$$)
{
my ($self, $ScriptText, $Timeout) = @_;
- my $TA = TestAgent->new($self->Hostname, $AgentPort);
+ my $TA = TestAgent->new($self->Hostname, $AgentPort, $self->_GetTunnel());
$TA->SetTimeout($Timeout);
my $Success;
diff --git a/testbot/scripts/TestAgent b/testbot/scripts/TestAgent
index 10f6f2e..db31a3d 100755
--- a/testbot/scripts/TestAgent
+++ b/testbot/scripts/TestAgent
@@ -33,6 +33,7 @@ sub BEGIN
my $name0 = $0;
$name0 =~ s+^.*/++;
+use URI;
use WineTestBot::Config;
use WineTestBot::TestAgent;
use WineTestBot::Log;
@@ -46,7 +47,7 @@ my ($Cmd, $Hostname, $LocalFilename, $ServerFilename, @Rm);
my (@Run, $RunIn, $RunOut, $RunErr);
my $SendFlags = 0;
my $RunFlags = 0;
-my ($Port, $ConnectTimeout, $Timeout);
+my ($Port, $ConnectTimeout, $Timeout, $Tunnel);
my $Usage;
sub check_opt_val($$)
@@ -86,6 +87,10 @@ while (@ARGV)
{
$Timeout = check_opt_val($arg, $Timeout);
}
+ elsif ($arg eq "--tunnel")
+ {
+ $Tunnel = check_opt_val($arg, $Tunnel);
+ }
elsif ($arg eq "--sendfile-exe")
{
$SendFlags |= $TestAgent::SENDFILE_EXE;
@@ -178,6 +183,11 @@ if (!defined $Usage)
$Usage = 2;
}
$AgentPort = $Port if (defined $Port);
+ if (defined $Tunnel and $Tunnel !~ /^ssh:/)
+ {
+ error("only SSH proxies are supported\n");
+ $Usage = 2;
+ }
}
if (defined $Usage)
{
@@ -217,11 +227,22 @@ if (defined $Usage)
print " connecting instead of the default one.\n";
print " --timeout <timeout> Use the specified timeout (in seconds) instead of the\n";
print " default one for the operation.\n";
+ print " --tunnel <uri> Tunnel the connection through ssh. The SSH connection is\n";
+ print " specified in the form of an ssh:// URI.\n";
print " --help Shows this usage message.\n";
exit 0;
}
-my $TA = TestAgent->new($Hostname, $AgentPort);
+my $TunnelInfo;
+if (defined $Tunnel)
+{
+ my $URI = URI->new($Tunnel);
+ $TunnelInfo = {sshhost => $URI->host,
+ sshport => $URI->port,
+ username => $URI->userinfo};
+}
+
+my $TA = TestAgent->new($Hostname, $AgentPort, $TunnelInfo);
$TA->SetConnectTimeout($ConnectTimeout) if (defined $ConnectTimeout);
$TA->SetTimeout($Timeout) if (defined $Timeout);
--
1.7.10.4
More information about the wine-patches
mailing list