Echolot/Pinger/CPunk.pm

package Echolot::Pinger::CPunk;

# (c) 2002 Peter Palfrader <peter@palfrader.org>
# $Id: CPunk.pm,v 1.15 2003/02/17 14:44:15 weasel Exp $
#

=pod

=head1 Name

Echolot::Pinger::CPunk - send cypherpunk pings

=head1 DESCRIPTION

This package provides functions for sending cypherpunk (type I) pings.

=cut

use strict;
use English;
use GnuPG::Interface;
use IO::Handle;
use Echolot::Log;

sub encrypt_to($$$$) {
        my ($msg, $recipient, $keys, $pgp2compat) = @_;

        (defined $keys->{$recipient}) or
                Echolot::Log::warn("Key for recipient $recipient is not defined."),
                return undef;
        (defined $keys->{$recipient}->{'key'}) or
                Echolot::Log::warn("Key->key for recipient $recipient is not defined."),
                return undef;
        my $keyring = Echolot::Config::get()->{'tmpdir'}.'/'.
                Echolot::Globals::get()->{'hostname'}.".".time.'.'.$PROCESS_ID.'_'.Echolot::Globals::get()->{'internalcounter'}++.'.keyring';
        
        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 ( $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     => [ '--import' ],
                command_args => [qw{--no-options --no-secmem-warning --no-default-keyring --fast-list-mode --keyring}, $keyring, '--', '-' ],
                handles      => $handles );
        print $stdin_fh $keys->{$recipient}->{'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;

        ($stdout eq '') or
                Echolot::Log::info("GnuPG returned something in stdout '$stdout' while adding key for '$recipient': So what?");
        #($stderr eq '') or
                #Echolot::Log::warn("GnuPG returned something in stderr: '$stderr' while adding key for '$recipient'; returning."),
                #return undef;
        ($status =~ /^^\[GNUPG:\] IMPORTED $recipient /m) or
                Echolot::Log::info("GnuPG status '$status' didn't indicate key for '$recipient' was imported correctly."),
                return undef;


        $msg =~ s/\r?\n/\r\n/g;


        $GnuPG->options->hash_init(
                armor   => 1 );

        ( $stdin_fh, $stdout_fh, $stderr_fh, $status_fh )
                = ( IO::Handle->new(),
                IO::Handle->new(),
                IO::Handle->new(),
                IO::Handle->new(),
                );
        $handles = GnuPG::Handles->new (
                stdin      => $stdin_fh,
                stdout     => $stdout_fh,
                stderr     => $stderr_fh,
                status     => $status_fh
                );
        my $command_args = [qw{--no-options --no-secmem-warning --always-trust --no-default-keyring --cipher-algo 3DES --keyring}, $keyring, '--recipient', $recipient];
        my $plaintextfile;

        #if ($pgp2compat) {
        #       push @$command_args, qw{--pgp2};
        #};
        # Files are required for compaitibility with PGP 2.*
        # we also use files in all other cases since there is a bug in either GnuPG or GnuPG::Interface
        # that let Echolot die if in certain cases:
        #  If a key is unuseable because it expired and we want to encrypt something to it
        #  pingd dies if there is only enough time between calling encrypt() and printing the message
        #  to GnuPG. (a sleep 1 triggered that reproduceably)
        $plaintextfile = Echolot::Config::get()->{'tmpdir'}.'/'.
                Echolot::Globals::get()->{'hostname'}.".".time.'.'.$PROCESS_ID.'_'.Echolot::Globals::get()->{'internalcounter'}++.'.plaintext';
        open (F, '>'.$plaintextfile) or
                Echolot::Log::warn("Cannot open $plaintextfile for writing: $!."),
                return 0;
        print (F $msg);
        close (F) or
                Echolot::Log::warn("Cannot close $plaintextfile."),
                return 0;
        push @$command_args, $plaintextfile;

        $pid = $GnuPG->encrypt(
                command_args => $command_args,
                handles      => $handles );
        close($stdin_fh);

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

        waitpid $pid, 0;

        #($stderr eq '') or
                #Echolot::Log::warn("GnuPG returned something in stderr: '$stderr' while encrypting to '$recipient'."),
                #return undef;
        ($status =~ /^\[GNUPG:\] KEYEXPIRED (\d+)/m) and
                Echolot::Log::info("Key $recipient expired at ".scalar gmtime($1)." UTC"),
                return undef;
        (($status =~ /^\[GNUPG:\] BEGIN_ENCRYPTION\s/m) &&
         ($status =~ /^\[GNUPG:\] END_ENCRYPTION\s/m)) or
                Echolot::Log::info("GnuPG status '$status' didn't indicate message to '$recipient' was encrypted correctly (stderr: $stderr; args: ".join(' ', @$command_args).")."),
                return undef;

        unlink ($keyring) or
                Echolot::Log::warn("Cannot unlink tmp keyring '$keyring'."),
                return undef;
        unlink ($keyring.'~'); # gnupg does those evil backups

        (defined $plaintextfile) and 
                ( unlink ($plaintextfile) or
                        Echolot::Log::warn("Cannot unlink tmp keyring '$plaintextfile'."),
                        return undef);


        my $result;

        $plaintextfile .= '.asc';
        open (F, '<'.$plaintextfile) or
                Echolot::Log::warn("Cannot open $plaintextfile for reading: $!."),
                return 0;
        $result = join '', <F>;
        close (F) or
                Echolot::Log::warn("Cannot close $plaintextfile."),
                return 0;

        (defined $plaintextfile) and 
                ( unlink ($plaintextfile) or
                        Echolot::Log::warn("Cannot unlink tmp keyring '$plaintextfile'."),
                        return undef);

        $result =~ s,^Version: .*$,Version: N/A,m;
        return $result;
};

sub ping($$$$$) {
        my ($body, $to, $with_from, $chain, $keys) = @_;

        my $msg = $body;

        for my $hop (reverse @$chain) {
                my $header = '';
                if ($with_from) {
                        my $address = Echolot::Config::get()->{'my_localpart'} . '@' .
                                      Echolot::Config::get()->{'my_domain'};
                        $header = "##\nFrom: Echolot Pinger <$address>\n\n";
                        $with_from = 0;
                };
                $msg = "::\n".
                        "Anon-To: $to\n".
                        "\n".
                        $header.
                        $msg;

                if ($hop->{'encrypt'}) {
                        my $encrypted = encrypt_to($msg, $hop->{'keyid'}, $keys, $hop->{'pgp2compat'});
                        (defined $encrypted) or 
                                Echolot::Log::debug("Encrypted is undefined."),
                                return undef;
                        $msg = "::\n".
                                "Encrypted: PGP\n".
                                "\n".
                                $encrypted;
                };
                $to = $hop->{'address'};
        }

        Echolot::Tools::send_message(
                To      => $to,
                Body => $msg
        );

        return 1;
};

1;
# vim: set ts=4 shiftwidth=4:
1	package Echolot::Pinger::CPunk;
2
3	# (c) 2002 Peter Palfrader <peter@palfrader.org>
4	# $Id: CPunk.pm,v 1.15 2003/02/17 14:44:15 weasel Exp $
5	#
6
7	=pod
8
9	=head1 Name
10
11	Echolot::Pinger::CPunk - send cypherpunk pings
12
13	=head1 DESCRIPTION
14
15	This package provides functions for sending cypherpunk (type I) pings.
16
17	=cut
18
19	use strict;
20	use English;
21	use GnuPG::Interface;
22	use IO::Handle;
23	use Echolot::Log;
24
25	sub encrypt_to($$$$) {
26	my ($msg, $recipient, $keys, $pgp2compat) = @_;
27
28	(defined $keys->{$recipient}) or
29	Echolot::Log::warn("Key for recipient $recipient is not defined."),
30	return undef;
31	(defined $keys->{$recipient}->{'key'}) or
32	Echolot::Log::warn("Key->key for recipient $recipient is not defined."),
33	return undef;
34	my $keyring = Echolot::Config::get()->{'tmpdir'}.'/'.
35	Echolot::Globals::get()->{'hostname'}.".".time.'.'.$PROCESS_ID.'_'.Echolot::Globals::get()->{'internalcounter'}++.'.keyring';
36
37	my $GnuPG = new GnuPG::Interface;
38	$GnuPG->call( Echolot::Config::get()->{'gnupg'} ) if (Echolot::Config::get()->{'gnupg'});
39	$GnuPG->options->hash_init(
40	homedir => Echolot::Config::get()->{'gnupghome'} );
41	$GnuPG->options->meta_interactive( 0 );
42
43	my ( $stdin_fh, $stdout_fh, $stderr_fh, $status_fh )
44	= ( IO::Handle->new(),
45	IO::Handle->new(),
46	IO::Handle->new(),
47	IO::Handle->new(),
48	);
49	my $handles = GnuPG::Handles->new (
50	stdin => $stdin_fh,
51	stdout => $stdout_fh,
52	stderr => $stderr_fh,
53	status => $status_fh
54	);
55	my $pid = $GnuPG->wrap_call(
56	commands => [ '--import' ],
57	command_args => [qw{--no-options --no-secmem-warning --no-default-keyring --fast-list-mode --keyring}, $keyring, '--', '-' ],
58	handles => $handles );
59	print $stdin_fh $keys->{$recipient}->{'key'};
60	close($stdin_fh);
61
62	my $stdout = join '', <$stdout_fh>; close($stdout_fh);
63	my $stderr = join '', <$stderr_fh>; close($stderr_fh);
64	my $status = join '', <$status_fh>; close($status_fh);
65
66	waitpid $pid, 0;
67
68	($stdout eq '') or
69	Echolot::Log::info("GnuPG returned something in stdout '$stdout' while adding key for '$recipient': So what?");
70	#($stderr eq '') or
71	#Echolot::Log::warn("GnuPG returned something in stderr: '$stderr' while adding key for '$recipient'; returning."),
72	#return undef;
73	($status =~ /^^\[GNUPG:\] IMPORTED $recipient /m) or
74	Echolot::Log::info("GnuPG status '$status' didn't indicate key for '$recipient' was imported correctly."),
75	return undef;
76
77
78
79
80
81
82	$msg =~ s/\r?\n/\r\n/g;
83
84
85
86
87	$GnuPG->options->hash_init(
88	armor => 1 );
89
90	( $stdin_fh, $stdout_fh, $stderr_fh, $status_fh )
91	= ( IO::Handle->new(),
92	IO::Handle->new(),
93	IO::Handle->new(),
94	IO::Handle->new(),
95	);
96	$handles = GnuPG::Handles->new (
97	stdin => $stdin_fh,
98	stdout => $stdout_fh,
99	stderr => $stderr_fh,
100	status => $status_fh
101	);
102	my $command_args = [qw{--no-options --no-secmem-warning --always-trust --no-default-keyring --cipher-algo 3DES --keyring}, $keyring, '--recipient', $recipient];
103	my $plaintextfile;
104
105	#if ($pgp2compat) {
106	# push @$command_args, qw{--pgp2};
107	#};
108	# Files are required for compaitibility with PGP 2.*
109	# we also use files in all other cases since there is a bug in either GnuPG or GnuPG::Interface
110	# that let Echolot die if in certain cases:
111	# If a key is unuseable because it expired and we want to encrypt something to it
112	# pingd dies if there is only enough time between calling encrypt() and printing the message
113	# to GnuPG. (a sleep 1 triggered that reproduceably)
114	$plaintextfile = Echolot::Config::get()->{'tmpdir'}.'/'.
115	Echolot::Globals::get()->{'hostname'}.".".time.'.'.$PROCESS_ID.'_'.Echolot::Globals::get()->{'internalcounter'}++.'.plaintext';
116	open (F, '>'.$plaintextfile) or
117	Echolot::Log::warn("Cannot open $plaintextfile for writing: $!."),
118	return 0;
119	print (F $msg);
120	close (F) or
121	Echolot::Log::warn("Cannot close $plaintextfile."),
122	return 0;
123	push @$command_args, $plaintextfile;
124
125	$pid = $GnuPG->encrypt(
126	command_args => $command_args,
127	handles => $handles );
128	close($stdin_fh);
129
130	$stdout = join '', <$stdout_fh>; close($stdout_fh);
131	$stderr = join '', <$stderr_fh>; close($stderr_fh);
132	$status = join '', <$status_fh>; close($status_fh);
133
134	waitpid $pid, 0;
135
136	#($stderr eq '') or
137	#Echolot::Log::warn("GnuPG returned something in stderr: '$stderr' while encrypting to '$recipient'."),
138	#return undef;
139	($status =~ /^\[GNUPG:\] KEYEXPIRED (\d+)/m) and
140	Echolot::Log::info("Key $recipient expired at ".scalar gmtime($1)." UTC"),
141	return undef;
142	(($status =~ /^\[GNUPG:\] BEGIN_ENCRYPTION\s/m) &&
143	($status =~ /^\[GNUPG:\] END_ENCRYPTION\s/m)) or
144	Echolot::Log::info("GnuPG status '$status' didn't indicate message to '$recipient' was encrypted correctly (stderr: $stderr; args: ".join(' ', @$command_args).")."),
145	return undef;
146
147	unlink ($keyring) or
148	Echolot::Log::warn("Cannot unlink tmp keyring '$keyring'."),
149	return undef;
150	unlink ($keyring.'~'); # gnupg does those evil backups
151
152	(defined $plaintextfile) and
153	( unlink ($plaintextfile) or
154	Echolot::Log::warn("Cannot unlink tmp keyring '$plaintextfile'."),
155	return undef);
156
157
158	my $result;
159
160	$plaintextfile .= '.asc';
161	open (F, '<'.$plaintextfile) or
162	Echolot::Log::warn("Cannot open $plaintextfile for reading: $!."),
163	return 0;
164	$result = join '', <F>;
165	close (F) or
166	Echolot::Log::warn("Cannot close $plaintextfile."),
167	return 0;
168
169	(defined $plaintextfile) and
170	( unlink ($plaintextfile) or
171	Echolot::Log::warn("Cannot unlink tmp keyring '$plaintextfile'."),
172	return undef);
173
174	$result =~ s,^Version: .*$,Version: N/A,m;
175	return $result;
176	};
177
178	sub ping($$$$$) {
179	my ($body, $to, $with_from, $chain, $keys) = @_;
180
181	my $msg = $body;
182
183	for my $hop (reverse @$chain) {
184	my $header = '';
185	if ($with_from) {
186	my $address = Echolot::Config::get()->{'my_localpart'} . '@' .
187	Echolot::Config::get()->{'my_domain'};
188	$header = "##\nFrom: Echolot Pinger <$address>\n\n";
189	$with_from = 0;
190	};
191	$msg = "::\n".
192	"Anon-To: $to\n".
193	"\n".
194	$header.
195	$msg;
196
197	if ($hop->{'encrypt'}) {
198	my $encrypted = encrypt_to($msg, $hop->{'keyid'}, $keys, $hop->{'pgp2compat'});
199	(defined $encrypted) or
200	Echolot::Log::debug("Encrypted is undefined."),
201	return undef;
202	$msg = "::\n".
203	"Encrypted: PGP\n".
204	"\n".
205	$encrypted;
206	};
207	$to = $hop->{'address'};
208	}
209
210	Echolot::Tools::send_message(
211	To => $to,
212	Body => $msg
213	);
214
215	return 1;
216	};
217
218	1;
219	# vim: set ts=4 shiftwidth=4: