pl_mom.pl

   1 #!/usr/bin/perl -w
   2
   3 use POSIX qw(setsid);
   4 use Sys::Syslog;
   5 use Sys::Hostname;
   6 #use LWP::Simple;
   7
   8 $debug = 0;
   9 $proc = "pl_mom";
  10 $alias_addr = "pl-mom\@planet-lab.org";
  11 $from_addr = "support\@planet-lab.org";
  12
  13 if (! $debug) {
  14     $kill_thresh = 90;
  15     $reboot_thresh = 95;
  16     $log_thresh = 85;
  17     $change_thresh = 5;
  18     $min_thresh = 10;
  19     #$bwcap_default = "off";
  20     $bwcap_default = "1.5Mbit";
  21     $cutoff_default = "16200000000";  # 16GB, for 1.5Mbit cap
  22     $bwmon_sleep = 900;
  23
  24     $sendmail = "/usr/sbin/sendmail -t -f$from_addr";
  25     $vservers = "/etc/vservers";
  26     $pidfile = "/var/run/$proc.pid";
  27     $rebootfile = "/var/lib/misc/pl_mom.reboot";
  28     $daily_log = "/var/lib/misc/pl_mom.daily";
  29     $daily_stamp = "/var/lib/misc/pl_mom.stamp";
  30     $configfile = "/etc/planetlab/pl_mom.conf";
  31     $capfile = "/var/lib/misc/pl_mom.oldcaps";
  32 } else {
  33     $kill_thresh = 2;
  34     $reboot_thresh = 20;
  35     $log_thresh = 2;
  36     $change_thresh = 5;
  37     $min_thresh = 2;
  38     $bwcap_default = "1Kbit";
  39     $cutoff_default = "10800";
  40     $bwmon_sleep = 10;
  41
  42     $sendmail = "cat";
  43     $vservers = "./debug";
  44     $pidfile = "./$proc.pid";
  45     $rebootfile = "./debug/pl_mom.reboot";
  46     $daily_log = "./debug/pl_mom.daily";
  47     $daily_stamp = "./debug/pl_mom.stamp";
  48     $configfile = "./debug/pl_mom.conf";
  49     $capfile = "./debug/pl_mom.oldcaps";
  50 }
  51
  52 $sleep = 30;
  53
  54 # daemonize the program
  55 if (! $debug) {
  56     &daemonize;
  57 }
  58
  59 system("echo $$ > $pidfile");
  60
  61 read_config_file();
  62
  63 # Check to see whether pl_mom rebooted the node
  64 if (-e $rebootfile) {
  65     unlink($rebootfile);
  66     syslog ("warning", "pl_mom: Sending shutdown mail");
  67     shutdown_mail();
  68 }
  69
  70 my $pid = fork();
  71 if (! $pid) {
  72     syslog ("info", "pl_mom: Launching reboot kicker");
  73     reboot_kicker();
  74     die (0);
  75 }
  76 $pid = fork();
  77 if (! $pid) {
  78     syslog ("info", "pl_mom: Launching bandwidth monitor");
  79     if ($bwcap_default =~ /off/) {
  80         syslog("info", "pl_mom: Max rate unlimited by default");
  81     }
  82     reset_bandwidth_caps();
  83     bandwidth_monitor();
  84     die (0);
  85 }
  86
  87 while (1) {
  88     $used = int(swap_used());
  89
  90     if (defined($old_used)) {
  91         if ($used >= $old_used + $change_thresh) {
  92             syslog ("info", "pl_mom: %d%% swap consumed in last %d seconds",
  93                     $used - $old_used, $sleep);
  94         }
  95     }
  96
  97     if ($used >= $log_thresh) {
  98         if (! defined($old_used) || $used != $old_used) {
  99             syslog ("info", "pl_mom: Swap used: %d%%", $used);
 100         }
 101         get_slice_info();
 102         my $hog = memory_hog();
 103         if ($hog) {
 104             if ($used < $kill_thresh) {
 105                 if (! defined($Warning{$hog})) {
 106                     $Warning{$hog} = "sent";
 107                     syslog ("warning", "pl_mom: Slice $hog is ".
 108                             "using $Slice{$hog}{mem_pct}%% of memory");
 109                     #slice_warning_mail($hog);
 110                 }
 111             } else {
 112                 my $id = `id -u $hog`;
 113                 chomp($id);
 114                 my $top = `/usr/sbin/chcontext --ctx $id /usr/bin/top -b -n 1`;
 115                 syslog ("warning", "pl_mom: Resetting slice $hog");
 116                 if (! $debug) {
 117                     slice_reset($hog);
 118                 }
 119                 syslog ("warning", "pl_mom: Sending mail to slice $hog");
 120                 slice_reset_mail($hog, $top);
 121             }
 122         }
 123     }
 124
 125     sleep ($sleep);
 126
 127     $old_used = $used;
 128 }
 129
 130 sub reboot_kicker {
 131     while (1) {
 132         $used = swap_used();
 133
 134         if ($used >= $reboot_thresh) {
 135             syslog ("warning", "pl_mom: Rebooting node");
 136
 137             system("touch $rebootfile");
 138             if (! $debug) {
 139                 #system("shutdown -r now");
 140                 system("/bin/sync; /sbin/reboot -f");
 141             }
 142             die (0);
 143         }
 144
 145         sleep (1);
 146     }
 147 }
 148
 149 sub bandwidth_monitor {
 150     while (1) {
 151         # See if a new day has started for bandwidth monitoring
 152         chomp($now = `date -u +%D`);
 153         if (-e $daily_stamp) {
 154             chomp($stamp = `cat $daily_stamp`);
 155         }
 156         if (! defined($stamp) || !($stamp =~ $now)) {
 157             open (STAMP, ">$daily_stamp") ||
 158                 die "Can't open file $daily_stamp for writing: $!\n";
 159             print STAMP "$now\n";
 160             close STAMP;
 161             unlink ($daily_log);
 162
 163             # Could save the list of capped slices in a file in order to
 164             # avoid re-sending mails if the daemon restarts.
 165             # Also may want a list of slices that are exempt from capping.
 166             if (defined(%Start)) { undef %Start; }
 167             if (defined(%Now))   { undef %Now; }
 168             if (defined(%Cap))   { undef %Cap; }
 169
 170             reset_bandwidth_caps();
 171
 172             syslog("info", "pl_mom: Beginning bandwidth monitoring for $now");
 173         }
 174
 175         get_slice_names();
 176         get_baseline_counts();
 177         get_slice_limits();
 178
 179         foreach $slice ( sort (keys %Start) ) {
 180             if (defined $Now{$slice}) {
 181                 $today = $Now{$slice} - $Start{$slice};
 182                 if (! (defined ($Cutoff{$slice})||$bwcap_default =~ /off/)) {
 183                     $Cutoff{$slice} = $cutoff_default;
 184                     $Maxrate{$slice} = $bwcap_default;
 185                 }
 186                 if ($debug) {
 187                     if ($today) {
 188                         $cutoff = defined($Cutoff{$slice})
 189                             ? $Cutoff{$slice} : "<none>";
 190                         print "Slice $slice sent $today bytes; ".
 191                             "cutoff $cutoff\n";
 192                     }
 193                 }
 194                 if (defined ($Cutoff{$slice}) &&
 195                     $today >= $Cutoff{$slice} &&
 196                     ! defined($Cap{$slice})) {
 197                     $Cap{$slice} = "sent";
 198                     bw_cap_mail($slice);
 199                     if (! $debug) {
 200                         log_bandwidth_cap($slice, $Maxrate{$slice});
 201                         cap_bandwidth($slice, $Maxrate{$slice});
 202                     }
 203                 }
 204             } else {
 205                 # Token bucket for this slice is gone!
 206             }
 207         }
 208
 209         sleep($bwmon_sleep);
 210     }
 211 }
 212
 213 sub read_config_file {
 214     if (-e $configfile) {
 215         open (CONFIG, "<$configfile") ||
 216             print "Cannot open $configfile; $!\n";
 217         while (<CONFIG>) {
 218             if (m/^(.*)=(.*)$/) {
 219                 ${$1} = $2;
 220                 if ($debug) {
 221                     print "read_config_file: $1 = ${$1}\n";
 222                 }
 223             }
 224         }
 225         close CONFIG;
 226     }
 227 }
 228
 229 sub get_slice_names {
 230     # Read slice names from /etc/passwd
 231     if (defined (%Name)) { undef %Name; }
 232     open (PASSWD, "</etc/passwd") ||
 233         print "Cannot open /etc/passwd; $!\n";
 234     while (<PASSWD>) {
 235         my ($slicename, $passwd, $sliceid) = split(/:/);
 236         $Name{$sliceid} = $slicename;
 237     }
 238     close PASSWD;
 239 }
 240
 241 sub get_baseline_counts {
 242     `touch $daily_log`;
 243     open (BASE, "+<$daily_log") ||
 244         print "Cannot open $daily_log; $!\n";
 245     while (<BASE>) {
 246         my ($slice, $bytecount) = split(/ /);
 247         $Start{$slice} = $bytecount;
 248     }
 249
 250     my $status = `tc -s -d qdisc show`;
 251     my $sliceid = "9999";
 252     @Lines = split(/\n/, $status);
 253     foreach $line ( @Lines ) {
 254         if ($line =~ /qdisc pfifo (.*): dev/) {
 255             $sliceid = $1;
 256         } else {
 257             if ($line =~ /Sent (.*) bytes/) {
 258                 my $bytes = $1;
 259                 if ($sliceid != 9999) {
 260                     my $slice = $Name{$sliceid};
 261                     if ($debug && $bytes) {
 262                         print "Slice: $slice ($sliceid), bytes $bytes\n";
 263                     }
 264                     if (! defined($Start{$slice})) {
 265                         print BASE "$slice $bytes\n";
 266                         $Start{$slice} = $bytes;
 267                     }
 268                     $Now{$slice} = $bytes;
 269                 }
 270             }
 271         }
 272     }
 273     close (BASE);
 274 }
 275
 276 sub get_slice_limits {
 277     if (defined %Maxrate) { undef %Maxrate; }
 278     if (defined %Cutoff)  { undef %Cutoff; }
 279     if (-e $vservers) {
 280         my $result = `grep -H "^BWMAXRATE" $vservers/*.conf`;
 281         chomp ($result);
 282         my @Lines = split(/\n/,$result);
 283         foreach $line ( @Lines ) {
 284             if ($line =~ /\/([^\/]*).conf:BWMAXRATE=(.*)[Mm]bit/) {
 285                 $slice = $1;
 286                 $limit = $2."Mbit";
 287                 $cutoff = ($2 * 1000000 * 86400)/8;
 288             } else {
 289                 if ($line =~ /\/([^\/]*).conf:BWMAXRATE=(.*)[Kk]bit/) {
 290                     $slice = $1;
 291                     $limit = $2."Kbit";
 292                     $cutoff = ($2 * 1000 * 86400)/8;
 293                 } else {
 294                     die "Could not parse line $line";
 295                 }
 296             }
 297             $Maxrate{$slice} = $limit;
 298             $Cutoff{$slice} = $cutoff;
 299             if ($debug) {
 300                 print "Slice $slice, maxrate $Maxrate{$slice}, ".
 301                     "cutoff $Cutoff{$slice}\n";
 302             }
 303         }
 304     }
 305 }
 306
 307 sub reset_bandwidth_caps {
 308     if (-e $capfile) {
 309         open(CAP, "<$capfile") or die "Cannot open $capfile: $!";
 310         while (<CAP>) {
 311             chomp();
 312             ($slicename, $oldcap) = split(/ /);
 313             syslog("info", "pl_mom: Restoring bandwidth cap of $oldcap ".
 314                    "to $slicename");
 315             cap_bandwidth ($slicename, $oldcap);
 316         }
 317         close CAP;
 318         unlink($capfile);
 319     }
 320 }
 321
 322 sub log_bandwidth_cap {
 323     ($slicename, $cap) = @_;
 324     syslog("warning", "pl_mom: Capping bandwidth of slice ".
 325            "$slicename at $cap until midnight GMT.");
 326     # Save current cap to $capfile
 327     system("echo $slicename `bwlimit getcap $slicename` >> $capfile");
 328 }
 329
 330 sub send_mail {
 331     # Arg 0: recipient addresses, comma-separated string
 332     # Arg 1: subject line
 333     # Arg 2: body of message
 334     my $to = "To: $_[0]\n";
 335     my $from = "From: $from_addr\n";
 336     my $subject = "Subject: $_[1]\n";
 337     my $msg = $_[2];
 338
 339     open(SENDMAIL, "|$sendmail") or die "Cannot open $sendmail: $!";
 340     print SENDMAIL $to;
 341     print SENDMAIL $from;
 342     print SENDMAIL $subject;
 343     print SENDMAIL "Content-type: text/plain\n\n";
 344     print SENDMAIL $msg;
 345     close(SENDMAIL);
 346 }
 347
 348 sub cap_bandwidth {
 349     ($slicename, $cap) = @_;
 350     system("bwlimit setcap $slicename $cap");
 351     system("bwlimit on $slicename");
 352 }
 353
 354 sub get_date {
 355     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdat)
 356         = localtime(time);
 357     my $date = sprintf("%4d-%02d-%02d %02d:%02d:%02d",
 358                        $year+1900, $mon+1, $mday, $hour, $min, $sec);
 359     return $date;
 360 }
 361
 362 sub bw_cap_mail {
 363     my ($slicename) = @_;
 364     my $hostname = hostname();
 365     my $date = get_date();
 366     my $sent = int($Cutoff{$slicename}/(1024*1024));
 367     my $bwcap = $Maxrate{$slicename};
 368
 369     send_mail("$alias_addr, $slicename\@slices.planet-lab.org",
 370               "$proc capped bandwidth of slice $slicename on $hostname",
 371               "Slice $slicename has transmitted more than ${sent}MB today".
 372               " on $hostname.  ".
 373               "Its bandwidth will be capped at $bwcap until midnight GMT.".
 374               "\n\n$date $hostname bwcap $slicename\n");
 375 }
 376
 377 sub shutdown_mail {
 378     my $hostname = hostname();
 379     my $date = get_date();
 380     send_mail($alias_addr,
 381               "$proc rebooted $hostname",
 382               "Swap space was exhausted on $hostname and so $proc rebooted ".
 383               "it.\n\nAs of $date, the node has successfully come back ".
 384               "online.\n\n$date $hostname reboot\n");
 385 }
 386
 387 sub slice_reset_mail {
 388     my $hog = $_[0];
 389     my $top = $_[1];
 390     my $hog_mem = sprintf ("%0.f", $Slice{$hog}{pmem}/1000);
 391     my $hog_pct = $Slice{$hog}{mem_pct};
 392     my $hostname = hostname();
 393     my $date = get_date();
 394     send_mail("$alias_addr, $hog\@slices.planet-lab.org",
 395               "$proc reset slice $hog on $hostname",
 396               "As of $date, swap space is nearly exhausted on $hostname.\n\n".
 397               "Slice $hog is being reset since it is the largest consumer ".
 398               "of physical memory at ${hog_mem}MB ($hog_pct%).\n\n".
 399               "Please reply to this message explaining the nature of your ".
 400               "experiment, and what you are doing to address the problem.\n".
 401               "\nOutput of 'top -b -n 1' in your slice prior to reset:\n".
 402               "$top\n\n$date $hostname reset $hog\n");
 403 }
 404
 405 sub slice_warning_mail {
 406     my $hog = $_[0];
 407     my $hog_mem = sprintf ("%0.f", $Slice{$hog}{pmem}/1000);
 408     my $hog_pct = $Slice{$hog}{mem_pct};
 409     my $hostname = hostname();
 410     my $date = get_date();
 411
 412     if ($hog =~ /^root$/) {
 413         $to = $alias_addr;
 414     } else {
 415         $to = "$alias_addr, $hog\@slices.planet-lab.org";
 416     }
 417
 418     send_mail($to,
 419               "$proc may reset slice $hog on $hostname",
 420               "As of $date, swap space is over $log_thresh% full on ".
 421               "$hostname.\n\nSlice $hog is the largest consumer ".
 422               "of physical memory at ${hog_mem}MB ($hog_pct%).\n".
 423               "Please check the memory usage of your slice to avoid a ".
 424               "reset.\n\n$date $hostname warning $hog\n");
 425 }
 426
 427 sub unkillable_alarm_mail {
 428     my $hog = $_[0];
 429     my $hog_mem = sprintf ("%0.f", $Slice{$hog}{pmem}/1000);
 430     my $hog_pct = $Slice{$hog}{mem_pct};
 431     my $hostname = hostname();
 432     my $date = get_date();
 433
 434     if ($hog =~ /^root$/) {
 435         $to = $alias_addr;
 436     } else {
 437         $to = "$alias_addr, $hog\@slices.planet-lab.org";
 438     }
 439
 440     send_mail($to,
 441               "$proc: alarm for slice $hog on $hostname",
 442               "As of $date, swap space is over $log_thresh% full on ".
 443               "$hostname.\n\nSlice $hog is the largest consumer ".
 444               "of physical memory at ${hog_mem}MB ($hog_pct%).\n".
 445               "The slice will not be reset, but please verify its behavior.\n".
 446               "\n$date $hostname alarm $hog\n");
 447 }
 448
 449 sub slice_reset {
 450     my $slice = $_[0];
 451     my $sliceid = $Slice{$slice}{ctx};
 452     system("chcontext --ctx $sliceid sudo kill -9 -1");
 453     system("/etc/init.d/vserver-init start $slice");
 454 }
 455
 456 sub swap_used {
 457     open (SWAP, "</proc/swaps") ||
 458         die "Cannot open /proc/swaps; $!\n";
 459
 460     $line = <SWAP>;
 461     $line = <SWAP>;
 462     $line =~ s/[\t ]+/ /g;
 463
 464     my ($filename, $type, $size, $used, $priority) = split(/ /, $line);
 465     close SWAP;
 466
 467     return 100*($used/$size);
 468 }
 469
 470 sub get_slice_info {
 471     if (! $debug) {
 472         $content = `curl -s http://127.0.0.1:3100/slicestat`;
 473     } else {
 474         #$content = `cat ../pl_mom-deploy/slicestat`
 475         $content = `curl -s http://127.0.0.1:3100/slicestat`;
 476     }
 477     my @lines = split(/\n/, $content);
 478     %Slice = ();
 479     foreach $line (@lines) {
 480         my ($slice, $ctx, $cpu_pct, $mem_pct, $pmem, $vmem, $ntasks)
 481             = split(/,/,$line);
 482         $Slice{$slice}{ctx} = $ctx;
 483         $Slice{$slice}{cpu_pct} = $cpu_pct;
 484         $Slice{$slice}{mem_pct} = $mem_pct;
 485         $Slice{$slice}{pmem} = $pmem;
 486         $Slice{$slice}{vmem} = $vmem;
 487         $Slice{$slice}{ntasks} = $ntasks;
 488     }
 489 }
 490
 491 sub memory_hog {
 492     @keys = sort { $Slice{$b}{mem_pct} <=> $Slice{$a}{mem_pct} } (keys %Slice);
 493     foreach $key (@keys) {
 494         if ($Slice{$key}{mem_pct} >= $min_thresh) {
 495             if ($key =~ /^root$/ || $key =~ /slicestat/ || $key =~ /netflow/) {
 496                 if (! defined ($Warning{$key})) {
 497                     $Warning{$key} = "sent";
 498                     syslog ("warning", "pl_mom: Sending alarm mail to ".
 499                             "unkillable slice $key, using ".
 500                             "$Slice{$key}{mem_pct}%% of memory");
 501                     unkillable_alarm_mail($key);
 502                 }
 503             } else {
 504                 return $key;
 505             }
 506         } else {
 507             #syslog ("info", "pl_mom: No killable slice using > ".
 508             #    "$min_thresh%% memory");
 509             return;
 510         }
 511     }
 512 }
 513
 514 sub daemonize {
 515     chdir '/'                 or die "Can't chdir to /: $!";
 516     open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
 517     open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
 518     open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
 519     defined(my $pid = fork)   or die "Can't fork: $!";
 520     exit if $pid;
 521     setsid                    or die "Can't start a new session: $!";
 522     umask 0;
 523 }