libwanetmon.pm 6.88 KB
Newer Older
1
#!/usr/bin/perl -w
Dan Gebhardt's avatar
Dan Gebhardt committed
2 3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2006, 2007 University of Utah and the Flux Group.
Dan Gebhardt's avatar
Dan Gebhardt committed
5 6 7
# All rights reserved.
#

8 9 10 11 12 13 14 15

package libwanetmon;

use strict;
use Exporter;
use vars qw(@ISA @EXPORT);
use IO::Socket::INET;
use IO::Select;
16 17
#use lib '/usr/testbed/lib';
#use event;
18 19 20
require Exporter;

@ISA    = "Exporter";
21
our @EXPORT = qw ( 
22 23 24 25 26
	       %deadnodes
	       %ERRID
	       deserialize_hash
	       serialize_hash
	       sendcmd
27
	       sendcmd_evsys
28 29 30
	       time_all
	       setcmdport
	       setexpid
31
	       setevexpid
32
	       stopnode
33
	       stopnode_evsys
34
	       edittest
35
	       edittest_evsys
36
	       killnode
37
	       getstatus
38
	       );
39 40
our @EXPORT_OK = qw(
		    );
41 42


43 44 45 46 47 48 49 50 51 52 53 54
# These errors define specifics of when a measurement value cannot be
# reported due to some error in the network or at the remote end.
our %ERRID;
$ERRID{timeout} = -1;
$ERRID{ttlexceed} = -2; # was an error for "ping", but is not seen in fping.
$ERRID{unknown} = -3;   # general error, which cannot be classified into others
$ERRID{unknownhost} = -4;
$ERRID{ICMPunreachable} = -5;  #used for all ICMP errors (see fping.c for strs)
$ERRID{iperfHostUnreachable} = -6;  #for iperf: error flagged by: write1 failed: Broken pipe

our %deadnodes;

55 56 57 58
my $socket;
my $sel = IO::Select->new();
my $port;
my $expid;
59
my $evexpid = "__none";
60 61 62 63

sub setcmdport($)
{
    $port = $_[0];
64
#    print "libwanetmon: port=$port\n";
65 66 67 68 69
}

sub setexpid($)
{
    $expid = $_[0];
70
#    print "libwanetmon: expid=$expid\n";
71 72
}

73 74 75 76 77 78
sub setevexpid($)
{
    $evexpid = $_[0];
#    print "libwanetmon: evexpid=$evexpid\n";
}

79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134

#
# Custom sub to turn a hash into a string. Hashes must not contain
# the substring of $separator anywhere!!!
#
sub serialize_hash($)
{
    my ($hashref) = @_;
    my %hash = %$hashref;
    my $separator = "::";
    my $out = "";

    for my $key (keys %hash){
	$out .= $separator if( $out ne "" );
	$out .= $key.$separator.$hash{$key};
    }
    return $out;
}



sub deserialize_hash($)
{
    my ($string) = @_;
    my $separator = "::";
    my %hashout;

    my @tokens = split( /$separator/, $string );

    for( my $i=0; $i<@tokens; $i+=2 ){
	$hashout{$tokens[$i]} = $tokens[$i+1];
#	print "setting $tokens[$i] => $tokens[$i+1]\n";
    }
    return \%hashout;
}



sub time_all()
{
    package main;
    require 'sys/syscall.ph';
    my $tv = pack("LL",());
    syscall( &SYS_gettimeofday, $tv, undef ) >=0
	or warn "gettimeofday: $!";
    my ($sec, $usec) = unpack ("LL",$tv);
    return $sec + ($usec / 1_000_000);
#    return time();
}


sub sendcmd($$)
{
    my $node = $_[0];
    my $hashref = $_[1];
    my %cmd = %$hashref;
135 136 137
    if( !defined $cmd{managerID} ){
	$cmd{managerID} = "default";
    }
138 139 140
    if( !defined $cmd{expid} ){
        $cmd{expid} = $expid;
    }
141 142

    my $sercmd = serialize_hash( \%cmd );
143
#    print "sercmd=$sercmd\n";
144 145
    my $f_success = 0;
    my $max_tries = 3;
146
    my $retval;
147 148 149 150
    do{
	$socket = IO::Socket::INET->new( PeerPort => $port,
					 Proto    => 'tcp',
					 PeerAddr => $node,
151
					 Timeout  => 3 );
152
	if( defined $socket ){
153
#	    $sel->add($socket);
154 155
	    print $socket "$sercmd\n";
	    $sel->add($socket);
156
	    my ($ready) = $sel->can_read(2);  #timeout (seconds) (?)
157
	    if( defined($ready) && $ready eq $socket ){
158 159
		my $ack;
		($ack, $retval) = <$ready>;
160 161 162 163 164 165 166 167
		if( defined $ack && ( (chomp($ack),$ack) eq "ACK") ){
		    $f_success = 1;
#		        print "Got ACK from $node for command\n";
		    close $socket;
		    
		}else{
		    $max_tries--;
		}
168 169
		chomp $retval 
		    if( defined $retval );
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
	    }else{
		$max_tries--;
	    }
	    $sel->remove($socket);
	    close($socket);
	}else{
	    select(undef, undef, undef, 0.2);
	    $max_tries--;
	}
    }while( $f_success != 1 && $max_tries != 0 );

    if( $f_success == 0 && $max_tries == 0 ){
	$deadnodes{$node} = 1;
#	print "DID NOT GET ACK from $node for command $sercmd\n";
	return -1;
    }elsif( $f_success == 1 ){
	#success!
	delete $deadnodes{$node};
188
	return (1,$retval);
189 190 191 192 193
    }

}


194 195 196 197 198 199 200


#
# input params:
# - name of command (EDIT, INIT, etc..)
# - hash of extra strings to add to event notification
# - handle to eventsystem "handle"
201
sub sendcmd_evsys($$$;$)
202
{
203
    my ($cmdname, $hashref,$handle,$manType) = @_;
204 205
    my %cmd = %$hashref;

206 207 208 209 210 211
    if( !defined $manType ){
	$manType = "managerclient";
    }

    print "manType = $manType\n";

212 213 214 215 216 217
    #
    # This is the evsys command to send
    #
    my $tuple = event::address_tuple_alloc();
    if (!$tuple) { die "Could not allocate an address tuple\n"; }

218 219
    %$tuple = ( objtype   => "WANETMON",
		objname   => $manType,
220
		eventtype => $cmdname,
221
		expt      => $evexpid,
222 223 224 225 226 227 228 229 230 231 232 233
		);

    my $notification = event::event_notification_alloc($handle,$tuple);
    if (!$notification) { die "Could not allocate notification\n"; }

    # set extra params
    foreach my $name (keys %cmd){
	if( 0 == event::event_notification_put_string( $handle,
						$notification,
						"$name",
						$cmd{$name} ) )
	{ warn "Could not add attribute to notification\n"; }
Dan Gebhardt's avatar
Dan Gebhardt committed
234
#	print "adding $name => ".$cmd{$name}."\n";
235 236 237 238 239 240 241 242 243 244 245 246 247 248
    }

    #send notification
    if (!event::event_notify($handle, $notification)) {
	die("could not send test event notification");
    }

    event::event_notification_free($handle, $notification);
}


sub stopnode($$)
{
    my ($node,$managerID) = @_;
249
    my %cmd = (
250
		managerID => $managerID,
251 252 253 254
		cmdtype  => "STOPALL" );
    sendcmd($node,\%cmd);
}

255 256 257 258 259 260 261 262 263

#
#
sub stopnode_evsys($$$)
{
    my ($node, $managerID, $handle) = @_;
    my %cmd = ( srcnode      => $node,
		managerID    => $managerID,
		cmdtype  => "STOPALL" );
264 265 266 267 268 269 270 271
    my $manType;
    if( $managerID eq "automanagerclient" ){
	$manType = $managerID;
    }else{
	$manType = "managerclient";
    }

    sendcmd_evsys("STOPALL",\%cmd,$handle,$manType);
272 273 274
}


Dan Gebhardt's avatar
Dan Gebhardt committed
275
sub killnode($)
276
{
Dan Gebhardt's avatar
Dan Gebhardt committed
277
    my ($node) = @_;
278
    my %cmd = (
279 280 281 282 283
		cmdtype  => "DIE" );
    sendcmd($node,\%cmd);
}


284
sub edittest($$$$$$)
285
{
286 287
    my ($srcnode, $destnode, $testper, $testtype, $duration, $managerID) = @_;

288 289 290 291 292 293 294 295
    if ($srcnode eq $destnode ){
	return -1;
    }

    my %cmd = ( expid    => $expid,
		cmdtype  => "EDIT",
		dstnode  => $destnode,
		testtype => $testtype,
296 297
		testper  => "$testper",
		duration => "$duration" );
298

299
    return ${[sendcmd($srcnode,\%cmd)]}[0];
300 301
}

302 303 304 305 306 307 308 309 310 311 312 313 314
sub edittest_evsys($$$$$$$)
{
    my ($srcnode, $destnode, $testper, $testtype, 
	$duration, $managerID, $handle) = @_;

    if ($srcnode eq $destnode ){
	return -1;
    }

    my %cmd = ( managerID    => $managerID,
		srcnode  => $srcnode,
		dstnode  => $destnode,
		testtype => $testtype,
315 316 317 318 319 320 321 322 323
		testper  => "$testper",
		 duration => "$duration" );

    my $manType;
    if( $managerID eq "automanagerclient" ){
	$manType = $managerID;
    }else{
	$manType = "managerclient";
    }
324

325
    sendcmd_evsys("EDIT",\%cmd,$handle,$manType);
326 327 328 329

    #return ${[sendcmd($srcnode,\%cmd)]}[0];
}

330

331 332 333 334 335 336 337 338 339 340 341
sub getstatus($){
    my ($node) = @_;
    my %cmd = ( expid    => $expid,
		cmdtype  => "GETSTATUS" );
    my @cmdresult = sendcmd($node,\%cmd);
    if( defined $cmdresult[1] ){
	return $cmdresult[1];
    }else{
	return "error";
    }
}
342 343


344 345


346
1;