Ben

#!/usr/bin/env perl

#////////////////////////////////////////////////////////////////////////////////////
#
#   memCron - DreamHost PS Memory Manager
#
#   Author   : Yaosan Yeo
#   Version  : 0.4.1
#   Date     : 10 August 2009
#   URL      : http://memcron.com/
#
#   History  :
#
#   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_total(), 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;
use diagnostics;

use LWP 5.64;
use Mail::Sendmail;
use File::Basename;

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

my $debug = 0;

# 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 $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 < 150 ) { $min_memory = 150; }

# 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

#////////////// get CPU load (5 min average) and unix timestamp

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

sub meminfo {
    open(MEM,"/proc/meminfo") || die "Unable to open /proc/meminfo";
    my %mem = map { (/(\w+):\s*(\w+)/) } <MEM>;
    close(MEM);
    return \%mem;
}

my ($cpu_load) = cpu_load();
my $unix_time = time();

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

my($mem_total, $mem_used, $mem_free, $mem_size, $mem_swap);

# take 60 samples over 1 minute duration
foreach (1..60) {
        my $mem = meminfo();
        $mem_size = int($mem->{MemTotal}  / 1024);
        $mem_swap = int($mem->{SwapTotal} / 1024);
        $mem_total = $mem_size + $mem_swap;
        $mem_used += ($mem_total - int( ($mem->{MemFree} + $mem->{SwapFree}) / 1024 )  );
        sleep 1;
}

$mem_used = round($mem_used / 60);
$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_size ) && $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 = Mail::Sendmail::time_to_date(time());

print "\nDate: $date\n\n";
print "Total: $mem_total\t Used: $mem_used\t Free: $mem_free\n";
print "Mem: $mem_size\t Swap: $mem_swap\n";
print "Mean: $mem_mean\t Stdev: $mem_stdev\t Load: $cpu_load\n";
print "Tolerance: $mem_used_tolerance \t Tolerance (free): $mem_free_tolerance\n";

if ($mem_target == $mem_size) {
        $set = 0;
}

if ($set) {
        print "Target: $mem_target\n";

        print "\nMemory was resized from $mem_size 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) {
                # send notification if necessary
                if ( $sendmail && $email ) {
                        my $top = `top -b -n 1`; chomp($top);

                        my $message = <<MESSAGE;
Date: $date

Total: $mem_total       Used: $mem_used Free: $mem_free
Mean: $mem_mean Stdev: $mem_stdev       Load: $cpu_load
Mem: $mem_size  Swap: $mem_swap
Tolerance: $mem_used_tolerance  Tolerance (free): $mem_free_tolerance
Target: $mem_target

Memory was resized from $mem_size MB to $mem_target MB!

-----

List of running processes:

$top

This report is generated by memCron at $date.
MESSAGE
                        my %mail = (
                                To => $email,
                                From => 'memCron <noreply@memcron.com>',
                                Message => $message,
                                Subject => "Memory threshold exceeded for $ps"
                        );

                        sendmail(%mail) or die $Mail::Sendmail::error;

                        print "\nNotification sent to $email.\n";
                }

                # use API to resize memory
                my $url = "https://panel.dreamhost.com/api/?key=" . $key . "&cmd=dreamhost_ps-set_size&unique_id=" . `uuidgen` . "&ps=" . $ps . "&size=" . $mem_target;
                my $browser = LWP::UserAgent->new;
                my $response = $browser->get($url);

                $response->is_success || die "Error at $url\n ", $response->status_line, "\n Aborting";
                print "\n" , $response->content, "\n";
        }
} else {
        print "Target: $mem_target\n";

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

print "\n-----\n";


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

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

unless ($debug) {
        open(LOG, ">>$log_csv") || die "Cannot open csv file!";


        if ($set) {
                print LOG "$unix_time,",get_mem_total($mem_target),",$mem_used,$cpu_load,$mem_mean,$mem_stdev,$mem_used_tolerance,$mem_free_tolerance,$downsize_count\n";
        } else {
                print LOG "$unix_time,$mem_total,$mem_used,$cpu_load,$mem_mean,$mem_stdev,$mem_used_tolerance,$mem_free_tolerance,$downsize_count\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_total {
        my $mem_target = shift;
        return ($mem_target < 1350) ? $mem_target * 3 : $mem_target + 900;
}

sub get_mem_target {
        my $mem_required = shift;
        my $mem_swap = ($mem_required < 1350) ? round($mem_required / 3 * 2) : 900;
        my $mem_target = $mem_required - $mem_swap;

        # 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 );
}