File Coverage

blib/lib/Finance/Bank/Cahoot/CredentialsProvider/CryptFile.pm
Criterion Covered Total %
statement 78 82 95.1
branch 23 24 95.8
condition n/a
subroutine 16 16 100.0
pod 1 1 100.0
total 118 123 95.9


line stmt bran cond sub pod time code
1             # Copyright (c) 2007 Jon Connell.
2             # All Rights Reserved.
3             #
4             # This program is free software; you can redistribute it and/or
5             # modify it under the same terms as Perl itself.
6              
7             package Finance::Bank::Cahoot::CredentialsProvider::CryptFile;
8 1     1   1022 use base qw(Finance::Bank::Cahoot::CredentialsProvider);
  1         2  
  1         697  
9              
10 1     1   6 use strict;
  1         1  
  1         28  
11 1     1   6 use warnings 'all';
  1         2  
  1         85  
12 1     1   7 use vars qw($VERSION);
  1         2  
  1         75  
13              
14             $VERSION = '1.07';
15              
16 1     1   5 use Carp qw(croak);
  1         2  
  1         38  
17 1     1   977 use Crypt::CBC;
  1         4211  
  1         37  
18 1     1   7 use English '-no_match_vars';
  1         2  
  1         6  
19 1     1   1558 use File::Slurp qw(slurp);
  1         12868  
  1         79  
20 1     1   852 use IO::File;
  1         10063  
  1         696  
21              
22             sub _init
23             {
24 9     9   15 my ($self, $options) = @_;
25              
26 9 100       35 croak 'No key provided' if not defined $options->{key};
27 8         69 my $cipher = Crypt::CBC->new(-key => $options->{key},
28             -cipher => 'DES_PP');
29 8         12799 my $keyfile = $options->{keyfile};
30 8 100       26 $keyfile = $ENV{HOME}.'/.cahoot' if not defined $keyfile;
31              
32 8 100       98 if (-e $keyfile) {
33 2 50       13 my $fh = new IO::File $keyfile, 'r'
34             or croak "Can't open $keyfile for reading: $OS_ERROR";
35 2         166 my $data = slurp $fh;
36 2         345 my $plaintext = $cipher->decrypt($data);
37 1         860 for (split /\n/, $plaintext) {
38 3         6 my ($k, $v) = split /\t/;
39 3         13 $self->{$k} = $v;
40             }
41 1         4 $fh->close;
42             }
43              
44 7 100       35 if (defined $options->{fallback}) {
45 5         12 my $fallback_class = 'Finance::Bank::Cahoot::CredentialsProvider::'.$options->{fallback};
46 1     1   458 eval "use $fallback_class"; ## no critic
  0     1   0  
  0     1   0  
  1     1   321  
  0     1   0  
  0         0  
  1         731  
  1         3  
  1         14  
  1         10  
  1         1  
  1         20  
  1         8  
  1         2  
  1         19  
  5         424  
47 5 100       59 croak 'Invalid fallback provider '.$options->{fallback} if $EVAL_ERROR;
48              
49 3         29 my $fallback_args = { credentials => $self->{_credentials},
50             options => $options->{fallback_options} };
51 3         339 eval "\$self->{_fallback} = $fallback_class->new(\%{\$fallback_args})"; ## no critic
52 3 100       934 croak 'Fallback provider '.$options->{fallback}.' failed to initialise' if $EVAL_ERROR;
53             }
54              
55 4         8 my $do_update = 0;
56 4         6 foreach my $credential (@{$self->{_credentials}}) {
  4         14  
57 10 100       25 if (not defined $self->{$credential}) {
58 7 100       30 croak 'No fallback provider given and '.$credential.' is not in keyfile'
59             if not defined $self->{_fallback};
60 6         20 $self->{$credential} = $self->{_fallback}->$credential;
61 6         12 $do_update = 1;
62             }
63             }
64              
65 3 100       8 if ($do_update) {
66 2 100       13 my $fh = new IO::File $keyfile, 'w'
67             or croak "Can't open $keyfile for writing: $OS_ERROR";
68              
69 1         165 my @ciphers;
70 1         3 foreach my $credential (@{$self->{_credentials}}) {
  1         4  
71 3         9 push @ciphers, $credential."\t".$self->{$credential};
72             }
73 1         8 my $ciphertext = $cipher->encrypt(join "\n", @ciphers);
74 1         1913 $fh->print($ciphertext);
75 1         13 $fh->close;
76             }
77 2         65 return $self;
78             }
79              
80             sub get
81             {
82 9     9 1 14 my ($self, $credential, $offset) = @_;
83 9 100       35 return substr $self->{$credential}, $offset, 1
84             if defined $offset;
85 5         27 return $self->{$credential};
86             }
87              
88             1;
89              
90             __END__