liblocsetup.pm 41.6 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2
3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2009 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5
6
7
# All rights reserved.
#

8
9
10
11
12
13
14
#
# Linux specific routines and constants for the client bootime setup stuff.
#
package liblocsetup;
use Exporter;
@ISA = "Exporter";
@EXPORT =
15
16
    qw ( $CP $EGREP $NFSMOUNT $UMOUNT $TMPASSWD $SFSSD $SFSCD $RPMCMD
	 $HOSTSFILE $LOOPBACKMOUNT
17
	 os_account_cleanup os_ifconfig_line os_etchosts_line
18
	 os_setup os_groupadd os_useradd os_userdel os_usermod os_mkdir
19
	 os_ifconfig_veth os_viface_name os_modpasswd
20
21
	 os_routing_enable_forward os_routing_enable_gated
	 os_routing_add_manual os_routing_del_manual os_homedirdel
Mike Hibler's avatar
Mike Hibler committed
22
	 os_groupdel os_getnfsmounts os_islocaldir
23
	 os_fwconfig_line os_fwrouteconfig_line os_config_gre
24
	 os_get_disks os_get_disk_size os_get_partition_info
25
26
27
28
29
       );

# Must come after package declaration!
use English;

30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
# Load up the paths. Its conditionalized to be compatabile with older images.
# Note this file has probably already been loaded by the caller.
BEGIN
{
    if (-e "/etc/emulab/paths.pm") {
	require "/etc/emulab/paths.pm";
	import emulabpaths;
    }
    else {
	my $ETCDIR  = "/etc/rc.d/testbed";
	my $BINDIR  = "/etc/rc.d/testbed";
	my $VARDIR  = "/etc/rc.d/testbed";
	my $BOOTDIR = "/etc/rc.d/testbed";
    }
}
45

46
47
# Convenience.
sub REMOTE()	{ return libsetup::REMOTE(); }
48
sub REMOTEDED()	{ return libsetup::REMOTEDED(); }
49
sub PLAB()	{ return libsetup::PLAB(); }
50
sub LINUXJAILED(){ return libsetup::LINUXJAILED(); }
51

52
53
54
55
#
# Various programs and things specific to Linux and that we want to export.
# 
$CP		= "/bin/cp";
Mike Hibler's avatar
Mike Hibler committed
56
$DF		= "/bin/df";
57
$EGREP		= "/bin/egrep -q";
Kevin Atkinson's avatar
Kevin Atkinson committed
58
$NFSMOUNT	= "/bin/mount -o vers=2,udp"; # Force NFS Version 2 over UDP
59
$LOOPBACKMOUNT	= "/bin/mount -n -o bind ";
60
$UMOUNT		= "/bin/umount";
61
$TMPASSWD	= "$ETCDIR/passwd";
62
63
$SFSSD		= "/usr/local/sbin/sfssd";
$SFSCD		= "/usr/local/sbin/sfscd";
Mike Hibler's avatar
Mike Hibler committed
64
$RPMCMD		= "/bin/rpm";
65
$HOSTSFILE	= "/etc/hosts";
66
$WGET		= "/usr/bin/wget";
67
68
69
70

#
# These are not exported
#
71
72
73
my $TMGROUP	= "$ETCDIR/group";
my $TMSHADOW    = "$ETCDIR/shadow";
my $TMGSHADOW   = "$ETCDIR/gshadow";
74
75
76
77
my $USERADD     = "/usr/sbin/useradd";
my $USERDEL     = "/usr/sbin/userdel";
my $USERMOD     = "/usr/sbin/usermod";
my $GROUPADD	= "/usr/sbin/groupadd";
78
my $GROUPDEL	= "/usr/sbin/groupdel";
79
80
my $IFCONFIGBIN = "/sbin/ifconfig";
my $IFCONFIG    = "$IFCONFIGBIN %s inet %s netmask %s";
81
my $VLANCONFIG  = "/sbin/vconfig";
82
my $IFC_1000MBS  = "1000baseTx";
83
84
85
86
my $IFC_100MBS  = "100baseTx";
my $IFC_10MBS   = "10baseT";
my $IFC_FDUPLEX = "FD";
my $IFC_HDUPLEX = "HD";
87
my @LOCKFILES   = ("/etc/group.lock", "/etc/gshadow.lock");
88
my $MKDIR	= "/bin/mkdir";
89
90
my $GATED	= "/usr/sbin/gated";
my $ROUTE	= "/sbin/route";
91
92
my $SHELLS	= "/etc/shells";
my $DEFSHELL	= "/bin/tcsh";
93
94
95
96
97
98
my $IWCONFIG    = '/usr/local/sbin/iwconfig';
my $WLANCONFIG  = '/usr/local/bin/wlanconfig';
my $RMMOD       = '/sbin/rmmod';
my $MODPROBE    = '/sbin/modprobe';
my $IWPRIV      = '/usr/local/sbin/iwpriv';
my $BRCTL       = "/usr/sbin/brctl";
99
100
101
102

#
# OS dependent part of cleanup node state.
# 
103
104
sub os_account_cleanup()
{
105
106
107
108
109
    unlink @LOCKFILES;

    printf STDOUT "Resetting passwd and group files\n";
    if (system("$CP -f $TMGROUP $TMPASSWD /etc") != 0) {
	print STDERR "Could not copy default group file into place: $!\n";
110
	return -1;
111
112
113
114
    }
    
    if (system("$CP -f $TMSHADOW $TMGSHADOW /etc") != 0) {
	print STDERR "Could not copy default passwd file into place: $!\n";
115
	return -1;
116
117
118
119
120
121
122
123
    }
    return 0;
}

#
# Generate and return an ifconfig line that is approriate for putting
# into a shell script (invoked at bootup).
#
124
sub os_ifconfig_line($$$$$$$$;$$$)
125
{
126
    my ($iface, $inet, $mask, $speed, $duplex, $aliases, $iface_type, $lan,
127
	$settings, $rtabid, $cookie) = @_;
128
129
130
131
132
133
134
    my ($miirest, $miisleep, $miisetspd, $media);
    my ($uplines, $downlines);

    #
    # Special handling for new style interfaces (which have settings).
    # This should all move into per-type modules at some point. 
    #
Kirk Webb's avatar
   
Kirk Webb committed
135
    if ($iface_type eq "ath" && defined($settings)) {
136

Kirk Webb's avatar
   
Kirk Webb committed
137
138
139
140
141
        # Get a handle on the "VAP" interface we will create when
        # setting up this interface.
        my ($ifnum) = $iface =~ /wifi(\d+)/;
        my $athiface = "ath" . $ifnum;

142
143
144
145
146
	#
	# Setting the protocol is special and appears to be card specific.
	# How stupid is that!
	#
	my $protocol = $settings->{"protocol"};
Kirk Webb's avatar
   
Kirk Webb committed
147
        my $privcmd = "/usr/local/sbin/iwpriv $athiface mode ";
Kirk Webb's avatar
   
Kirk Webb committed
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

        SWITCH1: for ($protocol) {
          /^80211a$/ && do {
              $privcmd .= "1";
              last SWITCH1;
          };
          /^80211b$/ && do {
              $privcmd .= "2";
              last SWITCH1;
          };
          /^80211g$/ && do {
              $privcmd .= "3";
              last SWITCH1;
          };
        }
163
164
165
166
167
	 
	#
	# At the moment, we expect just the various flavors of 80211, and
	# we treat them all the same, configuring with iwconfig and iwpriv.
	#
Kirk Webb's avatar
   
Kirk Webb committed
168
169
170
	my $iwcmd = "/usr/local/sbin/iwconfig $athiface ";
        my $wlccmd = "/usr/local/bin/wlanconfig $athiface create ".
            "wlandev $iface ";
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202

	#
	# We demand to be given an ssid.
	#
	if (!exists($settings->{"ssid"})) {
	    warn("*** WARNING: No SSID provided for $iface!\n");
	    return undef;
	}
	$iwcmd .= "essid ". $settings->{"ssid"};

	# If we do not get a channel, pick one.
	if (exists($settings->{"channel"})) {
	    $iwcmd .= " channel " . $settings->{"channel"};
	}
	else {
	    $iwcmd .= " channel 3";
	}

	# txpower and rate default to auto if not specified.
	if (exists($settings->{"rate"})) {
	    $iwcmd .= " rate " . $settings->{"rate"};
	}
	else {
	    $iwcmd .= " rate auto";
	}
	if (exists($settings->{"txpower"})) {
	    $iwcmd .= " txpower " . $settings->{"txpower"};
	}
	else {
	    $iwcmd .= " txpower auto";
	}
	# Allow this too. 
203
204
205
206
207
208
209
210
211
212
	if (exists($settings->{"sens"})) {
	    $iwcmd .= " sens " . $settings->{"sens"};
	}

	# allow rts threshold and frag size
	if (exists($settings->{'rts'})) {
	    $iwcmd .= ' rts ' . $settings->{'rts'};
	}
	if (exists($settings->{'frag'})) {
	    $iwcmd .= ' frag ' . $settings->{'frag'};
213
214
215
216
	}

	#
	# We demand to be told if we are the master or a peon.
217
218
219
220
221
222
223
	# We might also be in another mode.  Thus, if accesspoint is specified,
	# we assume we are in either ap/sta (Master/Managed) mode.  If not,
	# we look for a 'mode' argument and assume adhoc if we don't get one.
	# The reason to assume adhoc is because we need accesspoint set to
	# know how to configure the device for ap/sta modes, and setting a
	# device to monitor mode by default sucks.
	# 
224
225
	# This needs to be last for some reason.
	#
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
	if (exists($settings->{'accesspoint'})) {
	    my $accesspoint = $settings->{"accesspoint"};
	    my $accesspointwdots;
	    
	    # Allow either dotted or undotted notation!
	    if ($accesspoint =~ /^(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})(\w{2})$/) {
		$accesspointwdots = "$1:$2:$3:$4:$5:$6";
	    }
	    elsif ($accesspoint =~
		   /^(\w{2}):(\w{2}):(\w{2}):(\w{2}):(\w{2}):(\w{2})$/) {
		$accesspointwdots = $accesspoint;
		$accesspoint      = "${1}${2}${3}${4}${5}${6}";
	    }
	    else {
		warn("*** WARNING: Improper format for MAC ($accesspoint) ".
		     "provided for $iface!\n");
		return undef;
	    }
	    
	    if (libsetup::findiface($accesspoint) eq $iface) {
		$wlccmd .= " wlanmode ap";
		$iwcmd .= " mode Master";
	    }
	    else {
		$wlccmd .= " wlanmode sta";
		$iwcmd .= " mode Managed ap $accesspointwdots";
	    }
253
	}
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
	elsif (exists($settings->{'mode'})) {
	    if ($settings->{'mode'} =~ /ad[\s\-]*hoc/i) {
		$wlccmd .= " wlanmode adhoc";
		$iwcmd .= " mode Ad-Hoc";
	    }
	    elsif ($settings->{'mode'} =~ /monitor/i) {
		$wlccmd .= " wlanmode monitor";
		$iwcmd .= " mode Monitor";
	    }
	    elsif ($settings->{'mode'} =~ /ap/i 
		   || $settings->{'mode'} =~ /access[\s\-]*point/i 
		   || $settings->{'mode'} =~ /master/i) {
		$wlccmd .= " wlanmode ap";
		$iwcmd .= " mode Master";
	    }
	    elsif ($settings->{'mode'} =~ /sta/i 
		   || $settings->{'mode'} =~ /managed/i) {
		$wlccmd .= " wlanmode sta";
		$iwcmd .= " mode Managed ap any";
	    }
	    else {
		warn("*** WARNING: Invalid mode provided for $iface!\n");
		return undef;
	    }
278
279
	}
	else {
280
	    warn("*** WARNING: No mode implied for $iface!\n");
281
282
	    return undef;
	}
283

Kirk Webb's avatar
   
Kirk Webb committed
284
        $uplines   = $wlccmd . "\n";
285
	$uplines  .= $privcmd . "\n";
Kirk Webb's avatar
   
Kirk Webb committed
286
	$uplines  .= $iwcmd . "\n";
Kirk Webb's avatar
   
Kirk Webb committed
287
288
	$uplines  .= sprintf($IFCONFIG, $athiface, $inet, $mask) . "\n";
	$downlines  = "$IFCONFIGBIN $athiface down\n";
289
	$downlines .= "$WLANCONFIG $athiface destroy\n";
Kirk Webb's avatar
   
Kirk Webb committed
290
	$downlines .= "$IFCONFIGBIN $iface down\n";
291
292
	return ($uplines, $downlines);
    }
293

Kirk Webb's avatar
   
Kirk Webb committed
294
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
324
325
326
327
328
329
330
331
332
333
    #
    # GNU Radio network interface on the flex900 daugherboard
    #
    if ($iface_type eq "flex900" && defined($settings)) {

        my $tuncmd = 
            "/bin/env PYTHONPATH=/usr/local/lib/python2.4/site-packages ".
            "$BINDIR/tunnel.py";

        if (!exists($settings->{"mac"})) {
            warn("*** WARNING: No mac address provided for gnuradio ".
                 "interface!\n");
            return undef;
        }

        my $mac = $settings->{"mac"};

        if (!exists($settings->{"protocol"}) || 
            $settings->{"protocol"} ne "flex900") {
            warn("*** WARNING: Unknown gnuradio protocol specified!\n");
            return undef;
        }

        if (!exists($settings->{"frequency"})) {
            warn("*** WARNING: No frequency specified for gnuradio ".
                 "interface!\n");
            return undef;
        }

        my $frequency = $settings->{"frequency"};
        $tuncmd .= " -f $frequency";

        if (!exists($settings->{"rate"})) {
            warn("*** WARNING: No rate specified for gnuradio interface!\n");
            return undef;
        }

        my $rate = $settings->{"rate"};
        $tuncmd .= " -r $rate";

334
335
336
337
338
339
340
	if (exists($settings->{'carrierthresh'})) {
	    $tuncmd .= " -c " . $settings->{'carrierthresh'};
	}
	if (exists($settings->{'rxgain'})) {
	    $tuncmd .= " --rx-gain=" . $settings->{'rxgain'};
	}

Kirk Webb's avatar
   
Kirk Webb committed
341
342
343
344
345
346
347
348
        $uplines = $tuncmd . " > /dev/null 2>&1 &\n";
        $uplines .= "sleep 5\n";
        $uplines .= "$IFCONFIGBIN $iface hw ether $mac\n";
        $uplines .= sprintf($IFCONFIG, $iface, $inet, $mask) . "\n";
        $downlines = "$IFCONFIGBIN $iface down";
        return ($uplines, $downlines);
    }

349
    #
350
351
352
    # Only do this stuff if we have a physical interface, otherwise it doesn't
    # mean anything.  We need this for virtnodes whose networks must be 
    # config'd from inside the container, vm, whatever.
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
    if ($iface_type ne 'veth') {
        #
        # Need to check units on the speed. Just in case.
        #
	if ($speed =~ /(\d*)([A-Za-z]*)/) {
	    if ($2 eq "Mbps") {
		$speed = $1;
	    }
	    elsif ($2 eq "Kbps") {
		$speed = $1 / 1000;
	    }
	    else {
		warn("*** Bad speed units $2 in ifconfig, default to 100Mbps\n");
		$speed = 100;
	    }
	    if ($speed == 1000) {
		$media = $IFC_1000MBS;
	    }
	    elsif ($speed == 100) {
		$media = $IFC_100MBS;
	    }
	    elsif ($speed == 10) {
		$media = $IFC_10MBS;
	    }
	    else {
		warn("*** Bad Speed $speed in ifconfig, default to 100Mbps\n");
		$speed = 100;
		$media = $IFC_100MBS;
	    }
383
	}
384
385
	if ($duplex eq "full") {
	    $media = "$media-$IFC_FDUPLEX";
386
	}
387
388
	elsif ($duplex eq "half") {
	    $media = "$media-$IFC_HDUPLEX";
389
390
	}
	else {
391
392
393
	    warn("*** Bad duplex $duplex in ifconfig, default to full\n");
	    $duplex = "full";
	    $media = "$media-$IFC_FDUPLEX";
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
        #
        # Linux is apparently changing from mii-tool to ethtool but some drivers
        # don't support the new interface (3c59x), some don't support the old
        # interface (e1000), and some (eepro100) support the new interface just
        # enough that they can report success but not actually do anything. Sweet!
        #
	my $ethtool;
	if (-e "/sbin/ethtool") {
	    $ethtool = "/sbin/ethtool";
	} elsif (-e "/usr/sbin/ethtool") {
	    $ethtool = "/usr/sbin/ethtool";
	}
	if (defined($ethtool)) {
	    # this seems to work for returning an error on eepro100
	    $uplines = 
		"if $ethtool $iface >/dev/null 2>&1; then\n    " .
		"  $ethtool -s $iface autoneg off speed $speed duplex $duplex\n    " .
		"  sleep 2 # needed due to likely bug in e100 driver on pc850s\n".
		"else\n    " .
		"  /sbin/mii-tool --force=$media $iface\n    " .
		"fi\n    ";
	} else {
	    $uplines = "/sbin/mii-tool --force=$media $iface\n    ";
	}
420
421
    }

422
423
424
425
    if ($inet eq "") {
	$uplines .= "$IFCONFIGBIN $iface up";
    }
    else {
426
427
428
	$uplines  .= sprintf($IFCONFIG, $iface, $inet, $mask);
	$downlines = "$IFCONFIGBIN $iface down";
    }
429
    
430
    return ($uplines, $downlines);
431
432
}

433
#
434
# Specialized function for configing virtual ethernet devices:
435
#
436
#	'veth'	one end of an etun device embedded in a vserver
437
438
439
440
#	'vlan'	802.1q tagged vlan devices
#	'alias'	IP aliases on physical interfaces
#
sub os_ifconfig_veth($$$$$;$$$$%)
441
{
442
443
444
445
    my ($iface, $inet, $mask, $id, $vmac,
	$rtabid, $encap, $vtag, $itype, $cookie) = @_;
    my ($uplines, $downlines);

446
447
    if ($itype !~ /^(alias|vlan|veth)$/) {
	warn("Unknown virtual interface type $itype\n");
448
449
450
	return "";
    }

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
482
483
484
485
486
487
488
489
490
491
492
493
494
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
    #
    # Veth.
    #
    # Veths for Linux vservers mean vtun devices.  One end is outside
    # the vserver and is bridged with other veths and peths as appropriate
    # to form the topology.  The other end goes in the vserver and is
    # configured with an IP address.  This final step is not done here
    # as the vserver must be running first.
    #
    # In the current configuration, there is configuration that takes
    # place both inside and outside the vserver.
    #
    # Inside:
    # The inside case (LINUXJAILED() == 1) just configures the IP info on
    # the interface.
    #
    # Outside:
    # The outside actions are much more involved as described above.
    # The VTAG identifies a bridge device "ebrN" to be used.
    # The RTABID identifies the namespace, but we don't care here.
    #
    # To create a etun pair you do:
    #    echo etun0,etun1 > /sys/module/etun/parameters/newif
    # To destroy do:
    #    echo etun0 > /sys/module/etun/parameters/delif
    #
    if ($itype eq "veth") {
	#
	# We are inside a Linux jail.
	# We configure the interface pretty much like normal.
	#
	if (LINUXJAILED()) {
	    if ($inet eq "") {
		$uplines .= "$IFCONFIGBIN $iface up";
	    }
	    else {
		$uplines  .= sprintf($IFCONFIG, $iface, $inet, $mask);
		$downlines = "$IFCONFIGBIN $iface down";
	    }
	    
	    return ($uplines, $downlines);
	}

	#
	# Outside jail.
	# Create tunnels and bridge and plumb them all together.
	#
	my $brdev = "ebr$vtag";
	my $iniface = "veth$id";
	my $outiface = "peth$id";
	my $devdir = "/sys/module/etun/parameters";

	# UP
	$uplines = "";

	# modprobe (should be done already for cnet setup, but who cares)
	$uplines .= "modprobe etun\n";

	# make sure bridge device exists and is up
	$uplines .= "    $IFCONFIGBIN $brdev >/dev/null 2>&1 || {";
	$uplines .= "        $BRCTL addbr $brdev\n";
	$uplines .= "        $IFCONFIGBIN $brdev up\n";
	$uplines .= "    }\n";

	# create the tunnel device
	$uplines .= "    echo $outiface,$iniface > $devdir/newif || exit 1\n";

	# bring up outside IF, insert into bridge device
	$uplines .= "    $IFCONFIGBIN $outiface up || exit 2\n";
	$uplines .= "    $BRCTL addif $brdev $outiface || exit 3\n";

	# configure the MAC address for the inside device
	$uplines .= "    $IFCONFIGBIN $iniface hw ether $vmac || exit 4\n";

	# DOWN
	$downlines = "";

	# remove IF from bridge device, down it (remove bridge if empty?)
	$downlines .= "$BRCTL delif $brdev $outiface || exit 13\n";
	$downlines .= "    $IFCONFIGBIN $outiface down || exit 12\n";

	# destroy tunnel devices (this will fail if inside IF in vserver still)
	$downlines .= "    echo $iniface > $devdir/delif || exit 11\n";

	return ($uplines, $downlines);
    }

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
    #
    # IP aliases
    #
    if ($itype eq "alias") {
	my $aif = "$iface:$id";

	$uplines   = sprintf($IFCONFIG, $aif, $inet, $mask);
	$downlines = "$IFCONFIGBIN $aif down";

	return ($uplines, $downlines);
    }

    #
    # VLANs
    #   insmod 8021q (once only)
    #   vconfig set_name_type VLAN_PLUS_VID_NO_PAD (once only)
    #
    #	ifconfig eth0 up (should be done before we are ever called)
    #	vconfig add eth0 601 
    #   ifconfig vlan601 inet ...
    #
    #   ifconfig vlan601 down
    #	vconfig rem vlan601
    #
    if ($itype eq "vlan") {
	if (!defined($vtag)) {
	    warn("No vtag in veth config\n");
	    return "";
	}

	# one time stuff
	if (!exists($cookie->{"vlan"})) {
	    $uplines  = "/sbin/insmod 8021q >/dev/null 2>&1\n    ";
	    $uplines .= "$VLANCONFIG set_name_type VLAN_PLUS_VID_NO_PAD\n    ";
	    $cookie->{"vlan"} = 1;
	}

	my $vdev = "vlan$vtag";

	$uplines   .= "$VLANCONFIG add $iface $vtag\n    ";
	$uplines   .= sprintf($IFCONFIG, $vdev, $inet, $mask);
	$downlines .= "$IFCONFIGBIN $vdev down\n    ";
	$downlines .= "$VLANCONFIG rem $vdev";
    }

    return ($uplines, $downlines);
584
585
}

586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
#
# Compute the name of a virtual interface device based on the
# information in ifconfig hash (as returned by getifconfig).
#
sub os_viface_name($)
{
    my ($ifconfig) = @_;
    my $piface = $ifconfig->{"IFACE"};

    #
    # Physical interfaces use their own name
    #
    if (!$ifconfig->{"ISVIRT"}) {
	return $piface;
    }

    #
    # Otherwise we have a virtual interface: alias, veth, vlan.
    #
    # alias: There is an alias device, but not sure what it is good for
    #        so for now we just return the phys device.
    # vlan:  vlan<VTAG>
608
    # veth:  veth<ID>
609
610
611
612
613
614
    #
    my $itype = $ifconfig->{"ITYPE"};
    if ($itype eq "alias") {
	return $piface;
    } elsif ($itype eq "vlan") {
	return $itype . $ifconfig->{"VTAG"};
615
616
    } elsif ($itype eq "veth") {
	return $itype . $ifconfig->{"ID"};
617
618
619
620
621
622
    }

    warn("Linux does not support virtual interface type '$itype'\n");
    return undef;
}

623
624
625
626
#
# Generate and return an string that is approriate for putting
# into /etc/hosts.
#
627
sub os_etchosts_line($$$)
628
{
629
    my ($name, $ip, $aliases) = @_;
630
    
631
    return sprintf("%s\t%s %s", $ip, $name, $aliases);
632
633
634
635
636
637
638
639
640
641
642
643
}

#
# Add a new group
# 
sub os_groupadd($$)
{
    my($group, $gid) = @_;

    return system("$GROUPADD -g $gid $group");
}

644
645
646
647
648
649
650
651
652
653
#
# Delete an old group
# 
sub os_groupdel($)
{
    my($group) = @_;

    return system("$GROUPDEL $group");
}

654
655
656
657
658
659
660
661
662
663
664
665
666
#
# Remove a user account.
# 
sub os_userdel($)
{
    my($login) = @_;

    return system("$USERDEL $login");
}

#
# Modify user group membership.
# 
667
sub os_usermod($$$$$$)
668
{
669
    my($login, $gid, $glist, $pswd, $root, $shell) = @_;
670
671
672
673
674
675
676

    if ($root) {
	$glist = join(',', split(/,/, $glist), "root");
    }
    if ($glist ne "") {
	$glist = "-G $glist";
    }
677
678
    # Map the shell into a full path.
    $shell = MapShell($shell);
679

680
    return system("$USERMOD -s $shell -g $gid $glist -p '$pswd' $login");
681
682
}

683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
#
# Modify user password.
# 
sub os_modpasswd($$)
{
    my($login, $pswd) = @_;

    if (system("$USERMOD -p '$pswd' $login") != 0) {
	warn "*** WARNING: resetting password for $login.\n";
	return -1;
    }
    if ($login eq "root" &&
	system("$USERMOD -p '$pswd' toor") != 0) {
	warn "*** WARNING: resetting password for toor.\n";
	return -1;
    }
    return 0;
}

702
703
704
#
# Add a user.
# 
705
sub os_useradd($$$$$$$$$)
706
{
707
    my($login, $uid, $gid, $pswd, $glist, $homedir, $gcos, $root, $shell) = @_;
Mike Hibler's avatar
Mike Hibler committed
708
    my $args = "";
709
710
711
712
713

    if ($root) {
	$glist = join(',', split(/,/, $glist), "root");
    }
    if ($glist ne "") {
Mike Hibler's avatar
Mike Hibler committed
714
	$args .= "-G $glist ";
715
    }
Mike Hibler's avatar
Mike Hibler committed
716
717
718
    # If remote, let it decide where to put the homedir.
    if (!REMOTE()) {
	$args .= "-d $homedir ";
719

720
721
722
723
724
725
726
727
728
729
730
731
732
	# Locally, if directory exists and is populated, skip -m
	# and make sure no attempt is made to create.
	if (! -d $homedir || ! -e "$homedir/.cshrc") {
	    $args .= "-m ";
	}
	else {
	    #
	    # -M is Redhat only option?  Overrides default CREATE_HOME.
	    # So we see if CREATE_HOME is set and if so, use -M.
	    #
	    if (!system("grep -q CREATE_HOME /etc/login.defs")) {
		$args .= "-M ";
	    }
Mike Hibler's avatar
Mike Hibler committed
733
	}
734
    }
Mike Hibler's avatar
Mike Hibler committed
735
736
    elsif (!PLAB()) {
	my $marg = "-m";
737

Mike Hibler's avatar
Mike Hibler committed
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
	#
	# XXX DP hack
	# Only force creation of the homdir if the default homedir base
	# is on a local FS.  On the DP, all nodes share a homedir base
	# which is hosted on one of the nodes, so we create the homedir
	# only on that node.
	#
	$defhome = `$USERADD -D 2>/dev/null`;
	if ($defhome =~ /HOME=(.*)/) {
	    if (!os_islocaldir($1)) {
		$marg = "";
	    }
	}

	# populate on remote nodes. At some point will tar files over.
	$args .= $marg;
    }

    # Map the shell into a full path.
    $shell = MapShell($shell);
758
    my $oldmask = umask(0022);
Mike Hibler's avatar
Mike Hibler committed
759
760
761

    if (system("$USERADD -u $uid -g $gid $args -p '$pswd' ".
	       "-s $shell -c \"$gcos\" $login") != 0) {
762
	warn "*** WARNING: $USERADD $login error.\n";
763
	umask($oldmask);
764
765
	return -1;
    }
766
    umask($oldmask);
767
768
769
    return 0;
}

770
771
772
773
774
775
776
777
#
# Remove a homedir. Might someday archive and ship back.
#
sub os_homedirdel($$)
{
    return 0;
}

778
779
780
781
782
783
784
785
786
787
788
789
790
#
# Create a directory including all intermediate directories.
#
sub os_mkdir($$)
{
    my ($dir, $mode) = @_;

    if (system("$MKDIR -p -m $mode $dir")) {
	return 0;
    }
    return 1;
}

791
792
793
794
795
796
797
798
#
# OS Dependent configuration. 
# 
sub os_setup()
{
    return 0;
}
    
799
800
801
802
803
804
805
806
807
808
809
#
# OS dependent, routing-related commands
#
sub os_routing_enable_forward()
{
    my $cmd;

    $cmd = "sysctl -w net.ipv4.conf.all.forwarding=1";
    return $cmd;
}

810
sub os_routing_enable_gated($)
811
{
812
    my ($conffile) = @_;
813
814
    my $cmd;

815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
    #
    # XXX hack to avoid gated dying with TCP/616 already in use.
    #
    # Apparently the port is used by something contacting ops's
    # portmapper (i.e., NFS mounts) and probably only happens when
    # there are a bazillion NFS mounts (i.e., an experiment in the
    # testbed project).
    #
    $cmd  = "for try in 1 2 3 4 5 6; do\n";
    $cmd .= "\tif `cat /proc/net/tcp | ".
	"grep -E -e '[0-9A-Z]{8}:0268 ' >/dev/null`; then\n";
    $cmd .= "\t\techo 'gated GII port in use, sleeping...';\n";
    $cmd .= "\t\tsleep 10;\n";
    $cmd .= "\telse\n";
    $cmd .= "\t\tbreak;\n";
    $cmd .= "\tfi\n";
    $cmd .= "    done\n";
    $cmd .= "    $GATED -f $conffile";
833
834
835
    return $cmd;
}

836
sub os_routing_add_manual($$$$$;$)
837
{
838
    my ($routetype, $destip, $destmask, $gate, $cost, $rtabid) = @_;
839
840
841
842
843
844
    my $cmd;

    if ($routetype eq "host") {
	$cmd = "$ROUTE add -host $destip gw $gate";
    } elsif ($routetype eq "net") {
	$cmd = "$ROUTE add -net $destip netmask $destmask gw $gate";
845
846
    } elsif ($routetype eq "default") {
	$cmd = "$ROUTE add default gw $gate";
847
848
849
850
851
852
853
854
    } else {
	warn "*** WARNING: bad routing entry type: $routetype\n";
	$cmd = "";
    }

    return $cmd;
}

855
sub os_routing_del_manual($$$$$;$)
856
{
857
    my ($routetype, $destip, $destmask, $gate, $cost, $rtabid) = @_;
858
859
860
861
862
863
    my $cmd;

    if ($routetype eq "host") {
	$cmd = "$ROUTE delete -host $destip";
    } elsif ($routetype eq "net") {
	$cmd = "$ROUTE delete -net $destip netmask $destmask gw $gate";
864
865
    } elsif ($routetype eq "default") {
	$cmd = "$ROUTE delete default";
866
867
868
869
870
871
872
873
    } else {
	warn "*** WARNING: bad routing entry type: $routetype\n";
	$cmd = "";
    }

    return $cmd;
}

874
875
876
877
878
879
880
881
882
# Map a shell name to a full path using /etc/shells
sub MapShell($)
{
   my ($shell) = @_;

   if ($shell eq "") {
       return $DEFSHELL;
   }

883
884
885
886
887
   #
   # May be multiple lines (e.g., /bin/sh, /usr/bin/sh, etc.) in /etc/shells.
   # Just use the first entry.
   #
   my @paths = `grep '/${shell}\$' $SHELLS`;
888
889
890
   if ($?) {
       return $DEFSHELL;
   }
891
892
   my $fullpath = $paths[0];
   chomp($fullpath);
893

894
895
   # Sanity Checks
   if ($fullpath =~ /^([-\w\/]*)$/ && -x $fullpath) {
896
897
898
899
900
901
902
903
       $fullpath = $1;
   }
   else {
       $fullpath = $DEFSHELL;
   }
   return $fullpath;
}

Mike Hibler's avatar
Mike Hibler committed
904
905
906
907
908
909
910
911
912
913
914
915
916
# Return non-zero if given directory is on a "local" filesystem
sub os_islocaldir($)
{
    my ($dir) = @_;
    my $rv = 0; 

    my @dfoutput = `$DF -l $dir 2>/dev/null`;
    if (grep(!/^filesystem/i, @dfoutput) > 0) {
	$rv = 1;
    }
    return $rv;
}

917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
sub os_getnfsmounts($)
{
    my ($rptr) = @_;
    my %mounted = ();

    #
    # Grab the output of the mount command and parse. 
    #
    if (! open(MOUNT, "/bin/mount|")) {
	print "os_getnfsmounts: Cannot run mount command\n";
	return -1;
    }
    while (<MOUNT>) {
	if ($_ =~ /^([-\w\.\/:\(\)]+) on ([-\w\.\/]+) type (\w+) .*$/) {
	    # Check type for nfs string.
	    if ($3 eq "nfs") {
933
		# Key is the remote NFS path, value is the mount point path.
934
935
936
937
938
939
940
941
942
		$mounted{$1} = $2;
	    }
	}
    }
    close(MOUNT);
    %$rptr = %mounted;
    return 0;
}

943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
sub os_fwconfig_line($@)
{
    my ($fwinfo, @fwrules) = @_;
    my ($upline, $downline);
    my $errstr = "*** WARNING: Linux firewall not implemented\n";


    warn $errstr;
    $upline = "echo $errstr; exit 1";
    $downline = "echo $errstr; exit 1";

    return ($upline, $downline);
}

sub os_fwrouteconfig_line($$$)
{
    my ($orouter, $fwrouter, $routestr) = @_;
    my ($upline, $downline);

    #
    # XXX assume the original default route should be used to reach servers.
    #
    # For setting up the firewall, this means we create explicit routes for
    # each host via the original default route.
    #
    # For tearing down the firewall, we just remove the explicit routes
    # and let them fall back on the now re-established original default route.
    #
    $upline  = "for vir in $routestr; do\n";
    $upline .= "        $ROUTE delete \$vir >/dev/null 2>&1\n";
    $upline .= "        $ROUTE add -host \$vir gw $orouter || {\n";
    $upline .= "            echo \"Could not establish route for \$vir\"\n";
    $upline .= "            exit 1\n";
    $upline .= "        }\n";
    $upline .= "    done";

    $downline  = "for vir in $routestr; do\n";
    $downline .= "        $ROUTE delete \$vir >/dev/null 2>&1\n";
    $downline .= "    done";

    return ($upline, $downline);
}

986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
# proto for a function used in os_ifdynconfig_cmds
sub getCurrentIwconfig($;$);

#
# Returns a list of commands needed to change the current device state to 
# something matching the given configuration options.
#
sub os_ifdynconfig_cmds($$$$$) 
{
    my ($ret_aref,$iface,$action,$optref,$ifcfg) = @_;
    my %opts = %$optref;
    my %flags = ();
    # this is the hash returned from getifconfig, but only for this interface
    my %emifc = %$ifcfg;

    my @cmds = ();

    # only handle the atheros case for now, since it's the only one
    # that can be significantly parameterized
    if (exists($emifc{'TYPE'}) && $emifc{'TYPE'} eq 'ath') {
	my ($ifnum) = $iface =~ /wifi(\d+)/;
        my $ath = "ath${ifnum}";
	my $wifi = $iface;

	# check flags
	my ($reset_wlan,$reset_kmod,$remember) = (0,0,0);
	if (exists($opts{'resetkmod'}) && $opts{'resetkmod'} == 1) {
	    $reset_kmod = 1;
	    # note that this forces a wlan reset too!
	    $reset_wlan = 1;
	    delete $opts{'resetkmod'};
	}
	if (exists($flags{'resetwlan'}) && $opts{'resetwlan'} == 1) {
	    $reset_wlan = 1;
	    delete $opts{'resetwlan'};
	}
	# we only want to try to keep similar config options
	# if the user tells us to...
	if (exists($flags{'usecurrent'}) && $opts{'usecurrent'} == 1) {
	    $remember = 1;
	    delete $opts{'usecurrent'};
	}

	# handle the up/down case right away.
	if (($action eq 'up' || $action eq 'down') 
	    && scalar(keys(%opts)) == 0) {
	    push @cmds,"$IFCONFIGBIN $ath $action";
	    @$ret_aref = @cmds;
	    return 0;
	}

	# first grab as much current state as we can, so we don't destroy
	# previous state if we have to destroy the VAP (i.e., athX) interface
	# 
	# NOTE that we don't bother grabbing current ifconfig state --
	# we assume that the current state is just what Emulab configured!
	my $iwc_ref = getCurrentIwconfig($ath);
	my %iwc = %$iwc_ref;

	# hash containing new config:
	my %niwc;

	# first, whack the emulab and user-supplied configs
	# so that the iwconfig params match what we need to give iwconfig
	# i.e., emulab specifies ssid and we need essid.
	if (exists($emifc{'ssid'})) {
	    $emifc{'essid'} = $emifc{'ssid'};
	    delete $emifc{'ssid'};
	}
	if (exists($opts{'ssid'})) {
	    $opts{'essid'} = $opts{'ssid'};
	    delete $opts{'ssid'};
	}
	if (exists($opts{'ap'})) {
	    $opts{'accesspoint'} = $opts{'ap'};
	    delete $opts{'ap'};
	}
	# we want this to be determined by the keyword 'freq' to iwconfig, 
	# not channel
	if (exists($opts{'channel'}) && !exists($opts{'freq'})) {
	    $opts{'freq'} = $opts{'channel'};
	}

	for my $ok (keys(%opts)) {
	    print STDERR "opts kv $ok=".$opts{$ok}."\n";
	}
	for my $tk (keys(%iwc)) {
	    print STDERR "iwc kv $tk=".$iwc{$tk}."\n";
	}

	# here's how we set things up: we set niwc to emulab wireless data
	# (i.e., INTERFACE_SETTINGs), then add in any current state, then
	# add in any of the reconfig options.
	my $key;
	if ($remember) {
	    for $key (keys(%{$emifc{'SETTINGS'}})) {
		$niwc{$key} = $emifc{'SETTINGS'}->{$key};
	    }
	    for $key (keys(%iwc)) {
		$niwc{$key} = $iwc{$key};
	    }
	}
	for $key (keys(%opts)) {
	    $niwc{$key} = $opts{$key};
	}

	for my $nk (keys(%niwc)) {
	    print STDERR "niwc kv $nk=".$niwc{$nk}."\n";
	}

	# see what has changed and what we're going to have to do
	my ($mode_ch,$proto_ch) = (0,0);

	# first, change mode to a string matching those returned by iwconfig:
	if (exists($niwc{'mode'})) {
	    if ($niwc{'mode'} =~ /ad[\s\-]{0,1}hoc/i) {
		$niwc{'mode'} = 'Ad-Hoc';
	    }
	    elsif ($niwc{'mode'} =~ /monitor/i) {
		$niwc{'mode'} = "Monitor";
	    }
	    elsif ($niwc{'mode'} =~ /ap/i
		   || $niwc{'mode'} =~ /master/i) {
		$niwc{'mode'} = "Master";
	    }
	    elsif ($niwc{'mode'} =~ /sta/i 
		   || $niwc{'mode'} =~ /managed/i) {
		$niwc{'mode'} = 'Managed';
	    }
	    else {
		print STDERR "ERROR: invalid mode '" . $niwc{'mode'} . "'\n";
		return 10;
	    }
	}

	# also change protocol, sigh
	if (exists($niwc{'protocol'})) {
	    if ($niwc{'protocol'} =~ /(802){0,1}11a/) {
		$niwc{'protocol'} = '80211a';
	    }
	    elsif ($niwc{'protocol'} =~ /(802){0,1}11b/) {
		$niwc{'protocol'} = '80211b';
	    }
	    elsif ($niwc{'protocol'} =~ /(802){0,1}11g/) {
		$niwc{'protocol'} = '80211g';
	    }
	    else {
		print STDERR "ERROR: invalid protocol '" . $niwc{'protocol'} . 
		    "'\n";
		return 11;
	    }
	}

	# to be backwards compat:
	# If the user sets a mode, we will put the device in that mode.
	# If the user does not set a mode, but does set an accesspoint, 
	#   we force the mode to either Managed or Master.
	# If the user sets neither a mode nor accesspoint, but we are told to
	#   "remember" the current state, we use that mode and ap.
	if (exists($opts{'mode'})) {
	    if ($niwc{'mode'} eq 'Managed' && exists($niwc{'accesspoint'})) {
		# strip colons and lowercase to check if we are the accesspoint
		# or a station:
		my $tap = $niwc{'accesspoint'};
		$tap =~ s/://g;
		$tap = lc($tap);
		
1153
		my $tmac = lc($emifc{'MAC'});
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
		
		if ($tap eq $tmac) {
		    # we are going to be the accesspoint; switch our mode to
		    # master
		    $niwc{'mode'} = 'Master';
		}
		else {
		    $niwc{'mode'} = 'Managed';
		    $niwc{'ap'} = $tap;
		}
	    }
	}
	elsif (exists($opts{'accesspoint'})) {
	    # strip colons and lowercase to check if we are the accesspoint
	    # or a station:
	    my $tap = $niwc{'accesspoint'};
	    $tap =~ s/://g;
	    $tap = lc($tap);
	    
1173
	    my $tmac = lc($emifc{'MAC'});
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
	    
	    if ($tap eq $tmac) {
		# we are going to be the accesspoint; switch our mode to
		# master
		$niwc{'mode'} = 'Master';
	    }
	    else {
		$niwc{'mode'} = 'Managed';
		$niwc{'ap'} = $tap;
	    }
	}
	elsif ($remember) {
	    # swipe first the old emulab config state, then the current
	    # iwconfig state:
	    
	    # actually, this was already done above.
	}

	# get rid of ap option if we're the master:
	if (exists($niwc{'mode'}) && $niwc{'mode'} eq 'Master') {
	    delete $niwc{'ap'};
	}

	print STDERR "after whacking niwc into compliance:\n";
	for my $nk (keys(%niwc)) {
	    print STDERR "niwc kv $nk=".$niwc{$nk}."\n";
	}

	# assemble params to commands:
	my ($iwc_mode,$wlc_mode);
	my $iwp_mode;

	if (exists($niwc{'mode'}) && $niwc{'mode'} ne $iwc{'mode'}) {
	    $mode_ch = 1;
	}
	
	if (exists($niwc{'mode'})) {
	    $iwc_mode = $niwc{'mode'};
	    if ($niwc{'mode'} eq 'Ad-Hoc') {
		$wlc_mode = 'adhoc';
	    }
	    elsif ($niwc{'mode'} eq 'Managed') {
		$wlc_mode = 'sta';
	    }
	    elsif ($niwc{'mode'} eq 'Monitor') {
		$wlc_mode = 'monitor';
	    }
	    elsif ($niwc{'mode'} eq 'Master') {
		$wlc_mode = 'ap';
	    }
	}

	if (exists($niwc{'protocol'})) {
	    if ($niwc{'protocol'} ne $iwc{'protocol'}) {
		$proto_ch = 1;
	    }
	    
	    if ($niwc{'protocol'} eq '80211a') {
		$iwp_mode = 1;
	    }
	    elsif ($niwc{'protocol'} eq '80211b') {
		$iwp_mode = 2;
	    }
	    elsif ($niwc{'protocol'} eq '80211g') {
		$iwp_mode = 3;
	    }
	}

	# for atheros cards, if we have to change the mode, we have to 
	# first tear down the VAP and rerun wlanconfig, then reconstruct
	# and reconfig the VAP.
	if ($mode_ch == 1) {
	    $reset_wlan = 1;
	}

        # Log what we're going to do:
	if ($reset_wlan && defined($wlc_mode)) {
	    print STDERR "WLANCONFIG: iface=$wifi; mode=$wlc_mode\n";
	}
	if (($proto_ch || $reset_wlan) && defined($iwp_mode)) {
	    print STDERR "IWPRIV: proto=".$niwc{'protocol'}." ($iwp_mode)\n";
	}
	if ($reset_wlan) {
	    print STDERR "IFCONFIG: iface=$ath; ip=" . $emifc{'IPADDR'} . 
		"; netmask=" . $emifc{'IPMASK'} . "\n";
	}

	# assemble iwconfig params:
	my $iwcstr = '';
	if (exists($niwc{'essid'})) {
	    $iwcstr .= ' essid ' . $niwc{'essid'};
	}
	if (exists($niwc{'freq'})) {
	    $iwcstr .= ' freq ' . $niwc{'freq'};
	}
	if (exists($niwc{'rate'})) {
	    $iwcstr .= ' rate ' . $niwc{'rate'};
	}
	if (exists($niwc{'txpower'})) {
	    $iwcstr .= ' txpower ' . $niwc{'txpower'};
	}
	if (exists($niwc{'sens'})) {
	    $iwcstr .= ' sens ' . $niwc{'sens'};
	}
	if (exists($niwc{'rts'})) {
	    $iwcstr .= ' rts ' . $niwc{'rts'};
	}
	if (exists($niwc{'frag'})) {
	    $iwcstr .= ' frag ' . $niwc{'frag'};
	}
	if (defined($iwc_mode) && $iwc_mode ne '') {
	    $iwcstr .= " mode $iwc_mode";
	    
	    if ($iwc_mode eq 'Managed') {
		if (exists($niwc{'ap'})) {
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
		    if (!($niwc{'ap'} =~ /:/)) {
                        # I really dislike perl sometimes.
                        $iwcstr .= ' ap ' .
                            substr($niwc{'ap'},0,2) . ":" .
                            substr($niwc{'ap'},2,2) . ":" .
                            substr($niwc{'ap'},4,2) . ":" .
                            substr($niwc{'ap'},6,2) . ":" .
                            substr($niwc{'ap'},8,2) . ":" .
                            substr($niwc{'ap'},10,2);
                    }
                    else {
			$iwcstr .= ' ap ' . $niwc{'ap'};
		    }
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
		}
		else {
		    $iwcstr .= ' ap any';
		}
	    }
	}

	print STDERR "IWCONFIG: $iwcstr\n";

        #
        # Generate commands to reconfigure the device.
        #
	if ($action eq 'up') {
	    push @cmds,"$IFCONFIGBIN $ath $action";
	}

	if ($reset_wlan) {
	    push @cmds,"$IFCONFIGBIN $ath down";
	    push @cmds,"$IFCONFIGBIN $wifi down";
	    push @cmds,"$WLANCONFIG $ath destroy";
	    
	    if ($reset_kmod) {
		## also "reset" the kernel modules:
		push @cmds,"$RMMOD ath_pci ath_rate_sample ath_hal";
		push @cmds,"$RMMOD wlan_scan_ap wlan_scan_sta wlan";
		push @cmds,"$MODPROBE ath_pci autocreate=none";
	    }
	    
	    push @cmds,"$WLANCONFIG $ath create wlandev $wifi " . 
		"wlanmode $wlc_mode";
	}
	if (($proto_ch || $mode_ch || $reset_wlan) && defined($iwp_mode)) {
	    push @cmds,"$IWPRIV $ath mode $iwp_mode";
	}
	push @cmds,"$IWCONFIG $ath $iwcstr";
	if ($reset_wlan) {
	    push @cmds,"$IFCONFIGBIN $ath inet " . $emifc{'IPADDR'} . 
		" netmask " . $emifc{'IPMASK'} . " up";
	    # also make sure routing is up for this interface
	    push @cmds,"/var/emulab/boot/rc.route " . $emifc{'IPADDR'} . " up";
	}

	# We don't do this right now because when we have to reset
	# wlan state to force a new mode, we panic the kernel if we 
	# do a wlanconfig without first destroying any monitor mode VAPs.
	# What's more, I haven't found a way to see which VAP is attached to
	# which real atheros device.
	
	#if ($do_mon_vdev) {
	#    $athmon = "ath" . ($iface_num + 10);
	#    push @cmds,"$WLANCONFIG $athmon create wlandev $wifi wlanmode monitor";
	#    push @cmds,"$IFCONFIGBIN $athmon up";
	#}

	if ($action eq 'down') {
	    push @cmds,"$IFCONFIGBIN $ath $action";
	}
    }
    elsif (exists($emifc{'TYPE'}) && $emifc{'TYPE'} eq 'flex900') {
	# see if we have any flags...
	$resetkmod = 0;
	if (exists($opts{'resetkmod'}) && $opts{'resetkmod'} == 1) {
	    $resetkmod = 1;
	}

	# check args -- we MUST have freq and rate.
	my ($freq,$rate,$carrierthresh,$rxgain);

	if (!exists($opts{'protocol'})
	    || $opts{'protocol'} ne 'flex900') {
	    warn("*** WARNING: Unknown gnuradio protocol specified, " . 
		 "assuming flex900!\n");
        }

	if (exists($opts{'frequency'})) {
	    $freq = $opts{'frequency'};
	}
	elsif (exists($opts{'freq'})) {
            $freq = $opts{'freq'};
        }
	else {
	    warn("*** WARNING: No frequency specified for gnuradio ".
                 "interface!\n");
            return undef;
	}

	if (exists($opts{'rate'})) {
	    $rate = $opts{'rate'};
	}
	else {
	    warn("*** WARNING: No rate specified for gnuradio interface!\n");
            return undef;
        }

	if (exists($opts{'carrierthresh'})) {
	    $carrierthresh = $opts{'carrierthresh'};
	}
	if (exists($opts{'rxgain'})) {
	    $rxgain = $opts{'rxgain'};
	}

	#
	# Generate commands
	#
	push @cmds,"$IFCONFIGBIN $iface down";

	# find out if we have to kill the current tunnel process...
	my $tpid;
	if (!open(PSP, "ps axwww 2>&1 |")) {
	    print STDERR "ERROR: open: $!"; 
	    return 19;
	}
	while (my $psl = <PSP>) {
	    if ($psl =~ /\s*(\d+)\s*.*emulab\/tunnel\.py.*/) {
		$tpid = $1;
		last;
	    }
	}
	close(PSP);
	if (defined($tpid)) {
	    push @cmds,"kill $tpid";
	}

	if ($resetkmod) {
	    push @cmds,"/sbin/rmmod tun";
	    push @cmds,"/sbin/modprobe tun";
	}

	my $tuncmd = 
	    "/bin/env PYTHONPATH=/usr/local/lib/python2.4/site-packages " .
	    "$BINDIR/tunnel.py -f $freq -r $rate";
	if (defined($carrierthresh)) {
	    $tuncmd .= " -c $carrierthresh";
	}
	if (defined($rxgain)) {
	    $tuncmd .= " -rx-gain=$rxgain";
	}
	$tuncmd .= " > /dev/null 2>&1 &";
	push @cmds,$tuncmd;

	# Give the tun device time to come up
	push @cmds,"sleep 2";

	my $mac = $emifc{'MAC'};
	push @cmds,"$IFCONFIGBIN $iface hw ether $mac";
	push @cmds,"$IFCONFIGBIN $iface inet " . $emifc{'IPADDR'} .
	    " netmask " . $emifc{'IPMASK'} . " up";
	# also make sure routing is up for this interface
	push @cmds,"/var/emulab/boot/rc.route " . $emifc{'IPADDR'} . " up";
    }
    
    @$ret_aref = @cmds;
    
    return 0;
}

my %def_iwconfig_regex = ( 'protocol' => '.+(802.*11[abg]{1}).*',
1459
			   'essid'    => '.+SSID:\s*"*([\w\d_\-\.]+)"*.*',
1460
1461
1462
1463
			   'mode'     => '.+Mode:([\w\-]+)\s+',
			   'freq'     => '.+Frequency:(\d+\.\d+\s*\w+).*',
			   'ap'       => '.+Access Point:\s*([0-9A-Za-z\:]+).*',
			   'rate'     => '.+Rate[:|=]\s*(\d+\s*[\w\/]*)\s*',
1464
			   'txpower'  => '.+ower[:|=](\d+\s*[a-zA-Z]+).*',
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
			   'sens'     => '.+Sensitivity[:|=](\d+).*',
                           # can't set this on our atheros cards
                           #'retry'    => '.+Retry[:|=](\d+|off).*',
			   'rts'      => '.+RTS thr[:|=](\d+|off).*',
			   'frag'     => '.+Fragment thr[:|=](\d+|off).*',
                           # don't care about this on our cards
                           #'power'    => '.+Power Management[:|=](\d+|off).*',
			 );

#
# Grab current iwconfig data for a specific interface, based on the 
# specified regexps (which default to def_iwconfig_regex if unspecified).
# Postprocess the property values so that they can be stuck back into iwconfig.
#
sub getCurrentIwconfig($;$) {
    my ($dev,$regex_ref) = @_;
    my %regexps;

    if (!defined($dev) || $dev eq '') {
        return;
    }
    if (!defined($regex_ref)) {
	%regexps = %def_iwconfig_regex;
    }
    else {
	%regexps = %$regex_ref;
    }

    my %r = ();
    my @output = `$IWCONFIG`;

    my $foundit = 0;
    foreach my $line (@output) {
        if ($line =~ /^$dev/) {
            $foundit = 1;
        }
        elsif ($foundit && !($line =~ /^\s+/)) {
            last;
        }

        if ($foundit) {
            foreach my $iwprop (keys(%regexps)) {
                my $regexp = $regexps{$iwprop};
                if ($line =~ /$regexp/) {
                    $r{$iwprop} = $1;
                }
            }    
        }
    }
     
    # postprocessing.
    # We change the values back to valid args to the iwconfig command
    if (defined($r{'protocol'})) {
        $r{'protocol'} =~ s/\.//g;
    }
     
    if (defined($r{'rate'})) {
        if ($r{'rate'} =~ /^(\d+) Mb\/s/) {
            $r{'rate'} = "${1}M";
        }
        else {
            $r{'rate'} = $1;
        }
    }

    if (defined($r{'txpower'})) {
        if ($r{'txpower'} =~ /^(\d+)/) {
            $r{'txpower'} = $1;
        }
        else {
            $r{'txpower'} = 'auto';
        }
    }

    if (defined($r{'freq'})) {
        $r{'freq'} =~ s/\s//g;
    }

    foreach my $rk (keys(%r)) {
	print STDERR "gci $rk=".$r{$rk}."\n";
    }
     
    return \%r;
}

1550
1551
1552
1553
1554
1555
1556
1557
1558
sub os_config_gre($$$$$$$)
{
    my ($name, $unit, $inetip, $peerip, $mask, $srchost, $dsthost) = @_;

    my $dev = "$name$unit";

    if (system("ip tunnel add $dev mode gre remote $dsthost local $srchost") ||
	system("ip link set $dev up") ||
	system("ip addr add $inetip dev $dev") ||
1559
	system("$IFCONFIGBIN $dev netmask $mask")) {
1560
1561
1562
1563
1564
1565
	warn("Could not start tunnel!\n");
	return -1;
    }
    return 0;
}

1566
1567
1568
1569
sub os_get_disks
{
	my @blockdevs;

1570
	@blockdevs = map { s#/sys/block/##; $_ } glob('/sys/block/*');
1571
1572
1573
1574
1575
1576

	return @blockdevs;
}

sub os_get_disk_size($)
{
1577
	my ($disk) = @_;
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
	my $size;

	$disk =~ s#^/dev/##;

	if (!open SIZE, "/sys/block/$disk/size") {
		warn "Couldn't open /sys/block/$disk/size: $!\n";
		return undef;
	}
	$size = <SIZE>;
	close SIZE;
	chomp $size;

	$size = $size * 512 / 1024 / 1024;

	return $size;
}

sub os_get_partition_info($$)
{
    my ($bootdev, $partition) = @_;

1599
1600
    $bootdev =~ s#^/dev/##;

1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
    if (!open(FDISK, "fdisk -l /dev/$bootdev |")) {
	print("Failed to run fdisk on /dev/$bootdev!");
	return -1;
    }

    while (<FDISK>) {
	    next if (!m#^/dev/$bootdev$partition\s+#);

	    s/\*//;

	    my ($length, $ptype) = (split /\s+/)[3,4];

	    $length =~ s/\+$//;
	    $ptype = hex($ptype);

	    close FDISK;

	    return ($length, $ptype);
    }

    print "No such partition in fdisk summary info for MBR on /dev/$bootdev!\n";
    close FDISK;

    return -1;
}

1627
1;