All new accounts created on Gitlab now require administrator approval. If you invite any collaborators, please let Flux staff know so they can approve the accounts.

mkexpdir.in 5.86 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh B. Stoller's avatar
Leigh B. Stoller committed
2 3

#
4
# Copyright (c) 2000-2014 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
24
#
25
use English;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
use Getopt::Std;
27
use strict;
28

29 30
#
# This gets invoked from the Web interface. CD into the proper directory
31 32
# and do the tb stuff. This script cannot do any damage since it can
# only create directories where the caller has the permission to do so.
33
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
34 35
sub usage()
{
36
    print STDOUT "Usage: mkexpdir <eid>\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
37 38
    exit(-1);
}
39

40
sub fatal($;$);
41
sub chowner($$$);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
42

43
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44 45
# Configure variables
#
46 47 48
my $TB		= "@prefix@";
my $TBOPS	= "@TBOPSEMAIL@";
my $LINUX_FSNODE= @LINUX_FSNODE@;
49

Leigh B. Stoller's avatar
Leigh B. Stoller committed
50 51 52 53 54
#
# Turn off line buffering on output
#
$| = 1;

55 56 57 58 59 60
#
# Untaint the path
# 
$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libdb;
use libtestbed;
use libtblog;
use Experiment;

# Locals
my $projroot = PROJROOT();
my $grouproot= GROUPROOT();
my $tbdata   = "tbdata";
my @dirlist  = ($tbdata, "bin", "tmp", "logs", "archive", "datastore",
		"tftpboot", "swapinfo");
my $exitval;

78 79 80
#
# Check args.
# 
81
if (@ARGV != 1) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
82
    usage();
83
}
84 85 86
my $experiment = Experiment->Lookup($ARGV[0]);
if (!defined($experiment)) {
    tbdie("Could not lookup experiment object for $ARGV[0]!")
Leigh B. Stoller's avatar
Leigh B. Stoller committed
87
}
88 89 90
my $pid       = $experiment->pid();
my $eid       = $experiment->eid();
my $gid       = $experiment->gid();
91 92 93 94 95
my $piddir    = (($pid eq $gid) ? "$projroot/$pid" : "$grouproot/$pid/$gid");
my $expdir    = "$piddir/exp";
my $eiddir    = "$expdir/$eid";
my $eidlink   = "$projroot/$pid/exp/$eid";
my $workdir   = TBExptWorkDir($pid, $eid);
96
my $INFODIR   = "$TB/expinfo";
97

Leigh B. Stoller's avatar
Leigh B. Stoller committed
98 99 100
#
# Unix info for the group
#
101 102 103
my $group = $experiment->GetGroup();
if (!defined($group)) {
    tbdie("Could not lookup group object for $experiment!")
Leigh B. Stoller's avatar
Leigh B. Stoller committed
104
}
105 106
my $unix_gid  = $group->unix_gid();
my $unix_name = $group->unix_name();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
107

108 109 110 111
#
# We create a directory structure for the experiment in the project directory.
#
if (! chdir($expdir)) {
112
    print "Could not chdir to $expdir: $!\n";
113 114 115 116
    exit(-1);
}

if (! mkdir($eid, 0770)) {
117
    $exitval = $ERRNO;
118
    print "Could not mkdir $eid in $expdir: $!\n";
119
    exit($exitval);
120 121 122
}

if (! chmod(0770, "$eid")) {
123
    $exitval = $ERRNO;
124
    print "Could not chmod $eid to 0770 in $expdir: $!\n";
125
    rmdir($eid);
126
    exit($exitval);
127 128
}

129
if (! chowner($UID, $unix_gid, "$eid")) {
130
    $exitval = $ERRNO;
131
    print "Could not chown $eid to $UID/$unix_gid in $expdir: $!\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
132
    rmdir($eid);
133
    exit($exitval);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
134 135
}

136
if (! chdir($eid)) {
137
    $exitval = $ERRNO;
138
    print "Could not chdir to $eid in $expdir: $!\n";
139
    rmdir($eid);
140
    exit($exitval);
141 142 143 144 145
}

#
# Create the experiment directory list in the new directory.
#
146
foreach my $dir (@dirlist) {
147
    if (! mkdir($dir, 0770)) {
148
	fatal("Could not mkdir $dir in $eiddir: $!");
149 150 151
    }

    if (! chmod(0770, "$dir")) {
152
	fatal("Could not chmod $dir to 0770 in $eiddir: $!");
153 154 155
    }
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
156 157 158 159
#
# Update the DB. This leaves the decision about where the directory
# is created, in this script. 
#
160 161
$experiment->Update({"path" => "$eiddir"}) == 0 or
    fatal("Could not update path for $experiment");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
162

163 164 165
#
# Create the working directory.
#
166 167 168 169
if (! -e $workdir) {
    if (! mkdir($workdir, 0775)) {
	fatal("Could not create $workdir: $!");
    }
170
    if (! chowner($UID, $unix_gid, "$workdir")) {
171 172
	fatal("Could not chown $workdir to $UID/$unix_gid: $!");
    }
173 174
}

175 176 177 178 179 180 181 182 183
#
# Create the expinfo directory.
#
my $expinfo = "$INFODIR/$pid/$eid";

if (! -e $expinfo) {
    if (! mkdir($expinfo, 0777)) {
	fatal("Could not create $expinfo: $!");
    }
184 185 186 187 188 189 190 191 192 193 194 195 196 197
    #
    # expinfo dir should have the group ID of the primary project group.
    # This is because at different times, users in different subgroups can
    # create an experiment with the same name. If the directory has the
    # group of the initial experiment with that name, then any other future
    # experiment with that name but in a different subgroup will not be able
    # to write the directory.
    #
    my $ugid = $unix_gid;
    if ($pid ne $gid) {
	$ugid = $group->GetProject()->unix_gid();
    }
    if (! chowner($UID, $ugid, "$expinfo")) {
	fatal("Could not chown $expinfo to $UID/$ugid: $!");
198 199 200
    }
}

201 202
#
# If a group experiment, leave behind a symlink from the project experiment
203 204
# directory to the group experiment directory. This is convenient so that
# there is a common path for all experiments. 
205
#
206
if ($pid ne $gid) {
207 208
    # XXX Bad. This link should be removed when the experiment is removed.
    unlink($eidlink)
209
	if (-l $eidlink);
210 211 212
    symlink($eiddir, $eidlink) or
	fatal("Could not symlink($eiddir, $eidlink): $!");
}
213

214 215
exit(0);

216
sub fatal($;$)
217
{
218 219 220 221
    my ($msg, $exitval) = @_;

    $exitval = $ERRNO
	if (!defined($exitval));
222 223 224

    system("/bin/rm -rf $eiddir");
    system("/bin/rm -rf $workdir");
225 226
    unlink($eidlink)
	if ($pid ne $gid && -l $eidlink);
227

228
    tberror($msg);
229
    exit($exitval);
230 231
}

232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
sub chowner($$$)
{
    my ($uid, $gid, $file) = @_;

    if (0 && $LINUX_FSNODE) {
	#
	# use chgrp because linux NFS does not allow to chown !!
	# set chgrp suid root -- only on boss !!!
	#
	# XXX I do not think this is the case for linux in general, so
	# change the if expression above if you must.
	#
	system("/usr/bin/chgrp", $gid, $file);
	return ($? ? 0 : 1);
    }
    else {
	return chown($uid, $gid, $file);
    }
}