memcron.pl 0.5.5

#!/usr/bin/env perl

#////////////////////////////////////////////////////////////////////////////////////
#
#   memCron - DreamHost PS Memory Manager
#
#   Author     : Yaosan Yeo
#   Updated by : Ben
#   Version    : 0.5.5
#   Date       : 12 March 2010
#   URL        : http://memcron.com/
#
#   History  :
#   0.5.5 [2010.03.12] - Simplified memory collecting for now
#   0.5.4 [2010.03.11] - Update for DH changes.  Removes burst, combines base and swap to represent the number on the slider.
#   0.5.3 [2010.02.09] - Get memory sizes from /proc/PID/statm
#   0.5.2 [2010.02.04] - Removed depenency on Mail::SendMail
#   0.5.1 [2010.02.03] - Added: Sanity checks on /proc/meminfo, calculate mem_size and mem_swap based on total rather than reported values
#   0.5 [2010.01.22]   - Replaced most external calls with builtins
#
#   0.4.1 [2009.08.10 ] - Fixed: Memory calculation due to the 2x increase of swap memory by DreamHost
#
#   0.4 [2009.06.28] - Added: New parameter "$max_memory" and "$min_memory" to limit the memory range that memCron should operate within
#                    - Added: New parameter "$mem_threshold" to set a memory threshold, which when exceeded, will send out notification to $email
#                    - Added: 4 new subroutines - round(), get_mem_size(), get_mem_size(), get_mem_target() to simplify the code structure
#                    - Added: Base and swap memory size to function output
#                    - Added: Resize information to function output
#                    - Changed: "$debug" parameter moved from config.cfg to this file
#                    - Removed: "$username" parameter, now DreamHost API only needs API key for authentication
#                    - Fixed: Memory target are now computed more correctly during downsize
#
#   0.3 [2009.05.27] - Added: New parameter "$downsize_resistance" to prevent rapid fluctuations from causing multiple resizes within short period of time
#                    - Changed: 0.3 to 0.7 ratio between "$mem_mean" and "$mem_used instead" of 0.5 to 0.5 when calculating "$mem_free_tolerance"
#                    - Changed: More descriptive error message when log file cannot be opened
#                    - Fixed: "$unix_time" and "$cpu_load" will now be reevaluated until it is defined to ensure data point is always logged (removed in 0.5)
#                    - Fixed: Memory target calculations now correctly accounts max and swap memory, which is capped at 4000 MB and 450MB respectively
#
#   0.2 [2009.05.03] - Fixed: Account for "$num_data" in z-score calculation to ensure number of memory changes is minimized to within daily limits
#                    - Changed: "$use_api" is changed to "$debug", which if set disables all log outputs and API calls
#
#   0.1 [2009.04.30] - Initial release
#
#////////////////////////////////////////////////////////////////////////////////////

use strict;
use warnings;
no warnings 'uninitialized';

use LWP 5.64;
use File::Basename;
use Time::Local;

#////////////////////////////////////////////////// get configurations

my $debug = $ARGV[0] eq '-d';

# settings from config file

our (
    $key,                 $ps,                  $cron_interval,
    $max_memory,          $min_memory,          $mem_threshold,
    $email,               $mem_free_confidence, $mem_free_to_used_ratio,
    $downsize_resistance, $num_data,            $num_data_csv
);

my $SAMPLES = $debug ? 1 : 60;

my $dir = dirname($0);

do "$dir/config.cfg";

# include z-score function
require "$dir/zscore.pl";

# Log directory name
my $log_dir = "$dir/logs";

# DreamHost PS limit
my $daily_change_limit = 30;
my $runs_per_day       = 1440 / $cron_interval;

# DreamHost PS defaults
if ( $max_memory > 4000 ) { $max_memory = 4000; }
if ( $min_memory < 300 )  { $min_memory = 300; }

# Statistics values
my $mem_used_zscore = abs(
    normsinv(
        ( $daily_change_limit * $num_data / $runs_per_day ) / $runs_per_day
    )
);    #1.89;
my $mem_free_zscore = abs( normsinv($mem_free_confidence) );    #3.09;

#////////////////////////////////////////////////// main program starts

sub cpu_load {
    open( LOAD, "/proc/loadavg" ) || die "Unable to open /proc/loadavg";
    my @l = split /\s+/, <LOAD>;
    close(LOAD);
    return @l;
}

sub meminfo {
    while (1) {
        open( MEM, "/proc/meminfo" ) || die "Unable to open /proc/meminfo";
        my %mem = map { (/(\w+):\s*(\d+)/) } <MEM>;
        close(MEM);
        ## kB to MB
        for ( values %mem ) { $_ = int( $_ / 1024 ) }
        ## sanity check MemTotal and retry if it's not valid
        return \%mem if $mem{MemTotal} >= 150 && $mem{MemTotal} <= 4000;
    }
}

my $unix_time = time();

my $log_memory = "$log_dir/$ps.log";

my ( $mem_total, $mem_used, $mem_free, $cpu_load );

my $mem = meminfo();
$mem_total = $mem->{MemTotal} + $mem->{SwapTotal};

foreach ( 1 .. $SAMPLES ) {
    $cpu_load += ( cpu_load() )[1];
    $mem = meminfo();
    $mem_used += $mem_total - $mem->{MemFree} - $mem->{SwapFree} - $mem->{Cached};
    sleep 1;
}

$mem_used = round( $mem_used / $SAMPLES );
$cpu_load = round( $cpu_load / $SAMPLES, 2 );
$mem_free = $mem_total - $mem_used;

# write to memory log file
unless ($debug) {
    open( LOG, ">>$log_memory" ) || die "Cannot open memory log file!";
    print LOG "$mem_used\n";
    close(LOG);
}

#////////////// truncate memory log

system("tail -n $num_data $log_memory > $log_memory.temp");
rename "$log_memory.temp", $log_memory;

#////////////// calculate the amount of memory to be reserved based on past data

open( LOG, "$log_memory" ) || die "Cannot open memory log file!";
my @data = <LOG>;
close(LOG);

# construct a short list to be used when downsizing
my @shortlist =
  @data[ ( scalar(@data) - $downsize_resistance ) .. ( scalar(@data) - 1 ) ];

# make sure we have enough data points before proceeding
if ( scalar(@data) < round( $num_data * 0.1 ) ) { exit 0; }

my ( $mem_stattotal, $mem_mean, $mem_median, $mem_stdev ) = stats(@data);

$mem_mean = round($mem_mean);
$mem_stdev = round( $mem_stdev, 2 );

my $mem_used_tolerance = round( $mem_used_zscore * $mem_stdev );
my $mem_free_tolerance = round( $mem_free_zscore * $mem_stdev );

unless ( $mem_free_tolerance > ( $mem_mean * 0.3 + $mem_used * 0.7 ) * $mem_free_to_used_ratio )
{
    $mem_free_tolerance = round( ( $mem_mean * 0.3 + $mem_used * 0.7 ) * $mem_free_to_used_ratio );
}

#////////////// calculate the memory required

my $mem_required = $mem_used + $mem_free_tolerance;
my $mem_target   = get_mem_target($mem_required);
my $set = ( abs( $mem_total - $mem_required ) > $mem_used_tolerance ) ? 1 : 0;

#////////////// downsize resistance

my $downsize_count = 0;

my $log_downsize = "$log_dir/downsize.log";

if ( ( $mem_target < $mem_total ) && $set ) {
    if ( -e "$log_downsize" ) {
        open( LOG, "$log_downsize" ) || die "Cannot open downsize log file!";
        my @data = <LOG>;
        close(LOG);
        $downsize_count = shift(@data);
        $downsize_count++;
    }
    else {
        $downsize_count = 1;
    }

    if ( $downsize_count >= $downsize_resistance ) {
        $downsize_count = 0;

        $mem_required = round( ( stats(@shortlist) )[1] ) + $mem_free_tolerance;
        $mem_target = get_mem_target($mem_required);
    }
    else {
        $set = 0;
    }
}

unless ($debug) {
    open( LOG, ">$log_downsize" ) || die "Cannot open downsize log file!";
    print LOG "$downsize_count";
    close(LOG);
}

#////////////// set memory using DreamHost API, output result

my $sendmail;
my $date    = date_time_string();
my $message = <<"MESSAGE";
Total: $mem_total       Used: $mem_used Free: $mem_free
Mean: $mem_mean Stdev: $mem_stdev       Load: $cpu_load
Tolerance: $mem_used_tolerance  Tolerance (free): $mem_free_tolerance

Target: $mem_target
MESSAGE

$set = 0 if $mem_target == $mem_total || $debug;

if ($set) {

    $message .= "\nMemory was resized from $mem_total MB to $mem_target MB!\n";

    # check against memory threshold, send notification email if it is exceeded
    if ( $mem_threshold && $mem_target > $mem_threshold ) {
        print "\n*** Warning! Threshold exceeded! ***\n";
        $sendmail = 1 unless $debug;
    }

    # use API to resize memory
    my $ua       = LWP::UserAgent->new;
    my $url      = 'https://panel.dreamhost.com/api/';
    my $response = $ua->post(
        $url,
        {
            key       => $key,
            cmd       => 'dreamhost_ps-set_size',
            unique_id => $unix_time . $$,
            ps        => $ps,
            size      => $mem_target
        }
    );
    $mem_total = get_mem_total($mem_target);

    $response->is_success || die "Error at $url\n ", $response->status_line,
      "\n Aborting";
    $message .= "API Response: \n" . $response->content . "\n";

    # send notification if necessary
    if ( $sendmail && $email ) {
        my $top = `top -b -n 1`;
        chomp($top);

        open( MAIL, "/usr/bin/sendmail -t" )
          or die "Unable to open sendmail: $!";
        print MAIL <<"MESSAGE";
To: $email
From: memCron <noreply\@memcron.com>
Date: $date
Subject: Memory threshold exceeded for $ps

$message

-----

List of running processes:

$top

This report is generated by memCron at $date.
MESSAGE

        close(MAIL);
        $message .= "\nNotification sent to $email.\n";
    }

}
else {

    $message .= "\nNo need to adjust memory"
      . (
        ($downsize_count)
        ? " yet! ($downsize_count/$downsize_resistance)"
        : "!"
      ) . "\n";
}

print $message;
print "\n-----\n";

#////////////// write memory usage and cpu load to csv file

my $log_csv = "$log_dir/$ps.csv";

my $log_line = join( ",",
    $unix_time,          $mem_total,          $mem_used,
    $cpu_load,           $mem_mean,           $mem_stdev,
    $mem_used_tolerance, $mem_free_tolerance, $downsize_count );
if ($debug) {
    print "$log_line\n";
}
else {
    open( LOG, ">>$log_csv" ) || die "Cannot open csv file!";
    print LOG $log_line, "\n";
    close(LOG);
}

#////////////// truncate csv log

if ( -e $log_csv ) {
    system("tail -n $num_data_csv $log_csv > $log_csv.temp");
    system("mv $log_csv.temp $log_csv");
}

#////////////// subroutines

sub round {
    my ( $val, $places ) = @_;
    $places ||= 0;
    return sprintf( "%.${places}f", $val || 0 );
}

sub get_mem_target {
    my $mem_target = shift;

    # handle max and min memory limit
    if ( $mem_target < $min_memory ) {
        $mem_target = $min_memory;
    }
    elsif ( $mem_target > $max_memory ) {
        $mem_target = $max_memory;
    }

    return ( round($mem_target) );
}

sub stats {
    my $total = 0;
    foreach my $v (@_) { $total += $v; }

    my $average = $total / @_;
    my $median =
        @_ % 2
      ? $_[ ( @_ - 1 ) / 2 ]
      : ( $_[ @_ / 2 - 1 ] + $_[ @_ / 2 ] ) / 2;

    my $sqtotal = 0;
    foreach my $v (@_) {
        $sqtotal += ( $average - $v )**2;
    }
    my $stdev = ( $sqtotal / @_ )**0.5;

    return ( $total, $average, $median, $stdev );
}

sub date_time_string {

    # convert a time() value to a date-time string according to RFC 822

    my $time = $_[0] || time();    # default to now if no argument

    my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
    my @wdays  = qw(Sun Mon Tue Wed Thu Fri Sat);

    my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
      localtime($time);

    my $TZ = $ENV{TZ};
    if ( $TZ eq "" ) {

        # offset in hours
        my $offset = sprintf "%.1f", ( timegm(localtime) - time ) / 3600;
        my $minutes = sprintf "%02d", abs( $offset - int($offset) ) * 60;
        $TZ = sprintf( "%+03d", int($offset) ) . $minutes;
    }
    return join( " ",
        ( $wdays[$wday] . ',' ),
        $mday, $months[$mon],
        $year + 1900,
        sprintf( "%02d:%02d:%02d", $hour, $min, $sec ), $TZ );
}