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::PGP.pm

    18 #

    19 

    20 package Crypt::PGP;

    21 

    22 use strict;

    23 

    24 use Crypt;

    25 use vars qw(@ISA);

    26 @ISA=("Crypt");

    27 

    28 # Overidden methods from Crypt.pm

    29  

    30 sub Initialize {

    31   my $self = shift;

    32 

    33   #check to see if the pgp executable exists

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

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

    36   

    37   #call super class method

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

    39  

    40   #check for existence of keyrings and keys

    41   $self->CheckKeyRings();

    42 }

    43 

    44 #

    45 # Implemented abstract methods from Crypt.pm

    46 #

    47 

    48 sub DoEncrypt {

    49   my $self = shift;

    50   my $plainText = shift;

    51   my $cipherText = shift;

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

    53 

    54   $self->CheckKeyRings();

    55 

    56   #build options list

    57   my @options = qw(+force +batchmode +verbose=2);

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

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

    60     push @options, '+PUBRING='.$self->Quoted($self->DefaultPath().'/pubring.pkr');

    61   }

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

    63   push @command, @recipientKeys;

    64 

    65   #do encryption

    66   open PGP, "pgp @options @command 2>NUL |" or die "Error: Encrypt command failed.\n";

    67   my $unsignedKeyError;

    68   while (my $line = <PGP>) {

    69     if ($self->{verbose} > 1) {print $line;}

    70     if ($line =~ /skipping userid/i) { #check for unsigned key errors

    71       $unsignedKeyError = 1;

    72     }	

    73   }

    74   close PGP;

    75   if ($unsignedKeyError) {

    76     die "Error: Encryption failed. Public keys must be signed with the default signing key\n";

    77   }

    78 }

    79 

    80 sub DoDecrypt {

    81   my $self = shift;

    82   my $cipherText = shift;

    83   my $plainText = shift;

    84   my $passPhrase = shift;

    85   

    86   $self->CheckKeyRings();

    87 

    88   #build options list

    89   my @options =qw(+force +batchmode +verbose=2);

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

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

    92     push @options, '+SECRING='.$self->Quoted($self->DefaultPath().'/secring.skr');

    93   }

    94   push @options, '-z'.$self->Quoted($passPhrase);

    95 

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

    97 

    98   #do decryption

    99   open PGP, "pgp @options @command 2>NUL |" or die "Error: Decrypt command failed.\n";

   100   my ($errorCode, $exitCode);

   101   while (my $line = <PGP>) {

   102     if ($self->{verbose} > 1) {print $line;}

   103     if ($line =~ /error.*?-(\d+)/i) {

   104       $errorCode = $1;

   105     } 

   106     elsif ($line =~ /exitcode.*?(\d+)/i) {

   107       $exitCode = $1;

   108     }

   109   }

   110   close PGP;

   111 

   112   #handle specific decryption errors

   113   if (defined $errorCode) {

   114     if ($errorCode == 11477) {

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

   116     } 

   117     elsif ($errorCode == 11489) {

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

   119     }

   120   }	

   121 }

   122 

   123 sub GetPublicKeyList {

   124   my $self = shift;

   125 

   126   my @options = qw(+verbose=2);

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

   128     push @options, '+PUBRING='.$self->Quoted($self->DefaultPath().'/pubring.pkr');

   129   } 

   130   my @command = qw(-kv);

   131 

   132   #list and extract keyids

   133   open PGP, "pgp @options @command 2>NUL |" or die "Error: List keys command failed.\n";

   134   my @keys;

   135   while (my $line = <PGP>) {

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

   137       push @keys, $1;

   138     }

   139   }

   140   close PGP;

   141   return \@keys;

   142 }

   143 

   144 sub GetSecretKeyList {

   145   my $self = shift;

   146 

   147   my @options = qw(+verbose=2);

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

   149     push @options, '+SECRING='.$self->Quoted($self->DefaultPath().'/secring.skr');

   150   } 

   151   my @command = qw(-kv);

   152 

   153   #list and extract keyids

   154   open PGP, "pgp @options @command 2>NUL |" or die "Error: List keys command failed.\n";

   155   my @keys;

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

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

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

   159       push @keys, $1;

   160     }

   161   }

   162   close PGP;

   163   return \@keys;

   164 }

   165 

   166 #

   167 # Private

   168 #

   169 

   170 sub CheckKeyRings {

   171   my $self = shift;

   172 

   173   if ($self->DefaultPath) {

   174     unless (-e $self->DefaultPath.'/pubring.pkr') {

   175       die "Error: PGP public keyring does not exist\n";

   176     }

   177     unless (-e $self->DefaultPath.'/secring.skr') {

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

   179     }

   180   }

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

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

   183   }

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

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

   186   }

   187 }

   188 

   189 

   190 1;

   191 

   192 __END__

   193 

   194 =head1 NAME

   195 

   196 Crypt::PGP.pm - A wrapper over Network Associates command line PGP tool

   197 

   198 =head1 DESCRIPTION

   199 

   200 C<Crypt::PGP> is inherited from the abstract base class C<Crypt>, implementing the abstract methods required for PGP encryption, decryption, etc... by calling NAI Inc. PGP command line tool (tested with version 6). For this module to work the PGP executable must have the name C<pgp.exe> and exist in one of the directories defined in the users path.

   201 

   202 =head1 KNOWN BUGS

   203 

   204 None

   205 

   206 =head1 COPYRIGHT

   207 

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

   209  All rights reserved.

   210  This component and the accompanying materials are made available

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

   212  which accompanies this distribution, and is available

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

   214  

   215  Initial Contributors:

   216  Nokia Corporation - initial contribution.

   217  

   218  Contributors:

   219  

   220  Description:

   221  

   222 

   223 =cut