summaryrefslogtreecommitdiff
path: root/Echolot
diff options
context:
space:
mode:
authorPeter Palfrader <peter@palfrader.org>2003-02-14 05:03:15 +0000
committerPeter Palfrader <peter@palfrader.org>2003-02-14 05:03:15 +0000
commit86e4945b49ea8ae7625729e1b774c26e3861ebcb (patch)
treedeb2f7235c480c3d89169f98876090c870d7ebb6 /Echolot
parent1f87ea3feafbdca9e08b3495ba5a1c3ccb49f2eb (diff)
Chain Pinging Part I -
Storage and testing still missing
Diffstat (limited to 'Echolot')
-rw-r--r--Echolot/Chain.pm225
-rw-r--r--Echolot/Config.pm7
2 files changed, 231 insertions, 1 deletions
diff --git a/Echolot/Chain.pm b/Echolot/Chain.pm
new file mode 100644
index 0000000..60570c8
--- /dev/null
+++ b/Echolot/Chain.pm
@@ -0,0 +1,225 @@
+package Echolot::Chain;
+
+# (c) 2002 Peter Palfrader <peter@palfrader.org>
+# $Id: Chain.pm,v 1.1 2003/02/14 05:03:15 weasel Exp $
+#
+
+=pod
+
+=head1 Name
+
+Echolot::Chain - actual sending and receiving of Chain-Pings.
+
+=head1 DESCRIPTION
+
+This package provides functions for sending out and receiving chain-pings.
+
+=cut
+
+use strict;
+use English;
+use Echolot::Log;
+use Echolot::Pinger::Mix;
+use Echolot::Pinger::CPunk;
+
+sub do_mix_chainping($$$$$$$$) {
+ my ($addr1, $type1, $keyid1, $addr2, $type2, $keyid2, $to, $body) = @_;
+
+ ($type1 eq 'mix' && $type2 eq 'mix') or
+ Echolot::Log::warn("both types should really be mix ($type1, $type2)."),
+ return 0;
+
+ my %key1 = Echolot::Globals::get()->{'storage'}->get_key($addr1, $type1, $keyid1);
+ my %key2 = Echolot::Globals::get()->{'storage'}->get_key($addr2, $type2, $keyid2);
+ Echolot::Pinger::Mix::ping(
+ $body,
+ $to,
+ [ $key1{'nick'} , $key2{'nick'} ],
+ { $keyid1 => \%key1, $keyid2 => \%key2 } ) or
+ return 0;
+
+ return 1;
+};
+
+sub do_cpunk_ping($$$$$$$$) {
+ my ($addr1, $type1, $keyid1, $addr2, $type2, $keyid2, $to, $body) = @_;
+
+ my $keyhash = {};
+ if ($type1 ne 'cpunk-clear') {
+ my %key = Echolot::Globals::get()->{'storage'}->get_key($addr1, $type1, $keyid1);
+ $keyhash->{$keyid1} = \%key;
+ };
+ if ($type2 ne 'cpunk-clear') {
+ my %key = Echolot::Globals::get()->{'storage'}->get_key($addr2, $type2, $keyid2);
+ $keyhash->{$keyid2} = \%key;
+ };
+ Echolot::Pinger::CPunk::ping(
+ $body,
+ $to,
+ [ { address => $addr1,
+ keyid => $keyid1,
+ encrypt => ($type1 ne 'cpunk-clear'),
+ pgp2compat => ($type1 eq 'cpunk-rsa') },
+ { address => $addr2,
+ keyid => $keyid2,
+ encrypt => ($type2 ne 'cpunk-clear'),
+ pgp2compat => ($type2 eq 'cpunk-rsa') } ],
+ $keyhash ) or
+ return 0;
+
+ return 1;
+};
+
+sub do_chainping($$$$$$$) {
+ my ($chaintype, $addr1, $type1, $key1, $addr2, $type2, $key2) = @_;
+
+ my $now = time();
+ my $token = join(':', $chaintype, $addr1, $type1, $key1, $addr2, $type2, $key2, $now);
+ my $mac = Echolot::Tools::make_mac($token);
+ my $body = "chaintype: $chaintype\n".
+ "remailer1: $addr1\n".
+ "type1: $type1\n".
+ "key1: $key1\n".
+ "remailer2: $addr2\n".
+ "type2: $type2\n".
+ "key2: $key2\n".
+ "sent: $now\n".
+ "mac: $mac\n";
+ $body = Echolot::Tools::crypt_symmetrically($body, 'encrypt');
+
+ my $to = Echolot::Tools::make_address('chainping');
+ if ($chaintype eq 'mix') {
+ do_mix_chainping($addr1, $type1, $key1, $addr2, $type2, $key2, $to, $body);
+ } elsif ($chaintype eq 'cpunk') {
+ do_cpunk_chainping($addr1, $type1, $key1, $addr2, $type2, $key2, $to, $body);
+ } else {
+ Echolot::Log::warn("Don't know how to handle chain ping type $chaintype.");
+ return 0;
+ };
+
+ Echolot::Globals::get()->{'storage'}->register_chainpingout($chaintype, $addr1, $type1, $key1, $addr2, $type2, $key2, $now);
+ return 1;
+};
+
+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}}) {
+ return $type if $supports{$type};
+ };
+ return 0;
+};
+sub get_latest_key($$) {
+ my ($address, $type) = @_;
+
+ my $latest = 0;
+ my $chosen = undef;
+ for my $keyid (Echolot::Globals::get()->{'storage'}->get_keys($address, $type)) {
+ my $key = Echolot::Globals::get()->{'storage'}->get_key($address, $type, $keyid);
+ $chosen = $keyid if $latest < $key->{'last_updated'};
+ };
+ return $chosen;
+};
+
+sub send_pings($;$$) {
+ my ($scheduled_for, $which1, $which2) = @_;
+
+ $which1 = '' unless defined $which1;
+ $which2 = '' unless defined $which2;
+
+ my $call_intervall = Echolot::Config::get()->{'chainpinger_interval'};
+ my $send_every_n_calls = Echolot::Config::get()->{'chainping_every_nth_time'};
+
+ my $timemod = int ($scheduled_for / $call_intervall);
+ my $this_call_id = $timemod % $send_every_n_calls;
+ my $session_id = int ($scheduled_for / ($call_intervall * $send_every_n_calls));
+
+ my @remailers = Echolot::Globals::get()->{'storage'}->get_remailers();
+ for my $rem1 (@remailers) {
+ next unless $rem1->{'pingit'};
+ my $addr1 = $rem1->{'address'};
+
+ next unless (
+ $which1 eq 'all' ||
+ $which1 eq $addr1 ||
+ $which1 eq '');
+
+ for my $chaintype (keys %{Echolot::Config::get()->{'do_chainpings'}}) {
+ my $type1 = remailer_supports_chaintype($addr1, $chaintype);;
+ next unless $type1;
+ my $key1 = get_latest_key($addr1, $type1);
+
+ for my $rem2 (@remailers) {
+ next unless $rem2->{'pingit'};
+ my $addr2 = $rem2->{'address'};
+
+ next unless (
+ $which2 eq 'all' ||
+ $which2 eq $addr2 ||
+ $which2 eq '');
+
+ my $type2 = remailer_supports_chaintype($addr2, $chaintype);;
+ next unless $type2;
+ my $key2 = get_latest_key($addr2, $type2);
+
+
+ next unless (
+ (($which1 eq $addr1 || $which1 eq 'all' ) && ($which2 eq $addr2 || $which2 eq 'all')) ||
+ (($which1 eq '' && $which2 eq '') && ($this_call_id eq (Echolot::Tools::makeShortNumHash($addr1.$addr2.$chaintype.$session_id) % $send_every_n_calls))));
+
+ Echolot::Log::debug("chainping calling $chaintype, $addr1 ($type1, $key1) - $addr2 ($type2, $key2)");
+ do_chainping($chaintype, $addr1, $type1, $key1, $addr2, $type2, $key2);
+ };
+ };
+ };
+ return 1;
+};
+
+
+sub receive($$$) {
+ my ($msg, $token, $timestamp) = @_;
+
+ my $now = time();
+
+ my $body;
+ if ($msg =~ /^-----BEGIN PGP MESSAGE-----/m) {
+ # work around borken middleman remailers that have a problem with some
+ # sort of end of line characters and randhopping them through reliable
+ # remailers..
+ # they add an empty line between each usefull line
+ $msg =~ s/(\r?\n)\r?\n/$1/g if ($msg =~ /^-----BEGIN PGP MESSAGE-----\r?\n\r?\n/m);
+ $body = Echolot::Tools::crypt_symmetrically($msg, 'decrypt');
+ };
+ $body = $msg unless defined $body;
+
+ my ($chaintype) = $body =~ /^chaintype (.*)$/m;
+ my ($addr1) = $body =~ /^remailer1: (.*)$/m;
+ my ($type1) = $body =~ /^type1: (.*)$/m;
+ my ($key1) = $body =~ /^key1: (.*)$/m;
+ my ($addr2) = $body =~ /^remailer2: (.*)$/m;
+ my ($type2) = $body =~ /^type2: (.*)$/m;
+ my ($key2) = $body =~ /^key2: (.*)$/m;
+ my ($sent) = $body =~ /^sent: (.*)$/m;
+ my ($mac) = $body =~ /^mac: (.*)$/m;
+
+ my @values = ($chaintype, $addr1, $type1, $key1, $addr2, $type2, $key2, $sent, $mac);
+ my $cleanstring = join ":", map { defined() ? $_ : "undef" } @values;
+
+ (grep { ! defined() } @values) and
+ Echolot::Log::warn("Received chainping at $timestamp has undefined values: $cleanstring."),
+ return 0;
+
+ pop @values;
+ Echolot::Tools::verify_mac(join(':', @values), $mac) or
+ Echolot::Log::warn("Received chainping at $timestamp has wrong mac; $cleanstring."),
+ return 0;
+
+ Echolot::Globals::get()->{'storage'}->register_chainpingdone($chaintype, $addr1, $type1, $key1, $addr2, $type2, $key2, $now - $sent) or
+ return 0;
+
+ return 1;
+};
+
+1;
+# vim: set ts=4 shiftwidth=4:
diff --git a/Echolot/Config.pm b/Echolot/Config.pm
index 385d1d4..cd5412c 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.46 2003/01/14 06:40:24 weasel Exp $
+# $Id: Config.pm,v 1.47 2003/02/14 05:03:15 weasel Exp $
#
=pod
@@ -150,6 +150,11 @@ sub init($) {
'cpunk-clear' => 1,
'mix' => 1
},
+ # ping types
+ do_chainpings => {
+ 'cpunk' => [ qw{cpunk-dsa cpunk-rsa cpunk-clear} ],
+ 'mix' => [ qw{mix} ]
+ },
# templates
templates => {