#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2008 University of Utah and the Flux Group.
# 
# {{{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/>.
# 
# }}}
#
use strict;
use English;
use Getopt::Std;

#
# This gets invoked from the Web interface and from idlemail
#
sub usage()
{
    print STDOUT "Usage: idleswap [-i | -a] <eid>\n";
    exit(-1);
}
# Hidden switch: -r = root mode - used by idlemail
my $optlist    = "iar";
my $idleswap   = 0;
my $autoswap   = 0;
my $rootokay   = 0;

#
# Configure variables
#
my $TB		= "@prefix@";
my $DBNAME	= "@TBDBNAME@";
my $TBOPS	= "@TBOPSEMAIL@";
my $TBLOGS	= "@TBLOGSEMAIL@";
my $TBAUDIT	= "@TBAUDITEMAIL@";
my $swapexp	= "$TB/bin/swapexp";
my $template_swapout = "$TB/bin/template_swapout";
my $cleanupslice = "$TB/sbin/cleanupslice";

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

# Protos.
sub fatal($);

# 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) {
    fatal("Must be root! Maybe its a development version?");
}

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

if (@ARGV != 1) {
    usage();
}

#
# Verify user and get his DB uid and other info for later.
#
my $this_user = User->ThisUser();
if (!defined($this_user) && !$rootokay) {
    fatal("You ($UID) do not exist!");
}

#
# Grab the Experiment
#
my $experiment = Experiment->Lookup($ARGV[0]);
if (! defined($experiment)) {
    fatal("No such experiment in the Emulab Database.");
}
my $pid = $experiment->pid();
my $eid = $experiment->eid();

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

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

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

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

    exec "$template_swapout -e $eid $guid/$vers";
    die("Failed to exec $template_swapout!");
}
elsif ($experiment->geniflags()) {
    my $uuid = $experiment->uuid();
    
    exec "$cleanupslice $uuid";
    die("Failed to exec $cleanupslice!");
}
else {
    my $arg = "";
    
    if    ($idleswap) { $arg = "-i"; }
    elsif ($autoswap) { $arg = "-a"; }
    else { $arg = "-f"; }

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

sub fatal($)
{
    my ($msg) = @_;
    
    die("*** $0:\n".
	"    $msg\n");
}