libtmcc.pm 24.7 KB
Newer Older
1 2 3
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2011 University of Utah and the Flux Group.
5 6 7 8 9 10 11
# All rights reserved.
#

#
# TMCC library. Provides an interface to the TMCD via a config file
# or directly to it via TCP
#
12 13
# TODO: Proxy path in a jail.
#
14 15 16
package libtmcc;
use Exporter;
@ISA    = "Exporter";
17
@EXPORT = qw(configtmcc tmcc tmccbossname tmccgetconfig tmccclrconfig
18
	     tmcccopycache tmccbossinfo
19
	     TMCCCMD_REBOOT TMCCCMD_STATUS TMCCCMD_STATE TMCCCMD_IFC
Leigh B Stoller's avatar
Leigh B Stoller committed
20
	     TMCCCMD_ACCT TMCCCMD_DELAY TMCCCMD_BRIDGES TMCCCMD_HOSTS TMCCCMD_RPM
21
	     TMCCCMD_TARBALL TMCCCMD_BLOBS TMCCCMD_STARTUP TMCCCMD_STARTSTAT
22 23 24
	     TMCCCMD_READY TMCCCMD_MOUNTS TMCCCMD_ROUTING TMCCCMD_TRAFFIC
	     TMCCCMD_BOSSINFO TMCCCMD_TUNNEL TMCCCMD_NSECONFIGS
	     TMCCCMD_VNODELIST TMCCCMD_SUBNODELIST TMCCCMD_ISALIVE
25
	     TMCCCMD_SFSHOSTID TMCCCMD_JAILCONFIG
26 27
	     TMCCCMD_PLABCONFIG TMCCCMD_SUBCONFIG TMCCCMD_LINKDELAYS
	     TMCCCMD_PROGRAMS TMCCCMD_SYNCSERVER TMCCCMD_KEYHASH TMCCCMD_NODEID
28
	     TMCCCMD_NTPINFO TMCCCMD_NTPDRIFT TMCCCMD_EVENTKEY TMCCCMD_ROUTELIST
29
	     TMCCCMD_ROLE TMCCCMD_RUSAGE TMCCCMD_WATCHDOGINFO TMCCCMD_HOSTKEYS
30
	     TMCCCMD_FIREWALLINFO TMCCCMD_EMULABCONFIG
31
	     TMCCCMD_CREATOR TMCCCMD_HOSTINFO TMCCCMD_LOCALIZATION
32
	     TMCCCMD_BOOTERRNO TMCCCMD_BOOTLOG TMCCCMD_BATTERY TMCCCMD_USERENV
33
	     TMCCCMD_TIPTUNNELS TMCCCMD_TRACEINFO TMCCCMD_ELVINDPORT
34
             TMCCCMD_PLABEVENTKEYS TMCCCMD_PORTREGISTER
35
	     TMCCCMD_MOTELOG TMCCCMD_BOOTWHAT TMCCCMD_ROOTPSWD
36
	     TMCCCMD_LTMAP TMCCCMD_LTPMAP TMCCCMD_TOPOMAP TMCCCMD_LOADINFO
37
	     TMCCCMD_TPMBLOB TMCCCMD_TPMPUB TMCCCMD_DHCPDCONF TMCCCMD_MANIFEST
38
	     TMCCCMD_NODEUUID
39 40 41 42
	     );

# Must come after package declaration!
use English;
43
use Data::Dumper;
44

45 46 47 48 49
#
# Turn off line buffering on output
#
$| = 1;

50 51 52 53 54 55 56 57 58 59 60 61 62
# Load up the paths. Done like this in case init code is needed.
BEGIN
{
    if (! -e "/etc/emulab/paths.pm") {
	die("Yikes! Could not require /etc/emulab/paths.pm!\n");
    }
    require "/etc/emulab/paths.pm";
    import emulabpaths;
}

# The actual TMCC binary.
my $TMCCBIN	= "$BINDIR/tmcc.bin";
my $PROXYDEF    = "$BOOTDIR/proxypath";
63 64
my $CACHEDIR	= "$BOOTDIR";
my $CACHENAME   = "tmcc";
65
my $debug       = 0;
66
my $beproxy     = 0;
67 68 69

#
# Configuration. The importer of this library should set these values
70
# accordingly.
71 72 73 74 75 76
#
%config =
    ( "debug"		=> 0,
      "useudp"		=> 0,
      "beproxy"		=> 0,	# A unix domain path when true.
      "dounix"		=> 0,	# A unix domain path when true.
77
      "beinetproxy"	=> 0,   # A string of the form "ipaddr:port"
78 79 80 81 82
      "server"		=> undef,
      "portnum"		=> undef,
      "version"		=> undef,
      "subnode"		=> undef,
      "keyfile"		=> undef,
83
      "datafile"	=> undef,
84
      "timeout"		=> undef,
85
      "logfile"		=> undef,
86
      "nocache"         => 0,
87
      "clrcache"        => 0,
88
      "noproxy"         => 0,
89
      "nossl"           => 0,
90
      "cachedir"        => undef,
91
      "idkey"           => undef,
92
      "usetpm"          => 0,
93 94
    );

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
# The cache directory is named by the vnodeid. This avoids some confusion.
sub CacheDir()
{
    return "$CACHEDIR/$CACHENAME"
	if (!defined($config{"subnode"}));

    return "$CACHEDIR/$CACHENAME" . "." . $config{"subnode"};
}

# Copy a cachedir. This is for mkjail, which needs to copy the cache
# dir into the jail to avoid another download of the full config.
sub tmcccopycache($$)
{
    my ($vnodeid, $root) = @_;
    my $fromdir = "$CACHEDIR/$CACHENAME" . "." . $vnodeid;
    my $todir   = "$root/$fromdir";

    if (! -d $fromdir) {
	warn("*** WARNING: No such directory $fromdir!\n");
	return -1;
    }
    if (! -d $root) {
	warn("*** WARNING: No such directory $root!\n");
	return -1;
    }
120 121 122 123
    if (-d $todir) {
	system("rm -rf $todir") == 0 ||
	    warn("*** WARNING: Could not remove old cache $todir!\n");
    }
124 125 126
    return system("cp -rp $fromdir $todir");
}

127 128 129 130 131
#
# List of TMCD commands. Some of these have to be passed through to
# tmcd, others can come from a local config file if it exists.
#
my %commandset =
132 133 134 135
    ( "reboot"		=> {TAG => "reboot"},
      "status"		=> {TAG => "status"},
      "state"		=> {TAG => "state"},
      "ifconfig"	=> {TAG => "ifconfig"},
136
      "accounts"	=> {TAG => "accounts"},
137
      "delay"		=> {TAG => "delay"},
Leigh B Stoller's avatar
Leigh B Stoller committed
138
      "bridges"		=> {TAG => "bridges"},
139 140 141
      "hostnames"	=> {TAG => "hostnames"},
      "rpms"		=> {TAG => "rpms"},
      "tarballs"	=> {TAG => "tarballs"},
142
      "blobs"		=> {TAG => "blobs"},
143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
      "startupcmd"	=> {TAG => "startupcmd"},
      "startstatus"	=> {TAG => "startstatus"},
      "ready"		=> {TAG => "ready"},
      "mounts"		=> {TAG => "mounts"},
      "routing"		=> {TAG => "routing"},
      "trafgens"	=> {TAG => "trafgens"},
      "bossinfo"	=> {TAG => "bossinfo"},
      "tunnels"		=> {TAG => "tunnels"},
      "nseconfigs"	=> {TAG => "nseconfigs"},
      "vnodelist"	=> {TAG => "vnodelist"},
      "subnodelist"	=> {TAG => "subnodelist"},
      "isalive"		=> {TAG => "isalive"},
      "sfshostid"	=> {TAG => "sfshostid"},
      "jailconfig"	=> {TAG => "jailconfig"},
      "plabconfig"	=> {TAG => "plabconfig"},
      "subconfig"	=> {TAG => "subconfig"},
      "linkdelay"	=> {TAG => "linkdelay"},
      "programs"	=> {TAG => "programs"},
      "syncserver"	=> {TAG => "syncserver"},
      "keyhash"		=> {TAG => "keyhash"},
      "nodeid"		=> {TAG => "nodeid"},
164
      "ipodinfo"	=> {TAG => "ipodinfo", PERM => "0600"},
165
      "ntpinfo"		=> {TAG => "ntpinfo"},
166
      "ntpdrift"	=> {TAG => "ntpdrift"},
167
      "sdparams"	=> {TAG => "sdparams"},
168
      "eventkey"	=> {TAG => "eventkey"},
169 170
      "routelist"	=> {TAG => "routelist"},
      "role"		=> {TAG => "role"},
171
      "rusage"		=> {TAG => "rusage"},
Mike Hibler's avatar
Mike Hibler committed
172
      "watchdoginfo"	=> {TAG => "watchdoginfo"},
173
      "hostkeys"	=> {TAG => "hostkeys"},
174
      "firewallinfo"	=> {TAG => "firewallinfo"},
175 176
      "emulabconfig"	=> {TAG => "emulabconfig"},
      "creator"		=> {TAG => "creator"},
177
      "hostinfo"	=> {TAG => "hostinfo"},
178
      "localization"	=> {TAG => "localization"},
179 180
      "booterrno"	=> {TAG => "booterrno"},
      "bootlog"	        => {TAG => "bootlog"},
181
      "battery"	        => {TAG => "battery"},
182
      "userenv"	        => {TAG => "userenv"},
183
      "tiptunnels"      => {TAG => "tiptunnels"},
184
      "traceinfo"       => {TAG => "traceinfo"},
185
      "elvindport"      => {TAG => "elvindport"},
186
      "plabeventkeys"   => {TAG => "plabeventkeys"},
187
      "motelog"         => {TAG => "motelog"},
188
      "portregister"    => {TAG => "portregister"},
189
      "bootwhat"        => {TAG => "bootwhat"},
190
      "rootpswd"        => {TAG => "rootpswd"},
191 192 193
      "topomap"	        => {TAG => "topomap"},
      "ltmap"	        => {TAG => "ltmap"},
      "ltpmap"	        => {TAG => "ltpmap"},
194 195
      "tpmblob"      	=> {TAG => "tpmblob"},
      "tpmpubkey"       => {TAG => "tpmpubkey"},
196
      "loadinfo"        => {TAG => "loadinfo"},
197
      "dhcpdconf"       => {TAG => "dhcpdconf"},
198
      "manifest"        => {TAG => "manifest"},
199
      "nodeuuid"	=> {TAG => "nodeuuid"},
200 201 202 203 204 205 206 207 208 209 210
    );

#
# These are the TMCC commands for the user. They are exported above.
#
sub TMCCCMD_REBOOT()	{ $commandset{"reboot"}->{TAG}; }
sub TMCCCMD_STATUS()	{ $commandset{"status"}->{TAG}; }
sub TMCCCMD_STATE()	{ $commandset{"state"}->{TAG}; }
sub TMCCCMD_IFC()	{ $commandset{"ifconfig"}->{TAG}; }
sub TMCCCMD_ACCT()	{ $commandset{"accounts"}->{TAG}; }
sub TMCCCMD_DELAY()	{ $commandset{"delay"}->{TAG}; }
Leigh B Stoller's avatar
Leigh B Stoller committed
211
sub TMCCCMD_BRIDGES()	{ $commandset{"bridges"}->{TAG}; }
212 213 214
sub TMCCCMD_HOSTS()	{ $commandset{"hostnames"}->{TAG}; }
sub TMCCCMD_RPM()	{ $commandset{"rpms"}->{TAG}; }
sub TMCCCMD_TARBALL()	{ $commandset{"tarballs"}->{TAG}; }
215
sub TMCCCMD_BLOBS()	{ $commandset{"blobs"}->{TAG}; }
216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231
sub TMCCCMD_STARTUP()	{ $commandset{"startupcmd"}->{TAG}; }
sub TMCCCMD_STARTSTAT()	{ $commandset{"startstatus"}->{TAG}; }
sub TMCCCMD_READY()	{ $commandset{"ready"}->{TAG}; }
sub TMCCCMD_MOUNTS()	{ $commandset{"mounts"}->{TAG}; }
sub TMCCCMD_ROUTING()	{ $commandset{"routing"}->{TAG}; }
sub TMCCCMD_TRAFFIC()	{ $commandset{"trafgens"}->{TAG}; }
sub TMCCCMD_BOSSINFO()	{ $commandset{"bossinfo"}->{TAG}; }
sub TMCCCMD_TUNNEL()	{ $commandset{"tunnels"}->{TAG}; }
sub TMCCCMD_NSECONFIGS(){ $commandset{"nseconfigs"}->{TAG}; }
sub TMCCCMD_VNODELIST() { $commandset{"vnodelist"}->{TAG}; }
sub TMCCCMD_SUBNODELIST(){ $commandset{"subnodelist"}->{TAG}; }
sub TMCCCMD_ISALIVE()   { $commandset{"isalive"}->{TAG}; }
sub TMCCCMD_SFSHOSTID()	{ $commandset{"sfshostid"}->{TAG}; }
sub TMCCCMD_JAILCONFIG(){ $commandset{"jailconfig"}->{TAG}; }
sub TMCCCMD_PLABCONFIG(){ $commandset{"plabconfig"}->{TAG}; }
sub TMCCCMD_SUBCONFIG() { $commandset{"subconfig"}->{TAG}; }
232
sub TMCCCMD_LINKDELAYS(){ $commandset{"linkdelay"}->{TAG}; }
233 234 235 236 237 238
sub TMCCCMD_PROGRAMS()  { $commandset{"programs"}->{TAG}; }
sub TMCCCMD_SYNCSERVER(){ $commandset{"syncserver"}->{TAG}; }
sub TMCCCMD_KEYHASH()   { $commandset{"keyhash"}->{TAG}; }
sub TMCCCMD_NODEID()    { $commandset{"nodeid"}->{TAG}; }
sub TMCCCMD_NTPINFO()   { $commandset{"ntpinfo"}->{TAG}; }
sub TMCCCMD_NTPDRIFT()  { $commandset{"ntpdrift"}->{TAG}; }
239
sub TMCCCMD_EVENTKEY()  { $commandset{"eventkey"}->{TAG}; }
240 241
sub TMCCCMD_ROUTELIST()	{ $commandset{"routelist"}->{TAG}; }
sub TMCCCMD_ROLE()	{ $commandset{"role"}->{TAG}; }
242
sub TMCCCMD_RUSAGE()	{ $commandset{"rusage"}->{TAG}; }
Mike Hibler's avatar
Mike Hibler committed
243
sub TMCCCMD_WATCHDOGINFO(){ $commandset{"watchdoginfo"}->{TAG}; }
244
sub TMCCCMD_HOSTKEYS()  { $commandset{"hostkeys"}->{TAG}; }
245
sub TMCCCMD_FIREWALLINFO(){ $commandset{"firewallinfo"}->{TAG}; }
246 247
sub TMCCCMD_EMULABCONFIG(){ $commandset{"emulabconfig"}->{TAG}; }
sub TMCCCMD_CREATOR     (){ $commandset{"creator"}->{TAG}; }
248
sub TMCCCMD_HOSTINFO    (){ $commandset{"hostinfo"}->{TAG}; }
249
sub TMCCCMD_LOCALIZATION(){ $commandset{"localization"}->{TAG}; }
250 251
sub TMCCCMD_BOOTERRNO   (){ $commandset{"booterrno"}->{TAG}; }
sub TMCCCMD_BOOTLOG     (){ $commandset{"bootlog"}->{TAG}; }
252
sub TMCCCMD_BATTERY     (){ $commandset{"battery"}->{TAG}; }
253
sub TMCCCMD_USERENV     (){ $commandset{"userenv"}->{TAG}; }
254
sub TMCCCMD_TIPTUNNELS  (){ $commandset{"tiptunnels"}->{TAG}; }
255
sub TMCCCMD_TRACEINFO   (){ $commandset{"traceinfo"}->{TAG}; }
256
sub TMCCCMD_ELVINDPORT  (){ $commandset{"elvindport"}->{TAG}; }
257
sub TMCCCMD_PLABEVENTKEYS(){ $commandset{"plabeventkeys"}->{TAG}; }
258
sub TMCCCMD_MOTELOG()   { $commandset{"motelog"}->{TAG}; }
259 260
sub TMCCCMD_PORTREGISTER(){ $commandset{"portregister"}->{TAG}; }
sub TMCCCMD_BOOTWHAT()  { $commandset{"bootwhat"}->{TAG}; }
261
sub TMCCCMD_ROOTPSWD()  { $commandset{"rootpswd"}->{TAG}; }
262 263 264
sub TMCCCMD_TOPOMAP(){ $commandset{"topomap"}->{TAG}; }
sub TMCCCMD_LTMAP()  { $commandset{"ltmap"}->{TAG}; }
sub TMCCCMD_LTPMAP()  { $commandset{"ltpmap"}->{TAG}; }
265 266
sub TMCCCMD_TPMBLOB()  { $commandset{"tpmblob"}->{TAG}; }
sub TMCCCMD_TPMPUB()  { $commandset{"tpmpubkey"}->{TAG}; }
267
sub TMCCCMD_LOADINFO()  { $commandset{"loadinfo"}->{TAG}; }
268
sub TMCCCMD_DHCPDCONF()  { $commandset{"dhcpdconf"}->{TAG}; }
269
sub TMCCCMD_MANIFEST()  { $commandset{"manifest"}->{TAG}; }
270
sub TMCCCMD_NODEUUID()    { $commandset{"nodeuuid"}->{TAG}; }
271 272 273

#
# Caller uses this routine to set configuration of this library
274
#
275 276 277 278 279 280 281 282 283
sub configtmcc($$)
{
    my ($opt, $val) = @_;

    if (!exists($config{$opt})) {
	print STDERR "*** $0:\n".
	             "    Invalid libtmcc option: $opt/$val\n";
	return -1;
    }
284 285 286 287 288 289
    if ($opt eq "cachedir") {
	$CACHEDIR = $val;
    }
    elsif ($opt eq "server") {
	$ENV{'BOSSNAME'} = $val;
    }
290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309
    $config{$opt} = $val;
}

#
# Convert the config hash to an option string. This is separate so that
# the user can provide their own option hash on a single tmcc call, which
# *augments* the global options. First argument is a string to augment.
# Returns the augmented string.
#
sub optionstring($%)
{
    my ($options, %opthash) = @_;

    if ($opthash{"debug"}) {
	$options .= " -d";
	$debug    = 1;
    }
    if ($opthash{"useudp"}) {
	$options .= " -u";
    }
310 311 312
    if ($opthash{"nossl"}) {
	$options .= " -i";
    }
313 314 315
    if ($opthash{"usetpm"}) {
	$options .= " -T";
    }
316 317
    if ($opthash{"beproxy"}) {
	$options .= " -x " . $opthash{"beproxy"};
318
	$beproxy  = 1;
319 320 321 322
    }
    if ($opthash{"dounix"}) {
	$options .= " -l " . $opthash{"dounix"};
    }
323 324 325 326
    if ($opthash{"beinetproxy"}) {
	$options .= " -X " . $opthash{"beinetproxy"};
	$beproxy  = 1;
    }
327 328 329
    if (defined($opthash{"server"})) {
	$options .= " -s " . $opthash{"server"};
    }
330 331 332
    if (defined($opthash{"subnode"})) {
	$options .= " -n " . $opthash{"subnode"};
    }
333 334 335 336 337 338 339 340 341
    if (defined($opthash{"portnum"})) {
	$options .= " -p " . $opthash{"portnum"};
    }
    if (defined($opthash{"version"})) {
	$options .= " -v " . $opthash{"version"};
    }
    if (defined($opthash{"keyfile"})) {
	$options .= " -k " . $opthash{"keyfile"};
    }
342 343 344
    if (defined($opthash{"datafile"})) {
	$options .= " -f " . $opthash{"datafile"};
    }
345 346 347
    if (defined($opthash{"timeout"})) {
	$options .= " -t " . $opthash{"timeout"};
    }
348 349 350
    if (defined($opthash{"logfile"})) {
	$options .= " -o " . $opthash{"logfile"};
    }
351 352 353 354 355 356 357 358 359 360 361 362 363
    return $options;
}

#
# Run the external tmcc program with the proper arguments.
#
# usage: tmcc(char *command, char *arguments, list \$results, hash %options)
#        returns -1 if tmcc fails for any reason.
#        returns  0 if tmcc succeeds.
#
# If a "results" argument (pass by reference) has been provided, then
# take the results of tmcc, and store a list of strings into it.
# If an options hash is passed, use that to extend the global config options.
364
#
365 366 367 368 369 370 371 372 373 374
sub runtmcc ($;$$%)
{
    my ($cmd, $args, $results, %optconfig) = @_;
    my @strings = ();
    my $options;

    $options = optionstring("", %config);
    $options = optionstring($options, %optconfig)
	if (%optconfig);

375
    # Must be last option, before command
376 377
    if (defined($config{"idkey"})) {
	$options .= " IDKEY=" . $config{"idkey"};
378 379
    }

380 381 382 383 384 385 386 387
    if (!defined($args)) {
	$args = "";
    }
    my $string = "$TMCCBIN $options $cmd $args";
    if ($debug) {
	print STDERR "$string\n";
    }

388
    #
389
    # Special case. If a proxy option is given, exec and forget.
390 391 392 393 394
    #
    if ($beproxy) {
	exec($string);
	die("exec failure: $string\n");
    }
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 420 421 422 423
    if (!open(TM, "$string |")) {
	print STDERR "Cannot start TMCC: $!\n";
	return -1;
    }
    while (<TM>) {
	push(@strings, $_);
    }
    if (! close(TM)) {
	if ($?) {
	    print STDERR "TMCC exited with status $?!\n";
	}
	else {
	    print STDERR "Error closing TMCC pipe: $!\n";
	}
	return -1;
    }
    @$results = @strings
	if (defined($results));
    return 0;
}

#
# Standard entrypoint that is intended to behave just like the
# external program. Return -1 on failure, 0 on success.
#
sub tmcc ($;$$%)
{
    my ($cmd, $args, $results, %opthash) = @_;

424 425 426 427 428 429 430
    #
    # Clear cache first if requested.
    #
    if ($config{"clrcache"}) {
	tmccgetconfig();
    }

431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446
    #
    # Allow per-command setting of nocache and noproxy
    #
    my $nocache;
    if (defined($opthash{"nocache"})) {
	$nocache = $opthash{"nocache"};
    } else {
	$nocache = $config{"nocache"};
    }
    my $noproxy;
    if (defined($opthash{"noproxy"})) {
	$noproxy = $opthash{"noproxy"};
    } else {
	$noproxy = $config{"noproxy"};
    }

447
    #
448
    # See if this is a cmd we can get from the local config stash.
449
    #
450
    if (!$nocache && (!defined($args) || $args eq "")) {
451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466
	foreach my $key (keys(%commandset)) {
	    my $tag = $commandset{$key}->{TAG};

	    if ($cmd eq $tag) {
		#
		# If we can get it, great! Otherwise go to tmcd.
		#
		my $filename = CacheDir() . "/$tag";
		my @strings  = ();

		if (-e $filename && open(TD, $filename)) {
		    #
		    # Read file contents and return
		    #
		    print STDERR "Fetching locally from $filename\n"
			if ($debug);
467

468 469 470 471 472 473 474 475 476 477 478 479 480 481 482
		    while (<TD>) {
			next
			    if ($_ =~ /^\*\*\* $tag$/);

			push(@strings, $_);
		    }
		    @$results = @strings
			if (defined($results));
		    return 0;
		}
		last;
	    }
	}
    }

483
    #
484 485
    # If proxypath was not specified, check for a proxypath file,
    # unless they explicilty specified not to use a proxy.
486
    #
487
    if (!$config{"dounix"} && !$noproxy && -e $PROXYDEF) {
488
	#
489 490
	# Suck out the path and untaint.
	#
491 492 493 494 495
	open(PP, "$BOOTDIR/proxypath");
	my $ppath = <PP>;
	close(PP);

	if ($ppath =~ /^([-\w\.\/]+)$/) {
496
	    $config{"dounix"} = $1;
497 498 499 500 501 502 503 504 505 506 507 508 509 510 511
	}
	else {
	    die("Bad data in tmccproxy path: $ppath");
	}
    }
    return(runtmcc($cmd, $args, $results, %opthash));
}

#
# This is done very often! It should always work since we figure it out
# locally, so return the info directly.
#
sub tmccbossname()
{
    my @tmccresults;
Leigh B Stoller's avatar
Leigh B Stoller committed
512
    my $bossname;
513

Leigh B Stoller's avatar
Leigh B Stoller committed
514 515 516 517
    if (exists($ENV{'BOSSNAME'})) {
	$bossname = $ENV{'BOSSNAME'};
    }
    elsif (runtmcc(TMCCCMD_BOSSINFO, undef, \@tmccresults) < 0 ||
518 519 520 521
	!scalar(@tmccresults)) {
	warn("*** WARNING: Could not get bossinfo from tmcc!\n");
	return undef;
    }
Leigh B Stoller's avatar
Leigh B Stoller committed
522 523 524
    else {
	($bossname) = split(" ", $tmccresults[0]);
    }
525 526 527 528 529 530 531 532 533 534 535 536 537 538

    #
    # Taint check. Nice to do for the caller. Also strips any newline.
    #
    if ($bossname =~ /^([-\w\.]*)$/) {
	$bossname = $1;
    }
    else {
	warn("*** WARNING: Tainted bossname from tmcc: $bossname\n");
	return undef;
    }
    return $bossname;
}

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
#
# Ditto, but return both parts of the info.
#
sub tmccbossinfo()
{
    my @tmccresults;

    if (runtmcc(TMCCCMD_BOSSINFO, undef, \@tmccresults) < 0 ||
	!scalar(@tmccresults)) {
	warn("*** WARNING: Could not get bossinfo from tmcc!\n");
	return undef;
    }
    my ($bossname, $bossip) = split(" ", $tmccresults[0]);

    #
    # Taint check. Nice to do for the caller. Also strips any newline.
    #
    if ($bossname =~ /^([-\w\.]*)$/) {
	$bossname = $1;
    }
    else {
	warn("*** WARNING: Tainted bossname from tmcc: $bossname\n");
	return undef;
    }
    if ($bossip =~ /^([\d\.]*)$/) {
	$bossip = $1;
    }
    else {
	warn("*** WARNING: Tainted boss IP from tmcc: $bossip\n");
	return undef;
    }
    return ($bossname, $bossip);
}

573 574 575 576 577 578
#
# Special entrypoint to clear the current config cache (say, at reboot).
#
sub tmccclrconfig()
{
    my $dir = CacheDir();
579

580 581 582 583 584 585 586 587 588 589 590 591 592 593
    if (-d $dir) {
	system("rm -rf $dir");
    }
}

#
# Special entrypoint to download the entire configuration and cache for
# subsequent calls.
#
sub tmccgetconfig()
{
    my @tmccresults;
    my $cdir = CacheDir();

594 595
    my $noproxy = $config{"noproxy"};

596
    #
597
    # Check for proxypath file, but do not override config option.
598
    #
599
    if (!$config{"dounix"} && !$noproxy && -e $PROXYDEF) {
600
	#
601 602
	# Suck out the path and untaint.
	#
603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619
	open(PP, "$BOOTDIR/proxypath");
	my $ppath = <PP>;
	close(PP);

	if ($ppath =~ /^([-\w\.\/]+)$/) {
	    $config{"dounix"} = $1;
	}
	else {
	    die("Bad data in tmccproxy path: $ppath");
	}
    }

    tmccclrconfig();
    if (!mkdir("$cdir", 0775)) {
	warn("*** WARNING: Could not mkdir $cdir: $!\n");
	return -1;
    }
620

621
    # XXX  Can't "use libsetup" in libtmcc to reference the WINDOWS() function.
Russ Fish's avatar
Russ Fish committed
622
    my $arg = (-e "$ETCDIR/iscygwin") ? "windows" : undef;
623
    if (runtmcc("fullconfig", $arg, \@tmccresults) < 0 ||
624 625 626 627 628 629 630 631 632
	!scalar(@tmccresults)) {
	warn("*** WARNING: Could not get fullconfig from tmcd!\n");
	return -1;
    }

    my $str;
    while ($str = shift(@tmccresults)) {
	if ($str =~ /^\*\*\* ([-\w]*)$/) {
	    my $param = $1;
633

634
	    if (open(TD, "> $cdir/$param")) {
635 636 637 638 639 640 641 642 643 644 645 646 647 648
		#
		# Set the permission on the file first if necessary
		# XXX the commandset hash is odd
		#
		foreach my $key (keys(%commandset)) {
		    my $tag = $commandset{$key}->{TAG};
		    if ($param eq $tag) {
			if (defined($commandset{$key}->{PERM})) {
			    chmod(oct($commandset{$key}->{PERM}),
				  "$cdir/$param");
			}
			last;
		    }
		}
649 650
		while (@tmccresults) {
		    $str = shift(@tmccresults);
651

652 653 654 655 656 657 658 659 660 661 662 663 664 665 666
		    last
			if ($str =~ /^\*\*\* $param$/);
		    print TD $str;
		}
		close(TD);
	    }
	    else {
		warn("*** WARNING: Could not create $cdir/$str: $!\n");
		return -1;
	    }
	}
    }
    return 0;
}

667 668 669 670
# 
package libtmcc::blob;

my $NICKNAMEFILE = "$BOOTDIR/nickname";
671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714
my $KEYHASHFILE = "$BOOTDIR/keyhash";

##
## This method returns the keyhash that other things (i.e., fetching blobs after
## a call to getmanifest returns) depend on.  And since getmanifest is called
## first, we need the keyhash quick.  So we steal this method from rc.keys.
##

#
# Get the hashkey
# 
sub dokeyhash()
{
    my $keyhash;
    my @tmccresults;

    if (libtmcc::tmcc(libtmcc::TMCCCMD_KEYHASH, undef, \@tmccresults) < 0) {
	fatal("Could not get keyhash from server!");
    }
    unlink $KEYHASHFILE;
    return 0
	if (! @tmccresults);

    #
    # There should be just one string. Ignore anything else.
    #
    if ($tmccresults[0] =~ /KEYHASH HASH=\'([\w]*)\'/) {
	$keyhash = $1;
    }
    else {
	fatal("Bad keyhash line: $tmccresults[0]");
    }

    #
    # Write a file so the node knows the key.
    #
    my $oldumask = umask(0222);
    
    if (system("echo '$keyhash' > ". $KEYHASHFILE)) {
	fatal("Could not write " . $KEYHASHFILE);
    }
    umask($oldumask);
    return 0;
}
715 716 717 718 719 720 721 722 723 724 725

# Load up the paths. Done like this in case init code is needed.
BEGIN
{
    if (! -e "/etc/emulab/paths.pm") {
	die("Yikes! Could not require /etc/emulab/paths.pm!\n");
    }
    require "/etc/emulab/paths.pm";
    import emulabpaths;
}

726 727
sub hash($) {
    my ($struct) = @_;
728

729
    return $struct->{'hash'} if defined( $struct->{'hash'} );
730

731
    return undef unless defined( $struct->{'existing'} );
732 733 734 735

    my $digest = Digest::SHA1->new;
    my $hex;

736
    $digest->addfile( $struct->{'existing'} );
737 738 739

    $hash = $digest->hexdigest;

740
    print "Computed hash $struct->{hash}\n" if( $debug );
741 742 743 744

    return $hash;
}

745 746
sub http_common($$) {
    my ($struct,$prefix) = @_;
747

748
    my $cachedhash = hash($struct);
749

750 751
    my $URL = $prefix . "://" . $struct->{'server'} . "/blob/read/" . 
	$struct->{'key'} . "/" . $struct->{'blobid'};
752 753 754 755 756 757 758

    print "Attempting to retrieve $URL\n" if( $debug );

    $URL .= "?hash=" . $cachedhash if( defined( $cachedhash ) );

    my $ua = LWP::UserAgent->new;
    my $request = HTTP::Request->new( GET => $URL );
759 760 761 762 763 764 765 766 767 768 769 770

    # setup a callback
    my $callback = sub {
	my $cstruct = $struct;
	my ($chunk, $response, $protocol) = @_;

	print { $cstruct->{'output'} } $chunk;

	# FIXME would be nice to hash as we go
    };

    my $response = $ua->request( $request, $callback );
771 772 773 774

    if( $response->code == 304 ) { # Not modified
	print "Cached copy is current.\n" if( $debug );

775
	unlink( $struct->{'tempfilename'} ) if( exists( $struct->{'tempfilename'} ) );
776

777 778
	close ( $struct->{'output'} );
	return 1;
779 780 781 782 783
    }

    if( $response->is_success ) {
	print "Retrieved successfully.\n" if( $debug );

784 785 786
	if( exists( $struct->{'tempfilename'} ) ) {
	    rename( $struct->{'tempfilename'}, $struct->{'finalfilename'} )
		or die( "$struct->{finalfilename}: $!" );
787 788
	}

789 790
	close ( $struct->{'output'} );
	return 0;
791 792 793 794
    }

    print $response->status_line . "\n" if( $debug );

795
    return -1;
796 797
}

798 799 800
sub http($) {
    http_common( $_[0],"http" );
}
801

802 803
sub https($) {
    http_common( $_[0],"https" );
804 805
}

806 807 808 809 810
sub getblob($$;\@$) {
    my ($blobid,$outputfilename,$transport,$options) = @_;
    if (!defined($transport)) {
	$transport = [ 'https','http' ];
    }
811

812 813 814 815 816 817
    #
    # Build a struct so we're reentrant.
    #
    my %struct = ( 'blobid' => $blobid,
		   'outputfilename' => $outputfilename
	);
818 819 820 821 822 823 824

    $debug = 1 if( $options ); # the only option right now
    require Digest::SHA1;
    require LWP::UserAgent;

    open NICKNAME, $NICKNAMEFILE or die "$NICKNAMEFILE: $!";
    <NICKNAME> =~ /.+[.].+[.](.+)/;
825 826
    my $project = $1;
    $struct{'project'} = $project;
827 828
    close NICKNAME;
    
829 830 831 832 833 834
    #
    # We need the keyhash for any blobs we grab!
    #
    if (! -e $KEYHASHFILE) {
	dokeyhash();
    }
835
    open KEYHASH, $KEYHASHFILE or die "$KEYHASHFILE: $!";
836
    <KEYHASH> =~ /^([-\w\d]+)$/;
837 838
    my $key = $1;
    $struct{'key'} = $key;
839 840
    close KEYHASH;
    
841
    (undef,$struct{'server'}) = libtmcc::tmccbossinfo();
842
    
843 844 845 846 847 848 849 850 851
    if( $debug ) {
        $, = " ";
        print "Blob ID: $blobid\n";
        print "Key: $key\n";
        print "Output: " .
    	( $outputfilename ? $outputfilename : "(standard output)" ) . "\n";
        print "Project: $project\n";
        print "Transports: @$transport\n";
    }
852 853

    my $tempfilename;
854
    if( defined( $outputfilename ) ) {
855 856 857
        $tempfilename = $outputfilename . ".$$";
	$struct{'finalfilename'} = $outputfilename;
	$struct{'tempfilename'} = $tempfilename;
858 859
    
        open( OUTPUT, $outputfilename )
860
	and $struct{'existing'} = *OUTPUT{IO};
861
        
862 863 864 865
        if (!open( TEMP, ">$tempfilename" )) {
	    print STDERR "ERROR(getblob): $tempfilename: $!\n";
	    return -1;
	}
866
    
867 868
        $struct{'output'} = *TEMP{IO};
        $struct{'canhash'} = 1;
869
    } else {
870 871
        $struct{'output'} = *STDOUT{IO};
        $struct{'canhash'} = 0;
872 873
    }
    
874 875 876
    my $retval = 0;
    foreach my $t ( @$transport ) {
        print "Attempting transport $t...\n" if( $debug );
877
    
878 879 880 881
        if( $t =~ /^http$/i ) {
	    $retval = http(\%struct);
        } elsif( $t =~ /^https$/i ) {
	    $retval = https(\%struct);
882
        } else {
883 884 885
	    $retval = -1;
	    print STDERR "ERROR(getblob): unknown transport $t\n";
	    next;
886
        }
887 888 889 890 891 892 893 894 895

	if ($retval == 1 || $retval == 0) {
	    # success!
	    unlink( $tempfilename ) if( defined( $tempfilename ) );
	    return 0;
	}
	else {
	    print STDERR "ERROR(getblob): transport $t failed!\n";
	}
896 897
    }
    
898 899
    # nothing worked.
    print STDERR "ERROR(getblob): failed to retrieve blob $blobid\n";
900 901 902
    
    unlink( $tempfilename ) if( defined( $tempfilename ) );

903
    return -1;
904 905
}

906 907
1;