Module: tools Branch: master Commit: 98c47a2f7aa18862e4604175b14940d234adfa24 URL: http://source.winehq.org/git/tools.git/?a=commit;h=98c47a2f7aa18862e4604175b...
Author: Francois Gouget fgouget@codeweavers.com Date: Wed Dec 5 05:38:43 2012 +0100
testbot/TestAgent: Make it possible to tunnel the TestAgent connection through SSH.
---
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 35af883..4be607a 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);