delay_config.in 5.66 KB
Newer Older
1
#!/usr/bin/perl -w
2 3
use English;
use Getopt::Std;
4

5 6 7 8 9 10
#
# Change delay params for a link.
#
sub usage()
{
    print STDERR
11
	"Usage: delay_config [-m] [-d delay] [-b bw] [-l plr] [-p 0|1] ",
12
	"<pid> <eid> <link>\n",
13
	"Required: pid, eid, link, and at least one of -d, -b, or -l\n",
14 15 16
	"  pid = Project ID\n",
	"  eid = Experiment ID\n",
	" link = link name from ns file, ie. 'link1' in\n",
17
	"        'set link1 [\$ns duplex-link \$A \$B 100Kb 0ms DropTail]'\n",
18
	"   -d = one-way link delay in milliseconds greater than 1\n",
19
	"   -b = <NNN> N=bandwidth (10-100000 Kbits per second)\n",
20
	"   -l = packet loss rate (0 <= plr < 1)\n",
21 22
	"   -p = Select one of the pipes. 0 - packets received on iface0\n".
	"   -m = Modify the base experiment in addition to current state.\n";
23

24 25
    exit(-1);
}
26
my  $optlist = "gd:b:l:p:m";
27 28 29 30 31 32

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
33
my $TEVC        = "$TB/bin/tevc";
34 35 36 37 38
my $debug	= 0;

#
# Testbed Support libraries
#
39 40
use lib "@prefix@/lib";
use libdb;
41
use libtestbed;
42

43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
#
# 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.
#
58 59 60
if (@ARGV < 4) {
    usage();
}
61 62 63 64 65 66
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV != 3) {
    usage();
67
}
68 69 70 71
if (defined($options{"g"})) {
    $debug = 1;
}

72 73 74 75 76
my $pid    = $ARGV[0];
my $eid    = $ARGV[1];
my $link   = $ARGV[2];
my $modify = 0;
my $islink = 0;
77 78
my $pipe;

79 80 81 82
if (defined($options{"m"})) {
    $modify = 1;
}

83 84
if (defined($options{"p"})) {
    $pipe = $options{"p"};
85

86 87 88
    if ($pipe != 0 && $pipe != 1) {
	usage();
    }
89
}
90

91 92 93 94 95 96
#
# Verify user and get his DB uid.
#
if (! UNIX2DBUID($UID, \$dbuid)) {
    die("*** $0:\n".
	"    You do not exist in the Emulab Database.\n");
97 98
}

99 100 101 102 103 104 105 106
#
# Permission check.
#
if ($UID && !TBAdmin($UID) &&
    ! TBExptAccessCheck($dbuid, $pid, $eid, TB_EXPT_MODIFY)) {
    die("*** $0:\n".
	"    You do not have permission to modify the delay parameters!\n");
}
107

108 109 110 111 112 113 114 115 116 117
#
# Get current delay configuration.
# 
my $query_result = 
    DBQueryFatal("select * from delays ".
		 "where pid='$pid' and eid='$eid' and vname='$link'");
if (! $query_result->numrows) {
    die("*** $0:\n".
	"    No such delay link $link in $pid/$eid!\n");
}
118 119 120 121
if ($query_result->numrows > 1) {
    die("*** $0:\n".
	"    Cannot modify delay parameters for Lans. Duplex Links Only!\n");
}
122 123 124 125 126 127 128 129 130 131 132 133

my %row    = $query_result->fetchhash();
my %bw;
my %delay;
my %plr;

$delay[0] = $row{'delay0'};
$bw[0]    = $row{'bandwidth0'};
$plr[0]   = $row{'lossrate0'};
$delay[1] = $row{'delay1'};
$bw[1]    = $row{'bandwidth1'};
$plr[1]   = $row{'lossrate1'};
134

135 136 137 138 139 140 141 142 143 144 145 146 147
#
# Parse options, which modify the above configuration.
#
my $newdelay;
my $newbw;
my $newplr;

if (defined($options{"d"})) {
    $newdelay = $options{"d"};

    if (! ($newdelay =~ /^[0-9]*$/)) {
	die("Illegal delay spec: $newdelay\n");
    }
148

149
    if ($newdelay < 0) {
150 151 152 153 154
	usage();
    }
    if ($debug) {
	print "Setting delay to $newdelay milliseconds.\n";
    }
155 156
}

157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178
if (defined($options{"l"})) {
    $newplr = $options{"l"};

    if (! ($newplr =~ /^[0-9\.]*$/)) {
	die("Illegal plr spec: $newplr.\n");
    }

    if ($newplr < 0 || $newplr > 1) {
	usage();
    }
    if ($debug) {
	print "Setting plr to $newplr.\n";
    }
}

if (defined($options{"b"})) {
    $newbw = $options{"b"};

    if (! ($newbw =~ /^[0-9]*$/)) {
	die("Illegal bw spec: $newbw.\n");
    }

179
    if ($newbw > 100000 || $newbw < 10) {
180 181 182 183
	usage();
    }
    
    if ($debug) {
184
	print "Setting bandwidth to $newbw Kbs.\n";
185
    }
186
}
187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211

if (defined($pipe)) {
    if (defined($newbw)) {
	$bw[$pipe] = $newbw;
    }
    if (defined($newplr)) {
	$plr[$pipe] = $newplr;
    }
    if (defined($newdelay)) {
	$delay[$pipe] = $newdelay;
    }
}
else {
    if (defined($newbw)) {
	$bw[0] = $newbw;
	$bw[1] = $newbw;
    }
    if (defined($newplr)) {
	$plr[0] = $newplr;
	$plr[1] = $newplr;
    }
    if (defined($newdelay)) {
	$delay[0] = $newdelay;
	$delay[1] = $newdelay;
    }
212
}
213

214 215 216 217 218 219 220 221 222 223
if ($modify) {
    my $d0 = $delay[0] / 2.0;
    my $d1 = $delay[1] / 2.0;
    my $l0 = 1-sqrt(1-$plr[0]);
    my $l1 = 1-sqrt(1-$plr[1]);
    my $b0 = $bw[0];
    my $b1 = $bw[1];

    #
    # Need to get each of the virt_lan entries. Remember, just links! No lans!
224
    #
225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
    # XXX We don't actually know which entry is which, but depend on their
    # order in the DB. Rather bogus. Needs fixing.
    #
    $query_result =
	DBQueryFatal("select member from virt_lans ".
		     "where pid='$pid' and eid='$eid' and vname='$link'");

    my ($member1) = $query_result->fetchrow_array();
    my ($member2) = $query_result->fetchrow_array();
    
    DBQueryWarn("update virt_lans set ".
		" delay=$d1, bandwidth=$b1, lossrate=$l1, ".
		"rdelay=$d0,rbandwidth=$b0,rlossrate=$l0  ".
		"where pid='$pid' and eid='$eid' and ".
		"vname='$link' and member='$member1'");

    DBQueryWarn("update virt_lans set ".
		" delay=$d0, bandwidth=$b0, lossrate=$l0, ".
		"rdelay=$d1,rbandwidth=$b1,rlossrate=$l1  ".
		"where pid='$pid' and eid='$eid' and ".
		"vname='$link' and member='$member2'");
246 247 248 249 250 251 252 253 254 255 256
}

#
# Update the delays table.
#
DBQueryWarn("update delays set ".
	    "delay0=$delay[0],bandwidth0=$bw[0],lossrate0=$plr[0], ".
	    "delay1=$delay[1],bandwidth1=$bw[1],lossrate1=$plr[1] ".
	    "where pid='$pid' and eid='$eid' and vname='$link'");

#
257
# Inject an event. 
258
#
259 260 261 262 263 264 265 266 267 268
my $pipearg = "";
if (defined($pipe)) {
    $pipearg = "PIPE=pipe${pipe}";
}
else {
    $pipe = 0;
}
    
system("$TEVC -e $pid/$eid now $link modify $pipearg ".
       "BANDWIDTH=$bw[$pipe] DELAY=$delay[$pipe] PLR=$plr[$pipe]") &&
269
    die("*** $0:\n".
270
	"    Failed to inject delay update event!\n");
271 272 273
    
exit(0);