OLD | NEW |
(Empty) | |
| 1 package Brackup::Decrypt; |
| 2 |
| 3 use strict; |
| 4 use warnings; |
| 5 use Carp qw(croak); |
| 6 use Brackup::Util qw(slurp tempfile); |
| 7 |
| 8 # Decrypt a dataref into a dataref |
| 9 sub decrypt_data { |
| 10 my ($dataref,%opts) = @_; |
| 11 |
| 12 my $meta = $opts{meta}; |
| 13 |
| 14 # do nothing if the data is not encrypted |
| 15 return $dataref unless ($meta && $meta->{"GPG-Recipient"}); |
| 16 |
| 17 my $dataref_temp = ( (tempfile())[1] || die ); |
| 18 write_to_file($dataref_temp, $dataref); |
| 19 |
| 20 my $decrypted_temp = decrypt_file($dataref_temp,%opts); |
| 21 unlink($dataref_temp); |
| 22 |
| 23 my $data = Brackup::Util::slurp($decrypted_temp); |
| 24 unlink($decrypted_temp); |
| 25 |
| 26 return \$data; |
| 27 } |
| 28 |
| 29 sub write_to_file { |
| 30 my ($file, $ref) = @_; |
| 31 open (my $fh, '>', $file) or die "Failed to open $file for writing: $!\n"; |
| 32 print $fh $$ref; |
| 33 close($fh) or die; |
| 34 die "File is not of the correct size" unless -s $file == length $$ref; |
| 35 return 1; |
| 36 } |
| 37 |
| 38 sub decrypt_file_if_needed { |
| 39 my ($filename) = @_; |
| 40 |
| 41 my $meta = slurp($filename); |
| 42 if ($meta =~ /[\x00-\x08]/) { # silly is-binary heuristic |
| 43 my $new_file = decrypt_file($filename,no_batch => 1); |
| 44 if(defined $new_file) |
| 45 { |
| 46 warn "Decrypted ${filename} to ${new_file}.\n"; |
| 47 #scalar <STDIN>; |
| 48 } |
| 49 return $new_file; |
| 50 } |
| 51 return undef; |
| 52 } |
| 53 |
| 54 # Decrypt a file into a new file |
| 55 # Return the new file's name, or undef. |
| 56 |
| 57 our $warned_about_gpg_agent = 0; |
| 58 |
| 59 sub decrypt_file { |
| 60 my ($encrypted_file,%opts) = @_; |
| 61 |
| 62 my $no_batch = delete $opts{no_batch}; |
| 63 my $meta = delete $opts{meta}; |
| 64 croak("Unknown options: " . join(', ', keys %opts)) if %opts; |
| 65 |
| 66 # find which key we're using to decrypt it |
| 67 if ($meta) { |
| 68 my $rcpt = $meta->{"GPG-Recipient"} or |
| 69 return undef; |
| 70 } |
| 71 |
| 72 unless ($ENV{'GPG_AGENT_INFO'} || |
| 73 @Brackup::GPG_ARGS || |
| 74 $warned_about_gpg_agent++) |
| 75 { |
| 76 my $err = q{ |
| 77 # |
| 78 # WARNING: trying to restore encrypted files, |
| 79 # but $ENV{'GPG_AGENT_INFO'} not present. |
| 80 # Are you running gpg-agent? |
| 81 # |
| 82 }; |
| 83 $err =~ s/^\s+//gm; |
| 84 warn $err; |
| 85 } |
| 86 |
| 87 my $output_temp = ( (tempfile())[1] || die ); |
| 88 |
| 89 my @list = ("gpg", @Brackup::GPG_ARGS, |
| 90 "--use-agent", |
| 91 !$opts{no_batch} ? ("--batch") : (), |
| 92 "--trust-model=always", |
| 93 "--output", $output_temp, |
| 94 "--yes", "--quiet", |
| 95 "--decrypt", $encrypted_file); |
| 96 system(@list) |
| 97 and die "Failed to decrypt with gpg: $!\n"; |
| 98 |
| 99 return $output_temp; |
| 100 } |
| 101 |
| 102 1; |
OLD | NEW |