1 # Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies).

     2 # All rights reserved.

     3 # This component and the accompanying materials are made available

     4 # under the terms of the License "Eclipse Public License v1.0"

     5 # which accompanies this distribution, and is available

     6 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     7 # 

     8 # Initial Contributors:

     9 # Nokia Corporation - initial contribution.

    10 # 

    11 # Contributors:

    12 # 

    13 # Description:

    14 # 

    15 #

    16 # Description:

    17 # Crypt::GPG.pm

    18 #

    19 

    20 package Crypt::GPG;

    21 

    22 use strict;

    23 use File::Basename;

    24 use IPC::Open2;

    25 use IO::Handle;

    26 

    27 use Crypt;

    28 use vars qw(@ISA);

    29 @ISA=("Crypt");

    30 

    31 # Overidden methods from Crypt.pm

    32 

    33 sub Initialize {

    34   my $self = shift;

    35 

    36   #check to see if the pgp executable exists

    37   grep {-x "$_/gpg.exe"} split /;/, $ENV{PATH}

    38     or die "Error: The PGP executable \"gpg.exe\" does not exist in users path\n";

    39 

    40   #call super class method

    41   $self->SUPER::Initialize();

    42 

    43   #check for existence of keyrings and keys

    44   $self->CheckKeyRings();

    45 }

    46 

    47 #

    48 # Implemented abstract methods from Crypt.pm

    49 #

    50 

    51 sub DoEncrypt {

    52   my $self = shift;

    53   my $plainText = shift;

    54   my $cipherText = shift;

    55   my @recipientKeys = @{$_[0]};

    56 

    57   $self->CheckKeyRings();

    58 

    59   #build options list

    60   my @options = qw(--batch --no-tty --yes --always-trust);

    61   push @options, '--status-fd 1';

    62   push @options, '-o '.$self->Quoted($cipherText);

    63   if ($self->DefaultPath()) {

    64     push @options, '--homedir '.$self->Quoted($self->DefaultPath());

    65   }

    66   foreach my $key (@recipientKeys) {

    67     if ($key =~ /^0x([0-9a-fA-F]{8})$/i) {

    68       push @options, '-r '.$1;

    69     }

    70   }

    71   my @command = '-e '.$self->Quoted($plainText);

    72 

    73   # Do encryption. This occasionally fails due to GPG failing to read

    74   # the random_seed file when we get a return value of 2. Until we get

    75   # a later version of gpg checked as compatible, just retry if this happens.

    76   my $retries = 2;

    77   my $retval;

    78   do {

    79       my $cmd = "gpg @options @command";

    80       print "Executing command: $cmd\n" if $self->{verbose} > 1;

    81       open GPG, "$cmd 2>&1 |" or die "Error: Encrypt command failed.\n";

    82       my $error;

    83       while (my $line = <GPG>) {

    84         if ($self->{verbose} > 1) {

    85           print "\t$line";

    86         }

    87       }

    88       close GPG;

    89       $retval = $? >> 8;

    90       $retries = 0 unless( $retval == 2 );  # Only retry if retval is 2.

    91       if( $retval ) {

    92         print "WARNING: GPG failure. Error code $retval. ";

    93         print "Retrying GPG..." if( $retries > 0 );

    94         print "\n";

    95       }

    96   } while( $retries-- > 0 );

    97   die "ERROR: GPG returned error code $retval.\n" if ($retval > 0);

    98 }

    99 

   100 sub DoDecrypt {

   101   my $self = shift;

   102   my $cipherText = shift;

   103   my $plainText = shift;

   104   my $passPhrase = shift;

   105 

   106   $self->CheckKeyRings();

   107 

   108   #build options list

   109   my @options = qw(--batch);

   110   push @options, '--status-fd 1';

   111   push @options, '--passphrase-fd 0';

   112   push @options, '-o '.$self->Quoted($plainText);

   113   if ($self->DefaultPath()) {

   114     push @options, '--homedir '.$self->Quoted($self->DefaultPath());

   115   }

   116   my @command = '-d '.$self->Quoted($cipherText);

   117 

   118   #do decryption reading passphrase from STDIN writing output to log file

   119   my $gpgOutput = '/gpg_output.log';

   120   my $cmd = "gpg @options @command";

   121 

   122   # retry 100 times of GPG and opening GPG output

   123   my $retries = 100;

   124   while ($retries > 0) {

   125     print "Executing command: $cmd\n" if $self->{verbose} > 1;

   126     if (open GPGIN, "| $cmd 2>NUL 1> $gpgOutput") {

   127       print GPGIN "$passPhrase\n";

   128       while (my $line  = <GPGIN>) {

   129       }

   130       close GPGIN;

   131 	  

   132       #open output of gpg command from file for parsing

   133       if (open GPGOUT, "$gpgOutput") {

   134         #open output of gpg successfully, then jump out and go ahead

   135         last;

   136       }

   137       else {

   138         print "Warning: Cannot open gpg output file, $!\n";

   139       }

   140     }

   141     else {

   142       print "Warning: Error: Decrypt command failed, $!\n";

   143     }

   144     $retries--;

   145 

   146     # sleep 10 seconds for next try

   147     sleep(10);

   148   }

   149   die "Error: Cannot create or open output log file for $cipherText.\n" if ($retries<=0);

   150   

   151   my $badPassPhrase =0;

   152   my %enc_to;

   153   my %no_seckey;

   154   my $keyTally = 0;

   155   my $useKeyTally = 0; # Fallback for if parsing fails

   156   while (my $line = <GPGOUT>) {

   157     if ($self->{verbose} > 1) {

   158       print "\t$line";

   159     }

   160     next if ($line =~ /^\s*$/);

   161     if ($line =~ /BAD_PASSPHRASE/) {

   162       $badPassPhrase = 1;

   163     }

   164     elsif ($line =~ /GOOD_PASSPHRASE/) {

   165       $badPassPhrase = 0;

   166     }

   167     elsif ($line =~ /ENC_TO/) {

   168       if ($line =~ /ENC_TO\s+([\dA-F]*)/) {

   169         $enc_to{$1} = $1; # Value is unimportant

   170       } else {

   171         $useKeyTally = 1;

   172       }

   173       --$keyTally;

   174     }

   175     elsif ($line =~ /NO_SECKEY/) {

   176       if ($line =~ /NO_SECKEY\s+([\dA-F]*)/) {

   177         $no_seckey{$1} = $1; # Value is unimportant

   178       } else {

   179         $useKeyTally = 1;

   180       }

   181       --$keyTally;

   182     }

   183   }

   184   close GPGOUT;

   185   my $retval = $? >> 8;

   186   unlink $gpgOutput;

   187 

   188   if (!$useKeyTally) {

   189     foreach my $key (keys(%no_seckey)) {

   190       delete $no_seckey{$key};

   191       if (exists $enc_to{$key}) {

   192         delete $enc_to{$key};

   193       } else {

   194         die "Error: Parsing of GPG output failed. Got a NO_SECKEY for no corresponding ENC_TO.\n";

   195       }

   196     }

   197     $keyTally = scalar(keys(%enc_to)); # Number of private keys

   198   }

   199 

   200   #handle specific decryption errors

   201   if ($badPassPhrase and $keyTally != 0) {

   202     die "Error: Decryption of $cipherText failed. BAD_PASSPHRASE\n";

   203   }

   204   elsif ($keyTally == 0) {

   205     die "Error: Decryption of $cipherText failed. No decrypting key available. NO_SECKEY\n";

   206   }

   207   elsif ($keyTally < 0) {

   208     # Parsing failed, and we got spurious NO_SECKEY messages

   209     die "Error: Parsing of GPG output failed. Too many NO_SECKEYs\n";

   210   }

   211   die "Error code returned by gpg: $retval.\n" if ($retval > 0);

   212 }

   213 

   214 sub GetPublicKeyList {

   215   my $self = shift;

   216 

   217   my @options;

   218   if ($self->DefaultPath()) {

   219     push @options, '--homedir '.$self->Quoted($self->DefaultPath());

   220   }

   221   my @command = qw(--list-keys);

   222 

   223   #list and extract keyids

   224   open GPG, "gpg @options @command 2>&1 |" or die "Error: List keys command failed.\n";

   225   my @keys;

   226   while (my $line = <GPG>) {

   227     if ($line =~ /^pub.*?([0-9a-fA-F]{8})\b/i) {

   228       push @keys, '0x'.$1;

   229     }

   230   }

   231   close GPG;

   232   return \@keys;

   233 }

   234 

   235 sub GetSecretKeyList {

   236   my $self = shift;

   237 

   238   my @options;

   239   if ($self->DefaultPath()) {

   240     push @options, '--homedir '.$self->Quoted($self->DefaultPath());

   241   }

   242   my @command = qw(--list-secret-keys);

   243 

   244   #list and extract keyids

   245   open GPG, "gpg @options @command 2>&1 |" or die "Error: List keys command failed.\n";

   246   my @keys;

   247   while (my $line = <GPG>) {

   248     if ($line =~ /^sec.*?([0-9a-fA-F]{8})\b/i) {

   249       push @keys, '0x'.$1;

   250     }

   251   }

   252   close GPG;

   253   return \@keys;

   254 }

   255 #

   256 # Private

   257 #

   258 

   259 sub CheckKeyRings {

   260   my $self = shift;

   261 

   262   if ($self->DefaultPath) {

   263     unless (-e $self->DefaultPath.'/pubring.gpg') {

   264       die "Error: PGP Public keyring does not exist\n";

   265     }

   266     unless (-e $self->DefaultPath.'/secring.gpg') {

   267       die "Error: PGP secret keyring does not exist\n";

   268     }

   269   }

   270   unless (@{$self->PublicKeyList}) {

   271     die "Error: PGP public keyring is empty\n";

   272   }

   273   unless (@{$self->SecretKeyList}) {

   274     die "Error: PGP secret keyring is empty\n";

   275   }

   276 }

   277 

   278 1;

   279 

   280 __END__

   281 

   282 =head1 NAME

   283 

   284 Crypt::GPG.pm - A wrapper over the Gnu Privacy Guard command line PGP tool

   285 

   286 =head1 DESCRIPTION

   287 

   288 C<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.

   289 

   290 =head1 KNOWN BUGS

   291 

   292 None

   293 

   294 =head1 COPYRIGHT

   295 

   296  Copyright (c) 2000-2009 Nokia Corporation and/or its subsidiary(-ies).

   297  All rights reserved.

   298  This component and the accompanying materials are made available

   299  under the terms of the License "Eclipse Public License v1.0"

   300  which accompanies this distribution, and is available

   301  at the URL "http://www.eclipse.org/legal/epl-v10.html".

   302  

   303  Initial Contributors:

   304  Nokia Corporation - initial contribution.

   305  

   306  Contributors:

   307  

   308  Description:

   309  

   310 

   311 =cut