Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #!/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 );
- }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement