trunk/Echolot/Conf.pm

package Echolot::Conf;

# (c) 2002 Peter Palfrader <peter@palfrader.org>
# $Id: Conf.pm,v 1.36 2003/01/14 06:56:22 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 Echolot::Log;
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))));

                        Echolot::Log::info("Sending $type request to ".$address.".");

                        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'});
                Echolot::Log::info("Sending request to ".$remailer->{'address'}." to check for resurrection.");
                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
                Echolot::Log::info("Returned token '$token' has no id at all."),
                return 0;

        Echolot::Log::info("Could not find id in token '$token'."), return 0 unless defined $id;
        my ($remailer_type) = ($conf =~ /^\s*Remailer-Type:\s* (.*?) \s*$/imx);
        Echolot::Log::info("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);
        Echolot::Log::info("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);
        Echolot::Log::info("No remailer nick found in remailer_caps from '$token': '$remailer_caps'."), return 0 unless defined $remailer_nick;
        Echolot::Log::info("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);
        Echolot::Log::info("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
                Echolot::Log::info("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 (1) {
                my $head;
                while (@lines) {
                        $head = $lines[0];
                        chomp $head;
                        shift @lines;
                        last if ($head eq 'SUPPORTED CPUNK (TYPE I) REMAILERS' ||
                                 $head eq 'SUPPORTED MIXMASTER (TYPE II) REMAILERS');
                };
                last unless defined $head;
                my $wanting = $head eq 'SUPPORTED CPUNK (TYPE I) REMAILERS' ? 1 :
                              $head eq 'SUPPORTED MIXMASTER (TYPE II) REMAILERS' ? 2 :
                              undef;
                last unless defined $wanting;

                while (@lines) {
                        $head = $lines[0];
                        chomp $head;
                        shift @lines;
                        if ($wanting == 1) {
                                last unless ($head =~ /<(.*?@.*?)>/);
                                Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type1', $remailer_address);
                        } elsif ($wanting == 2) {
                                last unless ($head =~ /\s(.*?@.*?)\s/);
                                Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type2', $remailer_address);
                        } else {
                                Echolot::Log::confess("Shouldn't be here. wanting == $wanting.");
                        };
                };
        };

        return 1;
};

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

        my ($id) = $token =~ /^conf\.(\d+)$/;
        (defined $id) or
                Echolot::Log::info ("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
                Echolot::Log::info("Address not defined."),
                return 0;
        defined $caps or
                Echolot::Log::info("Caps not defined."),
                return 0;

        Echolot::Log::info("Setting caps for $addr manually to $caps.");

        my $remailer = Echolot::Globals::get()->{'storage'}->get_address($addr);
        defined $remailer or
                Echolot::Log::info("Remailer address $addr did not give a valid remailer."),
                return 0;
        my $id = $remailer->{'id'};
        defined $id or
                Echolot::Log::info("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
                        Echolot::Log::info("Mixmaster key header without key in reply from $remailer_address."),
                        next;
                (! defined $mixmasters{$keyid}->{'nick'} && defined $mixmasters{$keyid}->{'key'}) and
                        Echolot::Log::info("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
                        Echolot::Log::info("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 
                        Echolot::Log::info("GnuPG returned something in stderr: '$stderr' when checking key '$key'; So what?");
                ($status eq '') or 
                        Echolot::Log::info("GnuPG returned something in status '$status' when checking key '$key': So what?");
                
                my @included_keys = $stdout =~ /^pub:.*$/mg;
                (scalar @included_keys >= 2) &&
                        Echolot::Log::info ("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
                                Echolot::Log::info ("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
                        Echolot::Log::info("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 {
                                Echolot::Log::info("$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
                Echolot::Log::info ("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);
        Echolot::Log::info("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
                Echolot::Log::info ("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
                Echolot::Log::info ("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
                Echolot::Log::info ("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	374	# $Id: Conf.pm,v 1.36 2003/01/14 06:56:22 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	weasel	363	use Echolot::Log;
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	weasel	374	Echolot::Log::info("Sending $type request to ".$address.".");
72	weasel	206
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	weasel	293	Echolot::Globals::get()->{'storage'}->decrease_ttl($address) if (($type eq 'conf') && ($which eq ''));
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	weasel	374	Echolot::Log::info("Sending request to ".$remailer->{'address'}." to check for resurrection.");
101	weasel	121	for my $type (qw{conf key help stats adminkey}) {
102			Echolot::Tools::send_message(
103			'To' => $remailer->{'address'},
104			'Subject' => 'remailer-'.$type,
105			'Token' => $type.'.'.$remailer->{'id'})
106			};
107			Echolot::Globals::get()->{'storage'}->decrease_resurrection_ttl($remailer->{'address'});
108			};
109			Echolot::Globals::get()->{'storage'}->enable_commit();
110			};
111
112
113	weasel	106	sub remailer_caps($$$;$) {
114	weasel	104	my ($conf, $token, $time, $dontexpire) = @_;
115	weasel	1
116			my ($id) = $token =~ /^conf\.(\d+)$/;
117	weasel	5	(defined $id) or
118	weasel	363	Echolot::Log::info("Returned token '$token' has no id at all."),
119	weasel	2	return 0;
120
121	weasel	363	Echolot::Log::info("Could not find id in token '$token'."), return 0 unless defined $id;
122	weasel	1	my ($remailer_type) = ($conf =~ /^\sRemailer-Type:\s (.?) \s$/imx);
123	weasel	363	Echolot::Log::info("No remailer type found in remailer_caps from '$token'."), return 0 unless defined $remailer_type;
124	weasel	1	my ($remailer_caps) = ($conf =~ /^\s( \$remailer{"."} \s=\s "<.@.>."; )\s$/imx);
125	weasel	363	Echolot::Log::info("No remailer caps found in remailer_caps from '$token'."), return 0 unless defined $remailer_caps;
126	weasel	1	my ($remailer_nick, $remailer_address) = ($remailer_caps =~ /^\s* \$remailer{"(.)"} \s=\s* "<(.@.)>."; \s$/ix);
127	weasel	363	Echolot::Log::info("No remailer nick found in remailer_caps from '$token': '$remailer_caps'."), return 0 unless defined $remailer_nick;
128			Echolot::Log::info("No remailer address found in remailer_caps from '$token': '$remailer_caps'."), return 0 unless defined $remailer_address;
129	weasel	1
130
131			my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id);
132	weasel	363	Echolot::Log::info("No remailer found for id '$id'."), return 0 unless defined $remailer;
133	weasel	1	if ($remailer->{'address'} ne $remailer_address) {
134			# Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
135	weasel	363	Echolot::Log::info("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers.");
136	weasel	5	Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-conf', $remailer_address);
137	weasel	1	} else {
138			Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
139	weasel	104	Echolot::Globals::get()->{'storage'}->set_caps($remailer_type, $remailer_caps, $remailer_nick, $remailer_address, $time, $dontexpire);
140	weasel	85
141			# if remailer is cpunk and not pgponly
142			if (($remailer_caps =~ /\bcpunk\b/) && !($remailer_caps =~ /\bpgponly\b/)) {
143			Echolot::Globals::get()->{'storage'}->set_key(
144			'cpunk-clear',
145			$remailer_nick,
146			$remailer->{'address'},
147			'N/A',
148			'none',
149			'N/A',
150			'N/A',
151			'N/A',
152			$time);
153			}
154	weasel	1	}
155	weasel	2
156	weasel	5
157			# Fetch prospective remailers from reliable's remailer-conf reply:
158			my @lines = split /\r?\n/, $conf;
159
160	weasel	357	while (1) {
161			my $head;
162			while (@lines) {
163			$head = $lines[0];
164			chomp $head;
165			shift @lines;
166			last if ($head eq 'SUPPORTED CPUNK (TYPE I) REMAILERS' \|\|
167			$head eq 'SUPPORTED MIXMASTER (TYPE II) REMAILERS');
168			};
169	weasel	358	last unless defined $head;
170	weasel	357	my $wanting = $head eq 'SUPPORTED CPUNK (TYPE I) REMAILERS' ? 1 :
171			$head eq 'SUPPORTED MIXMASTER (TYPE II) REMAILERS' ? 2 :
172			undef;
173			last unless defined $wanting;
174	weasel	5
175	weasel	357	while (@lines) {
176			$head = $lines[0];
177			chomp $head;
178			shift @lines;
179			if ($wanting == 1) {
180			last unless ($head =~ /<(.?@.?)>/);
181			Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type1', $remailer_address);
182			} elsif ($wanting == 2) {
183			last unless ($head =~ /\s(.?@.?)\s/);
184			Echolot::Globals::get()->{'storage'}->add_prospective_address($1, 'reliable-caps-reply-type2', $remailer_address);
185			} else {
186	weasel	363	Echolot::Log::confess("Shouldn't be here. wanting == $wanting.");
187	weasel	357	};
188			};
189	weasel	5	};
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	weasel	363	Echolot::Log::info ("Returned token '$token' has no id at all."),
200	weasel	106	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	weasel	363	Echolot::Log::info("Address not defined."),
214	weasel	103	return 0;
215			defined $caps or
216	weasel	363	Echolot::Log::info("Caps not defined."),
217	weasel	103	return 0;
218
219	weasel	365	Echolot::Log::info("Setting caps for $addr manually to $caps.");
220	weasel	103
221			my $remailer = Echolot::Globals::get()->{'storage'}->get_address($addr);
222			defined $remailer or
223	weasel	363	Echolot::Log::info("Remailer address $addr did not give a valid remailer."),
224	weasel	103	return 0;
225			my $id = $remailer->{'id'};
226			defined $id or
227	weasel	363	Echolot::Log::info("Remailer address $addr did not give a remailer with an id."),
228	weasel	103	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	307	my @mix_confs = ($reply =~ /^
257			[a-z0-9]+
258			\s+
259			\S+\@\S+
260			\s+
261			[0-9a-f]{32}
262			.*?$/xmg);
263	weasel	33	my @mix_keys = ($reply =~ /^-----Begin \s Mix \s Key-----\r?\n
264	weasel	2	[0-9a-f]{32}\r?\n
265			\d+\r?\n
266			(?:[a-zA-Z0-9+\/]*\r?\n)+
267			-----End \s Mix \s Key-----$/xmg );
268			for (@mix_confs) {
269	weasel	307	my ($nick, $address, $keyid, $version, $caps, $created, $expires) = /^
270			([a-z0-9]+)
271			\s+
272			(\S+@\S+)
273			\s+
274			([0-9a-f]{32})
275			(?: [ \t]+
276			(\S+)
277			(?: [ \t]+
278			(\S+)
279			(?: [ \t]+
280			(\d{4}-\d{2}-\d{2})
281			(?: [ \t]+
282			(\d{4}-\d{2}-\d{2})
283			)?
284			)?
285			)?
286			)?/x;
287	weasel	2	$mixmasters{$keyid} = {
288			nick => $nick,
289			address => $address,
290			version => $version,
291			caps => $caps,
292			summary => $_
293			};
294			};
295			for (@mix_keys) {
296			my ($keyid) = /^-----Begin \s Mix \s Key-----\r?\n
297			([0-9a-f]{32})\r?\n
298			\d+\r?\n
299			(?:[a-zA-Z0-9+\/]*\r?\n)+
300			-----End \s Mix \s Key-----$/xmg;
301			$mixmasters{$keyid}->{'key'} = $_;
302			};
303
304			for my $keyid (keys %mixmasters) {
305			my $remailer_address = $mixmasters{$keyid}->{'address'};
306			(defined $mixmasters{$keyid}->{'nick'} && ! defined $mixmasters{$keyid}->{'key'}) and
307	weasel	363	Echolot::Log::info("Mixmaster key header without key in reply from $remailer_address."),
308	weasel	2	next;
309			(! defined $mixmasters{$keyid}->{'nick'} && defined $mixmasters{$keyid}->{'key'}) and
310	weasel	363	Echolot::Log::info("Mixmaster key without key header in reply from $remailer_address."),
311	weasel	2	next;
312
313			if ($remailer->{'address'} ne $remailer_address) {
314			# Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
315	weasel	363	Echolot::Log::info("Remailer address mismatch $remailer->{'address'} vs $remailer_address. Adding latter to prospective remailers.");
316	weasel	33	Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-key', $remailer_address);
317	weasel	2	} else {
318			Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
319			Echolot::Globals::get()->{'storage'}->set_key(
320			'mix',
321			$mixmasters{$keyid}->{'nick'},
322			$mixmasters{$keyid}->{'address'},
323			$mixmasters{$keyid}->{'key'},
324			$keyid,
325			$mixmasters{$keyid}->{'version'},
326			$mixmasters{$keyid}->{'caps'},
327			$mixmasters{$keyid}->{'summary'},
328			$time);
329			}
330			};
331
332			return 1;
333	weasel	1	};
334
335	weasel	33	sub parse_cpunk_key($$$) {
336			my ($reply, $time, $remailer) = @_;
337
338			my $GnuPG = new GnuPG::Interface;
339	weasel	212	$GnuPG->call( Echolot::Config::get()->{'gnupg'} ) if (Echolot::Config::get()->{'gnupg'});
340	weasel	40	$GnuPG->options->hash_init(
341			homedir => Echolot::Config::get()->{'gnupghome'} );
342	weasel	33	$GnuPG->options->meta_interactive( 0 );
343			my %cypherpunk;
344
345			my @pgp_keys = ($reply =~ /^-----BEGIN \s PGP \s PUBLIC \s KEY \s BLOCK-----\r?\n
346	weasel	49	(?:.+\r?\n)*
347	weasel	85	\r?\n
348			(?:[a-zA-Z0-9+\/=]*\r?\n)+
349			-----END \s PGP \s PUBLIC \s KEY \s BLOCK-----$/xmg );
350	weasel	33	for my $key (@pgp_keys) {
351			my ( $stdin_fh, $stdout_fh, $stderr_fh, $status_fh )
352			= ( IO::Handle->new(),
353			IO::Handle->new(),
354			IO::Handle->new(),
355			IO::Handle->new(),
356			);
357			my $handles = GnuPG::Handles->new (
358			stdin => $stdin_fh,
359			stdout => $stdout_fh,
360			stderr => $stderr_fh,
361			status => $status_fh
362			);
363
364			my $pid = $GnuPG->wrap_call(
365			commands => [qw{--with-colons}],
366	weasel	356	command_args => [qw{--no-options --no-secmem-warning --no-default-keyring --fast-list-mode}],
367	weasel	33	handles => $handles );
368			print $stdin_fh $key;
369			close($stdin_fh);
370
371			my $stdout = join '', <$stdout_fh>; close($stdout_fh);
372			my $stderr = join '', <$stderr_fh>; close($stderr_fh);
373			my $status = join '', <$status_fh>; close($status_fh);
374
375	weasel	40	waitpid $pid, 0;
376
377	weasel	33	($stderr eq '') or
378	weasel	363	Echolot::Log::info("GnuPG returned something in stderr: '$stderr' when checking key '$key'; So what?");
379	weasel	33	($status eq '') or
380	weasel	363	Echolot::Log::info("GnuPG returned something in status '$status' when checking key '$key': So what?");
381	weasel	33
382			my @included_keys = $stdout =~ /^pub:.*$/mg;
383			(scalar @included_keys >= 2) &&
384	weasel	363	Echolot::Log::info ("Cannot handle more than one key per block correctly yet. Found ".(scalar @included_keys)." in one block from ".$remailer->{'address'}.".");
385	weasel	33	for my $included_key (@included_keys) {
386	weasel	40	my ($type, $keyid, $uid) = $included_key =~ /pub::\d+:(\d+):([0-9A-F]+):[^:]+:[^:]*:::([^:]+):/;
387	weasel	33	(defined $uid) or
388	weasel	363	Echolot::Log::info ("Unexpected format of '$included_key' by ".$remailer->{'address'}."; Skipping."),
389	weasel	33	next;
390			my ($address) = $uid =~ /<(.*?)>/;
391			$cypherpunk{$keyid} = {
392			address => $address,
393			type => $type,
394			key => $key # FIXME handle more than one key per block correctly
395			};
396			};
397			};
398
399			for my $keyid (keys %cypherpunk) {
400			my $remailer_address = $cypherpunk{$keyid}->{'address'};
401
402			if ($remailer->{'address'} ne $remailer_address) {
403			# Address mismatch -> Ignore reply and add $remailer_address to prospective addresses
404	weasel	363	Echolot::Log::info("Remailer address mismatch $remailer->{'address'} vs $remailer_address id key $keyid. Adding latter to prospective remailers.");
405	weasel	33	Echolot::Globals::get()->{'storage'}->add_prospective_address($remailer_address, 'self-capsstring-key', $remailer_address);
406			} else {
407			Echolot::Globals::get()->{'storage'}->restore_ttl( $remailer->{'address'} );
408			# 1 .. RSA
409			# 17 .. DSA
410			if ($cypherpunk{$keyid}->{'type'} == 1 \|\| $cypherpunk{$keyid}->{'type'} == 17 ) {
411			Echolot::Globals::get()->{'storage'}->set_key(
412			(($cypherpunk{$keyid}->{'type'} == 1) ? 'cpunk-rsa' :
413			(($cypherpunk{$keyid}->{'type'} == 17) ? 'cpunk-dsa' :
414			'ERROR')),
415			$keyid, # as nick
416			$cypherpunk{$keyid}->{'address'},
417			$cypherpunk{$keyid}->{'key'},
418			$keyid,
419			'N/A',
420			'N/A',
421			'N/A',
422			$time);
423			} else {
424	weasel	363	Echolot::Log::info("$keyid from $remailer_address has algoid ".$cypherpunk{$keyid}->{'type'}.". Cannot handle those.");
425	weasel	33	};
426			}
427			};
428
429			return 1;
430			};
431
432			sub remailer_key($$$) {
433			my ($reply, $token, $time) = @_;
434
435	weasel	106	my $cp_reply = $reply;
436			$cp_reply =~ s/^- -/-/gm; # PGP Signed messages
437	weasel	49
438	weasel	33	my ($id) = $token =~ /^key\.(\d+)$/;
439			(defined $id) or
440	weasel	363	Echolot::Log::info ("Returned token '$token' has no id at all."),
441	weasel	33	return 0;
442	weasel	106
443	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
444			if (is_not_a_remailer($reply));
445	weasel	137	Echolot::Thesaurus::save_thesaurus('key', $id, $reply);
446	weasel	33
447			my $remailer = Echolot::Globals::get()->{'storage'}->get_address_by_id($id);
448	weasel	363	Echolot::Log::info("No remailer found for id '$id'."), return 0 unless defined $remailer;
449	weasel	33
450	weasel	106	parse_mix_key($cp_reply, $time, $remailer);
451			parse_cpunk_key($cp_reply, $time, $remailer);
452	weasel	33
453			return 1;
454			};
455
456	weasel	1	sub remailer_stats($$$) {
457	weasel	106	my ($reply, $token, $time) = @_;
458	weasel	1
459	weasel	106	my ($id) = $token =~ /^stats\.(\d+)$/;
460			(defined $id) or
461	weasel	363	Echolot::Log::info ("Returned token '$token' has no id at all."),
462	weasel	106	return 0;
463
464	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
465			if (is_not_a_remailer($reply));
466	weasel	137	Echolot::Thesaurus::save_thesaurus('stats', $id, $reply);
467	weasel	1	};
468
469			sub remailer_help($$$) {
470	weasel	106	my ($reply, $token, $time) = @_;
471	weasel	1
472	weasel	106	my ($id) = $token =~ /^help\.(\d+)$/;
473			(defined $id) or
474	weasel	363	Echolot::Log::info ("Returned token '$token' has no id at all."),
475	weasel	106	return 0;
476
477	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
478			if (is_not_a_remailer($reply));
479	weasel	137	Echolot::Thesaurus::save_thesaurus('help', $id, $reply);
480	weasel	1	};
481
482	weasel	106	sub remailer_adminkey($$$) {
483			my ($reply, $token, $time) = @_;
484
485			my ($id) = $token =~ /^adminkey\.(\d+)$/;
486			(defined $id) or
487	weasel	363	Echolot::Log::info ("Returned token '$token' has no id at all."),
488	weasel	106	return 0;
489
490	weasel	166	Echolot::Globals::get()->{'storage'}->not_a_remailer($id), return 1
491			if (is_not_a_remailer($reply));
492	weasel	137	Echolot::Thesaurus::save_thesaurus('adminkey', $id, $reply);
493	weasel	106	};
494
495	weasel	1	1;
496			# vim: set ts=4 shiftwidth=4: