From 1e423e4b65f9e1f8dd3bb70945020bfb877ec0f0 Mon Sep 17 00:00:00 2001 From: Peter Palfrader Date: Sun, 16 Feb 2003 03:06:51 +0000 Subject: Chain pinging and other minor things --- Echolot/Chain.pm | 6 +-- Echolot/Config.pm | 20 ++++--- Echolot/Mailin.pm | 4 +- Echolot/Stats.pm | 139 ++++++++++++++++++++++++++++++++++++++++-------- Echolot/Storage/File.pm | 86 ++++++++++++++++++++++++++++-- 5 files changed, 217 insertions(+), 38 deletions(-) (limited to 'Echolot') 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 -# $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 -# $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 -# $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 -# $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 -# $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( 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, B, B, B, +B, B, B, and in case of received pings B. + +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( 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(); -- cgit v1.2.3