diff -r 6d08f4a05d93 -r 3145852acc89 releasing/cbrtools/perl/Crypt/GPG.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/releasing/cbrtools/perl/Crypt/GPG.pm	Fri Jun 25 18:37:20 2010 +0800
@@ -0,0 +1,311 @@
+# 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.pm
+
+sub 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 NAME
+
+Crypt::GPG.pm - A wrapper over the Gnu Privacy Guard command line PGP tool
+
+=head1 DESCRIPTION
+
+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.
+
+=head1 KNOWN BUGS
+
+None
+
+=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