summaryrefslogtreecommitdiff
path: root/Echolot
diff options
context:
space:
mode:
authorPeter Palfrader <peter@palfrader.org>2002-06-11 15:34:53 +0000
committerPeter Palfrader <peter@palfrader.org>2002-06-11 15:34:53 +0000
commit36ee06801447088a594a55122ff3e450cbe739ae (patch)
tree154610a9639a37c798a5a93f63a2eb04c1279aa7 /Echolot
parentc8ae0714d09d64dc84b8092f0c671eee6306054c (diff)
Initial Import
Diffstat (limited to 'Echolot')
-rw-r--r--Echolot/Stats.pm319
1 files changed, 319 insertions, 0 deletions
diff --git a/Echolot/Stats.pm b/Echolot/Stats.pm
new file mode 100644
index 0000000..d6a181e
--- /dev/null
+++ b/Echolot/Stats.pm
@@ -0,0 +1,319 @@
+package Echolot::Stats;
+
+# (c) 2002 Peter Palfrader <peter@palfrader.org>
+# $Id: Stats.pm,v 1.1 2002/06/11 15:34:53 weasel Exp $
+#
+
+=pod
+
+=head1 Name
+
+Echolot::Stats - produce Stats, keyrings et al
+
+=head1 DESCRIPTION
+
+This package provides functions for generating remailer stats,
+and keyrings.
+
+=cut
+
+use strict;
+use warnings;
+use Carp qw{cluck};
+
+my $DAYS = 12;
+my $SECS_PER_DAY = 24 * 60 * 60;
+my @WDAY = qw{Sun Mon Tue Wed Thu Fri Sat};
+my @MON = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};
+
+
+sub makeDate() {
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = gmtime();
+ sprintf("%s %02d %s %4d %02d:%02d:%02d GMT",
+ $WDAY[$wday],
+ $mday,
+ $MON[$mon],
+ $year + 1900,
+ $hour,
+ $min,
+ $sec);
+};
+
+sub makeMinHr($$) {
+ my ($sec, $includesec) = @_;
+ my ($s, $m, $h);
+
+ if (defined $sec) {
+ $s = $sec % 60;
+ $m = $sec / 60 % 60;
+ $h = int ($sec / 60 / 60);
+ };
+ if ((! defined $h) || ($h > 99)) {
+ $h = 99;
+ $m = 59;
+ $s = 59;
+ };
+
+ if ($includesec) {
+ if ($h) { return sprintf ("%2d:%02d:%02d", $h, $m, $s); }
+ elsif ($m) { return sprintf ( " %2d:%02d", $m, $s); }
+ else { return sprintf ( " %2d", $s); };
+ } else {
+ if ($h) { return sprintf ("%2d:%02d", $h, $m); }
+ else { return sprintf ( " :%02d", $m); };
+ };
+};
+
+sub build_mlist1_latencystr($) {
+ my ($lat) = @_;
+
+ my $str = '?' x $DAYS;
+ for my $day (0 .. $DAYS - 1) {
+ substr($str, $DAYS - 1 - $day, 1) =
+ (defined $lat->[$day]) ?
+ ($lat->[$day] < 300 ? '#' :
+ ($lat->[$day] < 3600 ? '*' :
+ ($lat->[$day] < 14400 ? '+' :
+ ($lat->[$day] < 86400 ? '-' :
+ ($lat->[$day] < 172800 ? '.' :
+ '_'
+ )))))
+ : ' ';
+ };
+ return $str;
+}
+
+sub build_mlist2_latencystr($) {
+ my ($lat) = @_;
+
+ my $str = '?' x $DAYS;
+ for my $day (0 .. $DAYS - 1) {
+ substr($str, $DAYS - 1 - $day, 1) =
+ (defined $lat->[$day]) ?
+ ($lat->[$day] < 20*60 ? '0' :
+ ($lat->[$day] < 1*3600 ? '1' :
+ ($lat->[$day] < 2*3600 ? '2' :
+ ($lat->[$day] < 3*3600 ? '3' :
+ ($lat->[$day] < 4*3600 ? '4' :
+ ($lat->[$day] < 5*3600 ? '5' :
+ ($lat->[$day] < 6*3600 ? '6' :
+ ($lat->[$day] < 7*3600 ? '7' :
+ ($lat->[$day] < 8*3600 ? '8' :
+ ($lat->[$day] < 9*3600 ? '9' :
+ ($lat->[$day] < 12*3600 ? 'A' :
+ ($lat->[$day] < 18*3600 ? 'B' :
+ ($lat->[$day] < 24*3600 ? 'C' :
+ ($lat->[$day] < 30*3600 ? 'D' :
+ ($lat->[$day] < 36*3600 ? 'E' :
+ ($lat->[$day] < 42*3600 ? 'F' :
+ ($lat->[$day] < 48*3600 ? 'G' :
+ 'H'
+ )))))))))))))))))
+ : '?';
+ };
+ return $str;
+}
+
+sub build_mlist2_reliabilitystr($) {
+ my ($rel) = @_;
+
+ my $str = '?' x $DAYS;
+ for my $day (0 .. $DAYS - 1) {
+ substr($str, $DAYS - 1 - $day, 1) =
+ (defined $rel->[$day]) ?
+ (($rel->[$day] == 1) ?
+ '+' :
+ (int ($rel->[$day]*10)))
+ : '?';
+ };
+ return $str;
+}
+
+sub build_mlist2_capsstr($) {
+ my ($caps) = @_;
+
+ my %caps;
+ $caps{'middle'} = ($caps =~ m/\bmiddle\b/i);
+ $caps{'post'} = ($caps =~ m/\bpost\b/i) || ($caps =~ m/\banon-post-to\b/i);
+ $caps{'mix'} = ($caps =~ m/\bmix\b/i);
+ $caps{'remix'} = ($caps =~ m/\bremix\b/i);
+ $caps{'remix2'} = ($caps =~ m/\bremix2\b/i);
+ $caps{'hybrid'} = ($caps =~ m/\bhybrid\b/i);
+ $caps{'repgp2'} = ($caps =~ m/\brepgp2\b/i);
+ $caps{'repgp'} = ($caps =~ m/\brepgp\b/i);
+ $caps{'pgponly'} = ($caps =~ m/\bpgponly\b/i);
+ $caps{'ext'} = ($caps =~ m/\bext\b/i);
+ $caps{'max'} = ($caps =~ m/\bmax\b/i);
+ $caps{'test'} = ($caps =~ m/\btest\b/i);
+ $caps{'latent'} = ($caps =~ m/\blatent\b/i);
+ $caps{'ek'} = ($caps =~ m/\bek\b/i);
+ $caps{'ekx'} = ($caps =~ m/\bekx\b/i);
+ $caps{'esub'} = ($caps =~ m/\besub\b/i);
+ $caps{'inflt'} = ($caps =~ m/\binflt\d+\b/i);
+ $caps{'rhop'} = ($caps =~ m/\brhop\d+\b/i);
+ ($caps{'klen'}) = ($caps =~ m/\bklen(\d+)\b/i);
+
+ my $str =
+ ($caps{'middle'} ? 'D' : ' ') .
+ ($caps{'post'} ? 'P' : ' ') .
+ ($caps{'remix2'} ? '2' : ($caps{'remix'} ? 'R' : ($caps{'mix'} ? 'M' : ' ' ))) .
+ ($caps{'hybrid'} ? 'H' : ' ') .
+ ($caps{'repgp2'} ? '2' : ($caps{'repgp'} ? 'G' : ' ' )) .
+ ($caps{'pgponly'} ? 'O' : ' ') .
+ ($caps{'ext'} ? 'X' : ' ') .
+ ($caps{'max'} ? 'A' : ' ') .
+ ($caps{'test'} ? 'T' : ' ') .
+ ($caps{'latent'} ? 'L' : ' ') .
+ ($caps{'ekx'} ? 'E' : ($caps{'ek'} ? 'e' : ' ' )) .
+ ($caps{'esub'} ? 'U' : ' ') .
+ ($caps{'inflt'} ? 'I' : ' ') .
+ ($caps{'rhop'} ? 'N' : ' ') .
+ (defined $caps{'klen'} ?
+ ($caps{'klen'} >= 900 ? '9' : (
+ $caps{'klen'} >= 800 ? '8' : (
+ $caps{'klen'} >= 700 ? '7' : (
+ $caps{'klen'} >= 600 ? '6' : (
+ $caps{'klen'} >= 500 ? '5' : (
+ $caps{'klen'} >= 400 ? '4' : (
+ $caps{'klen'} >= 300 ? '3' : (
+ $caps{'klen'} >= 200 ? '2' : (
+ $caps{'klen'} >= 100 ? '1' : '0'
+ )))))))))
+ : ' ');
+ return $str;
+}
+
+
+sub calculate($$) {
+ my ($addr, $type) = @_;
+ my $now = time();
+
+ my @keys = Echolot::Globals::get()->{'storage'}->get_keys($addr, $type) or
+ carp ("No keys asoziated with $addr, $type"),
+ return 0;
+
+ my @out;
+ my @done;
+
+ 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');
+ };
+
+ my $latency = 0;
+ my $received = 0;
+ my $sent = 0;
+ my @latency;
+ 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 /= (scalar @done) if (scalar @done);
+ for ( 0 .. $DAYS - 1 ) {
+ $latency[$_] /= $received[$_] if ($received[$_]);
+ };
+
+ for my $out (@out) {
+ my $p = 0;
+ $sent ++; $sent [int(($now - $out) / $SECS_PER_DAY)] ++;
+ $received += $p; $received[int(($now - $out) / $SECS_PER_DAY)] += $p;
+ };
+ $received /= $sent if ($sent);
+ for ( 0 .. $DAYS - 1 ) {
+ $received[$_] /= $sent[$_] if ($sent[$_]);
+ };
+
+
+ my $variance = 0;
+ $variance += ($latency - $_->[1]) ** 2 for (@done);
+ $variance /= (scalar @done) if (scalar @done);
+
+ my $deviation = sqrt($variance);
+
+ return {
+ avr_latency => $latency,
+ avr_reliability => $received,
+ latency_day => \@latency,
+ reliability_day => \@received
+ };
+};
+
+
+
+sub build_mlist1($) {
+ my ($rems) = @_;
+
+ my $filename = Echolot::Config::get()->{'resultdir'}.'/mlist.txt';
+ open(F, '>'.$filename) or
+ cluck("Cannot open $filename: $!\n"),
+ return 0;
+ printf F "Last update: %s\n", makeDate();
+ printf F "mixmaster history latency uptime\n";
+ printf F "--------------------------------------------\n";
+
+ for my $remailer (@$rems) {
+ printf F "%-14s %-12s %8s %6.2f%%\n",
+ $remailer->{'nick'},
+ build_mlist1_latencystr($remailer->{'stats'}->{'latency_day'}),
+ makeMinHr($remailer->{'stats'}->{'avr_latency'}, 1),
+ $remailer->{'stats'}->{'avr_reliability'} * 100;
+ };
+ close (F);
+};
+
+sub build_mlist2($) {
+ my ($rems) = @_;
+
+ my $filename = Echolot::Config::get()->{'resultdir'}.'/mlist2.txt';
+ open(F, '>'.$filename) or
+ #cluck("Cannot open $filename: $!\n"),
+ #return 0;
+ printf F "Stats-Version: 2.0\n";
+ printf F "Generated: %s\n", makeDate();
+ printf F "Mixmaster Latent-Hist Latent Uptime-Hist Uptime Options\n";
+ printf F "------------------------------------------------------------------------\n";
+
+ for my $remailer (@$rems) {
+ printf F "%-12s %-12s %6s %-12s %5.1f%% %s\n",
+ $remailer->{'nick'},
+ build_mlist2_latencystr($remailer->{'stats'}->{'latency_day'}),
+ makeMinHr($remailer->{'stats'}->{'avr_latency'}, 0),
+ build_mlist2_reliabilitystr($remailer->{'stats'}->{'reliability_day'}),
+ $remailer->{'stats'}->{'avr_reliability'} * 100,
+ build_mlist2_capsstr($remailer->{'caps'});
+ };
+ close (F);
+};
+
+
+sub build_mlists() {
+ my %rems;
+ for my $addr (Echolot::Globals::get()->{'storage'}->get_remailers()) {
+ next unless Echolot::Globals::get()->{'storage'}->has_type($addr, 'mix');
+
+ $rems{$addr} = {
+ 'stats' => calculate($addr,'mix'),
+ 'nick' => Echolot::Globals::get()->{'storage'}->get_nick($addr),
+ 'caps' => Echolot::Globals::get()->{'storage'}->get_capabilities($addr)
+ };
+ };
+
+ my @rems = map { $rems{$_} }
+ sort {
+ - $rems{$a}->{'stats'}->{'avr_latency'} <=> $rems{$b}->{'stats'}->{'avr_latency'} ||
+ $rems{$a}->{'nick'} cmp $rems{$b}->{'nick'}
+ } keys %rems;
+
+ build_mlist1(\@rems);
+ build_mlist2(\@rems);
+};
+
+sub build() {
+ build_mlists();
+};
+
+1;
+# vim: set ts=4 shiftwidth=4: