API tools faq
paste
Advertisement
bret_miller

memcron 0.6.6-Bret memcron.pl

bret_miller
Nov 18th, 2011
131
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 25.33 KB | None | 0 0
raw download clone embed print report
  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.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
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
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!