Node.pm 3.47 KB
Newer Older
1
#!/usr/bin/perl
Mike Hibler's avatar
Mike Hibler committed
2 3
#
# Copyright (c) 2009 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Mike Hibler's avatar
Mike Hibler committed
23
#
24 25
package TestBed::TestSuite::Node;
use SemiModern::Perl;
26
use Moose;
27
use Tools;
28 29 30 31 32
use Tools::Network;
use Tools::TBSSH;
use Data::Dumper;

has 'name' => ( isa => 'Str', is => 'rw');
33
has 'experiment' => ( isa => 'TestBed::TestSuite::Experiment', is => 'rw');
34

35 36 37 38 39
=head1 NAME
TestBed::TestSuite::Node

=over 4

Kevin Tew's avatar
Kevin Tew committed
40
=item C<< $n->ping >>
41 42 43

=cut

Kevin Tew's avatar
Kevin Tew committed
44
sub ping {
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85
  my ($s) = @_;
  Tools::Network::ping($s->name);
}

=item C<< $n->reboot >>

=cut

sub reboot {
  my ($s) = shift;
  Tools::Network::node_reboot(@_, $s->pcXXX_name);
}

=item C<< $n->powercycle >>

=cut

sub powercycle {
  my ($s) = shift;
  Tools::Network::node_reboot('-f', $s->pcXXX_name);
}

=item C<< $n->hostname >>

=cut

sub hostname {
  my ($s) = shift;
  my $name = $s->name;
  $name =~ /([^\.]*)/; 
  $1;
}

=item C<< $n->pcXXX_name >>

=cut

sub pcXXX_name {
  my ($s) = shift;
  return $s->experiment->info(aspect => 'mapping')->{$s->hostname}->{node};
  
86 87
}

88 89 90 91
=item C<< $n->single_node_tests >>

executes hostname, sudo ls, mount via ssh on the remote node
=cut
92
sub single_node_tests {
Kevin Tew's avatar
Kevin Tew committed
93 94
  my ($s) = @_;
  my $ssh = $s->ssh();
95 96
  my $eid = $s->experiment->eid;
  my $name = $s->name;
Kevin Tew's avatar
Kevin Tew committed
97
  $ssh->cmdmatch("hostname", qr/$name/i, "$eid $name hostname died");
98 99
  $ssh->cmdmatch("sudo id", qr/uid=0\(root\)/, "$eid $name sudo died");
  $ssh->cmdmatch("mount", qr{/proj/}, "$eid $name mountdied");
100 101
}

102
=item C<< $n->ssh >>
103 104 105

returns a $ssh connection to the node
=cut
106 107
sub ssh {
  my $self = shift;
108
  return Tools::TBSSH::instance($self->name);
109 110
}

111 112 113 114 115 116 117 118 119
=item C<< $n->scp($lfile, $rfile) >>

returns a $ssh connection to the node
=cut
sub scp {
  my $self = shift;
  return Tools::TBSSH::scp($self->name, @_);
}

120 121 122 123
=item C<< $n->build_remote_name($filename) >>

builds "$user\@$host:$fn"
=cut
124 125 126 127 128 129 130
sub build_remote_name {
  my ($s, $fn) = @_;
  my $user = $TBConfig::EMULAB_USER;
  my $host = $s->name;
  return "$user\@$host:$fn";
}

131 132 133 134
=item C<< $n->splat($data, $filename) >>

cats $data to $filename on the node
=cut
135 136 137 138 139 140 141 142 143
sub splat {
  my ($s, $data, $fn) = @_;
  my $temp = Tools::splat_to_temp($data);
  my $dest = $s->build_remote_name($fn);
  my @results = $s->scp($temp, $dest);
  die "splat to $dest failed" if $results[0];
  return 1;
}

144 145 146 147
=item C<< $n->splatex($data, $filename) >>

cats $data to $filename on the node and make it executable
=cut
148 149 150 151 152 153
sub splatex {
  my ($s, $data, $fn) = @_;
  $s->splat($data, $fn);
  $s->ssh->cmdsuccess("chmod +x $fn");
}

154 155 156 157
=item C<< $n->slurp($filename) >>

pulls $filename content from node
=cut
158 159 160 161 162 163 164 165 166 167 168
sub slurp {
  my ($s, $fn) = @_;
  use File::Temp;
  my $temp = File::Temp->new;
  my $src = $s->build_remote_name($fn);
  my @results = $s->scp($src, $temp);
  die "spurp from $src failed" if $results[0];
  return Tools::slurp($temp);
  return 1;
}

169 170 171 172
=back 

=cut

173
1;