SHARE
TWEET

memcron.pl-0.6.7-Bret

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