bzr commit into nuts branch (luis.soares:338) WL#4858

[Luis Soares]

#At file:///home/lsoares/Workspace/nuts-wl4858/ based on
revid:alfranio.correia@stripped

  338 Luis Soares	2009-06-25
      WL#4858: Rep: Install a network test machine
      
      NOTE: This is ongoing work for WL#4858.
      
      This worklog requires that some commands are executed on the host
      that us running some mysqld instance. Example of such commands
      are: 'tcpkill' and 'tc'. 
      
      For addressing this, we add a library holding a function (for now
      just one) that enables contacting by ssh remote hosts involved in
      testing. This library relies on existing perl libraries for SSH:
      Net::SSH, Net::OpenSSH and Net::SSH::Perl. It checks for
      availability of these packages and tentatively tries to use one
      of them. Failure to use any will result in returning failure.

    added:
      lib/My/Nuts/Library/Net.pm
=== added file 'lib/My/Nuts/Library/Net.pm'
--- a/lib/My/Nuts/Library/Net.pm	1970-01-01 00:00:00 +0000
+++ b/lib/My/Nuts/Library/Net.pm	2009-06-25 12:46:24 +0000
@@ -0,0 +1,199 @@
+package My::Nuts::Library::Net;
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(ssh_cmd);
+use warnings;
+use My;
+use Log::Log4perl qw(get_logger :levels :easy);
+my @available = ();
+my $logger = get_logger ("My::Nuts::Library::Net");
+
+
+#
+# Since we can use this outside NUTS context, one should check if
+# logger is indeed initialized before start using it.
+#
+if(!Log::Log4perl->initialized()) {
+  Log::Log4perl->easy_init($WARN);
+}
+
+my @dependencies = ("Net::SSH", "Net::OpenSSH", "Net::SSH::Perl");
+for my $d (@dependencies)
+{
+  eval "require $d";
+  if ($@)
+  {     
+    $logger->info("$d not installed.");
+  }
+  else
+  {
+    if ($d eq "Net::SSH")
+    {
+      push (@available, _net_ssh_system);
+    }
+    elsif ($d eq "Net::OpenSSH")
+    {
+      push (@available, _net_openssh_system);
+    }
+    else
+    {
+      push (@available, _net_ssh_perl_system);
+    }
+  }
+
+  if (@available == 0)
+  {
+    $logger->warn("No SSH perl packages available. SSH sessions cannot be
established!");
+  }
+}
+
+#
+# =============================================
+#
+
+sub ssh_cmd
+{
+
+  my $success= 0;
+
+  for my $f (@available)
+  {
+    if ($f->(@_) == My::SUCCESS)
+    {
+      return My::SUCCESS;
+    }
+  }
+
+  return My::FAILURE;
+}
+
+#
+# =============================================
+#
+
+sub _net_ssh_system
+{
+  my ($user, $password, $ip, $cmd) = @_;
+  my $diag_msg= undef;
+
+  my %opts= (user =>$user, host =>$ip, command=> $cmd);
+  eval "Net::SSH->ssh_cmd(%opts)";
+  if($@)
+  {
+    $diag_msg= "Net::SSH Check that $ip is reachable from NUTS driver host.";
+    $logger->info($diag_msg);
+    return My::FAILURE;
+  }
+
+  return My::SUCCESS;
+
+}
+
+sub _net_openssh_system
+{
+  my ($user, $password, $ip, $cmd) = @_;
+  my $diag_msg= undef;
+
+  my %opts= (user=>$user, password=>$password);
+  my $ssh= Net::OpenSSH->new($ip, %opts);
+  if ($ssh->error)
+  {
+    $diag_msg= "ERROR: " . $ssh->error;
+    $diag_msg.= " Check that $ip is reachable from NUTS driver host.";
+  }
+  else
+  {    
+    $ssh->system($cmd);
+    if ($ssh->error)
+    {
+      $diag_msg= "ERROR: " . $ssh->error;
+      $diag_msg.= " Check that host supports command: $cmd.";
+    }
+  }
+  
+  if ($diag_msg) {  
+    $logger->warn(diag_msg);
+    return My::FAILURE;
+  }
+  
+  return My::SUCCESS;
+}
+
+sub _net_ssh_perl_system
+{
+  my ($user, $password, $ip, $cmd) = @_;
+  my $diag_msg= undef;
+
+  my $ssh = Net::SSH::Perl->new($ip);
+  $ssh->login($user, $password);
+  my($stdout, $stderr, $exit) = $ssh->cmd($cmd);
+  if ($exit != 0)
+  {
+    $diag_msg= "ERROR: " . $exit;
+    $diag_msg.= " Check that host supports command: $cmd.";
+    $logger->warn(diag_msg);
+    return My::FAILURE;
+  }
+  
+  return My::SUCCESS;
+}
+
+1;
+__END__
+
+=over
+
+=back
+
+=head1 My::Nuts::Library::Net
+
+=over
+
+=back
+
+=head2 SYNOPSYS
+
+This interface provides functions implementing network related
+features.
+
+=over
+
+=back
+
+=head2 METHODS
+
+=over
+
+=back
+
+=head3 ssh_cmd (user, pass, host, cmd)
+
+Description: Gives the user the ability to remotely authenticate and
+             execute commands using SSH. It leverages on existing perl
+             packages for SSH: 
+
+               - Net::OpenSSH
+               - Net::SSH
+               - Net::SSH::Perl
+
+             It tries to use one of each (for the listed order). If
+             the package is available then it tries to use it, if not,
+             then it moves to the next one.
+
+Parameters: 
+
+  user     - the login user name
+
+  pass     - the SSH password. This can be overriden if SSH-agent
+             provides an ident itself.
+
+  host     - where to connect. It can be an ip or a hostname (provided that
+             DNS is configured properly).
+
+  cmd      - the command to execute.
+
+Returns:
+
+  On success returns My::SUCCESS, My::FAILURE otherwise.
+
+=cut


Attachment: [text/bzr-bundle] bzr/[e-mail]