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