package Echolot::Pinger::CPunk; # (c) 2002 Peter Palfrader # $Id: CPunk.pm,v 1.20 2003/06/06 10:36:23 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 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, $handles ) = Echolot::Tools::make_gpg_fds(); 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, $handles ) = Echolot::Tools::make_gpg_fds(); my $command_args = [qw{--no-options --no-secmem-warning --always-trust --no-default-keyring --textmode --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 plaintextfile '$plaintextfile'."), return undef); my $result; $plaintextfile .= '.asc'; open (F, '<'.$plaintextfile) or Echolot::Log::warn("Cannot open $plaintextfile for reading: $!."), return 0; $result = join '', ; close (F) or Echolot::Log::warn("Cannot close $plaintextfile."), return 0; (defined $plaintextfile) and (unlink ($plaintextfile) or Echolot::Log::warn("Cannot unlink tmp plaintextfile '$plaintextfile'."), return undef); $result =~ s,^Version: .*$,Version: N/A,m; #$result =~ s/\r?\n/\r\n/g; 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; }; # "Latent-Time: +0\n". $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: