tbuisp.in 7.61 KB
Newer Older
1
#!/usr/bin/perl -wT
2 3
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2004, 2005 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13
# All rights reserved.
#

#
# tbuisp - An emulab frontend to UISP, which uploads programs to Mica motes
#

use lib '@prefix@/lib';
my $TB = '@prefix@';
14
 
15 16
use libdb;
use English;
17
use Getopt::Long;
18

19 20 21 22 23 24 25 26 27 28 29 30
#
# We have to be setuid root so that we can ssh into stargates as root
#
if ($EUID != 0) {
    die("*** $0:\n".
	"    Must be root! Maybe its a development version?\n");
}

# un-taint path
$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin:$TB/bin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
 
31 32 33 34 35
use strict;

#
# Constants
#
36 37 38
my $UISP   = "$TB/bin/uisp";
my $SGUISP = "/usr/local/bin/uisp";
my $SSHTB  = "$TB/bin/sshtb";
39
my $POWER  = "$TB/bin/power";
40
my $DEBUG  = 1;
41 42 43 44 45 46 47 48 49 50 51 52

#
# Handle command-line arguments
# TODO: Allow a user to specify some of their own arguments to uisp
#
sub usage() {
    warn "Usage: $0 <operation> [filename] <motes...>\n";
    warn "Supported operations: upload\n";
    warn "[filename] is required with the 'upload' operation\n";
    return 1;
}

53 54 55 56 57 58 59 60 61 62 63 64 65 66
my %opt = ();
GetOptions(\%opt, 'p=s','e=s');

if (($opt{e} && ! $opt{p}) || (!$opt{e} && $opt{p})) {
    warn "-e and -p must be used togehter\n";
    die usage;
}

my ($eid, $pid);
if ($opt{e}) {
    $eid = $opt{e};
    $pid = $opt{p};
}

67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
my $operation = shift @ARGV;
my $filename;
if (!$operation) {
    exit usage();
}
# Check the operation type
# XXX - support the other operations uisp supports, like downloading code
SWITCH: for ($operation) {
    /^upload$/ && do {
	$filename = shift @ARGV;
	if (!$filename) {
	    exit usage();
	}
	last SWITCH;
    };
    
    # Default
    warn "Uknown operation $operation\n";
    exit usage();
}

88 89
# They have to give us at least one mote, unless they gave a pid or eid, in
# which case we take that to mean all nodes in the experiment
90
my @motes = @ARGV;
91
if (!@motes && !$eid) {
92 93 94
    exit usage();
}

95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
# Perm check on the eid and pid
if ($eid) {
    if (!TBExptAccessCheck($UID,$pid,$eid,TB_EXPT_READINFO)) {
	die "*** You do not have permission to access nodes in\n" .
	    "     $pid/$eid\n";
    }
}

# If given an eid and a mote list, translate the mote names to physical ones
if ($eid && @motes) {
    my @tmp;
    foreach my $mote (@motes) {
	my $physmote;
	if (!VnameToNodeid($pid,$eid,$mote,\$physmote)) {
	    die "*** No such node $mote in $pid/$eid\n";
	}
	push @tmp, $physmote;
    }
    @motes = @tmp;
}

# If given an eid and no mote list, grab all nodes in the experiment
if (!@motes && $eid) {
    @motes = ExpNodes($pid, $eid);
    if (!@motes) {
	die "*** Unable to get nodes in experiment $pid/$eid\n";
    }
}

124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143
#
# Taint check the filename
#
if ($filename =~ /^([-\w\/.]+)$/) {
    $filename = $1;
} else {
    die("*** Tainted filename: $filename\n");
}

#
# Tait check the node names
#
@motes = map {
    if (/^([-\w]+)$/) {
	$1;
    } else {
	die("*** Tainted node name: $_\n");
    }
} @motes;

144 145 146
#
# Permission check
#
147
if ($UID && !TBNodeAccessCheck($UID,TB_NODEACCESS_LOADIMAGE,@motes)) {
148 149 150 151
    die "You do not have permission to modify one or more nodes\n";
}

#
152 153
# Check the file to make sure it's readable - note, we want to make sure it's
# readable by the real uid, since w'ere setuid root
154 155
#
if ($filename) {
156
    if (!-R $filename) {
157 158 159 160 161 162 163 164 165 166 167 168 169 170
	die "$filename not readable\n";
    }
}

#
# Program each mote
#
my $errors = 0;
MOTE: foreach my $mote (@motes) {
    #
    # Figure out the parameters we need to pass to uisp for this mote
    #
    my @uisp_args;

171 172 173 174 175
    #
    # Make sure they gave us an actual mote
    #
    my ($motetype, $moteclass) = TBNodeType($mote);
    if ($moteclass ne "mote") {
176 177 178 179 180
	warn "$mote is not a mote - skipping\n";
	$errors++;
	next MOTE;
    }

181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196
    #
    # Find out the type of the mote's host, which we use for actual programming
    #
    my $host;
    if (!TBPhysNodeID($mote,\$host)) {
	warn "Error getting host for $mote - skipping\n";
	$errors++;
	next MOTE;
    }
    if ($host eq $mote) {
	warn "Error - no host found for $mote - skipping\n";
	$errors++;
	next MOTE;
    }
    my ($hosttype, $hostclass) = TBNodeType($host);

197 198
    my $upload_method;

199 200 201
    #
    # Figure out how we talk to the programming board, and what chipset it has
    #
202
    TSWITCH: for ($hosttype) {
203 204 205 206
	/^emote$/ && do {
	    # Crossbow MIB600CA

	    # The name of the host to communicate with
207
	    push @uisp_args, "-dhost=$host";
208 209
	    # The type of programming board on a emote
	    push @uisp_args, "-dprog=stk500";
210 211 212 213 214 215

	    # We do the upload by running uisp directly on boss
	    $upload_method = "direct";

	    last TSWITCH;
	};
216 217 218
	# XXX - garcia is temporary - hopefully, at some point, we will
	# distinguish the garcia from the stargate that rides on it
	(/^sg/ || /^garcia/) && do {
219 220 221 222 223
	    # Stargate

	    # We have to ssh in to the stargate to do the programming

	    # The type of programming board on a stargate
224
	    push @uisp_args, "-dprog=sggpio";
225 226 227 228 229

	    # We do the upload by sshing to the toe stargate and running
	    # uisp
	    $upload_method = "ssh";

230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253
	    my $nodestate;
	    if (! TBGetNodeEventState($host, \$nodestate) ||
		$nodestate eq TBDB_NODESTATE_POWEROFF) {
		warn "$host: power cycling";
		
		system("$POWER cycle $host");
		if ($?) {
		    $errors++;
		    warn "Mote host ($host) failed to power up.";
		    next MOTE;
		}
	    }
	    
	    my $actual_state;
	    if (TBNodeStateWait($host,
				time,
				(60*6),
				\$actual_state,
				(TBDB_NODESTATE_ISUP,))) {
		$errors++;
		warn "Mote host ($host) is not up.";
		next MOTE;
	    }

254 255 256
	    last TSWITCH;
	};
	# Default
257 258
	warn "Mote host $host for $mote has unsupported type $hosttype " .
	    "- skipping";
259 260 261 262 263 264 265
	$errors++;
	next MOTE;
    }

    #
    # Find the name of the microcontroller on the board
    #
266
    my ($proc, $speed) = TBNodeTypeProcInfo($motetype);
267
    PSWITCH: for ($proc) {
268 269 270 271 272 273
	/^ATmega128/i && do { # mica2
	    push @uisp_args, "-dpart=ATmega128","--wr_fuse_e=ff";
	    last PSWITCH;
	};
	/^ATmega103/i && do { # mica1
	    push @uisp_args, "-dpart=ATmega103","--wr_fuse_e=fd";
274 275 276 277 278 279 280 281 282 283 284 285 286 287
	    last PSWITCH;
	};
	# Default
	warn "Unsupported processor $proc for $mote - skipping\n";
	$errors++;
	next MOTE;
    }

    #
    # The operation we want to perform
    #
    my $opstring;
    OSWITCH: for ($operation) {
	/^upload$/ && do {
288 289
	    #$opstring = "--wr_fuse_e=ff --erase --upload ";
	    $opstring = "--erase --upload ";
290 291 292 293 294
	    if ($upload_method eq "direct") {
		$opstring .= "if=$filename";
	    } elsif ($upload_method eq "ssh") {
		$opstring .= "if=-";
	    }
295 296 297 298 299 300 301 302 303 304 305 306
	    last OSWITCH;
	};

	# No default, we've checked for a valid operation above
    }

    #
    # Actually run uisp
    # TODO - Squelch output
    # TODO - Allow for some parallelism
    #
    print "Uploading code to $mote\n";
307 308 309 310 311 312 313
    my $commandstr;
    if ($upload_method eq "direct") {
	#
	# We're running uisp directly on this node
	#
	$commandstr = "$UISP " . join(" ",@uisp_args,$opstring);

314
	# Drop root permission, no need for it
315 316 317 318 319 320 321
	$EUID = $UID;
    } elsif ($upload_method eq "ssh") {
	#
	# We have to ssh into the mote host
	#
	$commandstr = "$SSHTB -host $host $SGUISP " .
	    join(" ",@uisp_args,$opstring) . " < $filename";
322 323 324 325 326

	#
	# SSH gets ticked if UID != EUID, so set that now
	#
	$UID = $EUID;
327 328 329 330 331
    } else {
	warn "Unsupported upload method for $mote - skipping";
	$errors++;
	next MOTE;
    }
332 333
    dprint("$commandstr\n");
    if (system($commandstr)) {
334 335
	$errors++;
	warn "Failed to upload code to $mote";
336
    }
337 338 339 340

    # XXX - We have to reboot stargates after loading the mote. Disgusting,
    # there should be some better way
    if ($upload_method eq "ssh") {
341
	if (system("$TB/bin/node_reboot $host")) {
342 343 344 345
	    $errors++;
	    warn "Failed to upload code to $mote";
	}
    }
346 347 348 349 350 351 352 353 354 355 356 357 358
}

if ($errors) {
    exit 1;
} else {
    exit 0;
}

sub dprint(@) {
    if ($DEBUG) {
	print @_;
    }
}