automanage.pl 12.6 KB
Newer Older
1 2
#!/usr/bin/perl -w

Dan Gebhardt's avatar
Dan Gebhardt committed
3
use strict;
4 5 6 7
use lib '/usr/testbed/lib';
use libxmlrpc;
use English;
use Getopt::Std;
Dan Gebhardt's avatar
Dan Gebhardt committed
8 9
use IO::Socket::INET;
use IO::Select;
10

Dan Gebhardt's avatar
Dan Gebhardt committed
11
my ($constrFilename, $expid, $bwdutycycle, $port);
12 13 14 15 16 17 18 19 20 21
my $numsites;
my %test_per = (  # defaults
	       "latency" => 300,
	       "bw"      => 0,
	       );
my %intersitenodes = (); #final list for fully-connected test
my @constrnodes;    #test constrained to these nodes
my %sitenodes;      #hash listing all sites => nodes
my $CPUUSAGETHRESHOLD = 10;  #should help prevent flip-flopping between
                             #"best" nodes at a site
Dan Gebhardt's avatar
Dan Gebhardt committed
22
my $SITEDIFFTHRESHOLD = 1;   #number of site differences between period
23 24 25
                             #calculations that trigger an update
my $IPERFDURATION = 10;      #duration in seconds of iperf test
my %allnodes;
Dan Gebhardt's avatar
Dan Gebhardt committed
26
my %deadnodes;
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42

# RPC STUFF ##############################################
my $TB         = "/usr/testbed";
my $ELABINELAB = 0;
my $RPCSERVER  = "boss.emulab.net";  #?
my $RPCPORT    = "3069";
#my $RPCCERT    = "/etc/outer_emulab.pem"; #?
my $RPCCERT = "~/.ssl/emulab.pem";
my $MODULE = "node";
my $METHOD = "getlist";
# END RPC STUFF ##########################################


sub usage 
{
	warn "Usage: $0 [-BLP] [-f constraint file] [-l latency test period]".
Dan Gebhardt's avatar
Dan Gebhardt committed
43 44
	     " [-e pid/eid]".
	     " <bandwidth duty cycle 0-1>".
45
#	     " <number of sites or \"all\">\n".
46 47 48 49 50 51
	     "where: -B = Do not measure bandwidth\n".
	     "       -L = Do not measure latency\n".
	     "       -P = Do not measure latency to nodes not responding to pings\n";
	return 1;
}

Dan Gebhardt's avatar
Dan Gebhardt committed
52 53 54 55 56 57 58 59 60 61

my %opt = ();
getopts("B:L:P:f:l:e:s:p",\%opt);
#TODO: other options
if( $opt{f}) { $constrFilename = $opt{f}; }
if( $opt{l}) { $test_per{latency} = $opt{l}; }
if ($opt{e}) { $expid = $opt{e}; } else { $expid = "none"; }
if ($opt{p}) { $port = $opt{p}; } else{ $port = 5060; }


62 63 64 65 66
if( !defined $ARGV[0] ){
    exit &usage;
}
$bwdutycycle = $ARGV[0];

Dan Gebhardt's avatar
Dan Gebhardt committed
67
my $lastupdated_numnodes = 0;
68

Dan Gebhardt's avatar
Dan Gebhardt committed
69 70
my $socket;
my $sel = IO::Select->new();
71

Dan Gebhardt's avatar
Dan Gebhardt committed
72
#FORWARD DECL'S
Dan Gebhardt's avatar
Dan Gebhardt committed
73
sub stopnode($);
Dan Gebhardt's avatar
Dan Gebhardt committed
74
sub outputErrors();
75

Dan Gebhardt's avatar
Dan Gebhardt committed
76
print "exp = $expid\n";
77
#############################################################################
78 79 80 81
#
# Initialization
#
libxmlrpc::Config({"server"  => $RPCSERVER,
82 83 84 85
		    "verbose" => 0,
#		    "cert"    => $RPCCERT,
		    "portnum" => $RPCPORT});

Dan Gebhardt's avatar
Dan Gebhardt committed
86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101
# Stop all nodes in constraint set
open FILE, "< $constrFilename"
    or die "cannot open file $constrFilename";
while( <FILE> ){
    chomp;
    if( $_ =~ m/plab/ ){ 
	push @constrnodes, $_;
	print "$_\n";
    }
}
close FILE;
foreach my $node (@constrnodes){
#    print "stopping $node\n";
    stopnode($node);
}

102 103

###########################################################
104 105 106
#
# Main Loop
#
Dan Gebhardt's avatar
Dan Gebhardt committed
107
#my $f_firsttime = 1;
108 109
while(1)
{
Dan Gebhardt's avatar
Dan Gebhardt committed
110 111
    %deadnodes = ();

112
    #update node list
Dan Gebhardt's avatar
Dan Gebhardt committed
113
#    print "getnodeinfo\n";
114
    getnodeinfo();
Dan Gebhardt's avatar
Dan Gebhardt committed
115 116 117
#    sleep(10);

#    print "choosenodes\n";
118
    choosenodes();
Dan Gebhardt's avatar
Dan Gebhardt committed
119 120 121
#    sleep(10);

#    print "modifytests\n";
122
    modifytests();
Dan Gebhardt's avatar
Dan Gebhardt committed
123 124
#    sleep(10);

Dan Gebhardt's avatar
Dan Gebhardt committed
125
#    printchosennodes();
Dan Gebhardt's avatar
Dan Gebhardt committed
126

Dan Gebhardt's avatar
Dan Gebhardt committed
127
    outputErrors();
Dan Gebhardt's avatar
Dan Gebhardt committed
128 129 130 131
#   sleep( 10 );

    sleep( 60 );
#    $f_firsttime = 0;
132 133 134 135 136 137 138 139 140 141
}


###########################################################

sub getnodeinfo
{
    #retrieve list of nodes
    my $rval = libxmlrpc::CallMethod($MODULE, $METHOD,
				     {"class" => "pcplabphys"});
Dan Gebhardt's avatar
Dan Gebhardt committed
142 143 144
    if( defined $rval ){
	%allnodes = %$rval;
    }else{ return; }
145

146 147 148
    #populate sitenodes
    foreach my $node (keys %allnodes){
	my $siteid = $allnodes{$node}{site};
Dan Gebhardt's avatar
Dan Gebhardt committed
149
 	@{$sitenodes{$siteid}} = ();
150 151 152 153 154
	push @{$sitenodes{$siteid}}, $node;
#       print @{$sitenodes{$siteid}}."\n";
    }
}

Dan Gebhardt's avatar
Dan Gebhardt committed
155 156 157 158 159 160 161
sub printNodeInfo($)
{
    my ($node) = @_;
    foreach my $key (keys %{$allnodes{$node}} ){
	print "\t$key = $allnodes{$node}{$key}\n";
    }
}
162 163 164 165 166 167 168 169

########################################################
#
# choose a node from each possible site
#
sub choosenodes
{
    foreach my $site (keys %sitenodes){
Dan Gebhardt's avatar
Dan Gebhardt committed
170
#	print "site $site\n";
Dan Gebhardt's avatar
Dan Gebhardt committed
171
#	my $bestnode = "NONE";
172
	my $bestnode = choosebestnode($site);
Dan Gebhardt's avatar
Dan Gebhardt committed
173 174 175 176 177 178 179 180 181 182 183 184 185 186
	if( !defined $bestnode ){ print "BESTNODE NOT DEF!!!\n"; }
	if( "NONE" ne $bestnode &&
	    !defined $intersitenodes{$site} )
	{
	    print "SECTION 1: adding $bestnode at $site\n";
	    # ** This section handles when a site is seen for the 1st time

	    #set new node to represent this site		
	    $intersitenodes{$site} = $bestnode;
	}
	elsif( ("NONE" eq $bestnode) && defined $intersitenodes{$site} )
	{
	    print "SECTION 2: removing tests to $site / ".
		"$intersitenodes{$site} \n";
187
	    # ** This section handles when a site has no nodes available
Dan Gebhardt's avatar
Dan Gebhardt committed
188

189
	    #no available node at this site, so remove site from hash
Dan Gebhardt's avatar
Dan Gebhardt committed
190
	    foreach my $srcsite (keys %intersitenodes){
Dan Gebhardt's avatar
Dan Gebhardt committed
191 192
		stoppairtest( $intersitenodes{$srcsite},
			      $intersitenodes{$site} );
Dan Gebhardt's avatar
Dan Gebhardt committed
193
	    }
194
	    delete $intersitenodes{$site};
195
	}
Dan Gebhardt's avatar
Dan Gebhardt committed
196 197 198 199 200 201 202 203 204 205 206
	elsif( defined $intersitenodes{$site} &&
	       $intersitenodes{$site} ne $bestnode
	       #&& isnodeinconstrset($bestnode) 
	       )
	{
	    print "SECTION 3: node change at $site from ".
		"$intersitenodes{$site} to $bestnode\n";
	    # ** This section handles when a "bestnode" at a site changes
	    
	    #  Stop sigs to other nodes using old "bestnode" value
	    if( defined $intersitenodes{$site} ){
Dan Gebhardt's avatar
Dan Gebhardt committed
207
		foreach my $srcsite (keys %intersitenodes){
Dan Gebhardt's avatar
Dan Gebhardt committed
208 209
		    stoppairtest( $intersitenodes{$srcsite},
				  $intersitenodes{$site} );
Dan Gebhardt's avatar
Dan Gebhardt committed
210
		}
Dan Gebhardt's avatar
Dan Gebhardt committed
211 212 213 214 215 216
	    }
	    
	    #set new node to represent this site		
	    $intersitenodes{$site} = $bestnode;
	    
	    foreach my $srcsite (keys %intersitenodes){
Dan Gebhardt's avatar
Dan Gebhardt committed
217 218
		edittest( $intersitenodes{$srcsite},
			  $intersitenodes{$site},
Dan Gebhardt's avatar
Dan Gebhardt committed
219 220 221 222 223 224 225 226 227 228 229 230 231 232
			  $test_per{bw},
			  "bw" );
		my $r = rand;
		if( $r <= .5 ){
		    edittest( $intersitenodes{$srcsite},
			      $intersitenodes{$site},
			      $test_per{latency},
			      "latency" );
		}else{
		    edittest( $intersitenodes{$site},
			      $intersitenodes{$srcsite},
			      $test_per{latency},
			      "latency" );
		}
233
	    }
Dan Gebhardt's avatar
Dan Gebhardt committed
234 235
	    
	}
236 237 238 239
    }
}


Dan Gebhardt's avatar
Dan Gebhardt committed
240

241 242 243 244 245 246 247
#
# Re-adjust the test periods of connections based on number of nodes
#
sub modifytests
{
    my $numsites = scalar(keys %intersitenodes);
    my $bwper = ($numsites - 1) * $IPERFDURATION * 1/$bwdutycycle;
248
    #TODO: ?? dynamically change latency period, too?
249

250 251
    #update connections to use  newly calculated periods
    if( abs($lastupdated_numnodes - $numsites) > $SITEDIFFTHRESHOLD )
252
    {
253 254 255 256 257
	if( !$opt{B} ){       
	    $test_per{bw} = $bwper;
	    print "new BW per = $bwper\n";
	}

258
	$lastupdated_numnodes = $numsites;
259
	updateTests();   #handles changing number of sites
260 261 262 263 264 265 266 267 268 269
    }  

}



sub printchosennodes
{
    foreach my $node (values %intersitenodes){
	print "site: ". $allnodes{$node}{site} . " = $node\n";
Dan Gebhardt's avatar
Dan Gebhardt committed
270 271
#	#TODO:: why does this give an error?
#	print "node = $node\n";
272 273 274 275 276 277 278
    }
}


sub choosebestnode($)
{
    my ($site) = @_;
Dan Gebhardt's avatar
Dan Gebhardt committed
279

280
    my $bestnode = "NONE";  #default to an error value
Dan Gebhardt's avatar
Dan Gebhardt committed
281 282
   

283 284 285 286 287 288 289 290
=pod
    print "$site ";
    foreach my $node ( @{$sitenodes{$site}} ){
	print $node. " ";
    }
    print "\n";
=cut
    foreach my $node ( @{$sitenodes{$site}} ){
Dan Gebhardt's avatar
Dan Gebhardt committed
291 292 293 294 295 296 297 298
=pod
	if(isnodeinconstrset($node)){
	    print "node $node is in constr set ";
	    if( $allnodes{$node}{free} == 1 ){
		print "and free";
	    }
	    print "\n";
	}
Dan Gebhardt's avatar
Dan Gebhardt committed
299 300 301 302 303 304 305 306 307 308 309
=cut     
        #this command acts like a bgmon "ping" - used to 
        #determine if bgmon running correctly
        my %cmd = ( expid    => $expid,
		    cmdtype  => "EDIT",
		    dstnode  => "NOADDR",
		    testtype => "bw",
		    testper  => 0 );
	if( $allnodes{$node}{free} == 1 && 
	    isnodeinconstrset($node) )
	{
Dan Gebhardt's avatar
Dan Gebhardt committed
310
#	    print "choosing best node for site $site\n";
311 312 313 314 315
	    #first time thru loop...
	    if( $bestnode eq "NONE" ){
		#set this to be best node
		$bestnode = $node;
	    }else{
Dan Gebhardt's avatar
Dan Gebhardt committed
316 317 318
		if( ($allnodes{$node}{cpu} < $allnodes{$bestnode}{cpu}
		    - $CPUUSAGETHRESHOLD) &&
		    (edittest($node,"NOADDR",0,"bw") == 1) )
319
		{
Dan Gebhardt's avatar
Dan Gebhardt committed
320 321 322 323
		    print "setting new bestnode\n";
		    print '$allnodes{$node}{cpu}'."  $allnodes{$node}{cpu}\n";
		    print '$allnodes{$bestnode}{cpu}'.
			"  $allnodes{$bestnode}{cpu}\n";
324 325 326 327 328
		    $bestnode = $node;
		}
	    }
	}
    }
Dan Gebhardt's avatar
Dan Gebhardt committed
329
#    print "bestnode for $site = $bestnode\n";
330 331 332 333 334 335 336 337 338
    return $bestnode;
}


sub isnodeinconstrset($)
{
    my ($node) = @_;
    
    #if constraint set is empty, return true
Dan Gebhardt's avatar
Dan Gebhardt committed
339
    if( @constrnodes == 0 ){
340 341
	return 1;
    }else{
Dan Gebhardt's avatar
Dan Gebhardt committed
342 343 344 345 346 347 348
	#check if node exists in contraint set
	foreach my $cnode (@constrnodes){
	    if( $node eq $cnode ){
		return 1;
	    }
	}
	return 0;
349 350 351 352
    }
}


353

354 355 356 357 358 359 360 361 362 363 364
#
# update all nodes with new test periods and destination nodes
#
sub updateTests
{
    my $srcnode;
    my $bw_destnodes;
    my $destnode;
    #init bandwidth
    foreach my $srcsite (keys %intersitenodes){
	$srcnode = $intersitenodes{$srcsite};
Dan Gebhardt's avatar
Dan Gebhardt committed
365 366 367
	$bw_destnodes = "";
	foreach my $destsite (keys %intersitenodes){
#	    print "looking at site $destsite\n";
368 369 370 371 372 373 374 375
	    if( defined $intersitenodes{$destsite}) {
		$destnode = $intersitenodes{$destsite};
	    }
	    #add destination nodes to this source node, but not "self"
	    if( $destnode ne $srcnode ){
		$bw_destnodes .= " ".$destnode;
	    }
	}
Dan Gebhardt's avatar
Dan Gebhardt committed
376
	initnode($srcnode, $bw_destnodes, $test_per{bw}, "bw");
377 378
    }

Dan Gebhardt's avatar
Dan Gebhardt committed
379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399
    #init latency: fully connected, but only one direction each path
    my %initstrs;  #build init strings for each site node
    my @sitekeys = keys %intersitenodes;
    for( my $i = 0; $i < @sitekeys-1; $i++ ){
	for( my $j = $i+1; $j < @sitekeys; $j++ ){
	    my $r = rand;
	    if( $r <= .5 ){
		$initstrs{$intersitenodes{$sitekeys[$i]}} .= 
		    "$intersitenodes{$sitekeys[$j]} ";
	    }else{
		$initstrs{$intersitenodes{$sitekeys[$j]}} .= 
		    "$intersitenodes{$sitekeys[$i]} ";
	    }
	}
    }
    # now send the inits to all nodes
    foreach my $srcsite (keys %intersitenodes){
	$srcnode = $intersitenodes{$srcsite};
	initnode($srcnode, $initstrs{$srcnode}, $test_per{latency}, "latency");
    }
    
400 401
}

Dan Gebhardt's avatar
Dan Gebhardt committed
402 403 404 405 406 407 408 409 410 411
#
# Stop all tests from a node
#
sub stopnode($)
{
    my ($node) = @_;

    if( isnodeinconstrset($node) ){
	my %cmd = ( expid    => $expid,
		    cmdtype  => "STOPALL" );
Dan Gebhardt's avatar
Dan Gebhardt committed
412
	print "stopnode $node called\n";
Dan Gebhardt's avatar
Dan Gebhardt committed
413 414 415
	sendcmd($node,\%cmd);
    }
}
416

417 418
#
#
Dan Gebhardt's avatar
Dan Gebhardt committed
419 420
#
sub edittest($$$$)
421
{
Dan Gebhardt's avatar
Dan Gebhardt committed
422 423 424
    my ($srcnode, $destnode, $testper, $testtype) = @_;
    if ($srcnode eq $destnode ){
	return -1;
425
    }
Dan Gebhardt's avatar
Dan Gebhardt committed
426 427 428 429 430 431 432 433 434 435 436
    print "editing test: $srcnode\n".
	  "              $destnode\n".
	  "		 $testtype\n".
	  "		 $testper\n";

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

Dan Gebhardt's avatar
Dan Gebhardt committed
437
    return sendcmd($srcnode,\%cmd);
438
}
439

440 441 442 443 444 445 446 447
#
# stops the tests from given source and destination nodes
#
sub stoppairtest($$)
{
    my ($srcnode, $destnode) = @_;
    my $testper = 0;
    my @testtypes = ("latency","bw");
Dan Gebhardt's avatar
Dan Gebhardt committed
448 449 450

    foreach my $testtype (@testtypes){
	edittest($srcnode, $destnode, 0, $testtype);
451
    }
Dan Gebhardt's avatar
Dan Gebhardt committed
452
    print "stopping pair tests from $srcnode to $destnode\n";
453 454 455
}

#
456
# destnodes is space-separated string
457
#
458 459 460 461
sub initnode($$$$)
{
    my ($node, $destnodes, $testper, $testtype) = @_;
    print "SENDING INIT: *$node*$destnodes*$testper*$testtype*\n";
Dan Gebhardt's avatar
Dan Gebhardt committed
462 463 464 465 466 467 468 469 470

    my %cmd = ( expid     => $expid,
		cmdtype   => "INIT",
		destnodes => $destnodes,
		testtype  => $testtype,
		testper   => $testper
		);

    sendcmd($node,\%cmd);
471 472 473 474 475 476

    print "sent initnode to $node\n";
    print "destnodes = $destnodes\n";
    print "testper = $testper\n";
    print "testtype = $testtype\n";
}
Dan Gebhardt's avatar
Dan Gebhardt committed
477 478 479 480 481 482 483 484 485 486 487



sub sendcmd($$)
{
    my $node = $_[0];
    my $hashref = $_[1];
    my %cmd = %$hashref;

    my $sercmd = serialize_hash( \%cmd );
    my $f_success = 0;
Dan Gebhardt's avatar
Dan Gebhardt committed
488
    my $max_tries = 3;
Dan Gebhardt's avatar
Dan Gebhardt committed
489 490 491
    do{
	$socket = IO::Socket::INET->new( PeerPort => $port,
					 Proto    => 'tcp',
Dan Gebhardt's avatar
Dan Gebhardt committed
492 493 494 495
					 PeerAddr => $node,
					 Timeout  => 1);
	if( defined $socket ){
	    $sel->add($socket);
Dan Gebhardt's avatar
Dan Gebhardt committed
496 497 498 499 500
	    print $socket "$sercmd\n";
	    #todo: wait for ack;
	    # timeout period?
	    $sel->add($socket);
	    my ($ready) = $sel->can_read(1);
Dan Gebhardt's avatar
Dan Gebhardt committed
501
	    if( defined($ready) && $ready eq $socket ){
Dan Gebhardt's avatar
Dan Gebhardt committed
502 503 504 505
		my $ack = <$ready>;
		chomp $ack;
		if( $ack eq "ACK" ){
		    $f_success = 1;
Dan Gebhardt's avatar
Dan Gebhardt committed
506
		    print "Got ACK from $node for command\n";
Dan Gebhardt's avatar
Dan Gebhardt committed
507 508 509 510
		    close $socket;
		}else{
		    $max_tries--;
		}
Dan Gebhardt's avatar
Dan Gebhardt committed
511 512
	    }else{
		$max_tries--;
Dan Gebhardt's avatar
Dan Gebhardt committed
513 514 515 516 517 518 519
	    }
	    $sel->remove($socket);
	    close($socket);
	}else{
	    select(undef, undef, undef, 0.2);
	    $max_tries--;
	}
520
    }while( $f_success != 1 && $max_tries != 0 );
Dan Gebhardt's avatar
Dan Gebhardt committed
521

Dan Gebhardt's avatar
Dan Gebhardt committed
522
    if( $f_success == 0 && $max_tries == 0 ){
Dan Gebhardt's avatar
Dan Gebhardt committed
523
	$deadnodes{$node} = 1;
Dan Gebhardt's avatar
Dan Gebhardt committed
524 525 526 527 528
	print "DID NOT GET ACK from $node for command $sercmd\n";
	return -1;
    }elsif( $f_success == 1 ){
	#success!
	return 1;
Dan Gebhardt's avatar
Dan Gebhardt committed
529 530 531 532 533 534 535
    }

}


sub outputErrors()
{
Dan Gebhardt's avatar
Dan Gebhardt committed
536 537 538 539 540 541
    if( keys %deadnodes > 0 ){
	print "Nodes not responding:\n";
	foreach my $node (keys %deadnodes){
	    print "$node  ";
	}
	print "\n";
Dan Gebhardt's avatar
Dan Gebhardt committed
542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562
    }
}


#
# 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;
}