SHARE
TWEET

memcron 0.6.6-Bret memcron.pl

bret_miller Nov 18th, 2011 54 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/bin/env perl
  2. our $VERSION = "0.6.6-Bret";
  3.  
  4. #////////////////////////////////////////////////////////////////////////////////////
  5. #
  6. #   memCron - DreamHost PS Memory Manager
  7. #
  8. #   Author     : Yaosan Yeo
  9. #   Version    : 0.6
  10. #   Date       : 22 March 2010
  11. #   URL        : http://memcron.com/
  12. #
  13. #   History  :
  14. #   0.6.6-Bret [2011.11.18] + Better reporting of what's going on
  15. #                           + Fixed bug in 5-minute delay between sets
  16. #   0.6.5-Bret [2011.09.22] + Don't try changing memory more often than once in 5 minutes.
  17. #   0.6.4-Bret [2011.08.16] + Replaced get memory routine, more efficient so can run as often as every minute
  18. #                          + Added/fixed code to force downsize (from 0.6.3-Bret)
  19. #                          + Added config: $force_downsize_ratio, defaults to 0.20, 0=disabled
  20. #                          + Added config: $num_samples, defaults to 60; number of samples to average memory usage from
  21. #                                          I set mine to 30 thinking looking at memory 30 times per minute is enough.
  22. #   0.6.2-chris [2010.06.30] - updated sendmail path from /usr/bin/sendmail to |/usr/sbin/sendmail
  23. #                                 |-> neet to place \ before @ in the email address (ex: me\@us.com)
  24. #                            + added random number to unique id
  25. #   0.6.1-ben [2010.03.22] - Added support for HTTP::MHTTP module
  26. #                          + Added a message log in ./logs/memcron.log, new config item $log_level
  27. #                            (0 = no log, 3 = default, 5 = debugging)
  28. #   0.6 [2010.03.22] - Added: Various improvements contributed by memCron's user, Ben and Bret: (thanks guys!)
  29. #                      + Replaced most external calls with built-ins
  30. #                      + Removed dependency on Mail::SendMail
  31. #                      + Replaced LWP (slow and bloated) with system call to curl
  32. #                      + Get memory sizes from /proc/meminfo
  33. #                      + Simplified memory collecting
  34. #                      + Get current size from API rather than OS
  35. #                      + New options to disable updates, alerts
  36. #                      + Include mem target, cache used in csv
  37. #                      + Better error handling on memory resize
  38. #                    - Changed: Z-score function is now internal
  39. #
  40. #   0.4.1 [2009.08.10 ] - Fixed: Memory calculation due to the 2x increase of swap memory by DreamHost
  41. #
  42. #   0.4 [2009.06.28] - Added: New parameter "$max_memory" and "$min_memory" to limit the memory range that memCron should operate within
  43. #                    - Added: New parameter "$mem_threshold" to set a memory threshold, which when exceeded, will send out notification to $email
  44. #                    - Added: 4 new subroutines - round(), get_mem_size(), get_mem_size(), get_mem_target() to simplify the code structure
  45. #                    - Added: Base and swap memory size to function output
  46. #                    - Added: Resize information to function output
  47. #                    - Changed: "$debug" parameter moved from config.cfg to this file
  48. #                    - Removed: "$username" parameter, now DreamHost API only needs API key for authentication
  49. #                    - Fixed: Memory target are now computed more correctly during downsize
  50. #
  51. #   0.3 [2009.05.27] - Added: New parameter "$downsize_resistance" to prevent rapid fluctuations from causing multiple resizes within short period of time
  52. #                    - 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"
  53. #                    - Changed: More descriptive error message when log file cannot be opened
  54. #                    - 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)
  55. #                    - Fixed: Memory target calculations now correctly accounts max and swap memory, which is capped at 4000 MB and 450MB respectively
  56. #
  57. #   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
  58. #                    - Changed: "$use_api" is changed to "$debug", which if set disables all log outputs and API calls
  59. #
  60. #   0.1 [2009.04.30] - Initial release
  61. #
  62. #////////////////////////////////////////////////////////////////////////////////////
  63. #
  64. # Copyright 2009 (c) Yaosan Yao - http://www.memcron.com/
  65. #
  66. # Portions of this product originally from psmanager:                     #
  67. # Copyright 2009 (C) Otto de Voogd - http://www.7is7.com/                 #
  68. #                                                                         #
  69. # This program is free software; you can redistribute it and/or modify    #
  70. # it under the terms of the GNU General Public License as published by    #
  71. # the Free Software Foundation; version 3 of the License.                 #
  72. #                                                                         #
  73. # This program is distributed in the hope that it will be useful,         #
  74. # but WITHOUT ANY WARRANTY; without even the implied warranty of          #
  75. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           #
  76. # GNU General Public License for more details.                            #
  77. #                                                                         #
  78. # See license: http://www.gnu.org/licenses/gpl.html                       #
  79. #////////////////////////////////////////////////////////////////////////////////////
  80.  
  81. use strict;
  82. use warnings;
  83. no warnings 'uninitialized';
  84.  
  85. use File::Basename;
  86. use Time::Local;
  87. use Sys::Hostname;
  88. use Fcntl qw(:flock); # import LOCK_* and SEEK_END constants
  89. use Date::Format;
  90.  
  91. #////////////////////////////////////////////////// get configurations
  92.  
  93. my $hostname = hostname;
  94. my $unix_time = time();
  95.  
  96.  
  97. # settings from config file
  98. our (
  99.         $key,                 $ps,                  $cron_interval,
  100.         $max_memory,          $min_memory,          $mem_threshold,
  101.         $disable_updates,     $alert_on_change,     $alert_on_error,
  102.         $email,               $mem_free_confidence, $mem_free_to_used_ratio,
  103.         $force_downsize_ratio, $num_samples,
  104.         $downsize_resistance, $num_data,            $num_data_csv,
  105.         $use_mhttp,               $debug,                               $log_level
  106. );
  107.  
  108. $force_downsize_ratio=0.20;
  109. $num_samples=60;
  110.  
  111. my $dir = dirname($0);
  112. do "$dir/config.cfg";
  113.  
  114. $debug ||= $ARGV[0] eq '-d';
  115. if (!defined $log_level) { $log_level = $debug ? 5 : 3 }
  116.  
  117. ## try to use the MHTTP if it's available, set $use_mhttp=0 in config to avoid this.
  118. if ($use_mhttp || !defined($use_mhttp)) {
  119.         eval {
  120.                 require "HTTP/MHTTP.pm";
  121.                 import HTTP::MHTTP;
  122.         };
  123.         $use_mhttp = !$@;
  124. }
  125.  
  126. # Logs
  127. my $log_dir = "$dir/logs";
  128. my $log_csv = "$log_dir/$hostname.csv";
  129. my $log_memory = "$log_dir/$hostname.log";
  130. my $log_lock = "$log_dir/$hostname.lck";
  131. my $log_downsize = "$log_dir/$hostname-downsize.log";
  132. my $log_set = "$log_dir/$hostname-set.log";
  133. my $log_message = "$log_dir/memcron.log";
  134.  
  135. startup();
  136. local $SIG{__DIE__} = sub {
  137.         if ($^S) {
  138.                 die @_;
  139.         } else {
  140.                 FATAL("$_[0]");
  141.                 cleanup(-1);
  142.         }
  143. };
  144.  
  145. # DreamHost PS limit
  146. my $daily_change_limit = 30;
  147. my $runs_per_day       = 1440 / $cron_interval;
  148.  
  149. # DreamHost PS defaults
  150. if ( $max_memory > 4000 ) { $max_memory = 4000; }
  151. if ( $min_memory < 300 )  { $min_memory = 300; }
  152.  
  153. # Statistics values
  154. my $SAMPLES = $debug ? 1 : $num_samples;
  155. my $mem_used_zscore = abs( normsinv( ( $daily_change_limit * $num_data / $runs_per_day ) / $runs_per_day ) );    #1.89;
  156. my $mem_free_zscore = abs( normsinv( $mem_free_confidence ) );    #3.09;
  157.  
  158. #////////////////////////////////////////////////// main program starts
  159.  
  160. my ( $mem_total, $mem_used, $mem_free, $mem_cached, $cpu_load );
  161.  
  162. #my $list_ps = call_api('list_ps');
  163. #
  164. #if ( $list_ps->{status} ) {
  165. #       for (@{$list_ps->{data}}){
  166. #               next if $_->{ps} ne $hostname;
  167. #               $mem_total = $_->{memory_mb};
  168. #               last;
  169. #       }
  170. #       if (!$mem_total) {
  171. #               die "Dreamhost PS $hostname not found!";
  172. #       }
  173. #} else {
  174. #       die "$list_ps->{error}";
  175. #}
  176.  
  177. #my $mem = meminfo();
  178.  
  179. #foreach ( 1 .. $SAMPLES ) {
  180. #       $cpu_load += ( cpu_load() )[1];
  181. #       $mem = meminfo();
  182. #       $mem_used += $mem->{MemTotal} - $mem->{MemFree} + $mem->{SwapTotal} - $mem->{SwapFree};
  183. #       $mem_cached += $mem->{Cached};
  184. #       sleep 1 if !$debug;
  185. #}
  186. my $firstpass=1;
  187. foreach ( 1 .. $SAMPLES ) {
  188.         my $mu=0;
  189.         my $mc=0;
  190.         sleep 1 if !$firstpass;
  191.         $firstpass=0;
  192.         $cpu_load += ( cpu_load() )[1];
  193.         ($mem_total,$mu,$mem_free,$mc) = split /\t/, &getMemoryInfo($mem_total,$mu,$mem_free,$mc);
  194.         $mem_used+=$mu;
  195.         $mem_cached+=$mc;
  196. }
  197.  
  198. $mem_used = round( $mem_used / $SAMPLES );
  199. $mem_cached = round( $mem_cached / $SAMPLES );
  200. #$mem_used -= $mem_cached;
  201. $cpu_load = round( $cpu_load / $SAMPLES, 2 );
  202. $mem_free = $mem_total - $mem_used;
  203.  
  204. write_log( $log_memory, $mem_used, $num_data );
  205.  
  206.  
  207. #////////////// calculate the amount of memory to be reserved based on past data
  208.  
  209. my @data = read_log( $log_memory, $num_data );
  210.  
  211. # construct a short list to be used when downsizing
  212. my @shortlist = @data[ ( scalar(@data) - $downsize_resistance ) .. ( scalar(@data) - 1 ) ];
  213.  
  214. # make sure we have enough data points before proceeding
  215. if ( scalar(@data) < round( $num_data * 0.1 ) ) {
  216.         WARN("need more data points");
  217.         cleanup();
  218. }
  219.  
  220. my ( $mem_stattotal, $mem_mean, $mem_median, $mem_stdev ) = stats(@data);
  221.  
  222. $mem_mean = round($mem_mean);
  223. $mem_stdev = round( $mem_stdev, 2 );
  224.  
  225. my $mem_used_tolerance = round( $mem_used_zscore * $mem_stdev );
  226. my $mem_free_tolerance = round( $mem_free_zscore * $mem_stdev );
  227.  
  228. unless ( $mem_free_tolerance > ( $mem_mean * 0.3 + $mem_used * 0.7 ) * $mem_free_to_used_ratio ) {
  229.         $mem_free_tolerance = round( ( $mem_mean * 0.3 + $mem_used * 0.7 ) * $mem_free_to_used_ratio );
  230. }
  231.  
  232. #////////////// calculate the memory required
  233.  
  234. my $mem_required = $mem_used + $mem_free_tolerance;
  235. my $mem_target   = get_mem_target($mem_required);
  236. my $set = ( abs( $mem_total - $mem_required ) > $mem_used_tolerance );
  237. $set=0 if $mem_target==$mem_total;
  238.  
  239. #////////////// resize resistance
  240. my $downsize_count = 0;
  241. if ( $set ) {
  242.         WARN("resize required $mem_target ($mem_total)");
  243.     if ( $mem_target < $mem_total ) {
  244.         $downsize_count = read_status( $log_downsize ) || 0;
  245.                 $downsize_count++;
  246.  
  247.                 if ( $downsize_count >= $downsize_resistance ) {
  248.                         $downsize_count = 0;
  249.                         $mem_required = round( ( stats(@shortlist) )[1] ) + $mem_free_tolerance;
  250.                         $mem_target = get_mem_target($mem_required);
  251.                 } else {
  252.                         $set = 0;
  253.                 }
  254.         }
  255. }
  256.  
  257. write_status( $log_downsize, $downsize_count );
  258.  
  259. #////////////// set memory using DreamHost API, output result
  260.  
  261. my $sendmail;
  262. my $subject;
  263. my $message = <<"MESSAGE";
  264. Total: $mem_total       Used: $mem_used Free: $mem_free
  265. Mean: $mem_mean Stdev: $mem_stdev       Load: $cpu_load
  266. Tolerance: $mem_used_tolerance  Tolerance (free): $mem_free_tolerance
  267.  
  268. Target: $mem_target     Required: $mem_required
  269. MESSAGE
  270.  
  271. $set = 0 if $mem_target == $mem_total || $debug || $disable_updates;
  272.  
  273. my $last_set = read_status( $log_set ) || 0;
  274. $set = 0 if (($unix_time-$last_set)<(5*60)); # Only try setting memory once in 5 minutes.
  275.  
  276. my $pscountcmd = "ps aux|gawk '{print \$11}'|sort -r -n|uniq -c|sort -r -n";
  277. my $processcount = `$pscountcmd`;
  278. chomp($processcount);
  279. my $top = `top -b -n 1`;
  280. chomp($top);
  281. my $curtimestr = time2str("%c",$unix_time);
  282. my $settimestr = time2str("%c",$last_set);
  283. my $setdiff = $unix_time-$last_set;
  284. my $setdiffhh = int($setdiff/3600);
  285. my $setdiffmm = int(($setdiff-($setdiffhh*3600))/60);
  286. my $setdiffss = int(($setdiff-($setdiffhh*3600)-($setdiffmm*60)));
  287.  
  288. if ($set) {
  289.         $message .= "\nMemory was resized from $mem_total MB to $mem_target MB!\n";
  290.  
  291.         # check against memory threshold, send notification email if it is exceeded
  292.         if ( $mem_threshold && $mem_target > $mem_threshold ) {
  293.                 print "\n*** Warning! Threshold exceeded! ***\n";
  294.                 $subject = "Memory threshold exceeded for $hostname";
  295.                 $sendmail = 1 unless $debug;
  296.         }
  297.  
  298.         write_status( $log_set, $unix_time );
  299.         my $set_response;
  300.         my $with_force=0;
  301.         if ( ($force_downsize_ratio) && ($mem_target < $mem_total) && ((($mem_total-$mem_target)/$mem_total) >= $force_downsize_ratio)) {
  302.                 #If we'll save more than 25%, then force the resize.
  303.                 $set_response = call_api('set_size', (size => $mem_target,force => 'yes'));
  304.                 $with_force=1;
  305.         } else {
  306.                 $set_response = call_api('set_size', size => $mem_target);
  307.         }
  308.         if ( $set_response->{status} ) {
  309.                 $subject = "Resized $hostname from $mem_total MB to $mem_target MB";
  310.                 if ($with_force) { $subject.=", with force"; }
  311.                 $sendmail = 1 if $alert_on_change;
  312.         } else {
  313.                 $subject = "Unable to set memory size for $hostname";
  314.                 $message .= $set_response->{error};
  315.                 $sendmail = 1 if $alert_on_error;
  316.         }
  317.  
  318.         $message .= "\n";
  319.  
  320.         # send notification if necessary
  321.         if ( $sendmail && $email ) {
  322.                 email_notice( $email, $subject, <<"MESSAGE" );
  323.  
  324. $message
  325. ---------------------------------------------------------------------------
  326. Time now: $curtimestr
  327. Last set: $settimestr, diff=$setdiff ($setdiffhh:$setdiffmm:$setdiffss)
  328. ---------------------------------------------------------------------------
  329. Process counts:
  330. $processcount
  331. ---------------------------------------------------------------------------
  332. List of running processes:
  333. $top
  334. ---------------------------------------------------------------------------
  335.  
  336. MESSAGE
  337.  
  338.         }
  339. } else {
  340.                 $message .= "\nNo need to adjust memory" . ( ($downsize_count) ? " yet! ($downsize_count/$downsize_resistance)" : "!" ) . "\n";
  341. }
  342.  
  343. my $date = date_time_string();
  344. $message = <<"MESSAGE";
  345.  
  346. $message
  347. ---------------------------------------------------------------------------
  348. Time now: $curtimestr
  349. Last set: $settimestr, diff=$setdiff ($setdiffhh:$setdiffmm:$setdiffss)
  350. ---------------------------------------------------------------------------
  351. Process counts:
  352. $processcount
  353. ---------------------------------------------------------------------------
  354. List of running processes:
  355. $top
  356.  
  357.  
  358. ---------------------------------------------------------------------------
  359. memCron $VERSION at $date
  360. ---------------------------------------------------------------------------
  361.  
  362. MESSAGE
  363. print $message;
  364.  
  365. #////////////// write memory usage and cpu load to csv file
  366.  
  367. my $log_line = join( ",",
  368.         $unix_time,          $mem_total,          $mem_used,
  369.         $cpu_load,           $mem_mean,           $mem_stdev,
  370.         $mem_used_tolerance, $mem_free_tolerance, $downsize_count,
  371.         $mem_target,         $mem_cached
  372. );
  373.  
  374. write_log($log_csv, $log_line, $num_data_csv);
  375. cleanup();
  376.  
  377.  
  378. #////////////// subroutines
  379.  
  380. sub cpu_load {
  381.         open( LOAD, "/proc/loadavg" ) or die "Unable to open /proc/loadavg";
  382.         my @l = split /\s+/, <LOAD>;
  383.         close(LOAD);
  384.         return @l;
  385. }
  386.  
  387. sub meminfo {
  388.         while (1) {
  389.                 open( MEM, "/proc/meminfo" ) or die "Unable to open /proc/meminfo";
  390.                 my %mem = map { (/(\w+):\s*(\d+)/) } <MEM>;
  391.                 close(MEM);
  392.                 ## kB to MB
  393.                 for ( values %mem ) { $_ = int( $_ / 1024 ) }
  394.                 ## sanity check MemTotal and retry if it's not valid
  395.                 return \%mem if $mem{MemTotal} >= 300 && $mem{MemTotal} <= 4000;
  396.         }
  397. }
  398.  
  399. sub getMemoryInfo {
  400.         my ($tot_mem_avail,$tot_mem_used,$tot_mem_free,$tot_mem_cach) = @_;
  401.  
  402.         my $lines_read = 0;
  403.         my $free_output = `free -m`;
  404.  
  405.         my $mem_avail;
  406.         my $mem_used;
  407.         my $mem_free;
  408.         my $mem_cach;
  409.         my $swap_avail;
  410.         my $swap_used;
  411.         my $swap_free;
  412.  
  413.         foreach my $line (split /\n/, $free_output) {
  414.                 $line =~ s/ +/ /g;
  415.                 my @linepart = split / /, $line;
  416.                 if ($line =~ /^Mem:/i) {
  417.                         $lines_read++;
  418.                         $mem_avail = $linepart[1];
  419.                         $mem_cach = $linepart[5] + $linepart[6];
  420.                         $mem_used = $linepart[2] - $mem_cach;
  421.                         $mem_free = $linepart[3] + $mem_cach;
  422.                 }
  423.                 if ($line =~ /^Swap:/i) {
  424.                         $lines_read++;
  425.                         $swap_avail = $linepart[1];
  426.                         $swap_used = $linepart[2];
  427.                         $swap_free = $linepart[3];
  428.                 }
  429.         }
  430.         if ($lines_read!=2) {
  431.                 &printError(9,"Could not retrieve memory information!");
  432.                 #die "Script terminated!\n";
  433.         }
  434.     # Occasionally excessively high memory values are returned
  435.     # by 'free', hence we check that the values make some sense.
  436.         if ( $mem_avail + $swap_avail < 16 * $max_memory ) {
  437.         $tot_mem_avail = $mem_avail + $swap_avail;
  438.                 if (
  439.                         ($mem_used + $swap_used >= 0) &&
  440.                         ($mem_used + $swap_used <= $tot_mem_avail) &&
  441.                         ($mem_used + $swap_used > $tot_mem_used)
  442.                 ) {
  443.                         $tot_mem_used = $mem_used + $swap_used;
  444.                         $tot_mem_free = $mem_free + $swap_free;
  445.                         $tot_mem_cach = $mem_cach;
  446.                 }
  447.         }
  448.         return "$tot_mem_avail\t$tot_mem_used\t$tot_mem_free\t$tot_mem_cach";
  449. }
  450.  
  451. sub email_notice {
  452.         my ($to, $subject, $message) = @_;
  453.  
  454.         my $date = date_time_string();
  455.         open( MAIL, "|/usr/sbin/sendmail -t" ) or die "Unable to open sendmail: $!";
  456.         print MAIL <<"MESSAGE";
  457. To: $to
  458. From: memCron on $hostname <noreply\@memcron.com>
  459. Date: $date
  460. Subject: $subject
  461.  
  462. $message
  463.  
  464. ---------------------------------------------------------------------------
  465. memCron $VERSION at $date
  466. ---------------------------------------------------------------------------
  467. MESSAGE
  468.  
  469.         close(MAIL);
  470. }
  471.  
  472.  
  473. ## initialize message log, etc...
  474. sub startup {
  475.     if ( $log_level && !$debug ) {
  476.                 open(LOGINFO, ">>$log_message") or die "Cannot open  system log $log_message!";
  477.         }
  478.         INFO("memcron $VERSION started (pid: $$)");
  479. }
  480.  
  481. sub cleanup {
  482.         INFO("memcron $VERSION complete");
  483.         if ( $log_level && !$debug ) {
  484.                 close(LOGINFO);
  485.         }
  486.         exit $_[0]||0;
  487. }
  488.  
  489. sub log_message {
  490.         my $ts = '['.date_time_string(time).']';
  491.         my $indent;
  492.         for ( split/\n/, $_[0]) {
  493.                 if ($debug) {
  494.                         print "$ts $indent$_\n";
  495.                 } else {
  496.                         print LOGINFO "$ts $indent$_\n";
  497.                 }
  498.                 $indent = "|";
  499.         }
  500. }
  501.  
  502. sub FATAL { &log_message if $log_level >= 1 }
  503. sub ERROR { &log_message if $log_level >= 2 }
  504. sub WARN  { &log_message if $log_level >= 3 }
  505. sub INFO  { &log_message if $log_level >= 4 }
  506. sub DEBUG { &log_message if $log_level >= 5 }
  507.  
  508.  
  509.  
  510. sub write_log {
  511.         my ($file, $line, $truncate) = @_;
  512.         if ($debug) {
  513.                 print "$file:\t$line\n";
  514.                 return;
  515.         }
  516.         open(LCK, ">$log_lock");
  517.         flock(LCK, LOCK_EX) or print "\nUnable to LOCK log.\n";
  518.         open(LOG, ">>$file") or die "Cannot open $file!";
  519.         print LOG $line,"\n";
  520.         close(LOG);
  521.         if ($truncate) {
  522.                 truncate_log( $file, $truncate );
  523.         }
  524.         flock(LCK, LOCK_UN) or print "\nUnable to UNlock log.\n";
  525.         close(LCK);
  526.         unlink($log_lock);
  527. }
  528.  
  529. sub read_log {
  530.         my ($file,$lines) = @_;
  531.         if ( ! -e $file ) { return () };
  532.         open(LCK, ">$log_lock");
  533.         flock(LCK, LOCK_EX) or print "\nUnable to LOCK log.\n";
  534.  
  535.         my $syscmd;
  536.         my $tmpfile="$file.$lines.tail";
  537.         $syscmd="tail -n $lines $file > $tmpfile";
  538.         #print "read_log:\n$syscmd\n\n";
  539.         system($syscmd);
  540.         sleep 1;
  541.         return unless -e $tmpfile;
  542.        
  543.         open(LOG, $tmpfile);
  544.         my @lines;
  545.         while (<LOG>) {
  546.                 chomp;
  547.                 push @lines, $_;
  548.         }
  549.         close LOG;
  550.         unlink($tmpfile);
  551.         flock(LCK, LOCK_UN) or print "\nUnable to UNlock log.\n";
  552.         close(LCK);
  553.         unlink($log_lock);
  554.         return @lines;
  555. }
  556.  
  557. sub truncate_log {
  558.         my ($file, $linesneeded) = @_;
  559.         my $lines=$linesneeded;
  560.         $lines=120 if ($lines<120);
  561.         return unless -e $file;
  562.         my $syscmd;
  563.         my $tmpfile="$file.temp";
  564.         $syscmd="tail -n $lines $file > $tmpfile";
  565.         #print "\n$syscmd\n";
  566.         system($syscmd);
  567.         sleep 1;
  568.         return unless -e $tmpfile;
  569.         $syscmd="mv -f $tmpfile $file";
  570.         #print "$syscmd\n\n";
  571.         system($syscmd); #disable for now so can investigate
  572. }
  573.  
  574. # single value status files
  575. sub write_status {
  576.         my ($file, $value) = @_;
  577.         if ($debug) {
  578.                 print "$file:\t$value\n";
  579.                 return;
  580.         }
  581.         open(LOG, ">$file") or die "Cannot open $file!";
  582.         print LOG $value,"\n";
  583.         close(LOG);
  584. }
  585.  
  586. sub read_status {
  587.         my ($file) = @_;
  588.         return unless -e $file;
  589.         open(LOG, $file);
  590.         my $value = <LOG>;
  591.         close LOG;
  592.         chomp $value;
  593.         return $value;
  594. }
  595.  
  596. # wraps call to DreamHost API so we can catch errors in a uniform way
  597. sub call_api {
  598.         my ( $command, %params ) = @_;
  599.         ## references globals: ($hostname, $time and $key)
  600.  
  601.         DEBUG("calling api $command");
  602.         my $url = 'https://panel.dreamhost.com/api/';
  603.         my %p = (
  604.                 key       => $key,
  605.                 cmd       => 'dreamhost_ps-' . $command,
  606.                 unique_id => $unix_time . rand() . $$,
  607.                 format    => 'perl',
  608.                 ps        => $hostname,
  609.                 %params
  610.         );
  611.         my $post = join(' ', map( "-d $_=$p{$_}", keys %p ) );
  612.     my $response = eval {
  613.         if ( $use_mhttp ) {
  614.                         DEBUG("using mhttp");
  615.             $post = join('&', map("$_=$p{$_}", keys %p ));
  616.             http_set_protocol(1);
  617.             switch_debug(0);
  618.             http_add_headers(
  619.                     'User-Agent' => "memcron/$VERSION",
  620.                     'Connection' => "Keep-Alive",
  621.                     'Host' => 'panel.dreamhost.com',
  622.                     'Content-Type' => 'application/x-www-form-urlencoded',
  623.                 );
  624.             http_body($post);
  625.             if (http_call('POST', $url)) {
  626.                 if (http_status() == 200) {
  627.                     return http_response();
  628.                 } else {
  629.                     die  http_reason() . "\n";
  630.                 }
  631.             } else {
  632.                 die "Unable to connect to API\n"
  633.             }
  634.         } else {
  635.                         DEBUG("using system curl");
  636.             $post = join(' ', map( "-d $_=$p{$_}", keys %p ) );
  637.             return `curl -s $post $url`;
  638.         }
  639.     }; 
  640.  
  641.         my ( $r, $error );
  642.         if ($@) {
  643.                 $error = "Error: \n" . $@;
  644.         } elsif ( !$response ) {
  645.                 $error = "No response\n";
  646.         } elsif ( $response !~ /^\$result/ ) {
  647.                 $error = "Unknown response format:\n" . $response;
  648.         }
  649.  
  650.         my $result;
  651.         if ( !$error ) {
  652.                 eval "$response";
  653.                 if ( $result->{result} eq 'error' ) {
  654.                         $error = "Error calling $command: $result->{data}\n";
  655.                 } elsif ( $result->{result} ne 'success' ) {
  656.                         $error = "Unknown API response:\n\n$response\n";
  657.                 }
  658.         }
  659.  
  660.         return $error ? { status => 0, error => $error } : { status => 1, data => $result->{data} };
  661. }
  662.  
  663. sub round {
  664.         my ( $val, $places ) = @_;
  665.         $places ||= 0;
  666.         return sprintf( "%.${places}f", $val || 0 );
  667. }
  668.  
  669. sub get_mem_target {
  670.         my $mem_target = shift;
  671.  
  672.         # handle max and min memory limit
  673.         if ( $mem_target < $min_memory ) {
  674.                 DEBUG("need $mem_target, using min_memory($min_memory)");
  675.                 $mem_target = $min_memory;
  676.         } elsif ( $mem_target > $max_memory ) {
  677.                 WARN("need $mem_target, using max_memory($max_memory)");
  678.                 $mem_target = $max_memory;
  679.         }
  680.  
  681.         return ( round($mem_target) );
  682. }
  683.  
  684. sub stats {
  685.         my $total = 0;
  686.         foreach my $v (@_) { $total += $v; }
  687.  
  688.         my $average = $total / @_;
  689.         my $median = @_ % 2
  690.                 ? $_[ ( @_ - 1 ) / 2 ]
  691.                 : ( $_[ @_ / 2 - 1 ] + $_[ @_ / 2 ] ) / 2;
  692.  
  693.         my $sqtotal = 0;
  694.         foreach my $v (@_) {
  695.                 $sqtotal += ( $average - $v )**2;
  696.         }
  697.         my $stdev = ( $sqtotal / @_ )**0.5;
  698.  
  699.         return ( $total, $average, $median, $stdev );
  700. }
  701.  
  702. sub date_time_string {
  703.         # convert a time() value to a date-time string according to RFC 822
  704.  
  705.         my $time = $_[0] || time();    # default to now if no argument
  706.  
  707.         my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
  708.         my @wdays  = qw(Sun Mon Tue Wed Thu Fri Sat);
  709.  
  710.         my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime($time);
  711.  
  712.         my $TZ = $ENV{TZ};
  713.         if ( $TZ eq "" ) {
  714.                 # offset in hours
  715.                 my $offset = sprintf "%.1f", ( timegm(localtime) - time ) / 3600;
  716.                 my $minutes = sprintf "%02d", abs( $offset - int($offset) ) * 60;
  717.                 $TZ = sprintf( "%+03d", int($offset) ) . $minutes;
  718.         }
  719.  
  720.         return join( " ",
  721.                 ( $wdays[$wday] . ',' ),
  722.                 $mday, $months[$mon],
  723.                 $year + 1900,
  724.                 sprintf( "%02d:%02d:%02d", $hour, $min, $sec ), $TZ );
  725. }
  726.  
  727. sub normsinv {
  728.     #
  729.     # This function returns an approximation of the inverse cumulative
  730.     # standard normal distribution function.  I.e., given P, it returns
  731.     # an approximation to the X satisfying P = Pr{Z <= X} where Z is a
  732.     # random variable from the standard normal distribution.
  733.     #
  734.     # The algorithm uses a minimax approximation by rational functions
  735.     # and the result has a relative error whose absolute value is less
  736.     # than 1.15e-9.
  737.     #
  738.     # Author:      Peter J. Acklam
  739.     # Time-stamp:  2000-07-19 18:26:14
  740.     # E-mail:      pjacklam@online.no
  741.     # WWW URL:     http://home.online.no/~pjacklam
  742.  
  743.     my $p = shift;
  744.     die "input argument must be in (0,1)\n" unless 0 < $p && $p < 1;
  745.  
  746.     # Coefficients in rational approximations.
  747.     my @a = (-3.969683028665376e+01,  2.209460984245205e+02,
  748.              -2.759285104469687e+02,  1.383577518672690e+02,
  749.              -3.066479806614716e+01,  2.506628277459239e+00);
  750.     my @b = (-5.447609879822406e+01,  1.615858368580409e+02,
  751.              -1.556989798598866e+02,  6.680131188771972e+01,
  752.              -1.328068155288572e+01 );
  753.     my @c = (-7.784894002430293e-03, -3.223964580411365e-01,
  754.              -2.400758277161838e+00, -2.549732539343734e+00,
  755.               4.374664141464968e+00,  2.938163982698783e+00);
  756.     my @d = ( 7.784695709041462e-03,  3.224671290700398e-01,
  757.               2.445134137142996e+00,  3.754408661907416e+00);
  758.  
  759.     # Define break-points.
  760.     my $plow  = 0.02425;
  761.     my $phigh = 1 - $plow;
  762.  
  763.     # Rational approximation for lower region:
  764.     if ( $p < $plow ) {
  765.        my $q  = sqrt(-2*log($p));
  766.        return ((((($c[0]*$q+$c[1])*$q+$c[2])*$q+$c[3])*$q+$c[4])*$q+$c[5]) /
  767.                (((($d[0]*$q+$d[1])*$q+$d[2])*$q+$d[3])*$q+1);
  768.     }
  769.  
  770.     # Rational approximation for upper region:
  771.     if ( $phigh < $p ) {
  772.        my $q  = sqrt(-2*log(1-$p));
  773.        return -((((($c[0]*$q+$c[1])*$q+$c[2])*$q+$c[3])*$q+$c[4])*$q+$c[5]) /
  774.                 (((($d[0]*$q+$d[1])*$q+$d[2])*$q+$d[3])*$q+1);
  775.     }
  776.  
  777.     # Rational approximation for central region:
  778.     my $q = $p - 0.5;
  779.     my $r = $q*$q;
  780.     return ((((($a[0]*$r+$a[1])*$r+$a[2])*$r+$a[3])*$r+$a[4])*$r+$a[5])*$q /
  781.            ((((($b[0]*$r+$b[1])*$r+$b[2])*$r+$b[3])*$r+$b[4])*$r+1);
  782. }
  783.  
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top