summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Echolot/Chain.pm6
-rw-r--r--Echolot/Config.pm20
-rw-r--r--Echolot/Mailin.pm4
-rw-r--r--Echolot/Stats.pm139
-rw-r--r--Echolot/Storage/File.pm86
-rwxr-xr-xpingd11
6 files changed, 223 insertions, 43 deletions
diff --git a/Echolot/Chain.pm b/Echolot/Chain.pm
index 02494ae..14186a2 100644
--- a/Echolot/Chain.pm
+++ b/Echolot/Chain.pm
@@ -1,7 +1,7 @@
package Echolot::Chain;
# (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: Chain.pm,v 1.3 2003/02/15 11:43:41 weasel Exp $
+# $Id: Chain.pm,v 1.4 2003/02/16 03:06:51 weasel Exp $
#
=pod
@@ -105,7 +105,7 @@ sub remailer_supports_chaintype($$) {
my ($address, $type) = @_;
my %supports = map { $_ => 1} Echolot::Globals::get()->{'storage'}->get_types($address);
- for my $type (@{Echolot::Config::get()->{'do_chainpings'}->{$type}}) {
+ for my $type (@{Echolot::Config::get()->{'which_chainpings'}->{$type}}) {
return $type if $supports{$type};
};
return 0;
@@ -145,7 +145,7 @@ sub send_pings($;$$) {
$which1 eq $addr1 ||
$which1 eq '');
- for my $chaintype (keys %{Echolot::Config::get()->{'do_chainpings'}}) {
+ for my $chaintype (keys %{Echolot::Config::get()->{'which_chainpings'}}) {
my $type1 = remailer_supports_chaintype($addr1, $chaintype);;
next unless $type1;
my $key1 = get_latest_key($addr1, $type1);
diff --git a/Echolot/Config.pm b/Echolot/Config.pm
index 50d7ca7..db20904 100644
--- a/Echolot/Config.pm
+++ b/Echolot/Config.pm
@@ -1,7 +1,7 @@
package Echolot::Config;
# (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: Config.pm,v 1.49 2003/02/15 11:43:41 weasel Exp $
+# $Id: Config.pm,v 1.50 2003/02/16 03:06:51 weasel Exp $
#
=pod
@@ -68,6 +68,8 @@ sub init($) {
# Magic Numbers
hash_len => 8,
+ stats_days => 12,
+ seconds_per_day => 24 * 60 * 60,
# New Remailers
fetch_new => 1,
@@ -99,6 +101,10 @@ sub init($) {
chainpinger_interval => 5*60, # send out pings every 5 minutes
chainping_every_nth_time => 810, # send out pings to the same chain every 810 calls, i.e. every 3 days
+ chainping_period => 10*24*60*60, # 10 days
+ chainping_fudge => 0.7, # if less than 0.7 * rel1 * rel2 make it, the chain is really broken
+ chainping_grace => 1.5, # don't count pings sent no longer than 1.5 * (lat1 + lat2) ago
+ chainping_update => 300, # chain stats should never be older than 300 seconds
addresses_default_ttl => 5, # getkeyconf seconds (days)
check_resurrection_ttl => 8, # check_resurrection seconds (weeks)
@@ -131,14 +137,14 @@ sub init($) {
commands_file => 'commands.txt',
pidfile => 'pingd.pid',
- 'save-errormails' => 0,
+ save_errormails => 0,
write_meta_files => 1,
meta_extension => '.meta',
storage => {
- backend => 'File',
- File => {
- basedir => 'data'
+ backend => 'File',
+ File => {
+ basedir => 'data'
}
},
@@ -154,8 +160,8 @@ sub init($) {
'cpunk-clear' => 1,
'mix' => 1
},
- # ping types
- do_chainpings => {
+ do_chainpings => 1,
+ which_chainpings => {
'cpunk' => [ qw{cpunk-dsa cpunk-rsa cpunk-clear} ],
'mix' => [ qw{mix} ]
},
diff --git a/Echolot/Mailin.pm b/Echolot/Mailin.pm
index 266ccff..41d4863 100644
--- a/Echolot/Mailin.pm
+++ b/Echolot/Mailin.pm
@@ -1,7 +1,7 @@
package Echolot::Mailin;
# (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: Mailin.pm,v 1.13 2003/02/15 11:43:41 weasel Exp $
+# $Id: Mailin.pm,v 1.14 2003/02/16 03:06:51 weasel Exp $
#
=pod
@@ -214,7 +214,7 @@ sub process() {
Echolot::Globals::get()->{'storage'}->delay_commit();
for my $mail (@$mails) {
unless (handle($mail)) {
- if (Echolot::Config::get()->{'save-errormails'}) {
+ if (Echolot::Config::get()->{'save_errormails'}) {
Echolot::Log::info("Saving mail with unknown destination (probably a bounce) to mail-errordir.");
my $name = make_sane_name();
storemail($mailerrordir, $mail) or
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() {
diff --git a/Echolot/Storage/File.pm b/Echolot/Storage/File.pm
index c22b325..9309a03 100644
--- a/Echolot/Storage/File.pm
+++ b/Echolot/Storage/File.pm
@@ -1,7 +1,7 @@
package Echolot::Storage::File;
# (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: File.pm,v 1.49 2003/02/15 11:43:41 weasel Exp $
+# $Id: File.pm,v 1.50 2003/02/16 03:06:51 weasel Exp $
#
=pod
@@ -639,7 +639,7 @@ Returns 1.
sub chainpingdata_open($) {
my ($self) = @_;
- for my $type ( keys %{Echolot::Config::get()->{'do_chainpings'}} ) {
+ for my $type ( keys %{Echolot::Config::get()->{'which_chainpings'}} ) {
$self->chainpingdata_open_one($type);
};
@@ -715,6 +715,86 @@ sub chainpingdata_close($) {
+=item $storage->B<get_chainpings>( I<$chaintype> )
+
+Return chainping data for I<$chaintype>.
+
+The result is a reference to a hash having two entries: out and done.
+
+Each of them is a reference to an array of single pings. Each ping is a hash
+reference with the hash having the keys B<sent>, B<addr1>, B<type1>, B<key1>,
+B<addr2>, B<type2>, B<key2>, and in case of received pings B<lat>.
+
+Out currently includes all sent pings - also those that allready arrived.
+This is different from the get_pings() function above.
+
+Returns undef on error.
+
+=cut
+sub get_chainpings($$) {
+ my ($self, $chaintype) = @_;
+
+ my $fh = $self->get_chainping_fh($chaintype, 'out') or
+ Echolot::Log::warn ("assigned filehandle for $chaintype out chainpings."),
+ return undef;
+ seek($fh, 0, SEEK_SET) or
+ Echolot::Log::warn("Cannot seek to start of $chaintype out chainpings $!."),
+ return undef;
+ my @out =
+ map {
+ chomp;
+ my @a = split;
+ { sent => $a[0],
+ addr1 => $a[1],
+ type1 => $a[2],
+ key1 => $a[3],
+ addr2 => $a[4],
+ type2 => $a[5],
+ key2 => $a[6]
+ }
+ } <$fh>;
+ my %sent = map {
+ my $a = $_;
+ my $key = join (' ', map ({ $a->{$_} } qw{sent addr1 type1 key1 addr2 type2 key2}));
+ $key => 1
+ } @out;
+
+ $fh = $self->get_chainping_fh($chaintype, 'done') or
+ Echolot::Log::warn ("assigned filehandle for $chaintype done chainpings."),
+ return undef;
+ seek($fh, 0, SEEK_SET) or
+ Echolot::Log::warn("Cannot seek to start of $chaintype done chainpings $!."),
+ return undef;
+ my @done =
+ grep {
+ # Only list things that actually got sent - and only once
+ my $a = $_;
+ my $key = join (' ', map ({ $a->{$_} } qw{sent addr1 type1 key1 addr2 type2 key2}));
+ my $exists = exists $sent{$key};
+ delete $sent{$key};
+ $exists
+ }
+ map {
+ chomp;
+ my @a = split;
+ { sent => $a[0],
+ addr1 => $a[1],
+ type1 => $a[2],
+ key1 => $a[3],
+ addr2 => $a[4],
+ type2 => $a[5],
+ key2 => $a[6],
+ lat => $a[7]
+ }
+ } <$fh>;
+
+ return {
+ out => \@out,
+ done => \@done
+ };
+};
+
+
=item $storage->B<register_chainpingout>( I<$chaintype>, I<$addr1>, I<$type1>, I<$key1>, I<$addr2>, I<$type2>, I<$key2>, I<$sent_time> >
Register a chain ping of type I<$chaintype> sent through I<$addr1> (I<$type1>, I<$key1>)
@@ -761,7 +841,7 @@ sub register_chainpingdone($$$$$$$$$$) {
seek($fh, 0, SEEK_END) or
Echolot::Log::warn("Cannot seek to end of $chaintype/done pings: $!."),
return undef;
- print($fh join(' ', $sent_time, $latency, $addr1, $type1, $key1, $addr2, $type2, $key2)."\n") or
+ print($fh join(' ', $sent_time, $addr1, $type1, $key1, $addr2, $type2, $key2, $latency)."\n") or
Echolot::Log::warn("Error when writing to $chaintype/done pings: $!."),
return undef;
$fh->flush();
diff --git a/pingd b/pingd
index 565956f..ce231a0 100755
--- a/pingd
+++ b/pingd
@@ -2,8 +2,8 @@
$| = 1;
-# (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: pingd,v 1.95 2003/02/14 05:12:37 weasel Exp $
+# (c) 2002, 2003 Peter Palfrader <peter@palfrader.org>
+# $Id: pingd,v 1.96 2003/02/16 03:06:51 weasel Exp $
#
=pod
@@ -502,7 +502,8 @@ sub daemon_run($) {
$scheduler->add('processmail' , Echolot::Config::get()->{'processmail'} , 0, \&Echolot::Mailin::process );
$scheduler->add('ping' , Echolot::Config::get()->{'pinger_interval'} , 0, \&Echolot::Pinger::send_pings );
- $scheduler->add('chainping' , Echolot::Config::get()->{'chainpinger_interval'} , 0, \&Echolot::Chain::send_pings );
+ $scheduler->add('chainping' , Echolot::Config::get()->{'chainpinger_interval'} , 0, \&Echolot::Chain::send_pings )
+ if Echolot::Config::get()->{'do_chainpings'};
$scheduler->add('buildstats' , Echolot::Config::get()->{'buildstats'} , 0, \&Echolot::Stats::build_stats );
$scheduler->add('buildkeys' , Echolot::Config::get()->{'buildkeys'} , 0, \&Echolot::Stats::build_keys );
$scheduler->add('buildthesaurus' , Echolot::Config::get()->{'buildthesaurus'} , 0, \&Echolot::Thesaurus::build_thesaurus );
@@ -621,7 +622,7 @@ if (!GetOptions (
if ($params->{'help'}) {
print ("Usage: $PROGRAM_NAME [options] command\n");
print ("See man pingd or perldoc pingd for more info.\n");
- print ("echolot $VERSION - (c) 2002 Peter Palfrader <peter\@palfrader.org>\n");
+ print ("echolot $VERSION - (c) 2002, 2003 Peter Palfrader <peter\@palfrader.org>\n");
print ("http://savannah.gnu.org/projects/echolot/\n");
print ("\n");
print ("Commands:\n");
@@ -644,7 +645,7 @@ if ($params->{'help'}) {
};
if ($params->{'version'}) {
print ("echolot $VERSION\n");
- print ("(c) 2002 Peter Palfrader <peter\@palfrader.org>\n");
+ print ("(c) 2002, 2003 Peter Palfrader <peter\@palfrader.org>\n");
print ("http://savannah.gnu.org/projects/echolot/\n");
exit 0;
};
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 02:51:03 +0000