idleswap.in 3.28 KB
Newer Older
1 2 3
#!/usr/bin/perl -wT
#
# EMULAB-COPYRIGHT
4
# Copyright (c) 2000-2008 University of Utah and the Flux Group.
5 6
# All rights reserved.
#
7
use strict;
8 9 10 11
use English;
use Getopt::Std;

#
12
# This gets invoked from the Web interface and from idlemail
13 14 15
#
sub usage()
{
16
    print STDOUT "Usage: idleswap [-i | -a] <eid>\n";
17 18
    exit(-1);
}
19
# Hidden switch: -r = root mode - used by idlemail
20 21 22 23
my $optlist    = "iar";
my $idleswap   = 0;
my $autoswap   = 0;
my $rootokay   = 0;
24 25 26 27 28 29 30 31

#
# Configure variables
#
my $TB		= "@prefix@";
my $DBNAME	= "@TBDBNAME@";
my $TBOPS	= "@TBOPSEMAIL@";
my $TBLOGS	= "@TBLOGSEMAIL@";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
32
my $TBAUDIT	= "@TBAUDITEMAIL@";
33
my $swapexp	= "$TB/bin/swapexp";
34
my $template_swapout = "$TB/bin/template_swapout";
35
my $cleanupslice = "$TB/sbin/cleanupslice";
36 37 38 39 40

# Testbed Support libraries
use lib "@prefix@/lib";
use libdb;
use libtestbed;
41
use Template;
42
use Experiment;
43

44 45
# Protos.
sub fatal($);
46

47 48 49 50 51 52 53 54 55
# 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) {
56
    fatal("Must be root! Maybe its a development version?");
57 58 59 60
}

# Parse command arguments. Once we return from getopts, all that should
# left are the required arguments.
61
my %options = ();
62 63 64
if (! getopts($optlist, \%options)) { usage(); }
if (defined($options{"i"})) { $idleswap = 1; }
if (defined($options{"a"})) { $autoswap = 1; }
65 66 67 68 69
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) ) {
70
    fatal("Please do not run this as root! Its already setuid!");
71
}
72

73
if (@ARGV != 1) {
74 75 76
    usage();
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
77
#
78
# Verify user and get his DB uid and other info for later.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
79
#
80
my $this_user = User->ThisUser();
81
if (!defined($this_user) && !$rootokay) {
82
    fatal("You ($UID) do not exist!");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
83 84
}

85
#
86
# Grab the Experiment
87
#
88 89 90
my $experiment = Experiment->Lookup($ARGV[0]);
if (! defined($experiment)) {
    fatal("No such experiment in the Emulab Database.");
91
}
92 93
my $pid = $experiment->pid();
my $eid = $experiment->eid();
94

95 96 97 98 99
# Need the swapper for below.
my $swapper = $experiment->GetSwapper();
if (! defined($swapper)) {
    fatal("Could not get object for swapper.");
}
100

101 102
# Only admins or root can forcibly swap an idle experiment out.
if (! TBAdmin() && ($UID!=0 || !$rootokay) ) {
103 104
    fatal("Only testbed administrators can issue a forcible swap!");
}
105

106 107 108 109
# Flip to the user to do the swap.
if ($swapper->FlipTo($experiment->unix_gid()) != 0) {
    fatal("Could not flip to $swapper");
}
110

111 112 113 114
if ($experiment->IsInstance()) {
    my $instance = Template::Instance->LookupByExptidx($experiment->idx());
    my $guid     = $instance->guid();
    my $vers     = $instance->vers();
115

116
    exec "$template_swapout -e $eid $guid/$vers";
117
    die("Failed to exec $template_swapout!");
118
}
119 120 121 122 123 124
elsif ($experiment->geniflags()) {
    my $uuid = $experiment->uuid();
    
    exec "$cleanupslice $uuid";
    die("Failed to exec $cleanupslice!");
}
125 126 127 128 129 130
else {
    my $arg = "";
    
    if    ($idleswap) { $arg = "-i"; }
    elsif ($autoswap) { $arg = "-a"; }
    else { $arg = "-f"; }
131

132
    exec "$swapexp $arg -s out $pid $eid";
133
    die("Failed to exec $swapexp!");
134
}
135
exit(-1);
136

137 138 139 140 141 142 143
sub fatal($)
{
    my ($msg) = @_;
    
    die("*** $0:\n".
	"    $msg\n");
}