tbuisp.in 11.6 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 $TIP    = "$TB/bin/tiptunnel";
41 42 43
my $OBJCOPY= "/usr/local/bin/avr-objcopy";
my $SETID  = "$TB/bin/set-mote-id";
my $TMPDIR = "/tmp";
44
my $USERS  = "@USERNODE@";
45
my $DEBUG  = 1;
46
my $OBJDUMP= "/usr/local/bin/avr-objdump";
47 48 49 50 51 52 53 54 55 56 57 58

#
# 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;
}

59 60 61 62 63 64 65 66 67 68 69 70 71 72
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};
}

73 74
sub dprint(@);

75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95
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();
}

96 97
# 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
98
my @motes = @ARGV;
99
if (!@motes && !$eid) {
100 101 102
    exit usage();
}

103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
# 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";
    }
}

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

#
142
# Taint check the node names
143 144 145 146 147 148 149 150 151
#
@motes = map {
    if (/^([-\w]+)$/) {
	$1;
    } else {
	die("*** Tainted node name: $_\n");
    }
} @motes;

152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
#
# Give them a chance to put IDs in the command line
#
my $previous_mote = "";
my @tmpmotes;
my %moteIDs;
foreach my $mote (@motes) {
    if ($previous_mote) {
        # This could be an ID
        if ($mote =~ /^\d+$/) {
            # Not a mote, a mote ID
            $moteIDs{$previous_mote} = $mote;
        } else {
            push @tmpmotes, $mote;
            $previous_mote = $mote;
        }
    } else {
        push @tmpmotes, $mote;
        $previous_mote = $mote;
    }
}
@motes = @tmpmotes;

175 176 177
#
# Permission check
#
178
if ($UID && !TBNodeAccessCheck($UID,TB_NODEACCESS_LOADIMAGE,@motes)) {
179 180 181 182
    die "You do not have permission to modify one or more nodes\n";
}

#
183 184
# 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
185 186
#
if ($filename) {
187
    if (!-R $filename) {
188 189 190 191
	die "$filename not readable\n";
    }
}

192 193 194 195 196 197
#
# If this is an exe rather than an srec, we're going to have to process it
# a bit, so make up a tempfile name
#
my $tmpfile;
my $isexe = 0;
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 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242

# this is only broken because when an exe is uploaded via the xmlrpc stuff, 
# a tmp file is created WITHOUT the .exe extension.  Consequently, we check
# using avr-objcopy.

# to figure out what format it is, we look for the string 'file format', 
# followed by a another string.
# currently, 'srec' corresponds to an srec, and 'elf32-avr' corresponds to an
# exe.  THIS WILL CHANGE for different mote archs!

my @exe_strs = ("elf32-avr");
my $srec_str = "srec";

my @output = `$OBJDUMP -f $filename`;
my $line;

my $check = 0;

foreach $line (@output) {
    if ($line =~ /file format\s+(.+)$/) {
	$check = 1;

	# match srec
	if ($srec_str eq $1) {
	    $isexe = 0;
	    print "Binary is format $srec_str!\n";
	}
	else {
	    my $type;
	    foreach $type (@exe_strs) {
		if ($type eq $1) {
		    $isexe = 1;
		    print "exe file, extra processing will be done\n";
		    $tmpfile = "$TMPDIR/tbuisp.$$.srec";
		    print "Binary is format $type.\n";
		}
	    }
	    
	    # oops, found unsupported binary!
	    if (!$isexe) {
		die "Unsupported .exe format $1!\n";
	    }
		
	}
    }
243 244
}

245 246 247 248 249 250 251 252 253 254
if (!$check) {
    die "$OBJDUMP did not provide any information about your binary!\n";
}

#if ($filename =~ /\.exe$/) {
#    print "exe file, extra processing will be done\n";
#    $tmpfile = "$TMPDIR/tbuisp.$$.srec";
#    $isexe = 1;
#}

255 256 257 258 259 260 261 262 263 264
#
# 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;

265 266 267 268 269
    #
    # Make sure they gave us an actual mote
    #
    my ($motetype, $moteclass) = TBNodeType($mote);
    if ($moteclass ne "mote") {
270 271 272 273 274
	warn "$mote is not a mote - skipping\n";
	$errors++;
	next MOTE;
    }

275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303
    #
    # Process the exe file if necessary
    #
    my $uploadfile = $filename;
    if ($isexe) {
        #
        # Check to see if we have to set the mote ID
        #
        my $processedfile = $filename;
        my $tmpexe = "$TMPDIR/tbuisp.$$.exe";
        if (!exists $moteIDs{$mote}) {
            #
            # Try to grab an ID from the virt_nodes table
            #
            my $id_result = DBQueryFatal("select numeric_id from nodes as n " .
                "left join reserved as r on n.node_id = r.node_id " .
                "left join virt_nodes as v on r.vname = v.vname " .
                "where n.node_id='$mote' and v.numeric_id is not null");
            if ($id_result->num_rows() == 1) {
                $moteIDs{$mote} = ($id_result->fetch_row());
            } else {
                #
                # Default it to the numeric part of the node ID
                #
                if ($mote =~ /(\d+)$/) {
                    $moteIDs{$mote} = $1;
                }
            }
        }
304 305 306 307 308 309

        #
        # Flip to the user's ID before running these things
        #
        my $oldEUID = $EUID;
        $EUID = $UID;
310 311 312 313 314 315 316 317 318 319 320 321 322
        if (exists $moteIDs{$mote}) {
            print "Setting id for $mote to $moteIDs{$mote}\n";
            if (system "$SETID --exe $filename $tmpexe $moteIDs{$mote}") {
                warn "Error: Unable to set mote ID to $moteIDs{$mote}\n";
                next MOTE;
            }
            $processedfile = $tmpexe;
        }
        if (system "$OBJCOPY --output-target=srec $processedfile $tmpfile") {
            warn "Error: Trouble processing $filename\n";
            next MOTE;
        }
        $uploadfile = $tmpfile;
323 324 325 326
        #
        # And then flip back
        #
        $EUID = $oldEUID;
327 328 329 330 331 332

        if ($processedfile eq $tmpexe) {
            unlink $tmpexe;
        }
    }

333 334 335 336 337 338 339 340 341 342
    #
    # 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) {
343
	print "Uploading code to $mote\n";
344
	my $commandstr = "$SSHTB -host $USERS $TIP -u $UID -l $mote - < $uploadfile";
345 346 347 348 349 350 351
	my $OLDUID = $UID;
	$UID = $EUID;
	if (system($commandstr)) {
	    $errors++;
	    warn "Failed to upload code to $mote";
	}
	$UID = $OLDUID;
352 353 354 355
	next MOTE;
    }
    my ($hosttype, $hostclass) = TBNodeType($host);

356 357
    my $upload_method;

358 359 360
    #
    # Figure out how we talk to the programming board, and what chipset it has
    #
361
    TSWITCH: for ($hosttype) {
362 363 364 365
	/^emote$/ && do {
	    # Crossbow MIB600CA

	    # The name of the host to communicate with
366
	    push @uisp_args, "-dhost=$host";
367 368
	    # The type of programming board on a emote
	    push @uisp_args, "-dprog=stk500";
369 370 371 372 373 374

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

	    last TSWITCH;
	};
375 376 377
	# XXX - garcia is temporary - hopefully, at some point, we will
	# distinguish the garcia from the stargate that rides on it
	(/^sg/ || /^garcia/) && do {
378 379 380 381 382
	    # Stargate

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

	    # The type of programming board on a stargate
383
	    push @uisp_args, "-dprog=sggpio";
384 385 386 387 388

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

389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406
	    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,
407
				(TBDB_NODESTATE_ISUP,TBDB_NODESTATE_TBFAILED))) {
408 409 410 411 412
		$errors++;
		warn "Mote host ($host) is not up.";
		next MOTE;
	    }

413 414 415
	    last TSWITCH;
	};
	# Default
416 417
	warn "Mote host $host for $mote has unsupported type $hosttype " .
	    "- skipping";
418 419 420 421 422 423 424
	$errors++;
	next MOTE;
    }

    #
    # Find the name of the microcontroller on the board
    #
425
    my ($proc, $speed) = TBNodeTypeProcInfo($motetype);
426
    PSWITCH: for ($proc) {
427 428 429 430 431 432
	/^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";
433 434 435 436 437 438 439 440 441 442 443 444 445 446
	    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 {
447 448
	    #$opstring = "--wr_fuse_e=ff --erase --upload ";
	    $opstring = "--erase --upload ";
449
	    if ($upload_method eq "direct") {
450
		$opstring .= "if=$uploadfile";
451 452 453
	    } elsif ($upload_method eq "ssh") {
		$opstring .= "if=-";
	    }
454 455 456 457 458 459 460 461 462 463 464 465
	    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";
466 467 468 469 470 471 472
    my $commandstr;
    if ($upload_method eq "direct") {
	#
	# We're running uisp directly on this node
	#
	$commandstr = "$UISP " . join(" ",@uisp_args,$opstring);

473
	# Drop root permission, no need for it
474 475 476 477 478 479
	$EUID = $UID;
    } elsif ($upload_method eq "ssh") {
	#
	# We have to ssh into the mote host
	#
	$commandstr = "$SSHTB -host $host $SGUISP " .
480
	    join(" ",@uisp_args,$opstring) . " < $uploadfile";
481 482 483 484 485

	#
	# SSH gets ticked if UID != EUID, so set that now
	#
	$UID = $EUID;
486 487 488 489 490
    } else {
	warn "Unsupported upload method for $mote - skipping";
	$errors++;
	next MOTE;
    }
491 492
    dprint("$commandstr\n");
    if (system($commandstr)) {
493 494
	$errors++;
	warn "Failed to upload code to $mote";
495
    }
496

497 498 499 500
    #
    # Clean up the tempfile
    #
    if ($tmpfile) {
501
        system "rm -f $tmpfile";
502
    }
503 504 505 506 507 508 509 510 511 512 513 514 515
}

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

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