File Coverage

blib/lib/Metabrik/Crypto/Gpg.pm
Criterion Covered Total %
statement 9 220 4.0
branch 0 66 0.0
condition 0 6 0.0
subroutine 3 16 18.7
pod 2 13 15.3
total 14 321 4.3


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # crypto::gpg Brik
5             #
6             package Metabrik::Crypto::Gpg;
7 1     1   714 use strict;
  1         3  
  1         30  
8 1     1   6 use warnings;
  1         2  
  1         27  
9              
10 1     1   8 use base qw(Metabrik::System::Package);
  1         2  
  1         484  
11              
12             sub brik_properties {
13             return {
14             revision => '$Revision$',
15             tags => [ qw(unstable pgp gnupg) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             public_keyring => [ qw(file.gpg) ],
20             secret_keyring => [ qw(file.gpg) ],
21             passphrase => [ qw(passphrase) ],
22             type_key => [ qw(RSA|DSA) ],
23             type_subkey => [ qw(RSA|ELG-E) ],
24             length_key => [ qw(1024|2048|3072|4096) ],
25             length_subkey => [ qw(1024|2048|3072|4096) ],
26             expire_key => [ qw(count_y|0) ],
27             _gnupg => [ qw(INTERNAL) ],
28             },
29             attributes_default => {
30             public_keyring => $ENV{HOME}."/.gnupg/pubring.gpg",
31 0     0 1   secret_keyring => $ENV{HOME}."/.gnupg/secring.gpg",
32             type_key => 'DSA',
33             type_subkey => 'ELG-E',
34             length_key => 2048,
35             length_subkey => 3072,
36             expire_key => '5y',
37             },
38             commands => {
39             install => [ ], # Inherited
40             list_public_keys => [ ],
41             list_secret_keys => [ ],
42             get_public_keys => [ qw(keys_list) ],
43             get_secret_keys => [ qw(keys_list) ],
44             import_keys => [ qw(file) ],
45             delete_key => [ qw(key_id) ],
46             generate_key => [ qw(email description|OPTIONAL comment|OPTIONAL) ],
47             encrypt => [ qw($data email_recipient_list) ],
48             decrypt => [ qw($data) ],
49             decrypt_from_file => [ qw(file) ],
50             export_keys => [ qw(key_id) ],
51             },
52             require_modules => {
53             'IO::Handle' => [ ],
54             'GnuPG::Interface' => [ ],
55             'GnuPG::Handles' => [ ],
56             'Metabrik::File::Text' => [ ],
57             'Metabrik::String::Random' => [ ],
58             'Metabrik::String::Password' => [ ],
59             },
60             require_binaries => {
61             'rngd' => [ ],
62             },
63             need_packages => {
64             ubuntu => [ qw(rng-tools) ],
65             debian => [ qw(rng-tools) ],
66             kali => [ qw(rng-tools) ],
67             },
68             };
69             }
70              
71             sub brik_init {
72 0     0 1   my $self = shift;
73              
74 0           my $gnupg = GnuPG::Interface->new;
75 0 0         if (! $gnupg) {
76 0           return $self->log->error("brik_init: GnuPG::Interface failed");
77             }
78 0           $gnupg->options->hash_init(armor => 1);
79              
80 0           $self->_gnupg($gnupg);
81              
82 0           return $self->SUPER::brik_init;
83             }
84              
85             sub generate_key {
86 0     0 0   my $self = shift;
87 0           my ($email, $description, $comment) = @_;
88              
89 0 0         $self->brik_help_run_undef_arg('generate_key', $email) or return;
90              
91 0           my $passphrase = $self->passphrase;
92 0 0         $self->brik_help_set_undef_arg('passphrase', $passphrase) or return;
93              
94 0   0       $description ||= $email;
95 0   0       $comment ||= $email;
96              
97 0           my $type_key = $self->type_key;
98 0           my $type_subkey = $self->type_subkey;
99 0           my $length_key = $self->length_key;
100 0           my $length_subkey = $self->length_subkey;
101 0           my $expire_key = $self->expire_key;
102              
103 0 0         my $sr = Metabrik::String::Random->new_from_brik_init($self) or return;
104 0 0         my $filename = $sr->filename
105             or return $self->log->error("generate_key: filename failed");
106              
107 0 0         my $ft = Metabrik::File::Text->new_from_brik_init($self) or return;
108 0           $ft->output($filename);
109              
110             # If key is RSA, subkey will be RSA.
111             # If key is DSA, subkey will be Elgamal.
112             #my $subkey = $type_key;
113             #if ($type_key eq 'DSA') {
114             #$subkey = 'Elgamal';
115             #}
116              
117 0           $ft->write([
118             '%echo Generating a standard key', "\n",
119             "Key-Type: $type_key", "\n",
120             "Key-Length: $length_key", "\n",
121             "Subkey-Type: $type_subkey", "\n",
122             "Subkey-Length: $length_subkey", "\n",
123             "Name-Real: $description", "\n",
124             "Name-Email: $email", "\n",
125             "Expire-Date: $expire_key", "\n",
126             "Passphrase: $passphrase", "\n",
127             '#%pubring foo.pub', "\n",
128             '#%secring foo.sec', "\n",
129             '%commit', "\n",
130             '%echo done', "\n",
131             ''
132             ]);
133              
134 0           my $gnupg = $self->_gnupg;
135              
136 0           my $stdin = IO::Handle->new;
137 0           my $stdout = IO::Handle->new;
138 0           my $stderr = IO::Handle->new;
139 0           my $handles = GnuPG::Handles->new(
140             stdin => $stdin,
141             stdout => $stdout,
142             stderr => $stderr,
143             );
144              
145 0           my $pid = $gnupg->wrap_call(
146             commands => [ qw(--batch --gen-key) ],
147             command_args => [ $filename ],
148             handles => $handles,
149             );
150            
151 0           my @out = <$stdout>;
152 0           close($stdout);
153 0           my @err = <$stderr>;
154 0           close($stderr);
155 0           waitpid($pid, 0);
156              
157 0           unlink($filename);
158              
159 0           for my $this (@err) {
160 0           chomp($this);
161 0           $self->log->verbose("generate_key: $this");
162             }
163              
164 0           return \@out;
165             }
166              
167             sub delete_key {
168 0     0 0   my $self = shift;
169 0           my ($id) = @_;
170              
171 0 0         $self->brik_help_run_undef_arg('delete_key', $id) or return;
172              
173 0           my $gnupg = $self->_gnupg;
174              
175 0           my $stdin = IO::Handle->new;
176 0           my $stdout = IO::Handle->new;
177 0           my $stderr = IO::Handle->new;
178 0           my $handles = GnuPG::Handles->new(
179             stdin => $stdin,
180             stdout => $stdout,
181             stderr => $stderr,
182             );
183              
184 0           my $pid = $gnupg->wrap_call(
185             commands => [ qw(--delete-secret-and-public-key) ],
186             command_args => [ $id ],
187             handles => $handles,
188             );
189              
190 0           my @lines = ();
191 0           while (<$stdout>) {
192 0           chomp;
193 0           push @lines, $_;
194             }
195 0           close($stdout);
196 0           waitpid($pid, 0);
197              
198 0           return \@lines;
199             }
200              
201             sub import_keys {
202 0     0 0   my $self = shift;
203 0           my ($file) = @_;
204              
205 0 0         $self->brik_help_run_undef_arg('import_keys', $file) or return;
206              
207 0           my $gnupg = $self->_gnupg;
208              
209 0           my $stdin = IO::Handle->new;
210 0           my $stdout = IO::Handle->new;
211 0           my $stderr = IO::Handle->new;
212 0           my $handles = GnuPG::Handles->new(
213             stdin => $stdin,
214             stdout => $stdout,
215             stderr => $stderr,
216             );
217              
218 0           my $pid = $gnupg->import_keys(handles => $handles);
219 0 0         if (! $pid) {
220 0           return $self->log->error("import_keys: import_keys failed");
221             }
222              
223 0 0         my $ft = Metabrik::File::Text->new_from_brik_init($self) or return;
224 0 0         my $data = $ft->read($file)
225             or return $self->log->error("import_keys: read failed");
226              
227 0           print $stdin $data;
228 0           close($stdin);
229              
230 0           my @lines = ();
231 0           while (<$stdout>) {
232 0           chomp;
233 0           push @lines, $_;
234             }
235 0           close($stdout);
236 0           waitpid($pid, 0);
237              
238 0           return \@lines;
239              
240             }
241              
242             sub list_public_keys {
243 0     0 0   my $self = shift;
244              
245 0           my $gnupg = $self->_gnupg;
246              
247 0           my $stdin = IO::Handle->new;
248 0           my $stdout = IO::Handle->new;
249 0           my $stderr = IO::Handle->new;
250 0           my $handles = GnuPG::Handles->new(
251             stdin => $stdin,
252             stdout => $stdout,
253             stderr => $stderr,
254             );
255              
256 0           my $pid = $gnupg->list_public_keys(handles => $handles);
257 0 0         if (! $pid) {
258 0           return $self->log->error("list_public_keys: list_public_keys failed");
259             }
260              
261 0           my @lines = ();
262 0           while (<$stdout>) {
263 0           chomp;
264 0           push @lines, $_;
265             }
266 0           close($stdout);
267 0           waitpid($pid, 0);
268              
269 0           return \@lines;
270             }
271              
272             sub get_public_keys {
273 0     0 0   my $self = shift;
274 0           my ($keys) = @_;
275              
276 0 0         $self->brik_help_run_undef_arg('get_public_keys', $keys) or return;
277 0 0         $self->brik_help_run_invalid_arg('get_public_keys', $keys, 'ARRAY') or return;
278              
279 0           my $gnupg = $self->_gnupg;
280              
281 0           my @keys = $gnupg->get_public_keys_with_sigs(@$keys);
282              
283 0           return \@keys;
284             }
285              
286             sub list_secret_keys {
287 0     0 0   my $self = shift;
288              
289 0           my $gnupg = $self->_gnupg;
290              
291 0           my $stdin = IO::Handle->new;
292 0           my $stdout = IO::Handle->new;
293 0           my $stderr = IO::Handle->new;
294 0           my $handles = GnuPG::Handles->new(
295             stdin => $stdin,
296             stdout => $stdout,
297             stderr => $stderr,
298             );
299              
300 0           my $pid = $gnupg->list_secret_keys(handles => $handles);
301 0 0         if (! $pid) {
302 0           return $self->log->error("list_secret_keys: list_secret_keys failed");
303             }
304              
305 0           my @lines = ();
306 0           while (<$stdout>) {
307 0           chomp;
308 0           push @lines, $_;
309             }
310 0           close($stdout);
311 0           waitpid($pid, 0);
312              
313 0           return \@lines;
314             }
315              
316             sub get_secret_keys {
317 0     0 0   my $self = shift;
318 0           my ($keys) = @_;
319              
320 0 0         $self->brik_help_run_undef_arg('get_secret_keys', $keys) or return;
321 0 0         $self->brik_help_run_invalid_arg('get_secret_keys', $keys, 'ARRAY') or return;
322              
323 0           my $gnupg = $self->_gnupg;
324              
325             # XXX: does not work
326             #my $saved = $gnupg->options->copy;
327              
328 0           my @keys = $gnupg->get_secret_keys(@$keys);
329              
330             #$gnupg->options($saved);
331              
332 0           return \@keys;
333             }
334              
335             sub encrypt {
336 0     0 0   my $self = shift;
337 0           my ($data, $recipient_list) = @_;
338              
339 0 0         $self->brik_help_run_undef_arg('encrypt', $data) or return;
340 0 0         $self->brik_help_run_undef_arg('encrypt', $recipient_list) or return;
341 0 0         $self->brik_help_run_invalid_arg('encrypt', $recipient_list, 'ARRAY') or return;
342              
343 0           my @data = ();
344 0 0         if (ref($data) eq 'ARRAY') {
345 0           for my $this (@$data) {
346 0           push @data, $this;
347             }
348             }
349             else {
350 0 0         if (ref($data) eq 'SCALAR') {
351 0           push @data, $$data;
352             }
353             else {
354 0           push @data, $data;
355             }
356             }
357              
358 0           my $gnupg = $self->_gnupg;
359              
360 0           my $stdin = IO::Handle->new;
361 0           my $stdout = IO::Handle->new;
362 0           my $stderr = IO::Handle->new;
363 0           my $handles = GnuPG::Handles->new(
364             stdin => $stdin,
365             stdout => $stdout,
366             stderr => $stderr,
367             );
368              
369 0           for my $email (@$recipient_list) {
370 0           $gnupg->options->push_recipients($email);
371             }
372              
373 0           my $pid = $gnupg->encrypt(handles => $handles);
374 0           print $stdin @data;
375 0           close($stdin);
376              
377 0           my @lines = ();
378 0           while (<$stdout>) {
379 0           chomp;
380 0           push @lines, $_;
381             }
382 0           close($stdout);
383 0           waitpid($pid, 0);
384              
385 0           return \@lines;
386             }
387              
388             sub decrypt {
389 0     0 0   my $self = shift;
390 0           my ($data) = @_;
391              
392 0 0         $self->brik_help_run_undef_arg('decrypt', $data) or return;
393              
394 0 0         my $sp = Metabrik::String::Password->new_from_brik_init($self) or return;
395              
396 0           my $passphrase = $sp->prompt;
397 0 0         if (! defined($passphrase)) {
398 0           return $self->log->error("decrypt: invalid passphrase entered");
399             }
400              
401 0           my @data = ();
402 0 0         if (ref($data) eq 'ARRAY') {
403 0           for my $this (@$data) {
404 0           push @data, $this;
405             }
406             }
407             else {
408 0 0         if (ref($data) eq 'SCALAR') {
409 0           push @data, $$data;
410             }
411             else {
412 0           push @data, $data;
413             }
414             }
415              
416 0           my $gnupg = $self->_gnupg;
417              
418 0           my $stdin = IO::Handle->new;
419 0           my $stdout = IO::Handle->new;
420 0           my $stderr = IO::Handle->new;
421 0           my $stdpass = IO::Handle->new;
422 0           my $handles = GnuPG::Handles->new(
423             stdin => $stdin,
424             stdout => $stdout,
425             stderr => $stderr,
426             passphrase => $stdpass,
427             );
428              
429 0           my $pid = $gnupg->decrypt(handles => $handles);
430              
431             # Print passphrase
432 0           print $stdpass $passphrase;
433 0           close($stdpass);
434              
435             # Then data to decrypt
436 0           print $stdin @data;
437 0           close($stdin);
438              
439 0           my @lines = ();
440 0           while (<$stdout>) {
441 0           chomp;
442 0           push @lines, $_;
443             }
444 0           close($stdout);
445 0           waitpid($pid, 0);
446              
447 0           return \@lines;
448             }
449              
450             sub decrypt_from_file {
451 0     0 0   my $self = shift;
452 0           my ($file) = @_;
453              
454 0 0         $self->brik_help_run_undef_arg('decrypt_from_file', $file) or return;
455 0 0         $self->brik_help_run_file_not_found('decrypt_from_file', $file) or return;
456              
457 0 0         my $ft = Metabrik::File::Text->new_from_brik_init($self) or return;
458 0 0         my $data = $ft->read($file) or return;
459              
460 0           return $self->decrypt($data);
461             }
462              
463             sub export_keys {
464 0     0 0   my $self = shift;
465 0           my ($key_id) = @_;
466              
467 0 0         $self->brik_help_run_undef_arg('export_keys', $key_id) or return;
468              
469 0           my $gnupg = $self->_gnupg;
470              
471 0           my $stdin = IO::Handle->new;
472 0           my $stdout = IO::Handle->new;
473 0           my $stderr = IO::Handle->new;
474 0           my $handles = GnuPG::Handles->new(
475             stdin => $stdin,
476             stdout => $stdout,
477             stderr => $stderr,
478             );
479              
480 0           my $pid = $gnupg->export_keys(
481             handles => $handles,
482             command_args => $key_id,
483             );
484 0 0         if (! $pid) {
485 0           return $self->log->error("export_keys: export_keys failed");
486             }
487              
488 0           my @lines = ();
489 0           while (<$stdout>) {
490 0           chomp;
491 0           push @lines, $_;
492             }
493 0           close($stdout);
494 0           waitpid($pid, 0);
495              
496 0           return \@lines;
497             }
498              
499             1;
500              
501             __END__