rmproj.in 6.07 KB
Newer Older
1
#!/usr/bin/perl -wT
Leigh Stoller's avatar
Leigh Stoller committed
2
#
3
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
# 
# {{{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 Stoller's avatar
Leigh Stoller committed
23
#
24
use English;
Leigh Stoller's avatar
Leigh Stoller committed
25
use strict;
26 27

#
28 29
# Remove a project. We delete the project directory hierarchy and the
# we remove the group from /etc/group. Actually, the project directory
30
# is *renamed* since we do not want to be so destructive.
31 32 33 34
#
# usage: rmprojdir <pid>
#

35 36 37
#
# Configure variables
#
38 39 40
my $TB       = "@prefix@";
my $TBOPS    = "@TBOPSEMAIL@";
my $CONTROL  = "@USERNODE@";
41
my $MAILMANSUPPORT= @MAILMANSUPPORT@;
42

43
my $RMGROUP  = "$TB/sbin/rmgroup";
44
my $MODGROUPS= "$TB/sbin/modgroups";
45
my $DELMMLIST= "$TB/sbin/delmmlist";
Leigh Stoller's avatar
Leigh Stoller committed
46
my @grouplist= ();
47

48 49 50 51 52 53
#
# Change this if you really want to remove the directories associated
# with a project. Note: we have never tested the remove path!
# 
my $renamedirs = 1;

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

60 61 62 63 64 65 66 67 68
#
# Turn off line buffering on output
#
$| = 1;

#
# Load the Testbed support stuff. 
#
use lib "@prefix@/lib";
69
use libaudit;
70 71
use libdb;
use libtestbed;
Leigh Stoller's avatar
Leigh Stoller committed
72 73
use Project;
use User;
74

Leigh Stoller's avatar
Leigh Stoller committed
75
# Locals, defined in libdb.
76 77 78
my $PROJROOT     = PROJROOT();
my $SCRATCHROOT  = SCRATCHROOT();

Leigh Stoller's avatar
Leigh Stoller committed
79 80
# Protos
sub fatal($);
81
sub removedir($);
Leigh Stoller's avatar
Leigh Stoller committed
82

83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
#
# We don't want to run this script unless its the real version.
#
if ($EUID != 0) {
    die("*** $0:\n".
	"    Must be setuid! Maybe its a development version?\n");
}

#
# This script is setuid, so please do not run it as root. Hard to track
# what has happened.
# 
if ($UID == 0) {
    die("*** $0:\n".
	"    Please do not run this as root! Its already setuid!\n");
}

100 101 102 103 104 105 106
#
# Check args.
#
if ($#ARGV < 0) {
    die("Usage: rmprojdir <pid>\n");
}

Leigh Stoller's avatar
Leigh Stoller committed
107 108 109 110
# Map invoking user to object.
my $this_user = User->ThisUser();
if (! defined($this_user)) {
    fatal("You ($UID) do not exist!");
111 112 113
}

#
Leigh Stoller's avatar
Leigh Stoller committed
114
# Figure out who called us. Must have admin status to do this.
115
#
Leigh Stoller's avatar
Leigh Stoller committed
116 117
if (!TBAdmin()) {
    fatal("You must be a TB administrator to run this script!");
118 119 120
}

#
Leigh Stoller's avatar
Leigh Stoller committed
121
# Map project name to object.
122
#
Leigh Stoller's avatar
Leigh Stoller committed
123 124 125
my $target_project = Project->Lookup($ARGV[0]);
if (! defined($target_project)) {
    fatal("Could not map project to its object!");
126
}
Leigh Stoller's avatar
Leigh Stoller committed
127 128 129
my $pid     = $target_project->pid();
my $pid_idx = $target_project->pid_idx();
my $gid_idx = $target_project->gid_idx();
130 131

#
132 133 134 135 136 137 138
# This script is always audited. Mail is sent automatically upon exit.
#
if (AuditStart(0)) {
    #
    # Parent exits normally
    #
    exit(0);
139 140
}

141
#
142
# Project related directories will be removed by rmgroup call.
143
#
144

145
#
146
# Remove/rename the experiment working directory.
147
#
148
my $workdir = TBDB_EXPT_WORKDIR() . "/$pid";
149
my $savename = "_ARCHIVED-${pid}-${pid_idx}";
150

151 152
if (-d $workdir) {
    my $newname = TBDB_EXPT_WORKDIR() . "/$savename";
153

154 155 156 157 158 159 160 161 162 163 164
    if (rename($workdir, $newname)) {
	#
	# Chown the owner/group to root. There is no need to modify
	# the permissions since its on boss.
	#
	if (! chown(0, 0, $newname)) {
	    fatal("Could not chown directory $newname to 0/0: $!");
	}
    }
    else {
	fatal("Could not rename proj work directory to $newname: $!");
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
    }
}

#
# Ditto for the experiment info directory.
#
my $infodir = TBDB_EXPT_INFODIR() . "/$pid";

if (-d $infodir) {
    my $newname = TBDB_EXPT_INFODIR() . "/$savename";

    if (rename($infodir, $newname)) {
	#
	# Chown the owner/group to root. There is no need to modify
	# the permissions since its on boss.
	#
	if (! chown(0, 0, $newname)) {
	    fatal("Could not chown directory $newname to 0/0: $!");
	}
    }
    else {
	fatal("Could not rename proj info directory to $newname: $!");
187
    }
188 189 190
}

#
191 192
# Grab the group list. We need to delete all of the unix groups for the
# project. We do this with a subscript, so need to flip UID for perl.
193 194
# Note that rmgroups will handle deleting users from group_membership
# table by calling modgroups for each user. 
195
#
Leigh Stoller's avatar
Leigh Stoller committed
196 197
$target_project->GroupList(\@grouplist) == 0 or
    fatal("Could not get subgroup list for $target_project");
198

199
$EUID = $UID;
Leigh Stoller's avatar
Leigh Stoller committed
200 201 202 203
foreach my $group (@grouplist) {
    my $idx = $group->gid_idx();
    
    print "Removing project group $group ...\n";
204

Leigh Stoller's avatar
Leigh Stoller committed
205 206
    if (system("$RMGROUP $idx")) {
	fatal("Could not remove subgroup $group!");
207
    }
208 209
}

210
#
211
# Now remove the main project group. 
212
#
213
print "Removing main project group ...\n";
Leigh Stoller's avatar
Leigh Stoller committed
214
if (system("$RMGROUP $pid_idx")) {
215
    fatal("Could not remove main project group $pid!");
216 217
}

218 219 220 221
#
# Now remote the proj admin list, but only if the proj was never
# approved
#
222
if (0 && $MAILMANSUPPORT) {
223 224
    my $approved =
	DBQuerySingleFatal("select approved from projects where pid='$pid'");
225 226 227 228 229 230 231
    if (!$approved) {
	my $listname = "$pid-admin";
	system("$DELMMLIST -a $listname") == 0 or
	    fatal("$DELMMLIST -a $listname failed!");
    }
}

232
$EUID = 0;
233

234 235 236
#
# Then the project table itself, plus a few other bits and pieces
# 
237
DBQueryFatal("delete FROM last_reservation where pid_idx='$pid_idx'");
238
DBQueryFatal("delete FROM project_reservations where pid_idx='$pid_idx'");
239
DBQueryFatal("delete FROM project_licenses where pid_idx='$pid_idx'");
240 241
DBQueryFatal("delete FROM nodetypeXpid_permissions where pid_idx='$pid_idx'");
DBQueryFatal("delete FROM project_stats where pid_idx='$pid_idx'");
242
DBQueryFatal("delete FROM group_stats where pid_idx='$pid_idx'");
243 244 245
DBQueryFatal("delete FROM projects where pid_idx='$pid_idx'");
DBQueryFatal("delete FROM group_policies where pid_idx='$pid_idx'");
DBQueryFatal("delete FROM group_features where pid_idx='$pid_idx'");
246 247 248

print "Project $pid has been removed!\n";
exit(0);
249

250 251 252 253 254 255
sub fatal($) {
    my($mesg) = $_[0];

    die("*** $0:\n".
	"    $mesg\n");
}