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