idleswap.in 3.97 KB
Newer Older
1 2
#!/usr/bin/perl -wT
#
3
# Copyright (c) 2000-2008 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/>.
# 
# }}}
23
#
24
use strict;
25 26 27 28
use English;
use Getopt::Std;

#
29
# This gets invoked from the Web interface and from idlemail
30 31 32
#
sub usage()
{
33
    print STDOUT "Usage: idleswap [-i | -a] <eid>\n";
34 35
    exit(-1);
}
36
# Hidden switch: -r = root mode - used by idlemail
37 38 39 40
my $optlist    = "iar";
my $idleswap   = 0;
my $autoswap   = 0;
my $rootokay   = 0;
41 42 43 44 45 46 47 48

#
# Configure variables
#
my $TB		= "@prefix@";
my $DBNAME	= "@TBDBNAME@";
my $TBOPS	= "@TBOPSEMAIL@";
my $TBLOGS	= "@TBLOGSEMAIL@";
Leigh Stoller's avatar
Leigh Stoller committed
49
my $TBAUDIT	= "@TBAUDITEMAIL@";
50
my $swapexp	= "$TB/bin/swapexp";
51
my $template_swapout = "$TB/bin/template_swapout";
52
my $cleanupslice = "$TB/sbin/cleanupslice";
53 54 55 56 57

# Testbed Support libraries
use lib "@prefix@/lib";
use libdb;
use libtestbed;
58
use Template;
59
use Experiment;
60

61 62
# Protos.
sub fatal($);
63

64 65 66 67 68 69 70 71 72
# Untaint the path
$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

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

# We don't want to run this script unless its the real version.
if ($EUID != 0) {
73
    fatal("Must be root! Maybe its a development version?");
74 75 76 77
}

# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
78
my %options = ();
79 80 81
if (! getopts($optlist, \%options)) { usage(); }
if (defined($options{"i"})) { $idleswap = 1; }
if (defined($options{"a"})) { $autoswap = 1; }
82 83 84 85 86
if (defined($options{"r"})) { $rootokay = 1; }

# This script is setuid, so please do not run it as root. Hard to track
# what has happened.
if ($UID == 0 && (!defined($rootokay) || !$rootokay) ) {
87
    fatal("Please do not run this as root! Its already setuid!");
88
}
89

90
if (@ARGV != 1) {
91 92 93
    usage();
}

Leigh Stoller's avatar
Leigh Stoller committed
94
#
95
# Verify user and get his DB uid and other info for later.
Leigh Stoller's avatar
Leigh Stoller committed
96
#
97
my $this_user = User->ThisUser();
98
if (!defined($this_user) && !$rootokay) {
99
    fatal("You ($UID) do not exist!");
Leigh Stoller's avatar
Leigh Stoller committed
100 101
}

102
#
103
# Grab the Experiment
104
#
105 106 107
my $experiment = Experiment->Lookup($ARGV[0]);
if (! defined($experiment)) {
    fatal("No such experiment in the Emulab Database.");
108
}
109 110
my $pid = $experiment->pid();
my $eid = $experiment->eid();
111

112 113 114 115 116
# Need the swapper for below.
my $swapper = $experiment->GetSwapper();
if (! defined($swapper)) {
    fatal("Could not get object for swapper.");
}
117

118 119
# Only admins or root can forcibly swap an idle experiment out.
if (! TBAdmin() && ($UID!=0 || !$rootokay) ) {
120 121
    fatal("Only testbed administrators can issue a forcible swap!");
}
122

123 124 125 126
# Flip to the user to do the swap.
if ($swapper->FlipTo($experiment->unix_gid()) != 0) {
    fatal("Could not flip to $swapper");
}
127

128 129 130 131
if ($experiment->IsInstance()) {
    my $instance = Template::Instance->LookupByExptidx($experiment->idx());
    my $guid     = $instance->guid();
    my $vers     = $instance->vers();
132

133
    exec "$template_swapout -e $eid $guid/$vers";
134
    die("Failed to exec $template_swapout!");
135
}
136 137 138 139 140 141
elsif ($experiment->geniflags()) {
    my $uuid = $experiment->uuid();
    
    exec "$cleanupslice $uuid";
    die("Failed to exec $cleanupslice!");
}
142 143 144 145 146 147
else {
    my $arg = "";
    
    if    ($idleswap) { $arg = "-i"; }
    elsif ($autoswap) { $arg = "-a"; }
    else { $arg = "-f"; }
148

149
    exec "$swapexp $arg -s out $pid $eid";
150
    die("Failed to exec $swapexp!");
151
}
152
exit(-1);
153

154 155 156 157 158 159 160
sub fatal($)
{
    my ($msg) = @_;
    
    die("*** $0:\n".
	"    $msg\n");
}