idlemail.in 21 KB
Newer Older
1 2 3
#!/usr/bin/perl -w

#
4
# Copyright (c) 2000-2018 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{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/>.
# 
# }}}
24 25
#

26
#
27
# idlemail - send mail to idle expts
28 29 30 31 32 33 34 35
#
# see usage message below for details
#
# This should get run out of cron, about every 5 minutes or so.
# Add an entry like this to /etc/crontab:
#
# */5     *       *       *       *       root    /usr/testbed/sbin/idlemail
#
36 37 38
# If you use a frequency other than 5 minutes, make sure to change the
# autowarn sections below, especially the query for who should be warned.
#
39 40 41 42

# Configure variables
use lib '@prefix@/lib';
use libdb;
43
use libtestbed;
44
use Experiment;
45
use EmulabFeatures;
46
use EmulabConstants;
47 48
use English;
use Getopt::Std;
49
use Sys::Syslog;
50

51 52 53
# Shh..
$EmulabFeatures::verbose = 0;

54 55 56 57
# Grab our site variables...
my $mailinterval = TBGetSiteVar("idle/mailinterval");
my $threshold    = TBGetSiteVar("idle/threshold");
my $cc_grp_ldrs  = TBGetSiteVar("idle/cc_grp_ldrs");
58 59 60 61
# minutes before idleswap that we warn them
my $idle_warnmin = TBGetSiteVar("swap/idleswap_warn");
# minutes before autoswap that we warn them
my $auto_warnmin = TBGetSiteVar("swap/autoswap_warn");
62
my $disabled     = TBGetSiteVar("web/nologins");
63

64 65 66 67 68
#
# When web logins are disabled, do not do anything!
#
exit (0)
    if ($disabled);
69

70 71
sub help {
    die("Usage:
72
idlemail [-h] [-d] [-v] [-n] [-i] [[-f] <pid> <eid>]
73
 -h     Show this help message
74 75
 -d     Enable debugging (uses stdout instead of syslog)
 -v     Enable verbose output 
76
 -n	No email sending. (for debugging only)
77
 -i	Impotent mode. (for debugging only)
78 79 80
 -f	Force sending a message for <pid> <eid>

If <pid> and <eid> are supplied, send a swap request for that experiment.
81 82
Without -f, the message won't be sent if pid/eid has not been idle long
enough or if it hasn't been long enough since its last message.
83 84

idlemail runs periodically (via cron(8)) to send email messages
85 86 87 88 89 90 91
regarding experiments that are idle, starting after $threshold hours 
of inactivity, and sending another message every $mailinterval hours.

Current settings:
idle threshold = $threshold hours
mail interval  = $mailinterval hours
Start CC'ing group leaders on message $cc_grp_ldrs\n");
92 93
}

Mac Newbold's avatar
Mac Newbold committed
94
my $TB               = "@prefix@";
95 96 97 98 99 100 101 102 103 104
my $THISHOMEBASE     = "@THISHOMEBASE@";
my $TBBASE           = "@TBBASE@";
my $TBDOCBASE        = "@TBDOCBASE@";
my $TBMAILADDR_OPS   = "@TBOPSEMAIL@";
my $TBMAILADDR_WWW   = "@TBWWWEMAIL@";
my $TBMAILADDR_AUDIT = "@TBAUDITEMAIL@";
my $TBMAIL_OPS       = "Testbed Ops <$TBMAILADDR_OPS>";
my $TBMAIL_WWW       = "Testbed WWW <$TBMAILADDR_WWW>";
my $TBMAIL_AUDIT     = "Testbed Audit <$TBMAILADDR_AUDIT>";
my $TBMAIL_AUTOMAIL  = "@TBAUTOMAILEMAIL@";
105
my $TBLOG	     = "@TBLOGFACIL@";
106 107 108 109

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

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
# Only root or admin types!
if (($UID != 0) && (!TBAdmin($UID))) {
    die("Only root or TB administrators can run idlemail.\n");
}

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

    return
	if (!$v);
    
    if ($d || $i) {
	print $msg;
    }
    else {
	chomp($msg);
	syslog("debug", "$msg");
    }
}

sub Notify($)
{
    my ($msg) = @_;
    
    if ($d || $i) {
	print $msg;
    }
    else {
	chomp($msg);
	syslog("notice", "$msg");
    }
}

sub Fatal($)
{
    my ($msg) = @_;
    
    if ($d || $i) {
	print STDERR "*** $0:\n".
	             "    $msg\n";
    }
    else {
	chomp($msg);
	syslog("error", "$msg");
    }
    exit(-1);
}

159 160 161 162
# Defaults

# Don't put 'my' on these, or they won't be settable with ${$var}
$h = 0; # help mode
163
$v = 0; # verbose mode
164 165 166
$d = 0; # debug mode
$n = 0; # no-mail mode
$f = 0; # force mode
167
$i = 0; # impotent mode
168

169
my $optlist = "hdnfiv";
170 171 172 173
my %opt = ();
if (! getopts($optlist,\%opt)) { help(); }
# Copy the options into global vars
foreach $var (keys %opt) {
174
    ${$var} += $opt{$var};
175
}
176
if ($h) { help(); }
177 178 179 180

my $pid = shift || "";
my $eid = shift || "";

181 182 183
# Set up syslog
openlog("idlemail", "pid", $TBLOG)
    if (!($d || $i));
184 185 186 187

if ($pid eq "" || $eid eq "") {
    # Normal mode

188 189
    my @idle=();
    # Grab a list of inactive expts, so we know who to reset when we're done
190
    my $sql = "select pid,eid from experiments where state='active' and swap_requests > 0 and geniflags=0";
191 192 193 194 195
    my $q = DBQueryFatal($sql);
    while (%r = $q->fetchhash()) {
	$pid = $r{'pid'};
	$eid = $r{'eid'};
	push(@idle,"$pid:$eid");
196
	Debug("Was idle: $pid/$eid\n");
197 198
    }

199 200 201
    # Important note: this query only counts nodes in the
    # node_activity table, which are all local nodes. So no virt or
    # remote nodes get counted towards the node total.
202
    $sql  = <<EOT;
203 204 205 206 207 208 209 210 211 212 213
select r.pid, e.gid, r.eid, swappable, swap_requests,
round((unix_timestamp(now()) - unix_timestamp(last_swap_req))/3600,2)
as lastreq, count(r.node_id) as nodes,
round((unix_timestamp(now()) - unix_timestamp(max(
greatest(last_tty_act, last_net_act, last_cpu_act, last_ext_act)
)))/3600,2) as idle_time, max(greatest(last_tty_act, last_net_act,
last_cpu_act, last_ext_act)) as lastact,
(unix_timestamp(now()) - unix_timestamp(min(last_report))) as staleness
from node_activity as na left join reserved as r on na.node_id=r.node_id
left join experiments as e on r.pid=e.pid and r.eid=e.eid
where r.pid is not null and r.eid is not null and idle_ignore=0
214
and geniflags=0
215
and (idleswap=0 or swappable=0)
216 217 218
group by pid,eid having idle_time >= $threshold and nodes > 0
order by pid,eid
EOT
219
    # We don't want idleswappable ones, since they get a different warning
220
    # unless they're unswappable.
221

222
    $q = DBQueryFatal($sql);
223

224
    my @stillidle=();
225 226
    while (%r = $q->fetchhash()) {
	$pid = $r{'pid'};
227
	$gid = $r{'gid'};
228
	$eid = $r{'eid'};
229 230 231 232
	$swappable = $r{'swappable'};
	$swapreqs = $r{'swap_requests'};
	$lastreq = $r{'lastreq'};
	$nodes = $r{'nodes'};
233
	$time= $r{'idle_time'};
234 235
	$lastact= $r{'lastact'};
        $staleness = $r{'staleness'};
236
        if (!defined($staleness) || $staleness >= 600) { # 10 minute stale limit
237 238
            $stale=1;
        }
239
	
240 241 242 243
	# If it is in the query, it is still idle, even if we don't
	# send a message this time through.
	push(@stillidle,"$pid:$eid");

244 245 246
	# We already know (from the query) that idletime>threshold.
	# So check the swap requests and time of last request, to make
	# sure we can send a message.
247

248 249 250 251
	if ($swapreqs == 0 || ($swapreqs > 0 && $lastreq > $mailinterval)) {
	    SendMessage($pid,$gid,$eid,$swappable,$swapreqs,$nodes,
			$time,$lastact,$stale);
	}
252
    }
253 254 255 256 257 258 259 260 261

    # Now reset counters for expts that aren't idle anymore.
    foreach $expt (@idle) {
	my ($pid,$eid)=split(":",$expt);
	my $found=0;
	foreach $e (@stillidle) {
	    if ($e eq $expt) { $found=1; last; }
	}
	if (!$found) {
262
	    Debug("Not idle: $pid/$eid\n");
263
	    DBQueryFatal("update experiments set swap_requests='0' ".
264 265
			 "where pid='$pid' and eid='$eid'")
		if (! $i);
266
	} else {
267
	    Debug("Still idle: $pid/$eid\n");
268 269 270
	}
    }

Mac Newbold's avatar
Mac Newbold committed
271 272 273
    # Next we need to check for stuff that needs to get swapped.
    # We need to find stuff to Idle-Swap, and stuff to Auto-Swap,
    # using two different queries.
274 275 276
    #
    # Note that 'paniced' experiments are ignored since there is no
    # hope of auto swapping them.
Mac Newbold's avatar
Mac Newbold committed
277 278
    $sql  = <<EOT;
select e.pid,e.eid, idleswap_timeout,
279
(unix_timestamp(now()) - unix_timestamp(min(last_report))) as staleness,
Mac Newbold's avatar
Mac Newbold committed
280 281 282 283 284
(unix_timestamp(now()) - unix_timestamp(max(greatest(
last_tty_act,last_net_act,last_cpu_act,last_ext_act))))/60 as idlemin
from reserved as r left join experiments as e on e.pid=r.pid and e.eid=r.eid
left join node_activity as na on r.node_id=na.node_id
where idleswap !=0 and swappable>0 and idle_ignore=0
285
and geniflags=0
286
and paniced=0
287 288
group by pid,eid having idlemin >= idleswap_timeout and staleness < 600
order by pid,eid
Mac Newbold's avatar
Mac Newbold committed
289 290 291 292 293
EOT
    $q = DBQueryFatal($sql);
    while (%r = $q->fetchhash()) {
	$pid = $r{'pid'};
	$eid = $r{'eid'};
294 295 296 297 298 299 300
	my $staleness = $r{'staleness'};
	my $idlemin   = $r{'idlemin'};
	my $idletimo  = $r{'idleswap_timeout'};
	
	Notify("$pid/$pid: staleness:$staleness, ".
	       "idlemin:$idlemin, idletimo:$idletimo\n");
	    
301
	if ($i) {
302
	    Debug("Would idleswap $pid,$eid\n");
303 304
	}
	else {
Leigh Stoller's avatar
Leigh Stoller committed
305
	    Notify("Starting idleswap of $pid/$eid\n");
306

Leigh Stoller's avatar
Leigh Stoller committed
307 308 309
	    if (system("$TB/sbin/idleswap -r -i $pid,$eid > /dev/null")) {
		Notify("Problem idleswapping $pid/$eid\n");
	    }
310
	}
Mac Newbold's avatar
Mac Newbold committed
311 312 313
    }

    $sql  = <<EOT;
314
select e.pid,e.eid,e.autoswap_timeout,e.expt_expires,
315 316 317
(unix_timestamp(now()) - unix_timestamp(s.swapin_last))/60 as activemin
from experiments as e
left join experiment_stats as s on s.exptidx=e.idx
318 319
where e.swappable>0 and e.state="active" and e.expt_locked is null
and e.autoswap>0
320
and now()>e.expt_expires
321
and e.geniflags=0
322
and e.paniced=0 
323
order by e.pid,e.eid
Mac Newbold's avatar
Mac Newbold committed
324 325 326 327 328
EOT
    $q = DBQueryFatal($sql);
    while (%r = $q->fetchhash()) {
	$pid = $r{'pid'};
	$eid = $r{'eid'};
329 330
	my $autotimo  = $r{'autoswap_timeout'};
	my $activemin = $r{'activemin'};
331
	my $expires   = $r{'expt_expires'};
332

333 334
	Notify("$pid/$eid: active:$activemin, ".
	       "autotimo:$autotimo, expires:$expires\n");
335
	    
336
	if ($i) {
337
	    Debug("Would autoswap $pid,$eid\n");
338 339
	}
	else {
Leigh Stoller's avatar
Leigh Stoller committed
340
	    Notify("Starting autoswap of $pid/$eid");
341

Leigh Stoller's avatar
Leigh Stoller committed
342 343 344
	    if (system("$TB/sbin/idleswap -r -a $pid,$eid > /dev/null")) {
		Notify("Problem autoswapping $pid/$eid\n");
	    }
345
	}
Mac Newbold's avatar
Mac Newbold committed
346 347
    }

348 349
    # Now send warning messages to those who will get automatically
    # swapped soon (idleswap/autoswap)
Mac Newbold's avatar
Mac Newbold committed
350
    my $window = 5; # same as idlemail frequency in cron
351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366

    if ($idle_warnmin>0) {
	$sql  = <<EOT;
select e.pid,e.eid,idleswap_timeout, count(r.node_id) as nodes,
round((unix_timestamp(now()) - unix_timestamp(max(
greatest(last_tty_act, last_net_act, last_cpu_act, last_ext_act)
)))/3600,2) as idle_time, max(greatest(last_tty_act, last_net_act,
last_cpu_act, last_ext_act)) as lastact,
(unix_timestamp(now()) - unix_timestamp(min(last_report))) as staleness,
(unix_timestamp(now()) - unix_timestamp(max(
greatest(last_tty_act, last_net_act, last_cpu_act, last_ext_act)
)))/60 as idlemin
from node_activity as na left join reserved as r on na.node_id=r.node_id
left join experiments as e on r.pid=e.pid and r.eid=e.eid
where swappable>0 and state="active" and idleswap>0 group by pid,eid
having idlemin+$idle_warnmin>=idleswap_timeout and
367
idlemin+$idle_warnmin<=idleswap_timeout+$window and
Mac Newbold's avatar
Mac Newbold committed
368
idlemin >= $window order by pid,eid
369 370 371 372 373 374 375 376 377 378
EOT
        $q = DBQueryFatal($sql);
	while (%r = $q->fetchhash()) {
	    # These get an idlewarn message
	    $pid = $r{'pid'};
	    $eid = $r{'eid'};
	    $nodes = $r{'nodes'};
	    $time= $r{'idle_time'};
	    $lastact= $r{'lastact'};
	    $staleness = $r{'staleness'};
379
	    if (!defined($staleness) || $staleness >= 600) { # 10 minute stale limit
380 381 382 383 384 385 386 387 388
		$stale=1;
	    }
	    SendMessage($pid,$pid,$eid,1,0,$nodes,$time,$lastact,$stale,
			2,$idle_warnmin);
	}
    }

    if ($auto_warnmin>0) {
	$sql  = <<EOT;
389
select e.pid,e.eid,e.autoswap_timeout,e.expt_expires,
390 391 392
(unix_timestamp(now()) - unix_timestamp(s.swapin_last))/60 as activemin
from experiments as e
left join experiment_stats as s on s.exptidx=e.idx
393 394 395 396
where e.swappable>0 and e.state="active" and e.autoswap>0 and
now()>=date_sub(e.expt_expires, interval $auto_warnmin minute) and
now()<=date_sub(e.expt_expires, interval ${auto_warnmin}-${window} minute)>now()
order by e.pid,e.eid
397
EOT
398 399 400 401 402 403 404 405
        $q = DBQueryFatal($sql);
	while (%r = $q->fetchhash()) {
	    # These get an autowarn message
	    $pid = $r{'pid'};
	    $eid = $r{'eid'};
	    # all options ignored but autoswap and warnmin and ids
	    SendMessage($pid,$pid,$eid,0,0,0,0,0,0,1,$auto_warnmin);
	}
406 407
    }

408
} else {
409 410 411
    # pid/eid mode - only check pid/eid, and let $f force sending,
    # even if msg was sent recently or expt isn't idle long enough.

412
    Debug("Checking $pid/$eid only... force is $f\n");
413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434

    # Important note: this query only counts nodes in the
    # node_activity table, which are all local nodes. So no virt or
    # remote nodes get counted towards the node total.

    # diffs from the normal query: don't restrict based on idleness
    # or idle_ignore, and only grab our expt

    my $sql  = <<EOT;
select r.pid, e.gid, r.eid, swappable, swap_requests, idle_ignore,
round((unix_timestamp(now()) - unix_timestamp(last_swap_req))/3600,2)
as lastreq, count(r.node_id) as nodes,
round((unix_timestamp(now()) - unix_timestamp(max(
greatest(last_tty_act, last_net_act, last_cpu_act, last_ext_act)
)))/3600,2) as idle_time, max(greatest(last_tty_act, last_net_act,
last_cpu_act, last_ext_act)) as lastact,
(unix_timestamp(now()) - unix_timestamp(min(last_report))) as staleness
from node_activity as na left join reserved as r on na.node_id=r.node_id
left join experiments as e on r.pid=e.pid and r.eid=e.eid
where r.pid='$pid' and r.eid='$eid'
group by pid,eid having nodes > 0
EOT
435

436 437 438 439 440 441 442 443 444 445 446 447 448 449
    my $q = DBQueryFatal($sql);

    if (%r = $q->fetchhash()) {
	$pid = $r{'pid'};
	$gid = $r{'gid'};
	$eid = $r{'eid'};
	$swappable = $r{'swappable'};
	$ignore = $r{'idle_ignore'};
	$swapreqs = $r{'swap_requests'};
	$lastreq = $r{'lastreq'};
	$nodes = $r{'nodes'};
	$time= $r{'idle_time'};
	$lastact= $r{'lastact'};
        $staleness = $r{'staleness'};
450
        if (!defined($staleness) || $staleness >= 600) { # 10 minute stale limit
451 452 453 454 455 456 457
            $stale=1;
        }
	
	# We don't know (from the query) that idletime>threshold.  So
	# check that we're either forcing, or that it is idle, and
	# then check the swap requests and time of last request, to
	# make sure we can send a message.
458

459 460 461 462 463 464
	if ($f || ($time > $threshold && !$ignore &&
		   ($swapreqs == 0 ||
		    ($swapreqs > 0 && $lastreq > $mailinterval)))) {
	    SendMessage($pid,$gid,$eid,$swappable,$swapreqs,$nodes,
			$time,$lastact,$stale);
	} else {
465 466
	    Debug("$pid/$eid: no msg (idle $time hrs, ".
		  "ignore=$ignore, msg #$swapreqs $lastreq hrs ago)\n");
467 468 469 470 471 472 473
	    # no message sent for whatever reason
	    exit(2);
	}
    } else {
	# expt didn't exist, or didn't have any nodes in node_activity
	exit(1);
    }
474 475 476 477 478
}

exit(0);

sub SendMessage {
479
    my ($pid,$gid,$eid,$swappable,$swapreqs,$c,$time,$lastact,$stale,
480
	$warn,$warnmin) = @_;
481 482 483 484 485 486
    # enable extra debugging...
    if (0) {
	SENDMAIL("Mac <newbold\@flux.utah.edu>","idlemail warnings",
		 "idlemail: send message(".join(",",@_)."\n".
		 "pid=$pid,gid=$gid,eid=$eid\nswappable=$swappable,".
		 "swapreqs=$swapreqs,c=$c,time=$time,lastact=$lastact,".
487
		 "stale=$stale\nwarn=$warn,warnmin=$warnmin\n".
488 489
		 "Date: ".`date`);
    }
490
    if (!defined($warn)) { $warn=0; }
491 492 493
    $idlehrs = int($time);
    $idlemin = int(($time-$idlehrs)*60);

494 495
    my $experiment = Experiment->Lookup($pid, $eid);
    if (!defined($experiment)) {
496
	Fatal("Could not lookup object for experiment $pid/$eid");
497 498 499
    }
    my $creator = $experiment->GetCreator();
    if (!defined($creator)) {
500
	Fatal("Could not lookup object for creator of $pid/$eid");
501 502 503 504
    }
    my $swapper = $experiment->GetSwapper();
    if (!defined($swapper)) {
	$swapper = $creator;
Mac Newbold's avatar
Mac Newbold committed
505
    }
506 507 508 509 510 511
    my $expcreator_uid   = $creator->uid();
    my $expcreator_name  = $creator->name();
    my $expcreator_email = $creator->email();
    my $expswapper_name  = $swapper->name();
    my $expswapper_email = $swapper->email();
    my $leaders =          $experiment->GetGroup()->LeaderMailList();
512 513 514 515 516 517 518 519 520 521 522 523

    if ($warn) {
	Notify("Sending warning message to $pid/$eid before swap\n");
    } else {
	# Don't send idle notification messages to experiments
	# that are externally managed.
	if (EmulabFeatures->FeatureEnabled("ExternalNodeManagement",
					   undef, undef, $experiment)) {
	    Notify("NOT sending idle notification to externally managed ".
		   "experiment $pid/$eid.\n");
	    return;
	}
524 525 526 527 528 529
	# Do not bother with emulab-ops ...
	if ($pid eq TBOPSPID()) {
	    Notify("NOT sending idle notification to system ".
		   "experiment $pid/$eid.\n");
	    return;
	}
530 531 532
	Notify("Sending message to $pid/$eid, ".
	       "idle $idlehrs hrs $idlemin min, total $time hrs\n");
    }
533
    
534 535 536 537
    if ($v > 1) {
	Debug("expt=$pid/$eid (gid=$gid)\n".
	      "uid=$expcreator_uid  ($expcreator_name <$expcreator_email>)\n".
	      "leaders=$leaders\n");
538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563
    }

    my $wrapwidth=75;

    # Important note about our wordwrapper:
    # It does funkyness with strings that already have some newlines in 
    # them, most especially with \n\n embedded. It also adds a final \n
    # to the end of the string it wraps.

    $msg="Hi, this is an important automated message from $THISHOMEBASE.\n\n";
    $msg .=
      wordwrap("It appears that the $c node".($c!=1?"s":"").
	       " in your experiment ".
	       "'$eid' ".($c!=1?"have":"has")." been inactive for ".
	       "$idlehrs hours, $idlemin minutes, since $lastact. ".
	       ( $stale
		 ? ("(This message may be based on incomplete or ".
		    "stale information. ".
		    "Contact Testbed Ops if this message is a mistake.) ")
		 : "").
	       ( $swapreqs > 0
		 ? ("You have been sent ".$swapreqs." other message".
		    ($swapreqs!=1?"s":"")." since this experiment ".
		    "became idle. ")
		 : "").
	       ($swappable ?
564 565 566 567 568 569
		( $warn==2 ?
		  ("If this experiment continues to be idle, it will be ".
		   "Idle-Swapped in about $warnmin minutes.") :
		  ("This experiment is marked as swappable, so it may be ".
		   "automatically swapped out by $THISHOMEBASE or its ".
		   "operational staff. ")) :
570 571 572 573 574 575 576 577
		("This experiment has not been marked swappable, so it ".
		 "will not be automatically swapped out. ")), $wrapwidth);
    $msg .= "\n".
      wordwrap("We would appreciate it if you could either terminate or ".
	       "swap this experiment out so that the nodes will be ".
	       "available for use by other experimenters. You can do this ".
	       "by logging into the $THISHOMEBASE Web Interface, and using ".
	       "the swap or terminate links on this page:",$wrapwidth);
578
    if ($warn==1) {
579 580 581
	# We're sending a different kind of message...
	# Fix the first half, and the rest is the same as the other message.
	$msg="Hi, this is an important automated message from $THISHOMEBASE.".
582 583 584 585 586
	  "\n\nYou set a Max Duration for your experiment $pid/$eid\n".
	  "so that it will be swapped out in about $warnmin minutes, ".
	  "whether it is in\nactive use or not.\n".
	  "If you would like to change the Max Duration, please use the \n".
	  "Edit Metadata option on this page:\n";
587
    }
588 589 590 591 592 593 594 595 596 597 598 599 600 601
    $msg .= "\n$TBBASE/showexp.php3?pid=$pid&eid=$eid\n\n";
    $msg .=
      wordwrap("More information on experiment swapping is available ".
	       "in the $THISHOMEBASE FAQ at",$wrapwidth);
    $msg .= "$TBDOCBASE/faq.php3#UTT-Swapping\n\n";
    $msg .=
      wordwrap("More information on our node usage policy is available at ",
	       $wrapwidth);
    $msg .= "$TBDOCBASE/docwrapper.php3?docname=swapping.html\n\n";
    $msg .=
      wordwrap("If you feel this message is in error then please contact ".
	       "Testbed Operations <$TBMAILADDR_OPS>.",$wrapwidth);
    $msg .= "\nThanks!\nTestbed Operations\n";

Mac Newbold's avatar
Mac Newbold committed
602
    $cclist="";
603
    if ($expcreator_name ne $expswapper_name) {
Mac Newbold's avatar
Mac Newbold committed
604 605 606 607 608 609 610 611 612 613 614 615
	# creator and swapper are different
	$cclist="Cc: $expcreator_name <$expcreator_email>";
    }
    if ($swapreqs+1 >= $cc_grp_ldrs) {
	if ($cclist ne "") {
	    $cclist .= ", $leaders\n";
	} else {
	    $cclist = "Cc: $leaders\n"
	}
    } elsif ($cclist ne "") {
	$cclist .="\n";
    }
616

617 618 619 620
    if ($warn==1) {
	$subj="Max Duration Warning: $pid/$eid";
    } elsif ($warn==2) {
	$subj="Idle-Swap Warning: $c PC".($c!=1?"s":"").", $pid/$eid";
621 622 623
    } else {
	$subj="$c PC".($c!=1?"s":"")." idle $idlehrs hours: $pid/$eid";
    }
624
    if ($n || $i) {
625 626
	# no mail mode: don't send mail or update db counters
	print "----NO-MAIL-MODE----\n";
627
	print "To: $expswapper_name <$expswapper_email>\n";
628
	print "From: $TBMAIL_OPS\n".
Mac Newbold's avatar
Mac Newbold committed
629 630 631
	  $cclist.
	  "Bcc: $TBMAIL_AUTOMAIL\n".
	  "Errors-To: $TBMAIL_WWW"."\n";
632
	print "Subject: $subj\n";
633 634 635 636 637 638
	print "\n$msg\n";
	print "----NO-MAIL-MODE----\n";
    } else {
	# libtestbed SENDMAIL syntax:
	# SENDMAIL(To, Subject, Message, [From], [More Headers],...)

Mac Newbold's avatar
Mac Newbold committed
639

640 641
	# For debugging:
	#SENDMAIL("Expt Leader <$TBMAILADDR_OPS>",
642
	SENDMAIL("$expswapper_name <$expswapper_email>",
643
		 $subj,
644 645
		 $msg,
		 "$TBMAIL_OPS",
Mac Newbold's avatar
Mac Newbold committed
646
		 $cclist.
647 648 649
		 "Bcc: $TBMAIL_AUTOMAIL\n".
		 "Errors-To: $TBMAIL_WWW");

650 651 652
	if ($warn!=1) {
	    # if I'm not doing an autoswap warning,
	    # Update the count and the time in the database
653 654
	    DBQueryFatal("update experiments set swap_requests=swap_requests+1,
                       last_swap_req=now() where pid='$pid' and eid='$eid'");
655
	}
656 657 658 659 660 661 662 663 664 665 666 667 668 669
    }

}

sub wordwrap($$) {
    # Perl version of the PHP wordwrap function.
    # Got the one-liner at http://www.consistent.org/terran/misc.shtml

    my ($str,$width) = @_;

    # The one liner sometimes produces spurious undefined values warnings, 
    # so we'll temporarily disable it in this function only
    local $WARNING = 0;

670
    if ($v > 1) { Debug("WRAPPING: $str => $width\n"); }
671
    $str=~s/(?:^|\G\n?)(?:(.{1,$width})(?:\s|\n|$)|(\S{$width})|\n)/$1$2\n/sg;
672
    if ($v > 1) { Debug("WRAPPING: => \n$str\n"); }
673 674 675

    return $str;
}
676