tarfiles_setup.in 8.16 KB
Newer Older
1 2 3 4
#!/usr/bin/perl -w

#
# EMULAB-COPYRIGHT
5
# Copyright (c) 2003-2008 University of Utah and the Flux Group.
6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
# All rights reserved.
#

use English;
use Getopt::Std;
use Socket;
    
#
# Fetch all tarball(s) (and RPM(s)) for an experiment. Since we don't want to
# give users the chance to exploit bugs or features used in the program to do
# the fetching, we ssh over to ops to do the actual fetching.
# 
# As a side-effect, copies the contents of the tarfiles and rpms fields from
# virt_nodes to the nodes table. Any fetched tarballs (or RPMs) are entered
# into the nodes table as the location on local disk they were fetched to.
#
# Should be run _after_ the experiment has begun swapin - ie. when the
# virt_nodes have already been assigned to physical nodes.
#

sub usage()
{
28
    print "Usage: $0 pid eid\n";
29 30 31 32
 
    exit(-1);
}

33 34 35 36 37
#
# Functions
#
sub verifyURL($);

38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
#
# Configure variables
#
my $TB       = "@prefix@";
my $TBOPS    = "@TBOPSEMAIL@";
my $CONTROL  = "@USERNODE@";
my $TESTMODE = @TESTMODE@;

my $SAVEUID  = $UID;
my $MD5      = "/sbin/md5";

#
# Turn off line buffering on output
#
$| = 1;

#
# Untaint the path
# 
$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/sbin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

if ($TESTMODE) {
    # In testmode, drop privs (my devel tree at home is TESTMODE=1)
    $EUID = $UID;
}
elsif ($EUID != 0) {
    # We don't want to run this script unless its the real version.
66
    die("Must be root! Maybe its a development version?");
67 68 69 70 71
}

# This script is setuid, so please do not run it as root. Hard to track
# what has happened.
if ($UID == 0) {
72
    die("Please do not run this as root! Its already setuid!");
73 74 75 76 77 78 79 80
}

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libtestbed;
use libdb;
81
use libtblog;
82 83
use Template;
use libArchive;
84 85
use Experiment;
use User;
86 87 88 89 90 91

if (@ARGV != 2) {
    usage();
}
my ($pid, $eid) = @ARGV;

92 93
my %tofetch   = ();
my %toarchive = ();
94 95

#
96 97 98 99 100
# Verify user and get his DB uid and other info for later.
#
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    tbdie("You ($UID) do not exist!");
101
}
102 103
my $user_uid   = $this_user->uid();

104 105 106
#
# First, make sure the experiment exists
#
107 108
my $experiment = Experiment->Lookup($pid, $eid);
if (! $experiment) {
109
    tbdie("There is no experiment $eid in project $pid");
110 111 112 113 114
}

#
# User must have at least MODIFY permissions to use this script
#
115
if (!$experiment->AccessCheck($this_user, TB_EXPT_MODIFY())) {
116
    tbdie("You are not allowed to modify experiment $eid in project $pid");
117 118 119
}

#
120
# Get the experiment's directory - that's where we'll stash any files we
121 122
# fetch
#
123 124
my $expdir  = $experiment->UserDir();
my $exptidx = $experiment->idx();
125

126 127 128
#
# Get a list of all RPMs and tarballs to fetch
#
129
my $result = $experiment->TableLookUp("virt_nodes", "vname,rpms,tarfiles");
130 131 132 133 134

while (my ($vname, $rpms, $tarfiles) = $result->fetchrow()) {
    #
    # Find out the pnode where the this vnode is mapped, if any
    #
135
    my $physnode = $experiment->VnameToNode($vname);
136 137 138 139
    
    # The if block below is needed for simulated nodes which do not
    # have a reserved table entry. A tarfile specified for a simulated
    # node ends up on its host PC
140 141
    if (! defined($physnode)) {
	$physnode = $experiment->VnameToPmap($vname);
142
    }
143 144 145 146
    $rpms = ""
	if (!defined($rpms));
    $tarfiles = ""
	if (!defined($tarfiles));
147 148 149 150 151

    #
    # Go through the list of RPMs looking for files to fetch
    #
    foreach my $rpm (split(";", $rpms)) {
152
	if ($rpm =~ /^(http|https|ftp)/) {
153 154 155 156 157
	    #
	    # Veryify that they gave us a legal URL
	    #
	    my $URL = verifyURL($rpm);
	    if (!$URL) {
158
		tbdie("Invalid RPM URL given: $rpm");
159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177
	    }

	    #
	    # Build up a local filename using an MD5 hash of the URL, so that
	    # we can uniquely identify it, but don't have to worry about
	    # putting funny characters in filenames.
	    # 
	    my $md5 = `$MD5 -q -s '$URL'`;
	    chomp $md5;
	    # Have to untaint the hash
	    $md5 =~ /^(\w+)$/;
	    $md5 = $1;
	    my $localfile = $expdir . "/" . $md5 . ".rpm";

	    #
	    # Remember this RPM and put the local filename in the string that
	    # will be uploaded to the nodes table
	    #
	    $tofetch{$URL} = $localfile;
178
	    $toarchive{$localfile} = $localfile;
179 180
	    $rpms =~ s/$URL/$localfile/g;
	}
181 182 183 184 185 186 187 188 189
	elsif ($rpm =~ /^xxx:\/\/(.*)$/) {
	    #
	    # XXX (well, what else did you expect!). This is a template
	    # "url" that refers to a file in the template datastore tree.
	    #
	    my $instance = Template::Instance->LookupByExptidx($exptidx);
	    if (!defined($instance)) {
		tbdie("Invalid RPM URL for non-template experiment: $rpm");
	    }
Leigh Stoller's avatar
Leigh Stoller committed
190
	    my $localfile = $instance->path() . "/datastore/" . $1;
191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206

	    tbdie("$rpm cannot be found; $localfile does not exist")
		if (! -e $localfile);

	    # no need to archive these since they are saved in the template
	    $rpms =~ s/$rpm/$localfile/g;
	}
	else {
	    #
	    # Should be a regular path.
	    #
	    tbdie("$rpm cannot be found; local file does not exist")
		if (! -e $rpm);

	    $toarchive{$rpm} = $rpm;
	}
207 208 209 210 211 212 213
    }
    
    #
    # Same as above, for tarballs
    #
    foreach my $tar (split(";", $tarfiles)) {
	my ($dir,$tarfile) = split(" ",$tar);
214
	if ($tarfile =~ /^(http|https|ftp)/) {
215 216
	    my $URL = verifyURL($tarfile);
	    if (!$URL) {
217
		tbdie("Invalid tarball URL given: $tarfile");
218 219 220 221 222
	    }
	    my $md5 = `md5 -q -s '$URL'`;
	    chomp $md5;
	    $md5 =~ /^(\w+)$/;
	    $md5 = $1;
223 224 225 226 227 228
	    my $ext = $tarfile;
	    # Need to copy the extension from the URL to the file name so
	    # install-tarfile can figure out how to decompress it.
	    $ext =~ /(\.tar|\.tar\.Z|\.tar\.gz|\.tgz|\.tar\.bz2)$/;
	    $ext = $1;
	    my $localfile = $expdir . "/" . $md5 . $ext;
229
	    $toarchive{$localfile} = $localfile;
230 231 232
	    $tofetch{$URL} = $localfile;
	    $tarfiles =~ s/$URL/$localfile/g;
	}
233 234 235 236 237 238 239 240 241 242
	elsif ($tarfile =~ /^xxx:\/\/(.*)$/) {
	    #
	    # XXX (well, what else did you expect!). This is a template
	    # "url" that refers to a file in the template datastore tree.
	    #
	    my $instance = Template::Instance->LookupByExptidx($exptidx);
	    if (!defined($instance)) {
		tbdie("Invalid tarball URL for non-template experiment: ".
		      "$tarfile");
	    }
Leigh Stoller's avatar
Leigh Stoller committed
243
	    my $localfile = $instance->path() . "/datastore/" . $1;
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259

	    tbdie("$tarfile cannot be found; $localfile does not exist")
		if (! -e $localfile);

	    # no need to archive these since they are saved in the template
	    $tarfiles =~ s/$tarfile/$localfile/g;
	}
	else {
	    #
	    # Should be a regular path.
	    #
	    tbdie("$tarfile cannot be found; local file does not exist")
		if (! -e $tarfile);

	    $toarchive{$tarfile} = $tarfile;
	}
260 261 262 263 264 265 266 267 268 269 270 271
    }

    #
    # Hack, hack, hack! We use ';' as a separator in the virt_nodes table, but
    # ":" in the nodes table. We should fix the latter
    #
    $tarfiles =~ s/;/:/g;
    $rpms =~ s/;/:/g;
    
    #
    # If this virtual node is allocated, update the nodes table
    #
272 273 274
    if (defined($physnode)) {
	$physnode->Update({'tarballs' => $tarfiles, 'rpms' => $rpms}) == 0
	    or tbdie("Could not update tarballs,rpms for $physnode");
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294
    }
}

#
# In testmode, don't actually fetch anything
#
if ($TESTMODE) {
    exit(0);
}

#
# Actually fetch the tarballs
#
while (my ($URL, $localfile) = each %tofetch) {
    print "Fetching $URL to $localfile\n";

    #
    # Build up a new command line to do the fetch on ops
    #
    my $cmdargs = "$TB/bin/fetchtar.proxy ";
295
    $cmdargs .= " -u $user_uid $URL $localfile ";
296 297 298 299 300 301 302 303 304

    #
    # Must flip to real root for the ssh, and then flip back afterwards.
    # 
    $EUID = $UID = 0;
    system("sshtb -host $CONTROL $cmdargs ");
    $EUID = $UID = $SAVEUID;

    if ($?) {
305
	tbdie("Fetch of Tarball/RPM failed!");
306 307 308
    }
}

309 310 311 312
#
# Now add to the archive.
#
while (my ($localfile, $ignored) = each %toarchive) {
313 314
    # Lets not do this as root. 
    $EUID = $UID;
315 316
    libArchive::TBExperimentArchiveAddFile($pid, $eid, $localfile) == 0 or
	tbdie("Failed to add $localfile to the archive!");
317
    $EUID = 0;
318 319
}

320 321 322 323 324 325
#
# Check to make sure a URL for a tarball or RPM is valid, and return an
# untained version of it. Returns undefined if the URL is not valid.
#
sub verifyURL($) {
    my ($URL) = @_;
326
    if ($URL =~
327
	    /^((http|https|ftp):\/\/[\w.\-\/\@:~]+(\.tar|\.tar\.Z|\.tar\.gz|\.tgz|\.bz2|\.rpm))$/) {
328 329 330 331 332 333 334
	return $1;
    } else {
	return undef;
    }
}

exit 0;