File Coverage

blib/lib/App/Tel/Passwd/Pass.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package App::Tel::Passwd::Pass;
2              
3             =head1 name
4              
5             App::Tel::Passwd::Pass - Tel Passwd module for Pass
6              
7             =cut
8              
9 1     1   752 use strict;
  1         9  
  1         24  
10 1     1   4 use warnings;
  1         2  
  1         23  
11 1     1   877 use IO::Handle;
  1         7246  
  1         39  
12 1     1   952 use IO::File;
  1         2016  
  1         130  
13 1     1   1340 use GnuPG::Interface;
  0            
  0            
14             use Carp;
15              
16             our $_debug = 0;
17              
18             =head1 METHODS
19              
20             A note on private subroutines in this file: Anything with two underscores
21             preceeding it is a private non-class sub.
22              
23             =head2 new
24              
25             my $passwd = App::Tel::Passwd::Pass->new( file => $filename, passwd => $password );
26              
27             Initializes a new passwdobject. This will return a Passwd::Pass Object if the module
28             exists and return undef if it doesn't.
29              
30             Requires filename and password for the file.
31              
32             =cut
33              
34             sub new {
35             my $proto = shift;
36             my $class = ref($proto) || $proto;
37             my %args = @_;
38              
39             my $self = { debug => $_debug,
40             gpg => '/usr/bin/gpg',
41             %args
42             };
43             $self->{file} = __find_password_store($self->{file});
44              
45             if (! -x $self->{gpg}) {
46             croak "$class: gpg executable not found.";
47             }
48              
49             if (!defined($self->{file}) || ! -r $self->{file} ) {
50             $self->{file} ||= '<undefined>';
51             croak "$class: Can't read file $self->{file}";
52             }
53              
54             bless( $self, $class );
55             $self->{pass} = $self->_run($self->{gpg}, $self->{file}, $self->{passwd});
56             return $self;
57             }
58              
59             sub _run {
60             my ($self, $call, $file, $passphrase) = @_;
61              
62             my $gnupg = GnuPG::Interface->new();
63             $gnupg->call($call);
64             $gnupg->options->no_greeting(1);
65             $gnupg->options->quiet(1);
66             $gnupg->options->batch(1);
67              
68             # This time we'll catch the standard error for our perusing
69             # as well as passing in the passphrase manually
70             # as well as the status information given by GnuPG
71             my ( $input, $output, $error, $passphrase_fh, $status_fh )
72             = ( IO::Handle->new(),
73             IO::Handle->new(),
74             IO::Handle->new(),
75             IO::Handle->new(),
76             IO::Handle->new(),
77             );
78              
79             my $handles = GnuPG::Handles->new( stdin => $input,
80             stdout => $output,
81             stderr => $error,
82             passphrase => $passphrase_fh,
83             status => $status_fh,
84             );
85              
86             # this time we'll also demonstrate decrypting
87             # a file written to disk
88             # Make sure you "use IO::File" if you use this module!
89             my $cipher_file = IO::File->new( $file );
90              
91             # this sets up the communication
92             my $pid = $gnupg->decrypt( handles => $handles );
93              
94             # This passes in the passphrase
95             print $passphrase_fh $passphrase;
96             close $passphrase_fh;
97              
98             # this passes in the plaintext
99             print $input $_ while <$cipher_file>;
100              
101             # this closes the communication channel,
102             # indicating we are done
103             close $input;
104             close $cipher_file;
105              
106             my @plaintext = <$output>; # reading the output
107             my @error_output = <$error>; # reading the error
108             my @status_info = <$status_fh>; # read the status info
109             chomp(@plaintext);
110              
111             for (@status_info) {
112             croak @error_output if (/BAD_PASSPHRASE|DECRYPTION_FAILED/);
113             }
114              
115             # clean up...
116             close $output;
117             close $error;
118             close $status_fh;
119              
120             waitpid $pid, 0; # clean up the finished GnuPG process
121             return $plaintext[0];
122             }
123              
124             sub __find_password_store {
125             my $file = shift;
126              
127             return if (!defined($file));
128             if ($file !~ /.gpg$/) {
129             $file .= '.gpg';
130             }
131             # if it's an absolute path then treat it as-is.
132             return $file if ($file =~ m#^/#);
133              
134             if (defined($ENV{PASSWORD_STORE_DIR})) {
135             return "$ENV{PASSWORD_STORE_DIR}/$file";
136             }
137              
138             return "$ENV{HOME}/.password-store/$file";
139             }
140              
141             =head2 passwd
142              
143             $passwd->passwd($entry);
144              
145             This requires a password for the router. It will return a blank line if not
146             found.
147              
148             =cut
149              
150             sub passwd {
151             $_[0]->{pass};
152             }
153              
154             1;