File Coverage

blib/lib/CTK/Crypt/GPG.pm
Criterion Covered Total %
statement 24 116 20.6
branch 0 60 0.0
condition 0 50 0.0
subroutine 8 12 66.6
pod 4 4 100.0
total 36 242 14.8


line stmt bran cond sub pod time code
1             package CTK::Crypt::GPG; # $Id: GPG.pm 250 2019-05-09 12:09:57Z minus $
2 2     2   734 use strict;
  2         4  
  2         56  
3 2     2   9 use utf8;
  2         3  
  2         10  
4              
5             =encoding utf-8
6              
7             =head1 NAME
8              
9             CTK::Crypt - GPG Crypt backend
10              
11             =head1 VERSION
12              
13             Version 1.00
14              
15             =head1 SYNOPSIS
16              
17             use CTK::Crypt::GPG;
18              
19             my $gpg = new CTK::Crypt::GPG(
20             -gpgbin => "/usr/bin/gpg",
21             -gpghome => "/gpg/homedir",
22             -gpgconf => "/gpg/homedir/gpg.conf",
23             -gpgopts => ["verbose", "yes"],
24             -publickey => "/path/to/public.key",
25             -privatekey => "/path/to/private.key",
26             -password => "passphrase", # Key password
27             -recipient => "anonymous@example.com", # Email, user id, keyid, or keygrip
28             ) or die("Can't create crypter");
29              
30             $gpg->encrypt(
31             -infile => "MyDocument.txt",
32             -outfile=> "MyDocument.txt.asc",
33             -armor => "yes",
34             ) or die( $gpg->error );
35              
36             $gpg->decrypt(
37             -infile => "MyDocument.txt.asc",
38             -outfile=> "MyDocument.txt",
39             ) or die( $gpg->error );
40              
41             =head1 DESCRIPTION
42              
43             GPG Crypt backend
44              
45             See L (GPG4Win - L) for details
46              
47             For start working with this module You need create public and private GPG keys:
48              
49             gpg --full-gen-key
50              
51             Example of interaction (test account):
52              
53             > Anonymous
54             > anonymous@example.com
55             > Password: test
56             < 58E79B320D135DEE
57             < ADF81A296AAC9503A6135F258E79B320D135DEE
58              
59             For show list of available keys run:
60              
61             gpg -k
62             gpg -K
63              
64             For export keys run:
65              
66             gpg --export -a -o mypublic.key "anonymous@example.com"
67             gpg --export-secret-keys --batch --pinentry-mode loopback --passphrase "test" -a -o myprivate.key "anonymous@example.com"
68              
69             =head2 new
70              
71             my $gpg = new CTK::Crypt::GPG(
72             -gpgbin => "/usr/bin/gpg",
73             -gpghome => "/gpg/homedir",
74             -gpgconf => "/gpg/homedir/gpg.conf",
75             -gpgopts => ["verbose", "yes"],
76             -publickey => "/path/to/public.key",
77             -privatekey => "/path/to/private.key",
78             -password => "passphrase", # Key password
79             -recipient => "anonymous@example.com", # Email, user id, keyid, or keygrip
80             ) or die("Can't create crypter");
81              
82             =over 8
83              
84             =item B
85              
86             GPG program
87              
88             For example: "/usr/bin/gpg"
89              
90             Default: gpg from PATH
91              
92             =item B, B
93              
94             GPG homedir
95              
96             For example: "/gpg/homedir"
97              
98             Default: /tmp/gpgXXXXX
99              
100             =item B
101              
102             Path to GPG config file (for options storing)
103              
104             For example: "/gpg/homedir/gpg.conf"
105              
106             Default: /tmp/gpgXXXXX/gpg.conf
107              
108             =item B, B
109              
110             GPG default options
111              
112             For example: ["verbose", "yes"]
113              
114             Default: ["verbose", "yes"],
115              
116             =item B, B, B
117              
118             Public key path
119              
120             For example: "/path/to/public.key"
121              
122             =item B, B, B, B, B
123              
124             Private key path
125              
126             For example: "/path/to/private.key"
127              
128             =item B, B, B, B
129              
130             Private key password
131              
132             For example: "passphrase"
133              
134             =item B, B, B, B, B
135              
136             Email, user id, keyid, or keygrip
137              
138             For example: "anonymous@example.com",
139              
140             =back
141              
142             =head2 decrypt
143              
144             $gpg->decrypt(
145             -infile => "MyDocument.txt.asc",
146             -outfile=> "MyDocument.txt",
147             ) or die( $gpg->error );
148              
149             PGP file decrypting
150              
151             =over 8
152              
153             =item B, B, B, B, B
154              
155             Source file (encrypted file)
156              
157             =item B, B, B, B, B
158              
159             Target file
160              
161             =back
162              
163             =head2 encrypt
164              
165             $gpg->encrypt(
166             -infile => "MyDocument.txt",
167             -outfile=> "MyDocument.txt.asc",
168             -armor => "yes",
169             ) or die( $gpg->error );
170              
171             PGP file encrypting
172              
173             =over 8
174              
175             =item B, B, B, B, B
176              
177             Source file
178              
179             =item B, B, B, B, B
180              
181             Target file (encrypted file)
182              
183             =item B, B
184              
185             Enable armor-mode (as text output): yes, on, 1, enable
186              
187             For example: "yes"
188              
189             Default: "no"
190              
191             =back
192              
193             =head2 error
194              
195             print $gpg->error;
196              
197             Returns error string
198              
199             =head1 HISTORY
200              
201             See C file
202              
203             =head1 DEPENDENCIES
204              
205             L, L
206              
207             =head1 TO DO
208              
209             See C file
210              
211             =head1 BUGS
212              
213             * none noted
214              
215             =head1 SEE ALSO
216              
217             L, L, L
218              
219             =head1 AUTHOR
220              
221             Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE
222              
223             =head1 COPYRIGHT
224              
225             Copyright (C) 1998-2019 D&D Corporation. All Rights Reserved
226              
227             =head1 LICENSE
228              
229             This program is free software; you can redistribute it and/or
230             modify it under the same terms as Perl itself.
231              
232             See C file and L
233              
234             =cut
235              
236 2     2   114 use vars qw/$VERSION/;
  2         5  
  2         96  
237             $VERSION = '1.00';
238              
239 2     2   12 use Carp;
  2         3  
  2         119  
240 2     2   12 use CTK::Util qw(:API :FORMAT :UTIL :FILE );
  2         4  
  2         914  
241 2     2   1539 use File::Temp qw();
  2         17747  
  2         52  
242 2     2   17 use File::Spec;
  2         4  
  2         82  
243              
244             use constant {
245             # GPG (GNUPG)
246 2         2769 GPGBIN => 'gpg',
247             GPGCONF => 'gpg.conf',
248             GPGOPTS => ["verbose", "yes"],
249             GPGEXT => ".asc",
250 2     2   11 };
  2         4  
251              
252             sub new {
253 0     0 1   my $class = shift;
254 0 0         my ($gpgbin, $gpghome, $gpgconf, $gpgopts, $pubkey, $seckey, $pass, $recipient) =
255             read_attributes([
256             ['GPG','GPGBIN','BIN','CMD','COMMAND'],
257             ['GPGHOME','GPGDIR','DIRGPG','HOMEGPG','HOMEDIR'],
258             ['GPGCONF','CONFIG','CONF'],
259             ['GPGOPTS','GPGOPTIONS','OPTIONS','OPTS'],
260             ['PUBLIC','PUBLICKEY','PUP','PUBKEY','PUBRING'],
261             ['PRIVATE','PRIV','PRIVATEKEY','SEC','SECKEY','SECRETKEY','PRIVKEY','PRIVRING','SECRING'],
262             ['PASS','PASSWORD','PASSPHRASE','PASSW'],
263             ['RECIPIENT','KEYID','ID','USER','KEYGRIP'],
264             ], @_) if defined $_[0];
265 0   0       $gpgbin ||= which(GPGBIN);
266 0 0         my $tmpdir = File::Temp->newdir(TEMPLATE => 'gpgXXXXX', TMPDIR => 1) unless $gpghome;
267 0 0         if ($gpghome) {
268 0 0         preparedir($gpghome, 0700) or do {
269 0           carp(sprintf("Can't prepare dir: %s", $gpghome));
270 0           return undef;
271             };
272             } else {
273 0           $gpghome = $tmpdir->dirname;
274             }
275 0   0       $gpgconf ||= File::Spec->catfile($gpghome, GPGCONF);
276 0   0       $gpgopts ||= GPGOPTS;
277 0           my @opts = ('# Do not edit this file');
278 0 0         if (ref($gpgopts) eq 'ARRAY') { push @opts, @$gpgopts }
  0            
279 0           else { push @opts, $gpgopts }
280 0 0         fsave($gpgconf, join("\n", @opts)) or do {
281 0           carp(sprintf("Can't save GPG conffile: %s", $gpgconf));
282 0           return undef;
283             };
284 0           eval { chmod $gpgconf, 0600 };
  0            
285              
286             # Get version
287 0           my @cmd = ();
288 0           push(@cmd, $gpgbin, "--homedir", $gpghome, "--options", $gpgconf, "--version");
289 0           my $err = "";
290 0           my $out = execute( [@cmd], undef, \$err, 1 );
291 0 0 0       my $version = $out && $out =~ /gpg.+?([0-9\.]+)\s*$/m ? $1 : 0;
292 0 0         if ($version) {
293 0           my $tv = pack("U*",split(/\./, $version));
294 0 0         unless ($tv gt pack("U*", 2, 0)) {
295 0           carp(sprintf("Incorrect GPG version v%vd. Require v2.0.0 and above", $tv));
296 0           return undef;
297             }
298             }
299 0 0         $out = "" if $version;
300              
301             # Import keys
302 0           foreach my $key ($pubkey, $seckey) {
303 0 0         next unless $key;
304 0 0         next unless length($key);
305 0 0         next unless -e $key;
306 0           @cmd = ($gpgbin, "--homedir", $gpghome, "--options", $gpgconf);
307 0 0 0       push @cmd, "--pinentry-mode", "loopback", "--passphrase", $pass if $pass && length($pass);
308 0           push @cmd, "--import", $key;
309 0           $out = execute( [@cmd], undef, \$err, 1 );
310 0 0         unless ($recipient) {
311 0           foreach my $t ($out, $err) {
312 0 0         next unless $t;
313 0 0         $recipient = $1 if $t =~ /key\s+([a-z0-9]+)\:/im;
314 0 0         last if $recipient;
315             }
316             }
317             }
318              
319 0 0         my $self = bless {
320             gpgbin => $gpgbin,
321             homedir => $gpghome,
322             tempdir => $tmpdir,
323             gpgconf => $gpgconf,
324             options => [@opts],
325             cmd => join(" ", @cmd),
326             stdout => $out,
327             stderr => $err,
328             version => $version,
329             pubkey => $pubkey,
330             seckey => $seckey,
331             password => $pass,
332             recipient => $recipient,
333             error => $recipient ? "" : "Incorrect recipient!",
334             }, $class;
335 0           return $self;
336             }
337              
338             sub encrypt {
339 0     0 1   my $self = shift;
340 0 0         my ($inf, $outf, $armor) =
341             read_attributes([
342             ['IN','FILEIN','INPUT','FILESRC','SRC','INFILE'],
343             ['OUT','FILEOUT','OUTPUT','FILEDST','DST','OUTFILE'],
344             ['ARMOR','ASCII'],
345             ], @_) if defined $_[0];
346 0           $self->{error} = "";
347 0           $armor = isTrueFlag($armor);
348 0           my $recipient = $self->{recipient};
349 0 0         return 0 unless $recipient;
350 0 0 0       unless (defined($inf) && length($inf) && -e $inf) {
      0        
351 0   0       $self->{error} = sprintf("File not found: %s", $inf // "");
352 0           return 0;
353             }
354 0 0 0       $outf = sprintf("%s%s", $inf, GPGEXT) unless defined($outf) && length($outf);
355              
356 0           my @cmd = ($self->{gpgbin}, "--homedir", $self->{homedir}, "--options", $self->{gpgconf}, "--always-trust");
357 0           push(@cmd, "-r", $recipient);
358 0 0         push(@cmd, "-a") if $armor;
359 0           push(@cmd, "-o", $outf);
360 0           push(@cmd, "-e", $inf);
361 0           $self->{cmd} = join(" ", @cmd);
362 0           my $err = "";
363 0           my $out = execute( [@cmd], undef, \$err, 1 );
364 0   0       $self->{stdout} = $out // '';
365 0   0       $self->{stderr} = $err // '';
366              
367             # Return
368 0 0         return 1 if -e $outf;
369 0   0       $self->{error} = sprintf("Can't encrypt file: %s\n%s", $outf, $err // "");
370 0           return 0;
371             }
372             sub decrypt {
373 0     0 1   my $self = shift;
374 0 0         my ($inf, $outf) =
375             read_attributes([
376             ['IN','FILEIN','INPUT','FILESRC','SRC','INFILE'],
377             ['OUT','FILEOUT','OUTPUT','FILEDST','DST','OUTFILE'],
378             ], @_) if defined $_[0];
379 0           $self->{error} = "";
380 0 0 0       unless (defined($inf) && length($inf) && -e $inf) {
      0        
381 0   0       $self->{error} = sprintf("File not found: %s", $inf // "");
382 0           return 0;
383             }
384 0 0 0       unless (defined($outf) && length($outf)) {
385 0           $self->{error} = "Incorrect output file";
386 0           return 0;
387             }
388              
389 0           my @cmd = ($self->{gpgbin}, "--homedir", $self->{homedir}, "--options", $self->{gpgconf}, "--always-trust");
390 0 0         push(@cmd, "--pinentry-mode", "loopback", "--passphrase", $self->{password}) if $self->{password};
391 0           push(@cmd, "-o", $outf);
392 0           push(@cmd, "-d", $inf);
393 0           $self->{cmd} = join(" ", @cmd);
394 0           my $err = "";
395 0           my $out = execute( [@cmd], undef, \$err, 1 );
396 0   0       $self->{stdout} = $out // '';
397 0   0       $self->{stderr} = $err // '';
398              
399             # Return
400 0 0         return 1 if -e $outf;
401 0   0       $self->{error} = sprintf("Can't decrypt file: %s\n%s", $outf, $err // "");
402 0           return 0;
403             }
404             sub error {
405 0     0 1   my $self = shift;
406 0   0       return $self->{error} // '';
407             }
408              
409              
410             1;
411             __END__