init-elabnodes.pl 12.5 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
#!/usr/bin/perl
#
# Based on pairwise characteristics of planet-* nodes (real planetlab nodes)
# in a pelab experiment, set the delay characteristics for the corresponding
# elab-* nodes.
#
# Elab nodes are in a "cloud" allowing you to set node-to-node characteristics
# for all nodes within the cloud.  To do this for node N to node M:
#
#	tevc -e pid/eid now elabc-elab-N MODIFY DEST=<elab-M-elabc IP> \
#		[ BANDWIDTH=<kbits/sec> ] [ DELAY=<ms> ] [ PLR=<prob> ]
#
# The characteristics are applied to the node->LAN pipe for node N.
# Since this is one-way, you will have to apply the usual tricks to
# convert round-trip delays and PLR.
#

my $TEVC = "/usr/testbed/bin/tevc";
my $NLIST = "/usr/testbed/bin/node_list";
20
21
#my $pprefix = "planet-";
my $pprefix = "plab-";
22

23
24
25
26
# XXX Need to configure this stuff!
use lib '/usr/testbed/lib';
use libtbdb;
use Socket;
Mike Hibler's avatar
Mike Hibler committed
27
use Getopt::Std;
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
use Class::Struct;
use libxmlrpc;
use strict;

my ($initvalLat, $initvalBw);
################
# Define a structure to hold the values used in initial condition reporting
struct( initvalres => {
    srcnode => '$',
    dstnode => '$',
    ave_exp => '$',
    numSamples => '$',
    numErrValSamples => '$',
    numLastSeqErr =>'$',
    tstampLastSample => '$' } );
#'################

Mike Hibler's avatar
Mike Hibler committed
45
46
47
48
49
50
#
# Every source host has a list of <dest-IP,bw,delay,plr> tuples, one
# element per possible destination
#
my %shapeinfo;

51
52
my $showonly = 0;

Mike Hibler's avatar
Mike Hibler committed
53
# Default values.  Note: delay and PLR are round trip values.
54
55
56
57
my $DEF_BW = 10000;	# Kbits/sec
my $DEF_DEL = 0;	# ms
my $DEF_PLR = 0.0;	# prob.

58
59
60
61
my $PWDFILE = "/usr/testbed/etc/pelabdb.pwd";
my $DBNAME  = "pelab";
my $DBUSER  = "pelab";

Mike Hibler's avatar
Mike Hibler committed
62
63
64
65
#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
66
67
my %options = ();
if (! getopts("n", \%options)) {
Mike Hibler's avatar
Mike Hibler committed
68
69
70
71
72
73
74
75
76
77
78
    usage();
}
if (defined($options{"n"})) {
    $showonly = 1;
}
if (@ARGV != 2) {
    print STDERR "usage: init-elabnodes pid eid\n";
    exit(1);
}
my ($pid,$eid) = @ARGV;

79
80
81
82
83
84
85
86
87
88
89
# Get DB password and connect.
my $DBPWD   = `cat $PWDFILE`;
if ($DBPWD =~ /^([\w]*)\s([\w]*)$/) {
    $DBPWD = $1;
}
else{
    fatal("Bad chars in password!");
}
TBDBConnect($DBNAME, $DBUSER, $DBPWD) == 0
    or die("Could not connect to pelab database!\n");

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
# 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";

libxmlrpc::Config({"server"  => $RPCSERVER,
		    "verbose" => 0,
		    "portnum" => $RPCPORT});
# END RPC STUFF ##########################################



107
108
109
110
111
#
# XXX figure out how many pairs there are, and for each, who the
# corresponding planetlab node is.  Can probably get all this easier
# via XMLRPC...
#
112
my @nodelist = split('\s+', `$NLIST -m -e $pid,$eid`);
113
chomp(@nodelist);
114
115
116
117
118
my $nnodes = grep(/^${pprefix}/, @nodelist);
if ($nnodes == 0) {
    print STDERR "No planetlab nodes in $pid/$eid?!\n";
    exit(1);
}
119

120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
# Preload the site indicies rather then doing fancy joins.
my %site_mapping = ();
my %node_mapping = ();
my %ix_mapping   = ();
my %ip_mapping   = ();

foreach my $mapping (@nodelist) {
    if ($mapping =~ /^(${pprefix}[\d]+)=([\w]*)$/) {
	my $vnode = $1;
	my $pnode = $2;

	# Grab the site index.
	my $query_result =
	    DBQueryFatal("select site_idx from site_mapping ".
			 "where node_id='$pnode'");

	if (! $query_result->numrows) {
	    die("Could not map $pnode to its site index!\n");
	}
	my ($site_index) = $query_result->fetchrow_array();
140
141
	
	print "Mapping $vnode to $pnode\n";
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

	$node_mapping{$vnode} = $pnode;
	$site_mapping{$pnode} = $site_index;

	if ($vnode =~ /^${pprefix}(\d+)/) {
	    $ix_mapping{$vnode} = $1;
	}
	else {
	    die("Could not map $vnode to its index!\n");
	}

	# Grab the IP address and save.
	my (undef,undef,undef,undef,@ips) = gethostbyname("$pnode");

	if (!@ips) {
	    die("Could not map $pnode to its ipaddr\n");
	}
	$ip_mapping{$pnode} = inet_ntoa($ips[0]);
    }
}

163
164
165
#
# Get planetlab info for each planetlab node...
#
166
167
foreach my $vnode (keys(%node_mapping)) {
    get_plabinfo($vnode);
168
169
170
171
172
}

#
# ...and send events to set the characteristics
#
173
174
send_events()
    if (!$showonly);
175
176
177
178
179
180
181
182
183
184

exit(0);

sub send_events()
{
    foreach my $src (keys %shapeinfo) {
	foreach my $rec (@{$shapeinfo{$src}}) {
	    my ($dst,$bw,$del,$plr) = @{$rec};
	    my $cmd = "$TEVC -e $pid/$eid now elabc-$src MODIFY ".
		"DEST=$dst BANDWIDTH=$bw DELAY=$del PLR=$plr";
185
	    print "elabc-$src: DEST=$dst BANDWIDTH=$bw DELAY=$del PLR=$plr...";
186
	    if (system("$cmd") != 0) {
187
		print "[FAILED]\n";
188
	    } else {
189
		print "[OK]\n";
190
191
192
193
194
195
	    }
	}
    }
}

#
196
# Grab data from DB.
197
198
199
#
sub get_plabinfo($)
{
200
201
    my ($srcvnode) = @_;
    my $srcix = $ix_mapping{$srcvnode};
202

203
    @{$shapeinfo{"elab-$srcix"}} = ();
204

205
206
207
208
    foreach my $dstvnode (keys(%node_mapping)) {
	next
	    if ($srcvnode eq $dstvnode);

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
	#Only need these two for error messages. get_pathInitCond finds them
        # itself.
	my $dst       = $ip_mapping{$node_mapping{$dstvnode}};
	my $src_site  = $site_mapping{$node_mapping{$srcvnode}};
	my $dst_site  = $site_mapping{$node_mapping{$dstvnode}};
	my $dstix  = $ix_mapping{$dstvnode};

	# Get initial conditions
	($initvalLat, $initvalBw) = 
	     get_pathInitCond( $node_mapping{$srcvnode}, 
			       $node_mapping{$dstvnode},
			       24, 0.8 );
	{ print "\nLATENCY\n";
	  printInitValResStruct($initvalLat);
	  print "\nBW\n";
	  printInitValResStruct($initvalBw);
	} #if ($showonly);
	#TODO: is this print statement wanted here? Should it be conditional
        #      on available path measurements, like in the original?
	print "elab-$srcix -> elab-$dstix (on behalf of $dst):\n"
	    if ($showonly);

	my ($del,$plr,$bw) = ($initvalLat->ave_exp,
			   undef,  #TODO!!! LOSS RATE!!!
			   $initvalBw->ave_exp);

	# handle a path with no available measurements
	if($initvalLat->numSamples == $initvalLat->numErrValSamples){
	    $del = $DEF_DEL;
	    warn("*** Could not get latency ".
		 "$srcvnode ($src_site) --> $dstvnode ($dst_site)\n".
		 "    defaulting to ".
		 "${DEF_DEL}ms\n" );
	}
	if(!defined($plr)){
	    $plr = $DEF_PLR;
	    warn("*** Could not get lossrate ".
		 "$srcvnode ($src_site) --> $dstvnode ($dst_site)\n".
		 "    defaulting to ".
		 "${DEF_PLR}plr\n" );
	}
	if($initvalBw->numSamples == $initvalLat->numErrValSamples){	 
	    $bw = $DEF_BW;
	    warn("*** Could not get bandwidth ".
		 "$srcvnode ($src_site) --> $dstvnode ($dst_site)\n".
		 "    defaulting to ".
		 "${DEF_BW}bps\n" );
	}
	    



=pod
262
263
264
265
266
267
268
269
	my $dst       = $ip_mapping{$node_mapping{$dstvnode}};
	my $src_site  = $site_mapping{$node_mapping{$srcvnode}};
	my $dst_site  = $site_mapping{$node_mapping{$dstvnode}};

	my $query_result =
	    DBQueryFatal("select latency,loss,bw from pair_data ".
			 "where srcsite_idx='$src_site' and ".
			 "      dstsite_idx='$dst_site' ".
270
			 "order by unixstamp desc limit 5");
271
272

	if (!$query_result->numrows) {
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
	    warn("*** Could not get pair data for ".
		 "$srcvnode ($src_site) --> $dstvnode ($dst_site)\n".
		 "    defaulting to ".
		 "${DEF_BW}bps, ${DEF_DEL}ms, ${DEF_PLR}plr\n");
	    ($del,$plr,$bw) = ($DEF_DEL, $DEF_PLR, $DEF_BW);
	} else {
	    my @vals;

	    print "elab-$srcix -> elab-$dstix (on behalf of $dst):\n"
		if ($showonly);
	    while (($del,$plr,$bw) = $query_result->fetchrow_array()) {
		print "  ($del, $plr, $bw)\n"
		    if ($showonly);
		push(@vals, [ $del, $plr, $bw ]);
	    }

	    #
	    # XXX This needs to be modified!
	    #
	    ($del,$plr,$bw) = @{$vals[0]};
293
294
295
296
	    $del = $DEF_DEL
		if (!defined($del));
	    $plr = $DEF_PLR
		if (!defined($plr));
297
	    $bw = $DEF_BW
298
		if ($bw == 0);	# undef or zero--zero BW is not very useful
Mike Hibler's avatar
Mike Hibler committed
299
300

	    $del = int($del / 2);
301
	}
302
=cut
303

304
305
	print "elab-$srcix -> elab-$dstix: ".
	    "real=$dst, bw=$bw, del=$del, plr=$plr\n";
306

307
308
	# XXX need to lookup "elab-$dstix"
	$dst = "10.0.0.$dstix";
309
310
	
	push(@{$shapeinfo{"elab-$srcix"}}, [ $dst, $bw, $del, $plr ]);
311
312
    }
}
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481




######################################################################
# Grab data from DB to create an initial condition structure
#
#  Notes:
#    + Data used in init cond is from any node at the sites containing
#      the given nodes.
#
sub get_pathInitCond($$$;$)
{
    my ($srcnode, $dstnode, $pasthours, $expAlpha) = @_;
    if( !defined $expAlpha) { $expAlpha = 0.6; }  #default alpha value
    my $endtime = time();
    #my $starttime = $endtime - (60*60*24);
    my $starttime = $endtime - (60*60*$pasthours);
    my $srcsite_idx    = $site_mapping{$srcnode};
    my $dstsite_idx    = $site_mapping{$dstnode};

    my $initvalLat = new initvalres;
    my $initvalBw = new initvalres;

    my @latsamples = ();
    my @bwsamples = ();
    my @latsamples_noerr;
    my @bwsamples_noerr;

    #
    # retreive data for last 24 hours for the given path and
    # populate result structures
    #
    my $sth = DBQuery(
		      "SELECT * ".
		      "FROM pair_data WHERE ".
		      "srcsite_idx = $srcsite_idx and ".
		      "dstsite_idx = $dstsite_idx and ".
		      "(latency IS NOT NULL or bw IS NOT NULL) and ".
		      "unixstamp > $starttime and ".
		      "unixstamp < $endtime ".
		      "order by unixstamp asc ".
		      ";" );
    while( my $hr = $sth->fetchrow_hashref() ){
	my %row = %{$hr};
	if ( defined $row{latency} ){
	    push @latsamples, $row{latency};
	    $initvalLat->tstampLastSample($row{unixstamp});
	    $initvalLat->srcnode($srcnode) if !defined($initvalLat->srcnode);
	    $initvalLat->dstnode($dstnode) if !defined($initvalLat->dstnode);
	}
	if ( defined $row{bw} ){
	    push @bwsamples, $row{bw} ;
	    $initvalBw->tstampLastSample($row{unixstamp});
	    $initvalBw->srcnode($srcnode) if !defined($initvalBw->srcnode);
	    $initvalBw->dstnode($dstnode) if !defined($initvalBw->dstnode);
	}
    }
    #do another query in reverse path if given one doesn't have latency data
    if( scalar @latsamples == 0 ){
	my $sth = DBQuery(
		      "SELECT latency ".
		      "FROM pair_data WHERE ".
		      "srcsite_idx = $dstsite_idx and ".
		      "dstsite_idx = $srcsite_idx and ".
		      "(latency IS NOT NULL) and ".
		      "unixstamp > $starttime and ".
		      "unixstamp < $endtime ".
		      "order by unixstamp asc ".
		      ";" );
	while( my $hr = $sth->fetchrow_hashref() ){
	    my %row = %{$hr};
	    if ( defined $row{latency} ){
		push @latsamples, $row{latency};
		$initvalLat->tstampLastSample($row{unixstamp});
		$initvalLat->srcnode($dstnode) 
		    if !defined($initvalLat->srcnode);
		$initvalLat->dstnode($srcnode) 
		    if !defined($initvalLat->dstnode);
	    }
	}
    }
#    print "latsamples = @latsamples\n";
#    print "bwsamples = @bwsamples\n";

    $initvalLat->numSamples(scalar @latsamples);
    $initvalBw->numSamples(scalar @bwsamples);

    
    # Find err vals

    #do for latency
    my $flag_errseriesEnd = 0;
    my $numErrs = 0;
    my $numSeriesErr = 0;
    for( my $i=$#latsamples; $i >=0; $i-- ){
	if( $latsamples[$i] < 0 ){
	    $numErrs++;
	    if( $flag_errseriesEnd == 0 ){
		$numSeriesErr++;
	    }
	}else{
	    $flag_errseriesEnd = 1;
	    unshift @latsamples_noerr, $latsamples[$i];
	}
    }
    $initvalLat->numLastSeqErr($numSeriesErr);
    $initvalLat->numErrValSamples($numErrs);
    #now for bw
    $flag_errseriesEnd = 0;
    $numErrs = 0;
    $numSeriesErr = 0;
    for( my $i=$#bwsamples; $i >=0; $i-- ){
	if( $bwsamples[$i] < 0 ){
	    $numErrs++;
	    if( $flag_errseriesEnd == 0 ){
		$numSeriesErr++;
	    }
	}else{
	    $flag_errseriesEnd = 1;
	    unshift @bwsamples_noerr, $bwsamples[$i];
	}
    }
    $initvalBw->numErrValSamples($numErrs);
    $initvalBw->numLastSeqErr($numSeriesErr);


    # Calculate Exponential average
    # TODO!! Change this called function such that the time between
    #        samples is factored into the weighting.
    $initvalLat->ave_exp( calcExpAve($expAlpha,\@latsamples_noerr) );
    $initvalBw->ave_exp( calcExpAve($expAlpha,\@bwsamples_noerr) );

=pod
    print "\nLatency\n@latsamples\n";
    printInitValResStruct($initvalLat);
    print "\nBW\n@bwsamples\n";
    printInitValResStruct($initvalBw);
=cut

    return [$initvalLat, $initvalBw];
}


sub printInitValResStruct($)
{
    my ($struct) = @_;

    print "printing InitValRes Structure\n";
    foreach my $var (keys %{$struct}){
	print "$var  =   \t".${$struct}{$var} ."\n" 
	    if defined ${$struct}{$var};
    }
}


sub calcExpAve($$\@)
{
    my ($alpha, $aref) = @_;
    my @values = @$aref;

    if( scalar(@values) == 0 ){ return 0; }

    my $lastAve = $values[0];  #start with first sample
    for( my $i=1; $i<@values; $i++ ){
	$lastAve = $alpha*$values[$i] + (1-$alpha)*$lastAve;
    }
    return $lastAve;
}