602
|
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
|