delay_config.in 13.6 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
#!/usr/bin/perl -wT
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
3
4

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2000-2005 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
6
7
8
# All rights reserved.
#

9
10
use English;
use Getopt::Std;
11

12
13
14
15
16
#
# Change delay params for a link.
#
sub usage()
{
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
    print(STDERR
	  "Usage: delay_config [-m] [-d] [-s vnode] <pid> <eid> <link>".
	  " PARAM=VALUE ...\n".
	  "Required: pid, eid, link, and at least one parameter to change!\n".
	  "  pid = Project ID\n".
	  "  eid = Experiment ID\n".
	  " link = link name from ns file, ie. 'link1' in\n".
	  "        'set link1 [\$ns duplex-link \$A \$B 10Kb 0ms DropTail]'\n".
	  "Options:\n".
	  "   -d = turn on debugging\n".
	  "   -s = Select the source of the link to determine which pipe\n".
	  "   -m = Modify the base experiment in addition to current state.\n".
	  "Parameters:\n".
	  " BANDWIDTH=NNN    - N=bandwidth (10-100000 Kbits per second)\n",
	  " PLR=NNN          - N=lossrate (0 <= plr < 1)\n".
	  " DELAY=NNN        - N=delay (one-way delay in milliseconds > 0)\n".
	  " LIMIT=NNN        - The queue size in bytes or packets\n".
	  " QUEUE-IN-BYTES=N - 0 means in packets, 1 means in bytes\n".
	  "RED/GRED Options: (only if link was specified as RED/GRED)\n".
	  " MAXTHRESH=NNN    - Maximum threshold for the average queue size\n".
Leigh B. Stoller's avatar
Leigh B. Stoller committed
37
	  " THRESH=NNN       - Minimum threshold for the average queue size\n".
38
39
	  " LINTERM=NNN      - Packet dropping probability\n".
	  " Q_WEIGHT=NNN     - For calculating the average queue size\n");
40
41
    # Web interface cares about this return value!
    exit(2);
42
}
43
my  $optlist = "dms:";
44
45
46
47
48
49

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
50
my $TEVC        = "$TB/bin/tevc";
51
52
53
54
55
my $debug	= 0;

#
# Testbed Support libraries
#
56
57
use lib "@prefix@/lib";
use libdb;
58
use libtestbed;
59

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
#
# Turn off line buffering on output
#
$| = 1;

#
# Untaint the path
# 
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
75
76
77
if (@ARGV < 4) {
    usage();
}
78
79
80
81
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
82
if (defined($options{"d"})) {
83
84
85
    $debug = 1;
}

86
87
88
89
90
91
92
# Functions

sub ChangeDelayConfig();
sub ChangeLinkDelayConfig();
sub ChangeVirtLans();

# Locals
93
94
95
my $pid    = shift(@ARGV);
my $eid    = shift(@ARGV);
my $link   = shift(@ARGV);
96
my $modify = 0;
97
98
99
my $srcvnode;
my %config;
my $pipeno;
100
101
my $pipe;

102
103
104
if (defined($options{"m"})) {
    $modify = 1;
}
105
106
if (defined($options{"s"})) {
    $srcvnode = $options{"s"};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
107
108

    if ($srcvnode =~ /^([-\w]+)$/) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
109
	$srcvnode = $1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
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
    }
    else {
	die("*** Bad srcvnode name: $srcvnode.\n");
    }
}
#
# Untaint args.
#
if ($pid =~ /^([-\w]+)$/) {
    $pid = $1;
}
else {
    die("*** Bad data in pid: $pid.\n");
}
if ($eid =~ /^([-\w]+)$/) {
    $eid = $1;
}
else {
    die("*** Bad data in eid: $eid.\n");
}
if ($link =~ /^([-\w]+)$/) {
    $link = $1;
}
else {
    die("*** Bad data in link: $link.\n");
135
}
136

137
138
139
140
141
142
143
144
145
146
147
148
#
# Permission check.
#
if ($UID && !TBAdmin($UID) &&
    ! TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_MODIFY)) {
    die("*** $0:\n".
	"    You do not have permission to modify the delay parameters!\n");
}

#
# No transitional experiments.
#
149
150
my $estate = ExpState($pid, $eid);
if (! $estate) {
151
152
153
    die("*** $0:\n".
	"    No such experiment $pid/$eid exists!\n");
}
154
155
if ($estate ne EXPTSTATE_ACTIVE &&
    $estate ne EXPTSTATE_SWAPPED) {
156
    die("*** $0:\n".
157
158
	"    Experiment $pid/$eid must be ACTIVE or SWAPPED\n".
	"    to alter its delay configuration.\n");
159
160
}

161
162
163
164
165
#
# Parse options, which will modify the existing configuration below.
#
while (@ARGV) {
    my $opt = shift(@ARGV);
166

167
168
169
170
171
172
173
174
175
176
    #
    # The parameter names correspond roughly to the names that the user
    # uses in the NS file. The $config{} keys correspond to the names of
    # the slots in the DB table. Well, roughly correspond since the delays
    # table uses q0_ and q1_, but we handle that below.
    #
    # XXX If you add to this list, be sure to add to agentmap hash below.
    #
    SWITCH: for ($opt) {
	/^BANDWIDTH=([0-9]*)$/i && do {
177
	    if ($1 && ($1 > 100000 || $1 < 10)) {
178
179
180
181
182
183
184
185
186
187
188
189
190
		usage();
	    }
	    $config{"bandwidth"} = $1;
	    last SWITCH;
	};
	/^DELAY=([0-9]*)$/i && do {
	    if ($1 < 0) {
		usage();
	    }
	    $config{"delay"} = $1;
	    last SWITCH;
	};
	/^PLR=([0-9\.]*)$/i && do {
191
	    if ($1 < 0 || $1 > 1) {
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
		usage();
	    }
	    $config{"lossrate"} = $1;
	    last SWITCH;
	};
	/^LIMIT=([0-9]*)$/i && do {
	    $config{"q_limit"} = $1;
	    last SWITCH;
	};
	/^QUEUE-IN-BYTES=(\d)$/i && do {
	    if ($1 != 0 && $1 != 1) {
		usage();
	    }
	    $config{"q_qinbytes"} = $1;
	    last SWITCH;
	};
	/^MAXTHRESH=(\d*)$/i && do {
	    $config{"q_maxthresh"} = $1;
	    last SWITCH;
	};
	/^THRESH=(\d*)$/i && do {
	    $config{"q_minthresh"} = $1;
	    last SWITCH;
	};
	/^LINTERM=([0-9\.]*)$/i && do {
	    $config{"q_linterm"} = $1;
	    last SWITCH;
	};
	/^Q_WEIGHT=([0-9\.]*)$/i && do {
	    $config{"q_weight"} = $1;
	    last SWITCH;
	};
	print "Invalid config option: $opt\n";
225
226
	usage();
    }
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
#
# More sanity checks.
#
foreach my $key (keys(%config)) {
    my $val = $config{$key};

    if ($debug) {
	print "$key=$val\n";
    }
}

#
# These map the names I'm using in the config hash (which correspond
# to the DB slot names) into the event parameter names to send over to the
# delay agent.
#
my %agentmap =
    ( bandwidth		=> BANDWIDTH,
      delay             => DELAY,
      lossrate		=> PLR,
      q_limit		=> LIMIT,
      q_qinbytes	=> "QUEUE-IN-BYTES",
      q_maxthresh	=> MAXTHRESH,
      q_minthresh	=> THRESH,
      q_linterm		=> LINTERM,
      q_weight		=> Q_WEIGHT
    );

257
#
258
259
260
261
262
263
# Link or Lan!
# 
$query_result =
    DBQueryFatal("select member from virt_lans ".
		 "where pid='$pid' and eid='$eid' and vname='$link'");
if (!$query_result->numrows) {
264
    die("*** $0:\n".
265
	"    $link is not a link in $pid/$eid!\n");
266
}
267
my $islink = ($query_result->numrows == 2 ? 1 : 0);
268

269
#
270
# If experiment is not active, all we can do is change virt_lans.
271
#
272
273
274
275
276
277
278
279
280
if ($estate ne EXPTSTATE_ACTIVE) {
    if ($modify) {
	ChangeVirtLans();
    }
    else {
	print "Experiment $pid/$eid is not active. If you want to change\n".
	    "the base experiment configuration, please use the -m option!\n";
    }
    exit(0);
281
}
282

283
284
285
286
287
288
#
# Check to see if linkdelays or normal delay nodes. This is a gross
# complication of this entire script!
#
if (ChangeDelayConfig() < 0 &&
    ChangeLinkDelayConfig() < 0) {
289
    die("*** $0:\n".
290
	"    $link is not a traffic shaped link in $pid/$eid!\n");
291
}
292
293
294
if ($modify) {
    ChangeVirtLans();
}
295

296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
#
# Inject an event. 
#
my $inject_string = "$TEVC -e $pid/$eid now $link";

# Direct the event to the whoever is handling this particular delay.
$inject_string .= "-${srcvnode} "
    if (defined($srcvnode));

$inject_string .= " modify ";

# Append the parameters.
foreach my $key (keys(%config)) {
    my $val = $config{$key};
    my $str = $agentmap{$key};
    
    $inject_string .= "${str}=$val ";
}
if ($debug) {
    print "$inject_string\n";
}

system($inject_string) &&
    die("*** $0:\n".
	"    Failed to inject delay update event!\n");
    
exit(0);

324
#
325
326
327
328
329
# Get current delay configuration. 
# 
sub ChangeDelayConfig() {
    my $query_clause;
    my $query_string;
330

331
    $query_string = "select * from delays ".
332
	"where pid='$pid' and eid='$eid' and vname='$link' and noshaping=0 ";
333

334
335
    $query_string .= "and (vnode0='$srcvnode' or vnode1='$srcvnode')"
	if (defined($srcvnode));
336

337
338
339
340
341
342
    #
    # Okay, see if there is a delay node.
    # 
    my $query_result = DBQueryFatal($query_string);
    if (! $query_result->numrows) {
	return -1;
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
    
    if (defined($srcvnode) && $islink) {
	#
	# If given a source node of a duplex link, must map that into
	# the actual delay pipe side and the pipe number, since the
	# names of the slots in the DB table have a 0/1 appended. Big
	# Yuck.
	#
	if ($query_result->numrows != 1) {
	    die("*** $0:\n".
		"    Too many delay links for $link in $pid/$eid!\n");
	}
	my %row = $query_result->fetchhash();

	if ($row{'vnode0'} eq $srcvnode) {
	    $pipe   = 0;
	}
	else {
	    $pipe   = 1;
	}
	$pipeno = $row{"pipe${pipe}"};
	
	foreach my $key (keys(%config)) {
	    my $val = $config{$key};

	    $query_clause .= ", "
		if (defined($query_clause));
		
	    if ($key =~ /^q_(.*)/) {
		$query_clause .= "q${pipe}_${1}=$val";
	    }
	    else {
		$query_clause .= "${key}${pipe}=$val";
	    }
	}
379
    }
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
    else {
	#
	# We are changing a link or entire lan symmetrically, or we are
	# changing one node in a lan symmetrically. Note, we cannot yet
	# make an asymmetric change to an indvidual lan node. Sorry, too
	# much pain. 
	#
	foreach my $key (keys(%config)) {
	    my $val = $config{$key};

	    $query_clause .= ", "
		if (defined($query_clause));
		
	    if ($key =~ /^q_(.*)/) {
		$query_clause .= "q0_${1}=$val,q1_${1}=$val";
	    }
	    else {
		$query_clause .= "${key}0=$val,${key}1=$val";
	    }
	}
400
    }
401
402
403
404
405
406
407
408
409
410
    
    #
    # Update the delays table.
    #
    $query_string =
	"update delays set $query_clause ".
	"where pid='$pid' and eid='$eid' and vname='$link' ";
    
    if (defined($srcvnode)) {
	$query_string .= "and (vnode0='$srcvnode' or vnode1='$srcvnode')";
411
412
    }
    if ($debug) {
413
	print "$query_string\n";
414
    }
415
416
417
    DBQueryFatal($query_string);
    return 0;
}    
418

419
420
421
422
423
424
#
# Change linkdelays.
# 
sub ChangeLinkDelayConfig() {
    my @query_clauses;
    my $query_string;
425

426
427
428
429
    $query_string = "select l.*,o.OS from linkdelays as l ".
	"left join nodes as n on n.node_id=l.node_id ".
	"left join os_info as o on o.osid=n.def_boot_osid ".
	"where l.pid='$pid' and l.eid='$eid' and l.vlan='$link' ";
430

431
    $query_string .= "and l.vnode='$srcvnode'"
432
	if (defined($srcvnode));
433

434
435
436
437
438
439
    #
    # Okay, see if there is a linkdelay.
    # 
    my $query_result = DBQueryFatal($query_string);
    if (! $query_result->numrows) {
	return -1;
440
    }
441

442
443
444
445
446
447
448
449
450
451
452
453
454
    #
    # XXX Check for linux; temporary.
    #
    while (my $row = $query_result->fetchrow_hashref()) {
	my $vnode = $row->{'vnode'};
	my $OS    = $row->{'OS'};

	if ($OS eq "Linux") {
	    die("*** $0:\n".
		"    Oops, dynamic events do not yet work on Linux!\n");
	}
    }

455
    #
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
    # This is much easier than delay nodes! As above, we cannot change a
    # lan node asymmetrically yet.
    #
    foreach my $key (keys(%config)) {
	my $val = $config{$key};

	push(@query_clauses, "${key}=$val");
	
	#
	# For a lan node, must also set the "r" params.
	# 
	if (!$islink &&
	    ($key eq "delay" ||
	     $key eq "bandwidth" ||
	     $key eq "lossrate")) {

	    push(@query_clauses, "r${key}=$val");
	}
    }
    
476
    #
477
    # Update the delays table.
478
    #
479
480
481
    $query_string = "update linkdelays set ".
	join(",", @query_clauses) . 
	" where pid='$pid' and eid='$eid' and vlan='$link' ";
482
    
483
484
485
486
487
488
489
490
    if (defined($srcvnode)) {
	$query_string .= "and vnode='$srcvnode'";
    }
    if ($debug) {
	print "$query_string\n";
    }
    DBQueryFatal($query_string);
    return 0;
491
492
493
}

#
494
# Change the virt_lans entry.
495
#
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
sub ChangeVirtLans() {
    my @query_clauses;
    my $query_string;
    my @query_clauses2;
    
    #
    # When changing an entire link or lan symmetrically its easy; they can
    # be done the same. When changing one node in a lan (symmetrically),
    # the numbers are slightly different for delay/lossrate, but otherwise
    # its the same operation, except for operating on a single node.
    #
    if (!defined($srcvnode) || !$islink) {
	foreach my $key (keys(%config)) {
	    my $val = $config{$key};

	    if ($key eq "delay") {
		my $delay = $val;

		# This follows what is done in the parser.
		$delay = $delay / 2.0
		    if ($islink);

		push(@query_clauses, "delay=$delay");
		push(@query_clauses, "rdelay=$delay");
	    }
	    elsif ($key eq "lossrate") {
		my $lossrate = $val;

		# This follows what is done in the parser.
		$lossrate = 1-sqrt(1-$lossrate)
		    if ($islink);

		push(@query_clauses, "lossrate=$lossrate");
		push(@query_clauses, "rlossrate=$lossrate");
	    }
	    elsif ($key eq "bandwidth") {
		push(@query_clauses, "bandwidth=$val");
		push(@query_clauses, "rbandwidth=$val");
	    }
	    else {
		push(@query_clauses, "$key=$val");
	    }
	}

	$query_string = "update virt_lans set ".
	    join(",", @query_clauses) .
	    " where pid='$pid' and eid='$eid' and vname='$link'";

	#
	# A lan node change since it cannot be a link if srcvnode defined.
	# 
	if (defined($srcvnode)) {
	    $query_string .= " and member like '${srcvnode}:%'";
	}

	if ($debug) {
	    print "$query_string\n";
	}
	DBQueryFatal($query_string);
    }
    else {
	#
	# Here we change a duplex link asymmetrically. In a duplex link
	# the delay/bw/plr params are split between the two virt_lan
	# members using the "r" params to hold the "from switch" half of
	# the value. This makes it rather confusing. 
	# 
	foreach my $key (keys(%config)) {
	    my $val = $config{$key};

	    if ($key eq "delay") {
		my $delay = $val / 2.0;

		push(@query_clauses,  "delay=$delay");
		push(@query_clauses2, "rdelay=$delay");
	    }
	    elsif ($key eq "lossrate") {
		my $lossrate = 1-sqrt(1-$val);

		push(@query_clauses, "lossrate=$lossrate");
		push(@query_clauses2, "rlossrate=$lossrate");
	    }
	    elsif ($key eq "bandwidth") {
		push(@query_clauses, "bandwidth=$val");
		push(@query_clauses2, "rbandwidth=$val");
	    }
	    else {
		push(@query_clauses, "$key=$val");
	    }
	}
	$query_string = "update virt_lans set ".
	    join(",", @query_clauses) .
	    " where pid='$pid' and eid='$eid' and ".
	    "      vname='$link' and member like '${srcvnode}:%'";
	
	if ($debug) {
	    print "$query_string\n";
	}
	DBQueryFatal($query_string);

596
597
598
599
600
601
	if (@query_clauses2) {
	    $query_string =
		"update virt_lans set ".
		join(",", @query_clauses2) .
		" where pid='$pid' and eid='$eid' and ".
		"      vname='$link' and member not like '${srcvnode}:%'";
602
	
603
604
605
606
	    if ($debug) {
		print "$query_string\n";
	    }
	    DBQueryFatal($query_string);
607
608
609
	}
    }
}