tbuisp.in 10.7 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 47 48 49 50 51 52 53 54 55 56 57

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

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

72 73
sub dprint(@);

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

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

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

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

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

151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
#
# 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;

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

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

191 192 193 194 195 196 197 198 199 200 201 202
#
# 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;
if ($filename =~ /\.exe$/) {
    print "exe file, extra processing will be done\n";
    $tmpfile = "$TMPDIR/tbuisp.$$.srec";
    $isexe = 1;
}

203 204 205 206 207 208 209 210 211 212
#
# 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;

213 214 215 216 217
    #
    # Make sure they gave us an actual mote
    #
    my ($motetype, $moteclass) = TBNodeType($mote);
    if ($moteclass ne "mote") {
218 219 220 221 222
	warn "$mote is not a mote - skipping\n";
	$errors++;
	next MOTE;
    }

223 224 225 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
    #
    # 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;
                }
            }
        }
252 253 254 255 256 257

        #
        # Flip to the user's ID before running these things
        #
        my $oldEUID = $EUID;
        $EUID = $UID;
258 259 260 261 262 263 264 265 266 267 268 269 270
        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;
271 272 273 274
        #
        # And then flip back
        #
        $EUID = $oldEUID;
275 276 277 278 279 280

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

281 282 283 284 285 286 287 288 289 290
    #
    # 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) {
291
	print "Uploading code to $mote\n";
292
	my $commandstr = "$SSHTB -host $USERS $TIP -u $UID -l $mote - < $uploadfile";
293 294 295 296 297 298 299
	my $OLDUID = $UID;
	$UID = $EUID;
	if (system($commandstr)) {
	    $errors++;
	    warn "Failed to upload code to $mote";
	}
	$UID = $OLDUID;
300 301 302 303
	next MOTE;
    }
    my ($hosttype, $hostclass) = TBNodeType($host);

304 305
    my $upload_method;

306 307 308
    #
    # Figure out how we talk to the programming board, and what chipset it has
    #
309
    TSWITCH: for ($hosttype) {
310 311 312 313
	/^emote$/ && do {
	    # Crossbow MIB600CA

	    # The name of the host to communicate with
314
	    push @uisp_args, "-dhost=$host";
315 316
	    # The type of programming board on a emote
	    push @uisp_args, "-dprog=stk500";
317 318 319 320 321 322

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

	    last TSWITCH;
	};
323 324 325
	# XXX - garcia is temporary - hopefully, at some point, we will
	# distinguish the garcia from the stargate that rides on it
	(/^sg/ || /^garcia/) && do {
326 327 328 329 330
	    # Stargate

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

	    # The type of programming board on a stargate
331
	    push @uisp_args, "-dprog=sggpio";
332 333 334 335 336

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

337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
	    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;
	    }

361 362 363
	    last TSWITCH;
	};
	# Default
364 365
	warn "Mote host $host for $mote has unsupported type $hosttype " .
	    "- skipping";
366 367 368 369 370 371 372
	$errors++;
	next MOTE;
    }

    #
    # Find the name of the microcontroller on the board
    #
373
    my ($proc, $speed) = TBNodeTypeProcInfo($motetype);
374
    PSWITCH: for ($proc) {
375 376 377 378 379 380
	/^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";
381 382 383 384 385 386 387 388 389 390 391 392 393 394
	    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 {
395 396
	    #$opstring = "--wr_fuse_e=ff --erase --upload ";
	    $opstring = "--erase --upload ";
397
	    if ($upload_method eq "direct") {
398
		$opstring .= "if=$uploadfile";
399 400 401
	    } elsif ($upload_method eq "ssh") {
		$opstring .= "if=-";
	    }
402 403 404 405 406 407 408 409 410 411 412 413
	    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";
414 415 416 417 418 419 420
    my $commandstr;
    if ($upload_method eq "direct") {
	#
	# We're running uisp directly on this node
	#
	$commandstr = "$UISP " . join(" ",@uisp_args,$opstring);

421
	# Drop root permission, no need for it
422 423 424 425 426 427
	$EUID = $UID;
    } elsif ($upload_method eq "ssh") {
	#
	# We have to ssh into the mote host
	#
	$commandstr = "$SSHTB -host $host $SGUISP " .
428
	    join(" ",@uisp_args,$opstring) . " < $uploadfile";
429 430 431 432 433

	#
	# SSH gets ticked if UID != EUID, so set that now
	#
	$UID = $EUID;
434 435 436 437 438
    } else {
	warn "Unsupported upload method for $mote - skipping";
	$errors++;
	next MOTE;
    }
439 440
    dprint("$commandstr\n");
    if (system($commandstr)) {
441 442
	$errors++;
	warn "Failed to upload code to $mote";
443
    }
444

445 446 447 448
    #
    # Clean up the tempfile
    #
    if ($tmpfile) {
449
        system "rm -f $tmpfile";
450 451
    }

452 453 454
    # XXX - We have to reboot stargates after loading the mote. Disgusting,
    # there should be some better way
    if ($upload_method eq "ssh") {
455
	if (system("$TB/bin/node_reboot $host")) {
456 457 458 459
	    $errors++;
	    warn "Failed to upload code to $mote";
	}
    }
460 461 462 463 464 465 466 467 468 469 470 471 472
}

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

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