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