summaryrefslogtreecommitdiff
path: root/Echolot/Stats.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Echolot/Stats.pm')
-rw-r--r--Echolot/Stats.pm139
1 files changed, 116 insertions, 23 deletions
diff --git a/Echolot/Stats.pm b/Echolot/Stats.pm
index 39eef51..c3a21b4 100644
--- a/Echolot/Stats.pm
+++ b/Echolot/Stats.pm
@@ -1,7 +1,7 @@
package Echolot::Stats;
# (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: Stats.pm,v 1.39 2003/02/15 11:43:41 weasel Exp $
+# $Id: Stats.pm,v 1.40 2003/02/16 03:06:51 weasel Exp $
#
=pod
@@ -18,8 +18,6 @@ and keyrings.
=cut
use strict;
-use constant DAYS => 12;
-use constant SECS_PER_DAY => 24 * 60 * 60;
use English;
use Echolot::Log;
@@ -29,6 +27,12 @@ my $NORMAL = new Statistics::Distrib::Normal;
$NORMAL->mu(0);
$NORMAL->sigma(1);
+my $STATS_DAYS;
+my $SECONDS_PER_DAY;
+
+my %LAST_BROKENCHAIN_RUN;
+my %BROKEN_CHAINS;
+
sub make_date() {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime();
sprintf("%s %02d %s %4d %02d:%02d:%02d GMT",
@@ -69,9 +73,9 @@ sub make_min_hr($$) {
sub build_list1_latencystr($) {
my ($lat) = @_;
- my $str = '?' x DAYS;
- for my $day (0 .. DAYS - 1) {
- substr($str, DAYS - 1 - $day, 1) =
+ my $str = '?' x $STATS_DAYS;
+ for my $day (0 .. $STATS_DAYS - 1) {
+ substr($str, $STATS_DAYS - 1 - $day, 1) =
(defined $lat->[$day]) ?
($lat->[$day] < 300 ? '#' :
($lat->[$day] < 3600 ? '*' :
@@ -88,9 +92,9 @@ sub build_list1_latencystr($) {
sub build_list2_latencystr($) {
my ($lat) = @_;
- my $str = '?' x DAYS;
- for my $day (0 .. DAYS - 1) {
- substr($str, DAYS - 1 - $day, 1) =
+ my $str = '?' x $STATS_DAYS;
+ for my $day (0 .. $STATS_DAYS - 1) {
+ substr($str, $STATS_DAYS - 1 - $day, 1) =
(defined $lat->[$day]) ?
($lat->[$day] < 20*60 ? '0' :
($lat->[$day] < 1*3600 ? '1' :
@@ -119,9 +123,9 @@ sub build_list2_latencystr($) {
sub build_list2_reliabilitystr($) {
my ($rel) = @_;
- my $str = '?' x DAYS;
- for my $day (0 .. DAYS - 1) {
- substr($str, DAYS - 1 - $day, 1) =
+ my $str = '?' x $STATS_DAYS;
+ for my $day (0 .. $STATS_DAYS - 1) {
+ substr($str, $STATS_DAYS - 1 - $day, 1) =
(defined $rel->[$day]) ?
(($rel->[$day] >= 0.9999) ?
#(($rel->[$day] == 1) ?
@@ -198,8 +202,8 @@ sub calculate($$) {
next unless Echolot::Globals::get()->{'storage'}->has_type($addr, $type);
my @keys = Echolot::Globals::get()->{'storage'}->get_keys($addr, $type);
for my $key (@keys) {
- push @out, grep {$_ > $now - DAYS * SECS_PER_DAY} Echolot::Globals::get()->{'storage'}->get_pings($addr, $type, $key, 'out');
- push @done, grep {$_->[0] > $now - DAYS * SECS_PER_DAY} Echolot::Globals::get()->{'storage'}->get_pings($addr, $type, $key, 'done');
+ push @out, grep {$_ > $now - $STATS_DAYS * $SECONDS_PER_DAY} Echolot::Globals::get()->{'storage'}->get_pings($addr, $type, $key, 'out');
+ push @done, grep {$_->[0] > $now - $STATS_DAYS * $SECONDS_PER_DAY} Echolot::Globals::get()->{'storage'}->get_pings($addr, $type, $key, 'done');
};
};
@@ -210,13 +214,13 @@ sub calculate($$) {
my @received;
my @sent;
for my $done (@done) {
- $latency += $done->[1]; $latency [int(($now - $done->[0]) / SECS_PER_DAY)] += $done->[1];
- $sent ++; $sent [int(($now - $done->[0]) / SECS_PER_DAY)] ++;
- $received ++; $received[int(($now - $done->[0]) / SECS_PER_DAY)] ++;
+ $latency += $done->[1]; $latency [int(($now - $done->[0]) / $SECONDS_PER_DAY)] += $done->[1];
+ $sent ++; $sent [int(($now - $done->[0]) / $SECONDS_PER_DAY)] ++;
+ $received ++; $received[int(($now - $done->[0]) / $SECONDS_PER_DAY)] ++;
};
$latency /= (scalar @done) if (scalar @done);
$latency = undef unless (scalar @done);
- for ( 0 .. DAYS - 1 ) {
+ for ( 0 .. $STATS_DAYS - 1 ) {
$latency[$_] /= $received[$_] if ($received[$_]);
};
@@ -232,12 +236,12 @@ sub calculate($$) {
$NORMAL->utp( map { ($now - $_ - $latency) / $deviation } @out ) :
map { 0 } @out;
for (my $i=0; $i < scalar @out; $i++) {
- $sent ++; $sent [int(($now - $out[$i]) / SECS_PER_DAY)] ++;
- $received += $p[$i]; $received[int(($now - $out[$i]) / SECS_PER_DAY)] += $p[$i];
+ $sent ++; $sent [int(($now - $out[$i]) / $SECONDS_PER_DAY)] ++;
+ $received += $p[$i]; $received[int(($now - $out[$i]) / $SECONDS_PER_DAY)] += $p[$i];
};
};
$received /= $sent if ($sent);
- for ( 0 .. DAYS - 1 ) {
+ for ( 0 .. $STATS_DAYS - 1 ) {
$received[$_] /= $sent[$_] if ($sent[$_]);
};
@@ -472,6 +476,83 @@ sub build_rems($) {
return \@rems;
};
+sub find_broken_chains($$$) {
+ my ($chaintype, $rems, $manual) = @_;
+
+ if (!defined $LAST_BROKENCHAIN_RUN{$chaintype} ||
+ $LAST_BROKENCHAIN_RUN{$chaintype} < time() - Echolot::Config::get()->{'chainping_update'} ||
+ ! defined $BROKEN_CHAINS{$chaintype} ) {
+ Echolot::Log::debug ("Broken Chains $chaintype need generating."),
+ $LAST_BROKENCHAIN_RUN{$chaintype} = time();
+
+ my $pings = Echolot::Globals::get()->{'storage'}->get_chainpings($chaintype);
+
+ my %remailers = map { $_->{'address'} => $_ } @$rems;
+
+ my $stats;
+ my %received;
+ my @broken_chains;
+ for my $status (qw{done out}) {
+ my $status_done = $status eq 'done';
+ my $status_out = $status eq 'out';
+ for my $ping (@{$pings->{$status}}) {
+ my $addr1 = $ping->{'addr1'};
+ my $addr2 = $ping->{'addr2'};
+ my $sent = $ping->{'sent'};
+ next if $sent < (time() - Echolot::Config::get()->{'chainping_period'});
+ next unless defined $remailers{$addr1};
+ next unless defined $remailers{$addr2};
+
+ if ($status_done) {
+ $received{$addr1.':'.$addr2.':'.$sent} = 1;
+ };
+ if ($status_out && !defined $received{$addr1.':'.$addr2.':'.$sent}) {
+ my $theoretical_lat = $remailers{$addr1}->{'stats'}->{'avr_latency'} +
+ $remailers{$addr2}->{'stats'}->{'avr_latency'};
+ $theoretical_lat = 0 unless defined $theoretical_lat;
+ my $latency = time() - $ping->{'sent'};
+ # print ("lat helps $latency $theoretical_lat\n"),
+ next if ($latency < $theoretical_lat * Echolot::Config::get()->{'chainping_grace'});
+ };
+
+ # print "Having $addr1 $addr2 $status at $sent\n";
+ $stats->{$addr1}->{$addr2}->{$status}++;
+ };
+ };
+ # require Data::Dumper;
+ # print Data::Dumper->Dump([$stats]);
+ for my $addr1 (keys %$stats) {
+ for my $addr2 (keys %{$stats->{$addr1}}) {
+ my $theoretical_rel = $remailers{$addr1}->{'stats'}->{'avr_reliability'} *
+ $remailers{$addr2}->{'stats'}->{'avr_reliability'};
+ ($stats->{$addr1}->{$addr2}->{'out'} != 0) or
+ Echolot::Log::debug("Should not devide through zero (".
+ $stats->{$addr1}->{$addr2}->{'done'}."/".
+ $stats->{$addr1}->{$addr2}->{'out'}.
+ ") for $addr1, $addr2."),
+ next;
+ my $real_rel = $stats->{$addr1}->{$addr2}->{'done'} /
+ $stats->{$addr1}->{$addr2}->{'out'};
+ # print "$addr1 $addr2 $stats->{$addr1}->{$addr2}->{'done'}/$stats->{$addr1}->{$addr2}->{'out'}".
+ # " == $real_rel ($theoretical_rel)\n";
+ next if ($real_rel > $theoretical_rel * Echolot::Config::get()->{'chainping_fudge'});
+ my $nick1 = $remailers{$addr1}->{'nick'};
+ my $nick2 = $remailers{$addr2}->{'nick'};
+ push @broken_chains, "($nick1 $nick2)\n";
+ };
+ };
+ $BROKEN_CHAINS{$chaintype} = \@broken_chains;
+ } else {
+ Echolot::Log::debug ("Broken Chains $chaintype are up to date."),
+ };
+
+ my @result = defined $manual ? (split /\n/, $manual) : ();
+ push @result, @{ $BROKEN_CHAINS{$chaintype} };
+ my %unique;
+ @result = grep { ! $unique{$_}++; } @result;
+ return join "\n", @result;
+};
+
sub build_lists() {
my $clist;
@@ -486,7 +567,16 @@ sub build_lists() {
my $broken2 = read_file( Echolot::Config::get()->{'broken2'}, 1);
my $sameop = read_file( Echolot::Config::get()->{'sameop'}, 1);
- $rems = build_rems(['mix']);
+
+ my $mixrems = build_rems(['mix']);
+ my $cpunkrems = build_rems(['cpunk-rsa', 'cpunk-dsa', 'cpunk-clear']);
+ if (Echolot::Config::get()->{'do_chainpings'}) {
+ $broken1 = find_broken_chains('cpunk', $cpunkrems, $broken1);
+ $broken2 = find_broken_chains('mix', $mixrems, $broken2);
+ };
+
+ $rems = $mixrems;
+ $mixrems = undef;
@$pubrems = grep { $_->{'showit'} } @$rems;
build_mlist1( $rems, $broken1, $broken2, $sameop, Echolot::Config::get()->{'private_resultdir'}.'/'.'mlist', 'mlist');
build_list2( $rems, 2, $broken1, $broken2, $sameop, Echolot::Config::get()->{'private_resultdir'}.'/'.'mlist2', 'mlist2');
@@ -500,7 +590,8 @@ sub build_lists() {
$pubclist->{'mix'} = $pubrems; $pubrems = undef;
};
- $rems = build_rems(['cpunk-rsa', 'cpunk-dsa', 'cpunk-clear']);
+ $rems = $cpunkrems;
+ $cpunkrems = undef;
@$pubrems = grep { $_->{'showit'} } @$rems;
build_rlist1( $rems, $broken1, $broken2, $sameop, Echolot::Config::get()->{'private_resultdir'}.'/'.'rlist', 'rlist');
build_list2( $rems, 1, $broken1, $broken2, $sameop, Echolot::Config::get()->{'private_resultdir'}.'/'.'rlist2', 'rlist2');
@@ -805,6 +896,8 @@ sub build_pgpring() {
};
sub build_stats() {
+ $STATS_DAYS = Echolot::Config::get()->{'stats_days'};
+ $SECONDS_PER_DAY = Echolot::Config::get()->{'seconds_per_day'};
build_lists();
};
sub build_keys() {
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 08:22:38 +0000