API tools faq
paste
Advertisement
Guest User

aids.pl

a guest
Jun 23rd, 2011
225
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 13.02 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl
  2. use warnings;
  3. use strict;
  4.  
  5. # You are free to use this software under the terms of a BSD-style license
  6. # Copyright TurdHurdur(pseudonym) of forum.bitcoin.org
  7.  
  8. use POE qw(Wheel::Run Filter::Stream);
  9. use File::Basename qw(dirname);
  10. use Cwd qw(getcwd);
  11. use JSON;
  12. use Getopt::Long qw(GetOptions);
  13. use Pod::Usage;
  14.  
  15. pod2usage(1) if (!@ARGV);
  16. my ($arg_file, $arg_help) = ('./aids_conf.json', undef);
  17. GetOptions(
  18.   'f|file:s' => \$arg_file,
  19.   'h|help' => \$arg_help
  20. ) or pod2usage(1);
  21. pod2usage(1) if ($arg_help);
  22. my %default_penalty_trigger_keys = (
  23.   'penalty' => 0,
  24.   'triggers_switch' => 1,
  25.   'repeat_penalty' => 0,
  26.   'stuck_penalty' => 0
  27. );
  28. open my $fh, '<', $arg_file;
  29. my $string = do { local $/ = <$fh> };
  30. close $fh;
  31. $string =~ s/\/\/#.+//g;
  32. my $config = decode_json $string;
  33. for (keys %{$config->{connections}}) {
  34.   $config->{connections}{$_}{command} = argify($config->{connections}{$_}{command});
  35. }
  36.  
  37. sub argify {
  38.   my $args = shift;
  39.   if (index($args, '"') == 0) {
  40.     $args = [split(/"/, $args, 3)];
  41.     shift(@$args);
  42.     $args->[0] =~ s/(?<!\\) /\\ /g;
  43.     my @args_args = split(/ +/, $args->[1]);
  44.     shift(@args_args);
  45.     @$args[1..@args_args] = @args_args;
  46.   } else {
  47.     $args = [split(/(?<!\\) +/, $args)];
  48.   }
  49.   $args->[0] =~ s/\\(?! )/\//g;
  50.   return $args;
  51. }
  52. $SIG{$_} = \&catch_sigs for(qw(INT TERM KILL));
  53. POE::Session->create(
  54.   inline_states => {
  55.     _start            => \&on_start,
  56.     got_child_stdout  => \&on_child_stdout,
  57.     got_child_stderr  => \&on_child_stderr,
  58.     got_child_close   => \&on_child_close,
  59.     got_child_signal  => \&on_child_signal,
  60.     close_all         => \&close_all,
  61.     run_new           => \&run_new,
  62.     error_state       => \&error_state,
  63.     handle_switch     => \&handle_switch,
  64.     granularity_tick  => \&granularity_tick
  65.   }
  66. );
  67. $poe_kernel->run();
  68. exit 0;
  69.  
  70. sub catch_sigs {
  71.   my $signame = shift;
  72.   # print "\n\nCaught SIG$signame\n" if ($arg_verbose > 0);
  73.   $poe_kernel->call('s_alias', 'close_all', $signame);
  74. }
  75.  
  76. sub close_all {
  77.   $poe_kernel->alarm_remove_all();
  78.   for my $key (keys %{$_[HEAP]{children_by_wid}}) {
  79.     $_[HEAP]{children_by_wid}{$key}->put("\cC");
  80.     $_[HEAP]{children_by_wid}{$key}->kill('INT');
  81.     #$_[HEAP]{children_by_wid}{$key}->kill('TERM');
  82.     #$_[HEAP]{children_by_wid}{$key}->kill('KILL');
  83.   }
  84.   exit;
  85. }
  86.  
  87. sub granularity_tick {
  88.   my ($heap, $tick) = @_[HEAP, ARG0];
  89.   my $runtime = $config->{interval_granularity} * $tick;
  90.   $poe_kernel->delay_add('granularity_tick' => $config->{interval_granularity}, ++$tick);
  91.   if (defined($config->{intervals_seconds}{rem_penalty})) {
  92.     $heap->{intervals_status}{rem_penalty} -= $config->{interval_granularity};
  93.     if ($heap->{intervals_status}{rem_penalty} <= 0) {
  94.       for my $k (keys %{$config->{connections}}) {
  95.         $heap->{miner_status}{$k}{penalty} -= $config->{connections}{$k}{rem_penalty_interval_amt};
  96.         $heap->{miner_status}{$k}{penalty} = $heap->{miner_status}{$k}{penalty} < 0 ? 0 : $heap->{miner_status}{$k}{penalty};
  97.       }
  98.       $heap->{intervals_status}{rem_penalty} = $config->{intervals_seconds}{rem_penalty};
  99.     }
  100.   }
  101.  
  102.   my $live_conn_name = (grep {$heap->{miner_status}{$_}{live}} keys %{$heap->{miner_status}})[0];
  103.   if (!$live_conn_name) {
  104.     warn 'Unusual occurance no $live_conn_name';
  105.     return;
  106.   }
  107.  
  108.   if (defined($config->{intervals_seconds}{stuck_check})) {
  109.     $heap->{intervals_status}{stuck_check} -= $config->{interval_granularity};
  110.     if ($heap->{intervals_status}{stuck_check} <= 0) {
  111.       $heap->{intervals_status}{stuck_check} = $config->{intervals_seconds}{stuck_check};
  112.       if ($heap->{miner_status}{$live_conn_name}{lastline_time} < time() - $config->{intervals_seconds}{stuck_check}) {
  113.         for my $penalty_key (keys %{$config->{penalty_triggers}}) {
  114.           if (
  115.             $config->{penalty_triggers}{$penalty_key}{stuck_switch} &&
  116.             (!defined($config->{connections}{$live_conn_name}{applicable_triggers}) ||
  117.             grep {$penalty_key eq $_} $config->{connections}{$live_conn_name}{applicable_triggers}) &&
  118.             $heap->{miner_status}{$live_conn_name}{lastline_time} != $heap->{miner_status}{$live_conn_name}{firstline_time} &&
  119.             $heap->{miner_status}{$live_conn_name}{lastline} =~ /$config->{penalty_triggers}{$penalty_key}{regex}/
  120.           ) {
  121.             $heap->{miner_status}{$live_conn_name}{penalty} += $config->{penalty_triggers}{$penalty_key}{stuck_penalty};
  122.             print 'Stuck penalty applied at line ' . __LINE__ . "\n";
  123.             print "\nSwitch at " . __LINE__ . "\n";
  124.             $poe_kernel->post('s_alias', 'handle_switch', $live_conn_name);
  125.             return;
  126.           }
  127.         }
  128.       }
  129.     }
  130.   }
  131.  
  132.   if (defined($config->{intervals_seconds}{switch_check})) {
  133.     $heap->{intervals_status}{switch_check} -= $config->{interval_granularity};
  134.     if ($heap->{intervals_status}{switch_check} <= 0) {
  135.       $heap->{intervals_status}{switch_check} = $config->{intervals_seconds}{switch_check};
  136.       if ((sort {$config->{connections}{$a}{base_priority} + $heap->{miner_status}{$a}{penalty} <=> $config->{connections}{$b}{base_priority} + $heap->{miner_status}{$b}{penalty}} keys %{$config->{connections}})[0] ne $live_conn_name) {
  137.         print "\nSwitch at " . __LINE__ . "\n";
  138.         $poe_kernel->post('s_alias', 'handle_switch', $live_conn_name);
  139.         return;
  140.       }
  141.     }
  142.   }
  143.  
  144.   if (defined($heap->{miner_status}{$live_conn_name}{switch_countdown})) {
  145.     $heap->{miner_status}{$live_conn_name}{switch_countdown} -= $config->{interval_granularity};
  146.     if ($heap->{miner_status}{$live_conn_name}{switch_countdown} <= 0) {
  147.       $heap->{miner_status}{$live_conn_name}{penalty} += $config->{connections}{$live_conn_name}{switch_after_sec_penalty};
  148.       $heap->{miner_status}{$live_conn_name}{switch_countdown} = $config->{connections}{$live_conn_name}{switch_after_sec};
  149.       print "\nSwitch at " . __LINE__ . "\n";
  150.       $poe_kernel->post('s_alias', 'handle_switch', $live_conn_name);
  151.     }
  152.   }
  153. }
  154.  
  155. sub run_new {
  156.   my ($wheelname, $command) = @_[ARG0, ARG1];
  157.   return if ($_[HEAP]{miner_status}{$wheelname}{live});
  158.   print "\nStarting $wheelname\n";
  159.   %{$_[HEAP]{intervals_status}} = %{$config->{intervals_seconds}} if (!defined($_[HEAP]{intervals_status}));
  160.   my $old_dir = getcwd;
  161.   chdir dirname($command->[0]);
  162.   $_[HEAP]{miner}{$wheelname} = POE::Wheel::Run->new(
  163.     Program       => $command,
  164.     Conduit       => $config->{connections}{$wheelname}{conduit} || undef,
  165.     StdoutFilter  => $config->{connections}{$wheelname}{nostream} ? POE::Filter::Line->new(InputRegexp => qr/\s*[\r\n]{1,2}\s*/, OutputLiteral => "\r\n") : POE::Filter::Stream->new(),
  166.     StderrFilter  => $config->{connections}{$wheelname}{nostream} ? POE::Filter::Line->new(InputRegexp => qr/\s*[\r\n]{1,2}\s*/, OutputLiteral => "\r\n") : POE::Filter::Stream->new(),
  167.     StdoutEvent   => "got_child_stdout",
  168.     StderrEvent   => "got_child_stderr",
  169.     CloseEvent    => "got_child_close",
  170.     ErrorEvent    => "error_state"
  171.   ) or die "$0: can't POE::Wheel::Run->new";
  172.   chdir $old_dir;
  173.   $_[KERNEL]->sig_child($_[HEAP]{miner}{$wheelname}->PID, "got_child_signal");
  174.   $_[HEAP]{children_by_wid}{$_[HEAP]{miner}{$wheelname}->ID} = $_[HEAP]{miner}{$wheelname};
  175.   $_[HEAP]{children_by_pid}{$_[HEAP]{miner}{$wheelname}->PID} = $_[HEAP]{miner}{$wheelname};
  176.   $_[HEAP]{miner_status}{$wheelname}{live} = 1;
  177.   $_[HEAP]{miner_status}{$wheelname}{penalty} = 0 if (!defined($_[HEAP]{miner_status}{$wheelname}{penalty}));
  178.   $_[HEAP]{miner_status}{$wheelname}{lastline} = '';
  179.   $_[HEAP]{miner_status}{$wheelname}{lastline_time} = 0;
  180.   $_[HEAP]{miner_status}{$wheelname}{firstline_time} = 0;
  181.   if (!defined($_[HEAP]{miner_status}{$wheelname}{switch_countdown}) && defined($config->{connections}{$wheelname}{switch_after_sec})) {
  182.     $_[HEAP]{miner_status}{$wheelname}{switch_countdown} = $config->{connections}{$wheelname}{switch_after_sec};
  183.   }
  184.   # $_[HEAP]{miner_status}{$wheelname}{pid} = $_[HEAP]{miner}{$wheelname}->PID;
  185.   #print(
  186.   # "\nChild pid ", $_[HEAP]{miner}{$wheelname}->PID,
  187.   # " started as wheel ", $_[HEAP]{miner}{$wheelname}->ID, ".\n"
  188.   #) if ($arg_verbose > 0);
  189.   return $_[HEAP]{miner}{$wheelname};
  190. }
  191.  
  192. sub handle_switch {
  193.   my ($heap, $conn_key) = @_[HEAP, ARG0];
  194.   $heap->{miner_status}{$conn_key}{lastline_time} = $heap->{miner_status}{$conn_key}{firstline_time};
  195.   $heap->{miner}{$conn_key}->put("\cC");
  196.   $heap->{miner}{$conn_key}->kill('INT');
  197.   my $next_up;
  198.   my @other_conns = grep({$_ ne $conn_key} keys %{$config->{connections}});
  199.   if (@other_conns > 1) {
  200.     $next_up = (sort({$config->{connections}{$a}{base_priority} + $heap->{miner_status}{$a}{penalty} <=> $config->{connections}{$b}{base_priority} + $heap->{miner_status}{$b}{penalty}} @other_conns))[0];
  201.   } else {
  202.     $next_up = $other_conns[0];
  203.   }
  204.   print "\nStopping $conn_key\n";
  205.   $poe_kernel->post('s_alias', 'run_new', $next_up, $config->{connections}{$next_up}{command});
  206. }
  207.  
  208. sub error_state {
  209.   my ($operation, $errnum, $errstr, $wheel_id) = @_[ARG0..ARG3];
  210.   $errstr = "\nremote end closed" if $operation eq "read" and !$errnum;
  211.   #warn "\n\nWheel $wheel_id generated $operation error $errnum: $errstr\n" if ($arg_verbose > 0);
  212. }
  213.  
  214. sub on_start {
  215.   $_[KERNEL]->alias_set('s_alias');
  216.   for my $k (keys %{$config->{connections}}) {
  217.     $_[HEAP]{miner_status}{$k}{penalty} = 0;
  218.   }
  219.   $poe_kernel->delay_add('granularity_tick' => $config->{interval_granularity}, 1);
  220.   for my $k (keys %{$config->{penalty_triggers}}) {
  221.     for (keys %default_penalty_trigger_keys) {
  222.       $config->{penalty_triggers}{$k}{$_} = defined($config->{penalty_triggers}{$k}{$_}) ? $config->{penalty_triggers}{$k}{$_} : $default_penalty_trigger_keys{${_}};
  223.     }
  224.   }
  225.   my $first_miner = (sort {$config->{connections}{$a}{base_priority} <=> $config->{connections}{$b}{base_priority}} keys %{$config->{connections}})[0];
  226.   $_[KERNEL]->post('s_alias', 'run_new', $first_miner, $config->{connections}{$first_miner}{command});
  227. }
  228.  
  229. sub on_child_stdout {
  230.   on_child_stdout_or_err('stdout', @_);
  231. }
  232.  
  233. sub on_child_stderr {
  234.   on_child_stdout_or_err('stderr', @_);
  235. }
  236.  
  237. sub on_child_stdout_or_err {
  238.   my $from = shift;
  239.   my ($heap, $line, $wheel_id) = @_[HEAP, ARG0, ARG1];
  240.   for my $conn_key (keys %{$config->{connections}}) {
  241.     if (defined($heap->{miner}{$conn_key}) && $wheel_id == $heap->{miner}{$conn_key}->ID) {
  242.       for my $penalty_key (keys %{$config->{penalty_triggers}}) {
  243.         if (
  244.           (!defined($config->{connections}{$conn_key}{applicable_triggers}) ||
  245.           grep {$penalty_key eq $_} @{$config->{connections}{$conn_key}{applicable_triggers}}) &&
  246.           $line =~ /$config->{penalty_triggers}{$penalty_key}{regex}/
  247.         ) {
  248.           my $time = time();
  249.           if ($line eq $heap->{miner_status}{$conn_key}{lastline}) {
  250.             $heap->{miner_status}{$conn_key}{penalty} += $config->{penalty_triggers}{$penalty_key}{repeat_penalty};
  251.             if ($config->{penalty_triggers}{$penalty_key}{repeat_switch}) {
  252.               $poe_kernel->post('s_alias', 'handle_switch', $conn_key);
  253.               print "\nSwitch at " . __LINE__ . "\n";
  254.               last;
  255.             }
  256.           }
  257.           $heap->{miner_status}{$conn_key}{penalty} += $config->{penalty_triggers}{$penalty_key}{penalty};
  258.           $heap->{miner_status}{$conn_key}{lastline} = $line;
  259.           $heap->{miner_status}{$conn_key}{lastline_time} = $time;
  260.           $heap->{miner_status}{$conn_key}{firstline_time} = $time if (!$heap->{miner_status}{$conn_key}{firstline_time});
  261.           if ($config->{penalty_triggers}{$penalty_key}{triggers_switch}) {
  262.             $poe_kernel->post('s_alias', 'handle_switch', $conn_key);
  263.             print "\nSwitch at " . __LINE__ . "\n";
  264.             last;
  265.           }
  266.         }
  267.       }
  268.       $line =~ s/([\x08\s])/$1/g;
  269.       #$line = $arg_verbose > 0 && $from eq 'stderr' ? $line . ' from stderr' : $line;
  270.       if (!defined($config->{connections}{$conn_key}{nostream}))
  271.       {
  272.         local $| = 1; # enable autoflush
  273.         print $line;
  274.       } else {
  275.       $line =~ s/[\r\n]//g;
  276.         print $line . "\n";
  277.       }
  278.       return;
  279.     }
  280.   }
  281. }
  282.  
  283. sub on_child_close {
  284.   my $wheel_id = $_[ARG0];
  285.   my $child = delete $_[HEAP]{children_by_wid}{$wheel_id};
  286.   unless (defined $child) {
  287.     # print "\nwid $wheel_id closed all pipes.\n" if ($arg_verbose > 0);
  288.     return;
  289.   }
  290.   # print "\npid ", $child->PID, " closed all pipes.\n" if ($arg_verbose > 0);
  291.   delete $_[HEAP]{children_by_pid}{$child->PID};
  292. }
  293.  
  294. sub on_child_signal {
  295.   # print "\npid $_[ARG1] exited with status $_[ARG2].\n" if ($arg_verbose > 0);
  296.   my $child = delete $_[HEAP]{children_by_pid}{$_[ARG1]};
  297.   for my $miner (keys %{$_[HEAP]{miner}}) {
  298.     if ($_[HEAP]{miner}{$miner}->PID == $_[ARG1]) {
  299.       $_[HEAP]{miner_status}{$miner}{live} = 0;
  300.     }
  301.   }
  302.   return unless defined $child;
  303.   delete $_[HEAP]{children_by_wid}{$child->ID};
  304. }
  305.  
  306. __END__
  307.  
  308. =head1 NAME
  309.  
  310. aids.pl - Using aids.pl
  311.  
  312. =head1 SYNOPSIS
  313.  
  314. aids.pl [-f filename]
  315.  
  316.  Options:
  317.    --file             -f  config file to use
  318.    --help             -h  this help message
  319. =cut
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!