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
  20     $sendmail = "/usr/sbin/sendmail -t -f$from_addr";
  21     $pidfile = "/var/run/$proc.pid";
  22     $rebootfile = "/var/lib/misc/pl_mom.reboot";
  23 } else {
  24     $kill_thresh = 2;
  25     $reboot_thresh = 20;
  26     $log_thresh = 2;
  27     $change_thresh = 5;
  28     $min_thresh = 10;
  29
  30     $sendmail = "cat";
  31     $pidfile = "./$proc.pid";
  32     $rebootfile = "./pl_mom.reboot";
  33 }
  34
  35 $sleep = 30;
  36
  37 # daemonize the program
  38 if (! $debug) {
  39     &daemonize;
  40 }
  41
  42 system("echo $$ > $pidfile");
  43
  44 if (-e $rebootfile) {
  45     unlink($rebootfile);
  46     syslog ("warning", "pl_mom: Sending shutdown mail");
  47     shutdown_mail();
  48 }
  49
  50 my $pid = fork();
  51 if (! $pid) {
  52     syslog ("info", "pl_mom: Launching reboot kicker");
  53     reboot_kicker();
  54     die (0);
  55 }
  56
  57 while (1) {
  58     $used = int(swap_used());
  59
  60     if (defined($old_used)) {
  61         if ($used >= $old_used + $change_thresh) {
  62             syslog ("info", "pl_mom: %d%% swap consumed in last %d seconds",
  63                     $used - $old_used, $sleep);
  64         }
  65     }
  66
  67     if ($used >= $log_thresh) {
  68         if (! defined($old_used) || $used != $old_used) {
  69             syslog ("info", "pl_mom: Swap used: %d%%", $used);
  70         }
  71         get_slice_info();
  72         my $hog = memory_hog();
  73         if ($hog) {
  74             if ($used < $kill_thresh) {
  75                 if (! defined($Warning{$hog})) {
  76                     $Warning{$hog} = "sent";
  77                     syslog ("warning", "pl_mom: Slice $hog is ".
  78                             "using $Slice{$hog}{mem_pct}%% of memory");
  79                     #slice_warning_mail($hog);
  80                 }
  81             } else {
  82                 my $id = `id -u $hog`;
  83                 chomp($id);
  84                 my $top = `chcontext --ctx $id top -b -n 1`;
  85                 syslog ("warning", "pl_mom: Resetting slice $hog");
  86                 if (! $debug) {
  87                     slice_reset($hog);
  88                 }
  89                 syslog ("warning", "pl_mom: Sending mail to slice $hog");
  90                 slice_reset_mail($hog, $top);
  91             }
  92         }
  93     }
  94
  95     sleep ($sleep);
  96
  97     $old_used = $used;
  98 }
  99
 100 sub reboot_kicker {
 101     while (1) {
 102         $used = swap_used();
 103
 104         if ($used >= $reboot_thresh) {
 105             syslog ("warning", "pl_mom: Rebooting node");
 106
 107             system("touch $rebootfile");
 108             if (! $debug) {
 109                 system("shutdown -r now");
 110             }
 111             die (0);
 112         }
 113
 114         sleep (1);
 115     }
 116 }
 117
 118 sub shutdown_mail {
 119     my $hostname = hostname();
 120     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdat)
 121         = localtime(time);
 122     my $date = sprintf("%4d-%02d-%02d %02d:%02d:%02d",
 123                        $year+1900, $mon+1, $mday, $hour, $min, $sec);
 124     my $to = "To: $alias_addr\n";
 125     my $from = "From: $from_addr\n";
 126     my $subject = "Subject: $proc rebooted $hostname\n";
 127     my $msg ="Swap space was exhausted on $hostname and so $proc rebooted ".
 128         "it.\n\nAs of $date, the node has successfully come back online.\n".
 129         "\n$date $hostname reboot\n";
 130
 131     open(SENDMAIL, "|$sendmail") or die "Cannot open $sendmail: $!";
 132     print SENDMAIL $to;
 133     print SENDMAIL $from;
 134     print SENDMAIL $subject;
 135     print SENDMAIL "Content-type: text/plain\n\n";
 136     print SENDMAIL $msg;
 137     close(SENDMAIL);
 138 }
 139
 140 sub slice_reset_mail {
 141     my $hog = $_[0];
 142     my $top = $_[1];
 143     my $hog_mem = sprintf ("%0.f", $Slice{$hog}{pmem}/1000);
 144     my $hog_pct = $Slice{$hog}{mem_pct};
 145     my $hostname = hostname();
 146     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdat)
 147         = localtime(time);
 148     my $date = sprintf("%4d-%02d-%02d %02d:%02d:%02d",
 149                        $year+1900, $mon+1, $mday, $hour, $min, $sec);
 150     my $to = "To: $alias_addr, $hog\@slices.planet-lab.org\n";
 151     my $from = "From: $from_addr\n";
 152     my $subject = "Subject: $proc reset slice $hog on $hostname\n";
 153     my $msg = "As of $date, swap space is nearly exhausted on $hostname.\n\n".
 154         "Slice $hog is being reset since it is the largest consumer ".
 155         "of physical memory at ${hog_mem}MB ($hog_pct%).\n\n".
 156         "Please reply to this message explaining the nature of your ".
 157         "experiment, and what you are doing to address the problem.\n".
 158         "\nOutput of 'top -b -n 1' in your slice prior to reset:\n".
 159         "$top\n\n$date $hostname reset $hog\n";
 160
 161     open(SENDMAIL, "|$sendmail") or die "Cannot open $sendmail: $!";
 162     print SENDMAIL $to;
 163     print SENDMAIL $from;
 164     print SENDMAIL $subject;
 165     print SENDMAIL "Content-type: text/plain\n\n";
 166     print SENDMAIL $msg;
 167     close(SENDMAIL);
 168 }
 169
 170 sub slice_warning_mail {
 171     my $hog = $_[0];
 172     my $hog_mem = sprintf ("%0.f", $Slice{$hog}{pmem}/1000);
 173     my $hog_pct = $Slice{$hog}{mem_pct};
 174     my $hostname = hostname();
 175     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdat)
 176         = localtime(time);
 177     my $date = sprintf("%4d-%02d-%02d %02d:%02d:%02d",
 178                        $year+1900, $mon+1, $mday, $hour, $min, $sec);
 179
 180     if ($hog =~ /^root$/) {
 181         $to = "To: $alias_addr\n";
 182     } else {
 183         $to = "To: $alias_addr, $hog\@slices.planet-lab.org\n";
 184     }
 185
 186     my $from = "From: $from_addr\n";
 187     my $subject = "Subject: $proc may reset slice $hog on $hostname\n";
 188     my $msg = "As of $date, swap space is over $log_thresh% full on ".
 189         "$hostname.\n\nSlice $hog is the largest consumer ".
 190         "of physical memory at ${hog_mem}MB ($hog_pct%).\n".
 191         "Please check the memory usage of your slice to avoid a reset.\n".
 192         "\n$date $hostname warning $hog\n";
 193
 194     open(SENDMAIL, "|$sendmail") or die "Cannot open $sendmail: $!";
 195     print SENDMAIL $to;
 196     print SENDMAIL $from;
 197     print SENDMAIL $subject;
 198     print SENDMAIL "Content-type: text/plain\n\n";
 199     print SENDMAIL $msg;
 200     close(SENDMAIL);
 201 }
 202
 203 sub unkillable_alarm_mail {
 204     my $hog = $_[0];
 205     my $hog_mem = sprintf ("%0.f", $Slice{$hog}{pmem}/1000);
 206     my $hog_pct = $Slice{$hog}{mem_pct};
 207     my $hostname = hostname();
 208     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdat)
 209         = localtime(time);
 210     my $date = sprintf("%4d-%02d-%02d %02d:%02d:%02d",
 211                        $year+1900, $mon+1, $mday, $hour, $min, $sec);
 212
 213     if ($hog =~ /^root$/) {
 214         $to = "To: $alias_addr\n";
 215     } else {
 216         $to = "To: $alias_addr, $hog\@slices.planet-lab.org\n";
 217     }
 218
 219     my $from = "From: $from_addr\n";
 220     my $subject = "Subject: $proc: alarm for slice $hog on $hostname\n";
 221     my $msg = "As of $date, swap space is over $log_thresh% full on ".
 222         "$hostname.\n\nSlice $hog is the largest consumer ".
 223         "of physical memory at ${hog_mem}MB ($hog_pct%).\n".
 224         "The slice will not be reset, but please verify its behavior.\n".
 225         "\n$date $hostname alarm $hog\n";
 226
 227     open(SENDMAIL, "|$sendmail") or die "Cannot open $sendmail: $!";
 228     print SENDMAIL $to;
 229     print SENDMAIL $from;
 230     print SENDMAIL $subject;
 231     print SENDMAIL "Content-type: text/plain\n\n";
 232     print SENDMAIL $msg;
 233     close(SENDMAIL);
 234 }
 235
 236 sub slice_reset {
 237     my $slice = $_[0];
 238     my $sliceid = $Slice{$slice}{ctx};
 239     system("chcontext --ctx $sliceid sudo kill -9 -1");
 240     system("/etc/init.d/vserver-init start $slice");
 241 }
 242
 243 sub swap_used {
 244     open (SWAP, "</proc/swaps") ||
 245         die "Cannot open /proc/swaps; $!\n";
 246
 247     $line = <SWAP>;
 248     $line = <SWAP>;
 249     $line =~ s/[\t ]+/ /g;
 250
 251     my ($filename, $type, $size, $used, $priority) = split(/ /, $line);
 252     close SWAP;
 253
 254     return 100*($used/$size);
 255 }
 256
 257 sub get_slice_info {
 258     if (! $debug) {
 259         #$content = get "http://127.0.0.1:3100/slicestat";
 260         $content = `curl -s http://127.0.0.1:3100/slicestat`;
 261     } else {
 262         $content = `cat ../pl_mom-deploy/slicestat`
 263     }
 264     my @lines = split(/\n/, $content);
 265     %Slice = ();
 266     foreach $line (@lines) {
 267         my ($slice, $ctx, $cpu_pct, $mem_pct, $pmem, $vmem, $ntasks)
 268             = split(/,/,$line);
 269         $Slice{$slice}{ctx} = $ctx;
 270         $Slice{$slice}{cpu_pct} = $cpu_pct;
 271         $Slice{$slice}{mem_pct} = $mem_pct;
 272         $Slice{$slice}{pmem} = $pmem;
 273         $Slice{$slice}{vmem} = $vmem;
 274         $Slice{$slice}{ntasks} = $ntasks;
 275     }
 276 }
 277
 278 sub memory_hog {
 279     @keys = sort { $Slice{$b}{mem_pct} <=> $Slice{$a}{mem_pct} } (keys %Slice);
 280     foreach $key (@keys) {
 281         if ($Slice{$key}{mem_pct} >= $min_thresh) {
 282             if ($key =~ /^root$/ || $key =~ /slicestat/ || $key =~ /netflow/) {
 283                 if (! defined ($Warning{$key})) {
 284                     $Warning{$key} = "sent";
 285                     syslog ("warning", "pl_mom: Sending alarm mail to ".
 286                             "unkillable slice $key, using ".
 287                             "$Slice{$key}{mem_pct}%% of memory");
 288                     unkillable_alarm_mail($key);
 289                 }
 290             } else {
 291                 return $key;
 292             }
 293         } else {
 294             #syslog ("info", "pl_mom: No killable slice using > ".
 295             #    "$min_thresh%% memory");
 296             return;
 297         }
 298     }
 299 }
 300
 301 sub daemonize {
 302     chdir '/'                 or die "Can't chdir to /: $!";
 303     open STDIN, '/dev/null'   or die "Can't read /dev/null: $!";
 304     open STDOUT, '>>/dev/null' or die "Can't write to /dev/null: $!";
 305     open STDERR, '>>/dev/null' or die "Can't write to /dev/null: $!";
 306     defined(my $pid = fork)   or die "Can't fork: $!";
 307     exit if $pid;
 308     setsid                    or die "Can't start a new session: $!";
 309     umask 0;
 310 }