# Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies).# All rights reserved.# This component and the accompanying materials are made available# under the terms of the License "Eclipse Public License v1.0"# which accompanies this distribution, and is available# at the URL "http://www.eclipse.org/legal/epl-v10.html".# # Initial Contributors:# Nokia Corporation - initial contribution.# # Contributors:# # Description:# ## Description:# Crypt::GPG.pm#package Crypt::GPG;use strict;use File::Basename;use IPC::Open2;use IO::Handle;use Crypt;use vars qw(@ISA);@ISA=("Crypt");# Overidden methods from Crypt.pmsub Initialize { my $self = shift; #check to see if the pgp executable exists grep {-x "$_/gpg.exe"} split /;/, $ENV{PATH} or die "Error: The PGP executable \"gpg.exe\" does not exist in users path\n"; #call super class method $self->SUPER::Initialize(); #check for existence of keyrings and keys $self->CheckKeyRings();}## Implemented abstract methods from Crypt.pm#sub DoEncrypt { my $self = shift; my $plainText = shift; my $cipherText = shift; my @recipientKeys = @{$_[0]}; $self->CheckKeyRings(); #build options list my @options = qw(--batch --no-tty --yes --always-trust); push @options, '--status-fd 1'; push @options, '-o '.$self->Quoted($cipherText); if ($self->DefaultPath()) { push @options, '--homedir '.$self->Quoted($self->DefaultPath()); } foreach my $key (@recipientKeys) { if ($key =~ /^0x([0-9a-fA-F]{8})$/i) { push @options, '-r '.$1; } } my @command = '-e '.$self->Quoted($plainText); # Do encryption. This occasionally fails due to GPG failing to read # the random_seed file when we get a return value of 2. Until we get # a later version of gpg checked as compatible, just retry if this happens. my $retries = 2; my $retval; do { my $cmd = "gpg @options @command"; print "Executing command: $cmd\n" if $self->{verbose} > 1; open GPG, "$cmd 2>&1 |" or die "Error: Encrypt command failed.\n"; my $error; while (my $line = <GPG>) { if ($self->{verbose} > 1) { print "\t$line"; } } close GPG; $retval = $? >> 8; $retries = 0 unless( $retval == 2 ); # Only retry if retval is 2. if( $retval ) { print "WARNING: GPG failure. Error code $retval. "; print "Retrying GPG..." if( $retries > 0 ); print "\n"; } } while( $retries-- > 0 ); die "ERROR: GPG returned error code $retval.\n" if ($retval > 0);}sub DoDecrypt { my $self = shift; my $cipherText = shift; my $plainText = shift; my $passPhrase = shift; $self->CheckKeyRings(); #build options list my @options = qw(--batch); push @options, '--status-fd 1'; push @options, '--passphrase-fd 0'; push @options, '-o '.$self->Quoted($plainText); if ($self->DefaultPath()) { push @options, '--homedir '.$self->Quoted($self->DefaultPath()); } my @command = '-d '.$self->Quoted($cipherText); #do decryption reading passphrase from STDIN writing output to log file my $gpgOutput = '/gpg_output.log'; my $cmd = "gpg @options @command"; # retry 100 times of GPG and opening GPG output my $retries = 100; while ($retries > 0) { print "Executing command: $cmd\n" if $self->{verbose} > 1; if (open GPGIN, "| $cmd 2>NUL 1> $gpgOutput") { print GPGIN "$passPhrase\n"; while (my $line = <GPGIN>) { } close GPGIN; #open output of gpg command from file for parsing if (open GPGOUT, "$gpgOutput") { #open output of gpg successfully, then jump out and go ahead last; } else { print "Warning: Cannot open gpg output file, $!\n"; } } else { print "Warning: Error: Decrypt command failed, $!\n"; } $retries--; # sleep 10 seconds for next try sleep(10); } die "Error: Cannot create or open output log file for $cipherText.\n" if ($retries<=0); my $badPassPhrase =0; my %enc_to; my %no_seckey; my $keyTally = 0; my $useKeyTally = 0; # Fallback for if parsing fails while (my $line = <GPGOUT>) { if ($self->{verbose} > 1) { print "\t$line"; } next if ($line =~ /^\s*$/); if ($line =~ /BAD_PASSPHRASE/) { $badPassPhrase = 1; } elsif ($line =~ /GOOD_PASSPHRASE/) { $badPassPhrase = 0; } elsif ($line =~ /ENC_TO/) { if ($line =~ /ENC_TO\s+([\dA-F]*)/) { $enc_to{$1} = $1; # Value is unimportant } else { $useKeyTally = 1; } --$keyTally; } elsif ($line =~ /NO_SECKEY/) { if ($line =~ /NO_SECKEY\s+([\dA-F]*)/) { $no_seckey{$1} = $1; # Value is unimportant } else { $useKeyTally = 1; } --$keyTally; } } close GPGOUT; my $retval = $? >> 8; unlink $gpgOutput; if (!$useKeyTally) { foreach my $key (keys(%no_seckey)) { delete $no_seckey{$key}; if (exists $enc_to{$key}) { delete $enc_to{$key}; } else { die "Error: Parsing of GPG output failed. Got a NO_SECKEY for no corresponding ENC_TO.\n"; } } $keyTally = scalar(keys(%enc_to)); # Number of private keys } #handle specific decryption errors if ($badPassPhrase and $keyTally != 0) { die "Error: Decryption of $cipherText failed. BAD_PASSPHRASE\n"; } elsif ($keyTally == 0) { die "Error: Decryption of $cipherText failed. No decrypting key available. NO_SECKEY\n"; } elsif ($keyTally < 0) { # Parsing failed, and we got spurious NO_SECKEY messages die "Error: Parsing of GPG output failed. Too many NO_SECKEYs\n"; } die "Error code returned by gpg: $retval.\n" if ($retval > 0);}sub GetPublicKeyList { my $self = shift; my @options; if ($self->DefaultPath()) { push @options, '--homedir '.$self->Quoted($self->DefaultPath()); } my @command = qw(--list-keys); #list and extract keyids open GPG, "gpg @options @command 2>&1 |" or die "Error: List keys command failed.\n"; my @keys; while (my $line = <GPG>) { if ($line =~ /^pub.*?([0-9a-fA-F]{8})\b/i) { push @keys, '0x'.$1; } } close GPG; return \@keys;}sub GetSecretKeyList { my $self = shift; my @options; if ($self->DefaultPath()) { push @options, '--homedir '.$self->Quoted($self->DefaultPath()); } my @command = qw(--list-secret-keys); #list and extract keyids open GPG, "gpg @options @command 2>&1 |" or die "Error: List keys command failed.\n"; my @keys; while (my $line = <GPG>) { if ($line =~ /^sec.*?([0-9a-fA-F]{8})\b/i) { push @keys, '0x'.$1; } } close GPG; return \@keys;}## Private#sub CheckKeyRings { my $self = shift; if ($self->DefaultPath) { unless (-e $self->DefaultPath.'/pubring.gpg') { die "Error: PGP Public keyring does not exist\n"; } unless (-e $self->DefaultPath.'/secring.gpg') { die "Error: PGP secret keyring does not exist\n"; } } unless (@{$self->PublicKeyList}) { die "Error: PGP public keyring is empty\n"; } unless (@{$self->SecretKeyList}) { die "Error: PGP secret keyring is empty\n"; }}1;__END__=head1 NAMECrypt::GPG.pm - A wrapper over the Gnu Privacy Guard command line PGP tool=head1 DESCRIPTIONC<Crypt::GPG> is inherited from the abstract base class C<Crypt>, implementing the abstract methods required for PGP encryption, decryption, etc... by calling Gnu Privacy Guard PGP command line tool (tested with version 1.0.6). For this module to work the PGP executable must have the name C<gpg.exe> and exist in one of the directories defined in the users path.=head1 KNOWN BUGSNone=head1 COPYRIGHT Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies). All rights reserved. This component and the accompanying materials are made available under the terms of the License "Eclipse Public License v1.0" which accompanies this distribution, and is available at the URL "http://www.eclipse.org/legal/epl-v10.html". Initial Contributors: Nokia Corporation - initial contribution. Contributors: Description:=cut