trunk/Echolot/Conf.pm

package Echolot::Conf;

# (c) 2002 Peter Palfrader <peter@palfrader.org>
# $Id: Conf.pm,v 1.31 2003/01/02 21:24:32 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 = 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));

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