Collect From: header lines

7 files changed, 150 insertions, 34 deletions

diff --git a/Echolot/Chain.pm b/Echolot/Chain.pm
index 02604ad..dcf6647 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.7 2003/02/17 07:22:49 weasel Exp $
+# $Id: Chain.pm,v 1.8 2003/02/17 14:44:15 weasel Exp $
 #
 
 =pod
@@ -36,6 +36,7 @@ sub do_mix_chainping($$$$$$$$) {
 	Echolot::Pinger::Mix::ping(
 		$body,
 		$to,
+		0,
 		[ $key1{'nick'}    , $key2{'nick'}     ],
 		{ $keyid1 => \%key1, $keyid2 => \%key2 } ) or
 		return 0;
@@ -58,6 +59,7 @@ sub do_cpunk_chainping($$$$$$$$) {
 	Echolot::Pinger::CPunk::ping(
 		$body,
 		$to,
+		0,
 		[ { address    => $addr1,
 		    keyid      => $keyid1,
 		    encrypt    => ($type1 ne 'cpunk-clear'),
@@ -202,8 +204,8 @@ sub set_intensive_care($@) {
 	};
 };
 
-sub receive($$$) {
-	my ($msg, $token, $timestamp) = @_;
+sub receive($$$$) {
+	my ($header, $msg, $token, $timestamp) = @_;
 
 	my $now = time();
 
diff --git a/Echolot/Config.pm b/Echolot/Config.pm
index 4b6a6fb..9561d55 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.57 2003/02/17 07:22:49 weasel Exp $
+# $Id: Config.pm,v 1.58 2003/02/17 14:44:15 weasel Exp $
 #
 
 =pod
@@ -119,6 +119,7 @@ sub init($) {
 		expire_pings                => 12*24*60*60, # 12 days
 		expire_thesaurus            => 21*24*60*60, # 21 days
 		expire_chainpings           => 12*24*60*60, # 12 days
+		expire_fromlines            => 5*24*60*60, # 5 days
 
 		random_garbage              => 8192,
 
diff --git a/Echolot/Mailin.pm b/Echolot/Mailin.pm
index 41d4863..a97a949 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.14 2003/02/16 03:06:51 weasel Exp $
+# $Id: Mailin.pm,v 1.15 2003/02/17 14:44:15 weasel Exp $
 #
 
 =pod
@@ -50,11 +50,13 @@ sub handle($) {
 
 	my $i=0;
 	my $body = '';
+	my $header = '';
 	my $to;
 	for ( ; $i < scalar @$lines; $i++) {
 		my $line = $lines->[$i];
 		chomp($line);
 		last if $line eq '';
+		$header .= $line."\n";
 
 		if ($line =~ m/^To:\s*(.*?)\s*$/) {
 			$to = $1;
@@ -81,8 +83,8 @@ sub handle($) {
 	Echolot::Conf::remailer_stats($body, $type, $timestamp), return 1 if ($type =~ /^stats\./);
 	Echolot::Conf::remailer_adminkey($body, $type, $timestamp), return 1 if ($type =~ /^adminkey\./);
 
-	Echolot::Pinger::receive($body, $type, $timestamp), return 1 if ($type eq 'ping');
-	Echolot::Chain::receive($body, $type, $timestamp), return 1 if ($type eq 'chainping');
+	Echolot::Pinger::receive($header, $body, $type, $timestamp), return 1 if ($type eq 'ping');
+	Echolot::Chain::receive($header, $body, $type, $timestamp), return 1 if ($type eq 'chainping');
 
 	Echolot::Log::warn("Didn't know what to do with '$to'."),
 	return 0;
diff --git a/Echolot/Pinger.pm b/Echolot/Pinger.pm
index 792cb1d..545c147 100644
--- a/Echolot/Pinger.pm
+++ b/Echolot/Pinger.pm
@@ -1,7 +1,7 @@
 package Echolot::Pinger;
 
 # (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: Pinger.pm,v 1.25 2003/02/16 10:07:27 weasel Exp $
+# $Id: Pinger.pm,v 1.26 2003/02/17 14:44:15 weasel Exp $
 #
 
 =pod
@@ -22,8 +22,8 @@ use Echolot::Log;
 use Echolot::Pinger::Mix;
 use Echolot::Pinger::CPunk;
 
-sub do_mix_ping($$$$$) {
-	my ($address, $type, $keyid, $to, $body) = @_;
+sub do_mix_ping($$$$$$) {
+	my ($address, $type, $keyid, $to, $with_from, $body) = @_;
 
 	($type eq 'mix') or
 		Echolot::Log::warn("types should really be mix ($type)."),
@@ -33,6 +33,7 @@ sub do_mix_ping($$$$$) {
 	Echolot::Pinger::Mix::ping(
 		$body,
 		$to,
+		$with_from,
 		[ $key{'nick'} ],
 		{ $keyid => \%key } ) or
 		return 0;
@@ -40,8 +41,8 @@ sub do_mix_ping($$$$$) {
 	return 1;
 };
 
-sub do_cpunk_ping($$$$$) {
-	my ($address, $type, $keyid, $to, $body) = @_;
+sub do_cpunk_ping($$$$$$) {
+	my ($address, $type, $keyid, $to, $with_from, $body) = @_;
 
 	my $keyhash = {};
 	if ($type ne 'cpunk-clear') {
@@ -51,6 +52,7 @@ sub do_cpunk_ping($$$$$) {
 	Echolot::Pinger::CPunk::ping(
 		$body,
 		$to,
+		$with_from,
 		[ { address    => $address,
 		    keyid      => $keyid,
 		    encrypt    => ($type ne 'cpunk-clear'),
@@ -61,15 +63,16 @@ sub do_cpunk_ping($$$$$) {
 	return 1;
 };
 
-sub do_ping($$$) {
-	my ($type, $address, $key) = @_;
+sub do_ping($$$$) {
+	my ($type, $address, $key, $with_from) = @_;
 	
 	my $now = time();
-	my $token = join(':', $address, $type, $key, $now);
+	my $token = join(':', $address, $type, $key, $with_from, $now);
 	my $mac = Echolot::Tools::make_mac($token);
 	my $body = "remailer: $address\n".
 		"type: $type\n".
 		"key: $key\n".
+		"with_from: $with_from\n".
 		"sent: $now\n".
 		"mac: $mac\n".
 		Echolot::Tools::make_garbage();
@@ -77,9 +80,9 @@ sub do_ping($$$) {
 		
 	my $to = Echolot::Tools::make_address('ping');
 	if ($type eq 'mix') {
-		do_mix_ping($address, $type, $key, $to, $body);
+		do_mix_ping($address, $type, $key, $to, $with_from, $body);
 	} elsif ($type eq 'cpunk-rsa' || $type eq 'cpunk-dsa' || $type eq 'cpunk-clear') {
-		do_cpunk_ping($address, $type, $key, $to, $body);
+		do_cpunk_ping($address, $type, $key, $to, $with_from, $body);
 	} else {
 		Echolot::Log::warn("Don't know how to handle ping type $type.");
 		return 0;
@@ -119,8 +122,9 @@ sub send_pings($;$) {
 					$which eq 'all' ||
 					(($which eq '') && ($this_call_id eq (Echolot::Tools::makeShortNumHash($address.$type.$key.$session_id) % $send_every_n_calls))));
 
-				Echolot::Log::debug("ping calling $type, $address, $key.");
-				do_ping($type, $address, $key);
+				my $with_from = (int($timemod / $send_every_n_calls)) % 2;
+				Echolot::Log::debug("ping calling $type, $address, $key, $with_from.");
+				do_ping($type, $address, $key, $with_from);
 			}
 		};
 	};
@@ -128,12 +132,13 @@ sub send_pings($;$) {
 };
 
 
-sub receive($$$) {
-	my ($msg, $token, $timestamp) = @_;
+sub receive($$$$) {
+	my ($header, $msg, $token, $timestamp) = @_;
 
 	my $now = time();
 
 	my $body;
+	# < 2.0beta34 didn't encrypt pings.
 	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
@@ -148,23 +153,33 @@ sub receive($$$) {
 	my ($type) = $body =~ /^type: (.*)$/m;
 	my ($key) = $body =~ /^key: (.*)$/m;
 	my ($sent) = $body =~ /^sent: (.*)$/m;
+	my ($with_from) = $body =~ /^with_from: (.*)$/m;
 	my ($mac) = $body =~ /^mac: (.*)$/m;
 
-	my @values = ($addr, $type, $key, $sent, $mac);
+	my @values = ($addr, $type, $key, defined $with_from ? $with_from : 'undef', $sent, $mac); # undef was added after 2.0.10
 	my $cleanstring = join ":", map { defined() ? $_ : "undef" } @values;
+	my @values_obsolete = ($addr, $type, $key, $sent, $mac); # <= 2.0.10
 
-	(grep { ! defined() } @values) and
+	(grep { ! defined() } @values_obsolete) and
 		Echolot::Log::warn("Received ping at $timestamp has undefined values: $cleanstring."),
 		return 0;
 
 	pop @values;
+	pop @values_obsolete;
 	Echolot::Tools::verify_mac(join(':', @values), $mac) or
-		Echolot::Log::warn("Received ping at $timestamp has wrong mac; $cleanstring."),
-		return 0;
+		Echolot::Tools::verify_mac(join(':', @values_obsolete), $mac) or # old style without with_from
+			Echolot::Log::warn("Received ping at $timestamp has wrong mac; $cleanstring."),
+			return 0;
 
 	Echolot::Globals::get()->{'storage'}->register_pingdone($addr, $type, $key, $sent, $now - $sent) or
 		return 0;
-	
+
+	if (defined $with_from) { # <= 2.0.10 didn't have with_from
+		my ($from) = $header =~ /From: (.*)/i;
+		$from = 'undefined' unless defined $from;
+		Echolot::Globals::get()->{'storage'}->register_fromline($addr, $type, $with_from, $from);
+	};
+
 	return 1;
 };
 
diff --git a/Echolot/Pinger/CPunk.pm b/Echolot/Pinger/CPunk.pm
index 6f6e950..3878cff 100644
--- a/Echolot/Pinger/CPunk.pm
+++ b/Echolot/Pinger/CPunk.pm
@@ -1,7 +1,7 @@
 package Echolot::Pinger::CPunk;
 
 # (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: CPunk.pm,v 1.14 2003/02/15 23:35:16 weasel Exp $
+# $Id: CPunk.pm,v 1.15 2003/02/17 14:44:15 weasel Exp $
 #
 
 =pod
@@ -175,15 +175,23 @@ sub encrypt_to($$$$) {
 	return $result;
 };
 
-sub ping($$$$) {
-	my ($body, $to, $chain, $keys) = @_;
+sub ping($$$$$) {
+	my ($body, $to, $with_from, $chain, $keys) = @_;
 
 	my $msg = $body;
 
 	for my $hop (reverse @$chain) {
+		my $header = '';
+		if ($with_from) {
+			my $address = Echolot::Config::get()->{'my_localpart'} . '@' .
+			              Echolot::Config::get()->{'my_domain'};
+			$header = "##\nFrom: Echolot Pinger <$address>\n\n";
+			$with_from = 0;
+		};
 		$msg = "::\n".
 			"Anon-To: $to\n".
 			"\n".
+			$header.
 			$msg;
 
 		if ($hop->{'encrypt'}) {
diff --git a/Echolot/Pinger/Mix.pm b/Echolot/Pinger/Mix.pm
index 6e1072d..f331f2a 100644
--- a/Echolot/Pinger/Mix.pm
+++ b/Echolot/Pinger/Mix.pm
@@ -1,7 +1,7 @@
 package Echolot::Pinger::Mix;
 
 # (c) 2002 Peter Palfrader <peter@palfrader.org>
-# $Id: Mix.pm,v 1.12 2003/01/14 06:40:24 weasel Exp $
+# $Id: Mix.pm,v 1.13 2003/02/17 14:44:15 weasel Exp $
 #
 
 =pod
@@ -20,8 +20,8 @@ use strict;
 use English;
 use Echolot::Log;
 
-sub ping($$$$) {
-	my ($body, $to, $chain, $keys) = @_;
+sub ping($$$$$) {
+	my ($body, $to, $with_from, $chain, $keys) = @_;
 
 	my $chaincomma = join (',', @$chain);
 
@@ -70,6 +70,8 @@ sub ping($$$$) {
 	open(MIX, "|".Echolot::Config::get()->{'mixmaster'}." -m -S -l $chaincomma 2>/dev/null") or
 		Echolot::Log::warn("Cannot exec mixpinger: $!."),
 		return 0;
+	print MIX "From: Echolot Pinger <$address>\n"
+		if $with_from;
 	print MIX "To: $to\n\n$body\n";
 	close (MIX);
 	    
diff --git a/Echolot/Storage/File.pm b/Echolot/Storage/File.pm
index bf0a57e..46ddbd5 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.51 2003/02/16 09:09:57 weasel Exp $
+# $Id: File.pm,v 1.52 2003/02/17 14:44:15 weasel Exp $
 #
 
 =pod
@@ -1545,12 +1545,13 @@ sub expire($) {
 	my $expire_conf = $now - Echolot::Config::get()->{'expire_confs'};
 	my $expire_pings = $now - Echolot::Config::get()->{'expire_pings'};
 	my $expire_chainpings = $now - Echolot::Config::get()->{'expire_chainpings'};
+	my $expire_fromlines = $now - Echolot::Config::get()->{'expire_fromlines'};
 
+	# Remailer Information and pings
 	for my $remailer_addr ( keys %{$self->{'METADATA'}->{'remailers'}} ) {
 		for my $type ( keys %{$self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}} ) {
 			for my $key ( keys %{$self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}} ) {
 				if ($self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}->{$key}->{'last_update'} < $expire_keys) {
-					# FIXME logging and such
 					Echolot::Log::info("Expiring $remailer_addr, key, $type, $key.");
 					$self->pingdata_close_one($remailer_addr, $type, $key, 'delete');
 					delete $self->{'METADATA'}->{'remailers'}->{$remailer_addr}->{'keys'}->{$type}->{$key};
@@ -1614,6 +1615,7 @@ sub expire($) {
 		};
 	};
 
+	# Chainpings
 	for my $type ( keys %{$self->{'CHAINPING_FHS'}} ) {
 		my $pings = $self->get_chainpings($type);
 
@@ -1649,6 +1651,20 @@ sub expire($) {
 		};
 	};
 
+	# From Header lines
+	for my $remailer_addr ( keys %{$self->{'METADATA'}->{'fromlines'}} ) {
+		for my $type ( keys %{$self->{'METADATA'}->{'fromlines'}->{$remailer_addr}} ) {
+			for my $user_supplied ( keys %{$self->{'METADATA'}->{'fromlines'}->{$remailer_addr}->{$type}} ) {
+				delete $self->{'METADATA'}->{'fromlines'}->{$remailer_addr}->{$type}->{$user_supplied}
+					if ($self->{'METADATA'}->{'fromlines'}->{$remailer_addr}->{$type}->{$user_supplied}->{'last_update'} < $expire_fromlines);
+			};
+			delete $self->{'METADATA'}->{'fromlines'}->{$remailer_addr}->{$type}
+				unless (scalar keys %{$self->{'METADATA'}->{'fromlines'}->{$remailer_addr}->{$type}});
+		};
+		delete $self->{'METADATA'}->{'fromlines'}->{$remailer_addr}
+			unless (scalar keys %{$self->{'METADATA'}->{'fromlines'}->{$remailer_addr}});
+	};
+
 	$self->commit();
 	
 	return 1;
@@ -1687,6 +1703,9 @@ sub delete_remailer($$) {
 		delete $self->{'METADATA'}->{'remailers'}->{$address}
 	};
 
+	delete $self->{'METADATA'}->{'fromlines'}->{$address}
+		if (defined $self->{'METADATA'}->{'fromlines'}->{$address});
+
 	$self->commit();
 	
 	return 1;
@@ -1716,6 +1735,73 @@ sub delete_remailercaps($$) {
 };
 
 
+=item $storage->B<register_fromline>( I<$address>, I<$with_from>, I<$from> )
+
+Register that the remailer I<$address> returned the From header
+line I<$from>.  If I<$with_from> is 1 we had tried to supply our own
+From, otherwhise not.
+
+Returns 1, undef on error.
+
+=cut
+
+sub register_fromline($$$$) {
+	my ($self, $address, $type, $with_from, $from) = @_;
+
+	defined ($self->{'METADATA'}->{'addresses'}->{$address}) or
+		Echolot::Log::cluck ("$address does not exist in Metadata address list."),
+		return undef;
+	defined ($from) or
+		Echolot::Log::cluck ("from is not defined in register_fromline."),
+		return undef;
+	defined ($with_from) or
+		Echolot::Log::cluck ("from is not defined in register_fromline."),
+		return undef;
+	($with_from == 0 || $with_from == 1) or
+		Echolot::Log::cluck ("with_from has evil value $with_from in register_fromline."),
+		return undef;
+
+	Echolot::Log::debug("registering fromline $address, $type, $with_from, $from.");
+
+	$self->{'METADATA'}->{'fromlines'}->{$address}->{$type}->{$with_from} = {
+		last_update => time(),
+		from => $from
+	};
+	$self->commit();
+
+	return 1;
+};
+
+
+=item $storage->B<get_fromlines>()
+
+Return a hash reference with header From line information.
+
+The key is the remailer address. This points to a hash of types (mix,
+cpunk-rsa, ..) which point to another hash with keys B<0> (no user supplied
+From header tried) and B<1> (a user supplied From header was given). These
+point to yet another hash with keys B<last_update> and B<from>.
+
+=cut
+
+sub get_fromlines($) {
+	my ($self) = @_;
+
+	my $result;
+	# rebuilding it so that external things cannot screw up our structure
+	for my $remailer_addr ( keys %{$self->{'METADATA'}->{'fromlines'}} ) {
+		for my $type ( keys %{$self->{'METADATA'}->{'fromlines'}->{$remailer_addr}} ) {
+			for my $user_supplied ( keys %{$self->{'METADATA'}->{'fromlines'}->{$remailer_addr}->{$type}} ) {
+				$result->{$remailer_addr}->{$user_supplied} = {
+					last_update => $self->{'METADATA'}->{'fromlines'}->{$remailer_addr}->{$type}->{$user_supplied}->{'last_update'},
+					from        => $self->{'METADATA'}->{'fromlines'}->{$remailer_addr}->{$type}->{$user_supplied}->{'from'}
+				};
+			};
+		};
+	};
+
+	return $result;
+}
 
 
 # sub convert($) {