robomonitord.in 7.62 KB
Newer Older
1 2
#!/usr/bin/perl -w
#
3
# Copyright (c) 2000-2003, 2005, 2007 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 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
#
use English;
use Getopt::Std;
use POSIX;

#
# Robot Lab Monitor Daemon.
#
#	usage: robomonitord [-d]
#
sub usage()
{
    print STDOUT "Usage: robomonitord [-d]\n" .
	"Use the -d option to prevent daemonization\n";
    exit(-1);
}
my $optlist     = "d";
my $debug	= 0;
41
my $impotent    = 0;
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61

#
# Must be runs as root, from boot.
#
if ($UID != 0) {
    die("*** $0:\n".
	"    Only root can run this script!\n");
}

#
# Configure variables
#
my $TB       = "@prefix@";
my $TBOPS    = "@TBOPSEMAIL@";
my $idleswap = "$TB/sbin/idleswap";

# Testbed Support library
use lib "@prefix@/lib";
use libdb;
use libtestbed;
62
use Experiment;
63

64 65 66 67 68 69
#
# Function phototypes
#
sub SwapWarn($$$);
sub SwapIt($$$);

70 71 72 73 74 75
#
# Locals
# 
my $TBOPSPID	= TBOPSPID();
my $logfile	= "$TB/log/robolab.log";

76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
#
# Holidays. I know, this is really terrible. I hope that by 2006, this
# daemon will be gone anyway.
#
my %holidays =
    ("1/17"  => 1,
     "2/21"  => 1,
     "5/30"  => 1,
     "7/4"   => 1,
     "7/24"  => 1,
     "9/5"   => 1,
     "11/24" => 1,
     "11/25" => 1,
     "12/26" => 1,
    );

92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239
#
# Turn off line buffering on output (dots ...).
#
$| = 1;

#
# Untaint the path
# 
$ENV{'PATH'} = "/bin:/usr/bin:";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (@ARGV != 0) {
    usage();
}
if (defined($options{"d"})) {
    $debug = $options{"d"};
}

# Go to ground.
if (! $debug) {
    if (TBBackGround($logfile)) {
	exit(0);
    }
}

sub fatal($)
{
    my ($msg) = @_;

    SENDMAIL($TBOPS, "Robot Lab Monitor Daemon Died!", $msg, $TBOPS);
    die($msg);
}

sub notify($)
{
    my ($msg) = @_;

    print "$msg\n";
    
    SENDMAIL($TBOPS, "Robot Lab Monitor Daemon Message", $msg, $TBOPS);
}

print "Robot Lab Monitor Daemon starting... pid $$, at ".`date`;

#
# These are sitevars.
# 
my ($override, $opentime, $closetime, $open);
my $sentemail = 0;

#
# Just loop, waking up and looking at the sitevars, the current time and
# date, and doing something reasonable! Just a hack ...
#
while (1) {
    my ($pid, $eid);
    
    #
    # Grab various sitevars.
    #
    if (!TBGetSiteVar("robotlab/override", \$override) ||
	!TBGetSiteVar("robotlab/open", \$open)) {
	print "Error getting sitevars; pausing for a little while ...\n";
	goto skip;
    }
    #
    # See if we are forcing the lab open or closed.
    # 
    if ($override && $override ne "") {
	#
	# Force close?
	# 
	if (($override eq "close" || $override eq "off") && $open) {
	    print "Robot lab was closed forcibly at ".
		TBDateTimeFSSafe() . "\n";

	    # Close the lab.
	    TBSetSiteVar("robotlab/open", 0);
	    $sentemail = 0;

	    #
	    # Swap out running experiments.
	    #
	    if (TBRobotLabExpt(\$pid, \$eid)) {
		SwapIt($pid, $eid, 1);
	    }
	}
	#
	# Force open?
	# 
	elsif (($override eq "open" || $override eq "on") && !$open) {
	    print "Robot lab was opened forcibly at ".
		TBDateTimeFSSafe() . "\n";

	    # Open the lab.
	    TBSetSiteVar("robotlab/open", 1);
	    $sentemail = 0;
	}

	# In override, the rest of this is skipped
	goto skip;
    }

    #
    # Get the current open/close times.
    # 
    if (!TBGetSiteVar("robotlab/closetime", \$closetime) ||
	!TBGetSiteVar("robotlab/opentime",  \$opentime)) {
	print "Error getting sitevars; pausing for a little while ...\n";
	goto skip;
    }

    #
    # Get current day/date info. We want to know the time of day, and the
    # day of the week. 
    #
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();

    # 
    # Convert open/close time strings (HH:MM) above to unix time using
    # above goo.
    #
    if ($opentime =~ /^(\d*):(\d*)/) {
	$opentime_unix =
	    mktime(0,$2,$1,$mday,$mon,$year,$wday,$yday,$isdst);
    }
    else {
	fatal("Bad format for opentime: $opentime");
    }
    if ($closetime =~ /^(\d*):(\d*)/) {
	$closetime_unix =
	    mktime(0,$2,$1,$mday,$mon,$year,$wday,$yday,$isdst);
    }
    else {
	fatal("Bad format for closetime: $closetime");
    }
    if ($debug) {
	print "$opentime,$opentime_unix $closetime,$closetime_unix " .
	    time() . "\n";
    }
240
    my $hday = ($mon + 1) . "/" . $mday;
241 242 243 244 245

    #
    # See if we need to make a change.
    #
    if (time() >= $opentime_unix && time() <= $closetime_unix &&
246 247
	$wday >= 1 && $wday <= 5 && !exists($holidays{$hday})) {
	
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293
	#
	# Robot lab should be open; make it so if not.
	#
	if (!$open) {
	    print "Robot is now open for business at " .
		TBDateTimeFSSafe() . "\n";

	    # Open the lab.
	    TBSetSiteVar("robotlab/open", 1);
	    $sentemail = 0;
	}

	#
	# See if getting close to closing the lab. If so, want to send
	# an email warning that an autoswap is going to happen. Only send
	# once though. Hmm, someone could swap in right at the end. Oh
	# well, not going to worry about that. 
	#
	if ($open && $closetime_unix - time() < 60 * 15 && !$sentemail &&
	    TBRobotLabExpt(\$pid, \$eid)) {
	    SwapWarn($pid, $eid, $closetime_unix - time());
	    $sentemail = 1;
	}
    }
    else {
	#
	# Robot lab should be closed; make it so if not.
	#
	if ($open) {
	    print "Robot is now closed for business at " .
		TBDateTimeFSSafe() . "\n";

	    # Open the lab.
	    TBSetSiteVar("robotlab/open", 0);
	    $sentemail = 0;
	}

	#
	# Swap out running experiments.
	#
	if (TBRobotLabExpt(\$pid, \$eid)) {
	    SwapIt($pid, $eid, 1);
	}
    }

  skip:
294
    sleep(60);
295 296 297 298 299 300 301 302 303 304
}
exit(0);

#
# Notify current user of the robot lab that they are going to get swapped.
# 
sub SwapWarn($$$)
{
    my ($pid, $eid, $timeleft) = @_;

305 306 307 308 309 310 311 312
    my $experiment = Experiment->Lookup($pid, $eid);
    if (!defined($experiment)) {
	fatal("No such experiment $pid/$eid in the Emulab Database.");
    }
    my $swapper     = $experiment->GetSwapper();
    my $swapper_uid = $swapper->uid();
    my $user_name   = $swapper->name();
    my $user_email  = $swapper->email();
313
    
314
    print "Sending swap warning email to $swapper_uid at ".
315 316
	TBDateTimeFSSafe() . "\n";

317
    SENDMAIL("$user_name <$user_email>",
318 319 320 321 322
	     "Robot Lab Monitor Daemon Message",
	     "Your experiment running on the robot testbed, $pid/$eid, \n".
	     "will soon be swapped out when the robot testbed closes for \n".
	     "for the night.\n".
	     "\n".
323 324 325 326 327 328 329
	     "You have " . int($timeleft / 60) .
	         " minutes before that happens!\n".
	     "\n".
	     "Please save your data and swap your experiment out to avoid\n".
	     "losing any work.\n".
	     "\n".
	     "Thanks!\n",
330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353
	     $TBOPS,
	     "Cc: $TBOPS");

    return 0;
}

#
# Swap a currently running experiment.
#
sub SwapIt($$$)
{
    my ($pid, $eid, $force) = @_;

    print "Starting swapout of $pid/$eid at ".
	TBDateTimeFSSafe() . "\n";

    return 0
	if ($impotent);

    #
    # Use idleswap with special options
    #
    my $optarg = ($force ? "-f" : "-a");
    
354
    return(system("$idleswap $optarg -r $pid,$eid"));
355
}