trunk/Echolot/Conf.pm

package Echolot::Conf;

# (c) 2002 Peter Palfrader <peter@palfrader.org>
# $Id: Conf.pm,v 1.26 2002/08/23 06:03:56 weasel Exp $
#

=pod

=head1 Name

Echolot::Conf - remailer Configuration/Capabilities

=head1 DESCRIPTION

This package provides functions for requesting, parsing, and analyzing
remailer-conf and remailer-key replies.

=head1 CAVEATS

When parsing OpenPGP keys only the address of the primary user id is taken into
account (This is the one with the latest self signature I think).

=cut

use strict;
use Carp qw{cluck};
use GnuPG::Interface;
use IO::Handle;


sub is_not_a_remailer($) {
        my ($reply) = @_;
        if ($reply =~ /^\s* not \s+ a \s+ remailer\b/xi) {
                return 1;
        } else {
                return 0;
        };
};

sub send_requests($;$) {
        my ($scheduled_for, $which) = @_;

        $which = '' unless defined $which;

        my $call_intervall = Echolot::Config::get()->{'getkeyconf_interval'};
        my $send_every_n_calls = Echolot::Config::get()->{'getkeyconf_every_nth_time'};

        my $timemod = ($scheduled_for / $call_intervall);
        my $this_call_id = $timemod % $send_every_n_calls;

        Echolot::Globals::get()->{'storage'}->delay_commit();
        
        for my $remailer (Echolot::Globals::get()->{'storage'}->get_addresses()) {
                next unless ($remailer->{'status'} eq 'active');
                next unless ($remailer->{'fetch'});
                my $address = $remailer->{'address'};

                next unless (
                        $which eq 'all' ||
                        $which eq $address ||
                        $which eq '');

                for my $type (qw{conf key help stats adminkey}) {

                        next unless (
                                $which eq $address ||
                                $which eq 'all' ||
                                ($which eq '' && $this_call_id eq (Echolot::Tools::makeShortNumHash($address.$type) % $send_every_n_calls)));

                        print "Sending $type requests to ".$address."\n"
                                if Echolot::Config::get()->{'verbose'};

                        my $source_text = Echolot::Config::get()->{'remailerxxxtext'};
                        my $template =  HTML::Template->new(
                                scalarref => \$source_text,
                                strict => 0,
                                global_vars => 1 );
                        $template->param ( address => $address );
                        $template->param ( operator_address => Echolot::Config::get()->{'operator_address'} );
                        my $body = $template->output();

                        Echolot::Tools::send_message(
                                'To' => $address,
                                'Subject' => 'remailer-'.$type,
                                'Token' => $type.'.'.$remailer->{'id'},
                                'Body' => $body);

                        Echolot::Globals::get()->{'storage'}->decrease_ttl($address) if ($type eq 'conf');
                };
        };
        Echolot::Globals::get()->{'storage'}->enable_commit();
};

sub check_resurrection() {
        Echolot::Globals::get()->{'storage'}->delay_commit();
        for my $remailer (Echolot::Globals::get()->{'storage'}->get_addresses()) {
                next unless ($remailer->{'status'} eq 'ttl timeout');
                next unless ($remailer->{'fetch'});
                next unless ($remailer->{'resurrection_ttl'});
                print "Sending requests to ".$remailer->{'address'}." to check for resurrection\n"
                        if Echolot::Config::get()->{'verbose'};
                for my $type (qw{conf key help stats adminkey}) {
                        Echolot::Tools::send_message(
                                'To' => $remailer->{'address'},
                                'Subject' => 'remailer-'.$type,
                                'Token' => $type.'.'.$remailer->{'id'})
                };
                Echolot::Globals::get()->{'storage'}->decrease_resurrection_ttl($remailer->{'address'});
        };
        Echolot::Globals::get()->{'storage'}->enable_commit();
};


sub remailer_caps($$$;$) {
        my ($conf, $token, $time, $dontexpire) = @_;

        my ($id) = $token =~ /^conf\.(\d+)$/;
        (defined $id) or
                cluck ("Returned token '$token' has no id at all"),
                return 0;

        cluck("Could not find id in token '$token'"), return 0 unless defined $id;
        my ($remailer_type) = ($conf =~ /^\s*Remailer-Type:\s* (.*?) \s*$/imx);
        cluck("No remailer type found in remailer_caps from '$token'"), return 0 unless defined $remailer_type;
        my ($remailer_caps) = ($conf =~ /^\s*(  \$remailer{".*"}  \s*=\s*  "<.*@.*>.*";   )\s*$/imx);
        cluck("No remailer caps found in remailer_caps from '$token'"), return 0 unless defined $remailer_caps;
        my ($remailer_nick, $remailer_address) = ($remailer_caps =~ /^\s*  \$remailer{"(.*)"}  \s*=\s*  "<(.*@.*)>.*";   \s*$/ix);
        cluck("No remailer nick found in remailer_caps from '$token': '$remailer_caps'"), return 0 unless defined $remailer_nick;
        cluck("No remailer address found in remailer_caps from '$token': '$remailer_caps'"), return 0 unless defined $remailer_address;
        

        my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id);
        cluck("No remailer found for id '$id'"), return 0 unless defined $remailer;
        if ($remailer->{'address'} ne $remailer_address) {
                # Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
                cluck("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers.");
                Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-conf', $remailer_address);
        } else {
                Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
                Echolot::Globals::get()->{'storage'}->set_caps($remailer_type, $remailer_caps, $remailer_nick, $remailer_address, $time, $dontexpire);

                # if remailer is cpunk and not pgponly
                if (($remailer_caps =~ /\bcpunk\b/) && !($remailer_caps =~ /\bpgponly\b/)) {
                        Echolot::Globals::get()->{'storage'}->set_key(
                                'cpunk-clear',
                                $remailer_nick,
                                $remailer->{'address'},
                                'N/A',
                                'none',
                                'N/A',
                                'N/A',
                                'N/A',
                                $time);
                }
        }


        # Fetch prospective remailers from reliable's remailer-conf reply:
        my @lines = split /\r?\n/, $conf;
        while (@lines) {
                my $head = $lines[0];
                chomp $head;
                shift @lines;
                last if ($head eq 'SUPPORTED CPUNK (TYPE I) REMAILERS');
        };

        while (@lines) {
                my $head = $lines[0];
                chomp $head;
                shift @lines;
                last unless ($head =~ /<(.*?@.*?)>/);
                Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type1', $remailer_address);
        };

        while (@lines) {
                my $head = $lines[0];
                chomp $head;
                shift @lines;
                last if ($head eq 'SUPPORTED MIXMASTER (TYPE II) REMAILERS');
        };

        while (@lines) {
                my $head = $lines[0];
                chomp $head;
                last unless ($head =~ /\s(.*?@.*?)\s/);
                shift @lines;
                Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type2', $remailer_address);
        };

        return 1;
};

sub remailer_conf($$$) {
        my ($reply, $token, $time) = @_;

        my ($id) = $token =~ /^conf\.(\d+)$/;
        (defined $id) or
                cluck ("Returned token '$token' has no id at all"),
                return 0;
        
        Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
                if (is_not_a_remailer($reply));
        Echolot::Thesaurus::save_thesaurus('conf', $id, $reply);

        remailer_caps($reply, $token, $time);
};

sub set_caps_manually($$) {
        my ($addr, $caps) = @_;

        defined $addr or
                cluck("Address not defined."),
                return 0;
        defined $caps or
                cluck("Caps not defined."),
                return 0;

        print "Setting caps for $addr manually to $caps\n"
                if Echolot::Config::get()->{'verbose'};

        my $remailer = Echolot::Globals::get()->{'storage'}->get_address($addr);
        defined $remailer or
                cluck("Remailer address $addr did not give a valid remailer."),
                return 0;
        my $id = $remailer->{'id'};
        defined $id or
                cluck("Remailer address $addr did not give a remailer with an id."),
                return 0;
        my $token = 'conf.'.$id;

        my $conf = "Remailer-Type: set-manually\n$caps";
        remailer_caps($conf, $token, time, 1);

        return 1;
};

sub parse_mix_key($$$) {
        my ($reply, $time, $remailer) = @_;

# -----Begin Mix Key-----
# 7f6d997678b19ccac110f6e669143126
# 258
# AASyedeKiP1/UKyfrBz2K6gIhv4jfXIaHo8dGmwD
# KqkG3DwytgSySSY3wYm0foT7KvEnkG2aTi/uJva/
# gymE+tsuM8l8iY1FOiXwHWLDdyUBPbrLjRkgm7GD
# Y7ogSjPhVLeMpzkSyO/ryeUfLZskBUBL0LxjLInB
# YBR3o6p/RiT0EQAAAAAAAAAAAAAAAAAAAAAAAAAA
# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
# AAAAAAAAAAAAAAAAAAAAAQAB
# -----End Mix Key-----

        my %mixmasters;
        # rot26 rot26@mix.uucico.de 7f6d997678b19ccac110f6e669143126 2.9b33 MC
        my @mix_confs = ($reply =~ /^[a-z0-9]+ \s+ \S+\@\S+ \s+ [0-9a-f]{32} (?:\s+ \S+ (?:[ \t]+ \S+)?)?/xmg);
        my @mix_keys = ($reply =~ /^-----Begin \s Mix \s Key-----\r?\n
                                  [0-9a-f]{32}\r?\n
                                                          \d+\r?\n
                                                          (?:[a-zA-Z0-9+\/]*\r?\n)+
                                                          -----End \s Mix \s Key-----$/xmg );
        for (@mix_confs) {
                my ($nick, $address, $keyid, $version, $caps) = /^([a-z0-9]+) \s+ (\S+@\S+) \s+ ([0-9a-f]{32}) (?:(\S+) (?:[\t]+ (\S+)))?/x;
                $mixmasters{$keyid} = {
                        nick    => $nick,
                        address => $address,
                        version => $version,
                        caps    => $caps,
                        summary => $_
                };
        };
        for (@mix_keys) {
                my ($keyid) =  /^-----Begin \s Mix \s Key-----\r?\n
                                  ([0-9a-f]{32})\r?\n
                                                          \d+\r?\n
                                                          (?:[a-zA-Z0-9+\/]*\r?\n)+
                                                          -----End \s Mix \s Key-----$/xmg;
                $mixmasters{$keyid}->{'key'} = $_;
        };

        for my $keyid (keys %mixmasters) {
                my $remailer_address = $mixmasters{$keyid}->{'address'};
                (defined $mixmasters{$keyid}->{'nick'} && ! defined $mixmasters{$keyid}->{'key'}) and
                        cluck("Mixmaster key header without key in reply from $remailer_address"),
                        next;
                (! defined $mixmasters{$keyid}->{'nick'} && defined $mixmasters{$keyid}->{'key'}) and
                        cluck("Mixmaster key without key header in reply from $remailer_address"),
                        next;

                if ($remailer->{'address'} ne $remailer_address) {
                        # Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
                        cluck("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers.");
                        Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-key', $remailer_address);
                } else {
                        Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
                        Echolot::Globals::get()->{'storage'}->set_key(
                                'mix',
                                $mixmasters{$keyid}->{'nick'},
                                $mixmasters{$keyid}->{'address'},
                                $mixmasters{$keyid}->{'key'},
                                $keyid,
                                $mixmasters{$keyid}->{'version'},
                                $mixmasters{$keyid}->{'caps'},
                                $mixmasters{$keyid}->{'summary'},
                                $time);
                }
        };

        return 1;
};

sub parse_cpunk_key($$$) {
        my ($reply, $time, $remailer) = @_;

        my $GnuPG = new GnuPG::Interface;
        $GnuPG->call( Echolot::Config::get()->{'gnupg'} ) if (Echolot::Config::get()->{'gnupg'});
        $GnuPG->options->hash_init(
                homedir => Echolot::Config::get()->{'gnupghome'} );
        $GnuPG->options->meta_interactive( 0 );
        my %cypherpunk;

        my @pgp_keys = ($reply =~ /^-----BEGIN \s PGP \s PUBLIC \s KEY \s BLOCK-----\r?\n
                                  (?:.+\r?\n)*
                                  \r?\n
                                  (?:[a-zA-Z0-9+\/=]*\r?\n)+
                                  -----END \s PGP \s PUBLIC \s KEY \s BLOCK-----$/xmg );
        for my $key (@pgp_keys) {
                my ( $stdin_fh, $stdout_fh, $stderr_fh, $status_fh )
                        = ( IO::Handle->new(),
                                IO::Handle->new(),
                                IO::Handle->new(),
                                IO::Handle->new(),
                        );
                my $handles = GnuPG::Handles->new (
                        stdin      => $stdin_fh,
                        stdout     => $stdout_fh,
                        stderr     => $stderr_fh,
                        status     => $status_fh
                        );

                my $pid = $GnuPG->wrap_call(
                        commands     => [qw{--with-colons}],
                        command_args => [qw{--no-options --no-default-keyring --fast-list-mode}],
                        handles      => $handles );
                print $stdin_fh $key;
                close($stdin_fh);

                my $stdout = join '', <$stdout_fh>; close($stdout_fh);
                my $stderr = join '', <$stderr_fh>; close($stderr_fh);
                my $status = join '', <$status_fh>; close($status_fh);

                waitpid $pid, 0;

                ($stderr eq '') or 
                        cluck("GnuPG returned something in stderr: '$stderr' when checking key '$key'; So what?\n");
                ($status eq '') or 
                        cluck("GnuPG returned something in status '$status' when checking key '$key': So what?\n");
                
                my @included_keys = $stdout =~ /^pub:.*$/mg;
                (scalar @included_keys >= 2) &&
                        cluck ("Cannot handle more than one key per block correctly yet. Found ".(scalar @included_keys)." in one block from ".$remailer->{'address'});
                for my $included_key (@included_keys) {
                        my ($type, $keyid, $uid) = $included_key =~ /pub::\d+:(\d+):([0-9A-F]+):[^:]+:[^:]*:::([^:]+):/;
                        (defined $uid) or
                                cluck ("Unexpected format of '$included_key' by ".$remailer->{'address'}."; Skipping"),
                                next;
                        my ($address) = $uid =~ /<(.*?)>/;
                        $cypherpunk{$keyid} = {
                                address => $address,
                                type => $type,
                                key => $key       # FIXME handle more than one key per block correctly
                        };
                };
        };

        for my $keyid (keys %cypherpunk) {
                my $remailer_address = $cypherpunk{$keyid}->{'address'};

                if ($remailer->{'address'} ne $remailer_address) {
                        # Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
                        cluck("Remailer address mismatch $remailer->{'address'} vs $remailer_address id key $keyid. Adding latter to prospective remailers.");
                        Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-key', $remailer_address);
                } else {
                        Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
                        # 1 .. RSA
                        # 17 .. DSA
                        if ($cypherpunk{$keyid}->{'type'} == 1 || $cypherpunk{$keyid}->{'type'} == 17 ) {
                                Echolot::Globals::get()->{'storage'}->set_key(
                                        (($cypherpunk{$keyid}->{'type'} == 1) ? 'cpunk-rsa' :
                                         (($cypherpunk{$keyid}->{'type'} == 17) ? 'cpunk-dsa' :
                                          'ERROR')),
                                        $keyid, # as nick
                                        $cypherpunk{$keyid}->{'address'},
                                        $cypherpunk{$keyid}->{'key'},
                                        $keyid,
                                        'N/A',
                                        'N/A',
                                        'N/A',
                                        $time);
                        } else {
                                cluck("$keyid from $remailer_address has algoid ".$cypherpunk{$keyid}->{'type'}.". Cannot handle those.");
                        };
                }
        };

        return 1;
};

sub remailer_key($$$) {
        my ($reply, $token, $time) = @_;

        my $cp_reply = $reply;
        $cp_reply =~ s/^- -/-/gm; # PGP Signed messages

        my ($id) = $token =~ /^key\.(\d+)$/;
        (defined $id) or
                cluck ("Returned token '$token' has no id at all"),
                return 0;
        
        Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
                if (is_not_a_remailer($reply));
        Echolot::Thesaurus::save_thesaurus('key', $id, $reply);

        my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id);
        cluck("No remailer found for id '$id'"), return 0 unless defined $remailer;

        parse_mix_key($cp_reply, $time, $remailer);
        parse_cpunk_key($cp_reply, $time, $remailer);

        return 1;
};

sub remailer_stats($$$) {
        my ($reply, $token, $time) = @_;

        my ($id) = $token =~ /^stats\.(\d+)$/;
        (defined $id) or
                cluck ("Returned token '$token' has no id at all"),
                return 0;
        
        Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
                if (is_not_a_remailer($reply));
        Echolot::Thesaurus::save_thesaurus('stats', $id, $reply);
};

sub remailer_help($$$) {
        my ($reply, $token, $time) = @_;

        my ($id) = $token =~ /^help\.(\d+)$/;
        (defined $id) or
                cluck ("Returned token '$token' has no id at all"),
                return 0;
        
        Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
                if (is_not_a_remailer($reply));
        Echolot::Thesaurus::save_thesaurus('help', $id, $reply);
};

sub remailer_adminkey($$$) {
        my ($reply, $token, $time) = @_;

        my ($id) = $token =~ /^adminkey\.(\d+)$/;
        (defined $id) or
                cluck ("Returned token '$token' has no id at all"),
                return 0;
        
        Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
                if (is_not_a_remailer($reply));
        Echolot::Thesaurus::save_thesaurus('adminkey', $id, $reply);
};

1;
# vim: set ts=4 shiftwidth=4:
1	weasel	1	package Echolot::Conf;
2
3			# (c) 2002 Peter Palfrader <peter@palfrader.org>
4	weasel	277	# $Id: Conf.pm,v 1.26 2002/08/23 06:03:56 weasel Exp $
5	weasel	1	#
6
7			=pod
8
9			=head1 Name
10
11			Echolot::Conf - remailer Configuration/Capabilities
12
13			=head1 DESCRIPTION
14
15			This package provides functions for requesting, parsing, and analyzing
16			remailer-conf and remailer-key replies.
17
18	weasel	203	=head1 CAVEATS
19
20			When parsing OpenPGP keys only the address of the primary user id is taken into
21			account (This is the one with the latest self signature I think).
22
23	weasel	1	=cut
24
25			use strict;
26			use Carp qw{cluck};
27	weasel	33	use GnuPG::Interface;
28			use IO::Handle;
29	weasel	1
30
31	weasel	166	sub is_not_a_remailer($) {
32			my ($reply) = @_;
33			if ($reply =~ /^\s* not \s+ a \s+ remailer\b/xi) {
34			return 1;
35			} else {
36			return 0;
37			};
38			};
39
40	weasel	211	sub send_requests($;$) {
41			my ($scheduled_for, $which) = @_;
42	weasel	206
43			$which = '' unless defined $which;
44
45			my $call_intervall = Echolot::Config::get()->{'getkeyconf_interval'};
46			my $send_every_n_calls = Echolot::Config::get()->{'getkeyconf_every_nth_time'};
47
48	weasel	211	my $timemod = ($scheduled_for / $call_intervall);
49	weasel	206	my $this_call_id = $timemod % $send_every_n_calls;
50
51	weasel	1	Echolot::Globals::get()->{'storage'}->delay_commit();
52	weasel	206
53	weasel	1	for my $remailer (Echolot::Globals::get()->{'storage'}->get_addresses()) {
54			next unless ($remailer->{'status'} eq 'active');
55	weasel	80	next unless ($remailer->{'fetch'});
56	weasel	206	my $address = $remailer->{'address'};
57	weasel	166
58	weasel	277	next unless (
59			$which eq 'all' \|\|
60			$which eq $address \|\|
61			$which eq '');
62
63	weasel	206	for my $type (qw{conf key help stats adminkey}) {
64	weasel	166
65	weasel	277	next unless (
66			$which eq $address \|\|
67			$which eq 'all' \|\|
68			($which eq '' && $this_call_id eq (Echolot::Tools::makeShortNumHash($address.$type) % $send_every_n_calls)));
69	weasel	206
70			print "Sending $type requests to ".$address."\n"
71			if Echolot::Config::get()->{'verbose'};
72
73			my $source_text = Echolot::Config::get()->{'remailerxxxtext'};
74			my $template = HTML::Template->new(
75			scalarref => \$source_text,
76			strict => 0,
77			global_vars => 1 );
78			$template->param ( address => $address );
79			$template->param ( operator_address => Echolot::Config::get()->{'operator_address'} );
80			my $body = $template->output();
81
82	weasel	1	Echolot::Tools::send_message(
83	weasel	206	'To' => $address,
84	weasel	1	'Subject' => 'remailer-'.$type,
85	weasel	166	'Token' => $type.'.'.$remailer->{'id'},
86	weasel	206	'Body' => $body);
87
88			Echolot::Globals::get()->{'storage'}->decrease_ttl($address) if ($type eq 'conf');
89	weasel	1	};
90			};
91			Echolot::Globals::get()->{'storage'}->enable_commit();
92			};
93
94	weasel	121	sub check_resurrection() {
95			Echolot::Globals::get()->{'storage'}->delay_commit();
96			for my $remailer (Echolot::Globals::get()->{'storage'}->get_addresses()) {
97			next unless ($remailer->{'status'} eq 'ttl timeout');
98			next unless ($remailer->{'fetch'});
99			next unless ($remailer->{'resurrection_ttl'});
100			print "Sending requests to ".$remailer->{'address'}." to check for resurrection\n"
101			if Echolot::Config::get()->{'verbose'};
102			for my $type (qw{conf key help stats adminkey}) {
103			Echolot::Tools::send_message(
104			'To' => $remailer->{'address'},
105			'Subject' => 'remailer-'.$type,
106			'Token' => $type.'.'.$remailer->{'id'})
107			};
108			Echolot::Globals::get()->{'storage'}->decrease_resurrection_ttl($remailer->{'address'});
109			};
110			Echolot::Globals::get()->{'storage'}->enable_commit();
111			};
112
113
114	weasel	106	sub remailer_caps($$$;$) {
115	weasel	104	my ($conf, $token, $time, $dontexpire) = @_;
116	weasel	1
117			my ($id) = $token =~ /^conf\.(\d+)$/;
118	weasel	5	(defined $id) or
119	weasel	2	cluck ("Returned token '$token' has no id at all"),
120			return 0;
121
122	weasel	1	cluck("Could not find id in token '$token'"), return 0 unless defined $id;
123			my ($remailer_type) = ($conf =~ /^\sRemailer-Type:\s (.?) \s$/imx);
124	weasel	106	cluck("No remailer type found in remailer_caps from '$token'"), return 0 unless defined $remailer_type;
125	weasel	1	my ($remailer_caps) = ($conf =~ /^\s( \$remailer{"."} \s=\s "<.@.>."; )\s$/imx);
126	weasel	106	cluck("No remailer caps found in remailer_caps from '$token'"), return 0 unless defined $remailer_caps;
127	weasel	1	my ($remailer_nick, $remailer_address) = ($remailer_caps =~ /^\s* \$remailer{"(.)"} \s=\s* "<(.@.)>."; \s$/ix);
128			cluck("No remailer nick found in remailer_caps from '$token': '$remailer_caps'"), return 0 unless defined $remailer_nick;
129			cluck("No remailer address found in remailer_caps from '$token': '$remailer_caps'"), return 0 unless defined $remailer_address;
130
131
132			my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id);
133	weasel	2	cluck("No remailer found for id '$id'"), return 0 unless defined $remailer;
134	weasel	1	if ($remailer->{'address'} ne $remailer_address) {
135			# Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
136			cluck("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers.");
137	weasel	5	Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-conf', $remailer_address);
138	weasel	1	} else {
139			Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
140	weasel	104	Echolot::Globals::get()->{'storage'}->set_caps($remailer_type, $remailer_caps, $remailer_nick, $remailer_address, $time, $dontexpire);
141	weasel	85
142			# if remailer is cpunk and not pgponly
143			if (($remailer_caps =~ /\bcpunk\b/) && !($remailer_caps =~ /\bpgponly\b/)) {
144			Echolot::Globals::get()->{'storage'}->set_key(
145			'cpunk-clear',
146			$remailer_nick,
147			$remailer->{'address'},
148			'N/A',
149			'none',
150			'N/A',
151			'N/A',
152			'N/A',
153			$time);
154			}
155	weasel	1	}
156	weasel	2
157	weasel	5
158			# Fetch prospective remailers from reliable's remailer-conf reply:
159			my @lines = split /\r?\n/, $conf;
160			while (@lines) {
161			my $head = $lines[0];
162			chomp $head;
163			shift @lines;
164			last if ($head eq 'SUPPORTED CPUNK (TYPE I) REMAILERS');
165			};
166
167			while (@lines) {
168			my $head = $lines[0];
169			chomp $head;
170			shift @lines;
171			last unless ($head =~ /<(.?@.?)>/);
172			Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type1', $remailer_address);
173			};
174
175			while (@lines) {
176			my $head = $lines[0];
177			chomp $head;
178			shift @lines;
179			last if ($head eq 'SUPPORTED MIXMASTER (TYPE II) REMAILERS');
180			};
181
182			while (@lines) {
183			my $head = $lines[0];
184			chomp $head;
185			last unless ($head =~ /\s(.?@.?)\s/);
186			shift @lines;
187			Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type2', $remailer_address);
188			};
189
190	weasel	2	return 1;
191	weasel	1	};
192
193	weasel	106	sub remailer_conf($$$) {
194			my ($reply, $token, $time) = @_;
195
196			my ($id) = $token =~ /^conf\.(\d+)$/;
197			(defined $id) or
198			cluck ("Returned token '$token' has no id at all"),
199			return 0;
200
201	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
202			if (is_not_a_remailer($reply));
203	weasel	137	Echolot::Thesaurus::save_thesaurus('conf', $id, $reply);
204	weasel	106
205			remailer_caps($reply, $token, $time);
206			};
207
208	weasel	103	sub set_caps_manually($$) {
209			my ($addr, $caps) = @_;
210
211			defined $addr or
212			cluck("Address not defined."),
213			return 0;
214			defined $caps or
215			cluck("Caps not defined."),
216			return 0;
217
218			print "Setting caps for $addr manually to $caps\n"
219			if Echolot::Config::get()->{'verbose'};
220
221			my $remailer = Echolot::Globals::get()->{'storage'}->get_address($addr);
222			defined $remailer or
223			cluck("Remailer address $addr did not give a valid remailer."),
224			return 0;
225			my $id = $remailer->{'id'};
226			defined $id or
227			cluck("Remailer address $addr did not give a remailer with an id."),
228			return 0;
229			my $token = 'conf.'.$id;
230
231			my $conf = "Remailer-Type: set-manually\n$caps";
232	weasel	106	remailer_caps($conf, $token, time, 1);
233	weasel	103
234			return 1;
235			};
236
237	weasel	33	sub parse_mix_key($$$) {
238			my ($reply, $time, $remailer) = @_;
239	weasel	1
240	weasel	2	# -----Begin Mix Key-----
241			# 7f6d997678b19ccac110f6e669143126
242			# 258
243			# AASyedeKiP1/UKyfrBz2K6gIhv4jfXIaHo8dGmwD
244			# KqkG3DwytgSySSY3wYm0foT7KvEnkG2aTi/uJva/
245			# gymE+tsuM8l8iY1FOiXwHWLDdyUBPbrLjRkgm7GD
246			# Y7ogSjPhVLeMpzkSyO/ryeUfLZskBUBL0LxjLInB
247			# YBR3o6p/RiT0EQAAAAAAAAAAAAAAAAAAAAAAAAAA
248			# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
249			# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
250			# AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
251			# AAAAAAAAAAAAAAAAAAAAAQAB
252			# -----End Mix Key-----
253
254			my %mixmasters;
255			# rot26 rot26@mix.uucico.de 7f6d997678b19ccac110f6e669143126 2.9b33 MC
256	weasel	111	my @mix_confs = ($reply =~ /^[a-z0-9]+ \s+ \S+\@\S+ \s+ [0-9a-f]{32} (?:\s+ \S+ (?:[ \t]+ \S+)?)?/xmg);
257	weasel	33	my @mix_keys = ($reply =~ /^-----Begin \s Mix \s Key-----\r?\n
258	weasel	2	[0-9a-f]{32}\r?\n
259			\d+\r?\n
260			(?:[a-zA-Z0-9+\/]*\r?\n)+
261			-----End \s Mix \s Key-----$/xmg );
262			for (@mix_confs) {
263	weasel	111	my ($nick, $address, $keyid, $version, $caps) = /^([a-z0-9]+) \s+ (\S+@\S+) \s+ ([0-9a-f]{32}) (?:(\S+) (?:[\t]+ (\S+)))?/x;
264	weasel	2	$mixmasters{$keyid} = {
265			nick => $nick,
266			address => $address,
267			version => $version,
268			caps => $caps,
269			summary => $_
270			};
271			};
272			for (@mix_keys) {
273			my ($keyid) = /^-----Begin \s Mix \s Key-----\r?\n
274			([0-9a-f]{32})\r?\n
275			\d+\r?\n
276			(?:[a-zA-Z0-9+\/]*\r?\n)+
277			-----End \s Mix \s Key-----$/xmg;
278			$mixmasters{$keyid}->{'key'} = $_;
279			};
280
281			for my $keyid (keys %mixmasters) {
282			my $remailer_address = $mixmasters{$keyid}->{'address'};
283			(defined $mixmasters{$keyid}->{'nick'} && ! defined $mixmasters{$keyid}->{'key'}) and
284			cluck("Mixmaster key header without key in reply from $remailer_address"),
285			next;
286			(! defined $mixmasters{$keyid}->{'nick'} && defined $mixmasters{$keyid}->{'key'}) and
287			cluck("Mixmaster key without key header in reply from $remailer_address"),
288			next;
289
290			if ($remailer->{'address'} ne $remailer_address) {
291			# Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
292			cluck("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers.");
293	weasel	33	Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-key', $remailer_address);
294	weasel	2	} else {
295			Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
296			Echolot::Globals::get()->{'storage'}->set_key(
297			'mix',
298			$mixmasters{$keyid}->{'nick'},
299			$mixmasters{$keyid}->{'address'},
300			$mixmasters{$keyid}->{'key'},
301			$keyid,
302			$mixmasters{$keyid}->{'version'},
303			$mixmasters{$keyid}->{'caps'},
304			$mixmasters{$keyid}->{'summary'},
305			$time);
306			}
307			};
308
309			return 1;
310	weasel	1	};
311
312	weasel	33	sub parse_cpunk_key($$$) {
313			my ($reply, $time, $remailer) = @_;
314
315			my $GnuPG = new GnuPG::Interface;
316	weasel	212	$GnuPG->call( Echolot::Config::get()->{'gnupg'} ) if (Echolot::Config::get()->{'gnupg'});
317	weasel	40	$GnuPG->options->hash_init(
318			homedir => Echolot::Config::get()->{'gnupghome'} );
319	weasel	33	$GnuPG->options->meta_interactive( 0 );
320			my %cypherpunk;
321
322			my @pgp_keys = ($reply =~ /^-----BEGIN \s PGP \s PUBLIC \s KEY \s BLOCK-----\r?\n
323	weasel	49	(?:.+\r?\n)*
324	weasel	85	\r?\n
325			(?:[a-zA-Z0-9+\/=]*\r?\n)+
326			-----END \s PGP \s PUBLIC \s KEY \s BLOCK-----$/xmg );
327	weasel	33	for my $key (@pgp_keys) {
328			my ( $stdin_fh, $stdout_fh, $stderr_fh, $status_fh )
329			= ( IO::Handle->new(),
330			IO::Handle->new(),
331			IO::Handle->new(),
332			IO::Handle->new(),
333			);
334			my $handles = GnuPG::Handles->new (
335			stdin => $stdin_fh,
336			stdout => $stdout_fh,
337			stderr => $stderr_fh,
338			status => $status_fh
339			);
340
341			my $pid = $GnuPG->wrap_call(
342			commands => [qw{--with-colons}],
343			command_args => [qw{--no-options --no-default-keyring --fast-list-mode}],
344			handles => $handles );
345			print $stdin_fh $key;
346			close($stdin_fh);
347
348			my $stdout = join '', <$stdout_fh>; close($stdout_fh);
349			my $stderr = join '', <$stderr_fh>; close($stderr_fh);
350			my $status = join '', <$status_fh>; close($status_fh);
351
352	weasel	40	waitpid $pid, 0;
353
354	weasel	33	($stderr eq '') or
355	weasel	168	cluck("GnuPG returned something in stderr: '$stderr' when checking key '$key'; So what?\n");
356	weasel	33	($status eq '') or
357	weasel	40	cluck("GnuPG returned something in status '$status' when checking key '$key': So what?\n");
358	weasel	33
359			my @included_keys = $stdout =~ /^pub:.*$/mg;
360			(scalar @included_keys >= 2) &&
361	weasel	208	cluck ("Cannot handle more than one key per block correctly yet. Found ".(scalar @included_keys)." in one block from ".$remailer->{'address'});
362	weasel	33	for my $included_key (@included_keys) {
363	weasel	40	my ($type, $keyid, $uid) = $included_key =~ /pub::\d+:(\d+):([0-9A-F]+):[^:]+:[^:]*:::([^:]+):/;
364	weasel	33	(defined $uid) or
365			cluck ("Unexpected format of '$included_key' by ".$remailer->{'address'}."; Skipping"),
366			next;
367			my ($address) = $uid =~ /<(.*?)>/;
368			$cypherpunk{$keyid} = {
369			address => $address,
370			type => $type,
371			key => $key # FIXME handle more than one key per block correctly
372			};
373			};
374			};
375
376			for my $keyid (keys %cypherpunk) {
377			my $remailer_address = $cypherpunk{$keyid}->{'address'};
378
379			if ($remailer->{'address'} ne $remailer_address) {
380			# Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
381			cluck("Remailer address mismatch $remailer->{'address'} vs $remailer_address id key $keyid. Adding latter to prospective remailers.");
382			Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-key', $remailer_address);
383			} else {
384			Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
385			# 1 .. RSA
386			# 17 .. DSA
387			if ($cypherpunk{$keyid}->{'type'} == 1 \|\| $cypherpunk{$keyid}->{'type'} == 17 ) {
388			Echolot::Globals::get()->{'storage'}->set_key(
389			(($cypherpunk{$keyid}->{'type'} == 1) ? 'cpunk-rsa' :
390			(($cypherpunk{$keyid}->{'type'} == 17) ? 'cpunk-dsa' :
391			'ERROR')),
392			$keyid, # as nick
393			$cypherpunk{$keyid}->{'address'},
394			$cypherpunk{$keyid}->{'key'},
395			$keyid,
396			'N/A',
397			'N/A',
398			'N/A',
399			$time);
400			} else {
401			cluck("$keyid from $remailer_address has algoid ".$cypherpunk{$keyid}->{'type'}.". Cannot handle those.");
402			};
403			}
404			};
405
406			return 1;
407			};
408
409			sub remailer_key($$$) {
410			my ($reply, $token, $time) = @_;
411
412	weasel	106	my $cp_reply = $reply;
413			$cp_reply =~ s/^- -/-/gm; # PGP Signed messages
414	weasel	49
415	weasel	33	my ($id) = $token =~ /^key\.(\d+)$/;
416			(defined $id) or
417			cluck ("Returned token '$token' has no id at all"),
418			return 0;
419	weasel	106
420	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
421			if (is_not_a_remailer($reply));
422	weasel	137	Echolot::Thesaurus::save_thesaurus('key', $id, $reply);
423	weasel	33
424			my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id);
425			cluck("No remailer found for id '$id'"), return 0 unless defined $remailer;
426
427	weasel	106	parse_mix_key($cp_reply, $time, $remailer);
428			parse_cpunk_key($cp_reply, $time, $remailer);
429	weasel	33
430			return 1;
431			};
432
433	weasel	1	sub remailer_stats($$$) {
434	weasel	106	my ($reply, $token, $time) = @_;
435	weasel	1
436	weasel	106	my ($id) = $token =~ /^stats\.(\d+)$/;
437			(defined $id) or
438			cluck ("Returned token '$token' has no id at all"),
439			return 0;
440
441	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
442			if (is_not_a_remailer($reply));
443	weasel	137	Echolot::Thesaurus::save_thesaurus('stats', $id, $reply);
444	weasel	1	};
445
446			sub remailer_help($$$) {
447	weasel	106	my ($reply, $token, $time) = @_;
448	weasel	1
449	weasel	106	my ($id) = $token =~ /^help\.(\d+)$/;
450			(defined $id) or
451			cluck ("Returned token '$token' has no id at all"),
452			return 0;
453
454	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
455			if (is_not_a_remailer($reply));
456	weasel	137	Echolot::Thesaurus::save_thesaurus('help', $id, $reply);
457	weasel	1	};
458
459	weasel	106	sub remailer_adminkey($$$) {
460			my ($reply, $token, $time) = @_;
461
462			my ($id) = $token =~ /^adminkey\.(\d+)$/;
463			(defined $id) or
464			cluck ("Returned token '$token' has no id at all"),
465			return 0;
466
467	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
468			if (is_not_a_remailer($reply));
469	weasel	137	Echolot::Thesaurus::save_thesaurus('adminkey', $id, $reply);
470	weasel	106	};
471
472	weasel	1	1;
473			# vim: set ts=4 shiftwidth=4: