File Coverage

lib/App/Tel/Passwd.pm
Criterion Covered Total %
statement 39 65 60.0
branch 6 18 44.4
condition 0 2 0.0
subroutine 9 11 81.8
pod 4 4 100.0
total 58 100 60.0


line stmt bran cond sub pod time code
1             package App::Tel::Passwd;
2              
3 12     12   278446 use strict;
  12         13  
  12         304  
4 12     12   36 use warnings;
  12         15  
  12         257  
5 12     12   38 use Carp;
  12         12  
  12         586  
6 12     12   2130 use Module::Load;
  12         3878  
  12         52  
7 12     12   2586 use POSIX qw(); # For isatty
  12         21962  
  12         196  
8 12     12   2178 use IO::Stty;
  12         18017  
  12         1250  
9             require Exporter;
10             our @ISA = qw(Exporter);
11             our @EXPORT = qw();
12             our @EXPORT_OK = qw ( keyring input_password );
13              
14             # unit test override variables
15             our $appname = 'tel script';
16             our $_mock = 0;
17              
18             =head1 NAME
19              
20             App::Tel::Passwd - Methods for managing App::Tel::Passwd:: modules
21              
22             =cut
23              
24             my $plugins = [ 'KeePass', 'PWSafe', 'Pass', 'KeyRing', 'Mock' ];
25              
26             =head2 load_module
27              
28             my $name = App::Tel::Passwd::load_module($password_module, $file, $passwd);
29              
30             Loads the module for the specified password store type. Returns the module's
31             namespace.
32              
33             =cut
34              
35             sub load_module {
36 5     5 1 206308 my ($type, $file, $passwd) = @_;
37 12     12   50 no warnings 'uninitialized';
  12         11  
  12         4517  
38 5         15 my $mod = 'App::Tel::Passwd::'. $type;
39 5         7 my $load = eval {
40 5         21 Module::Load::load $mod;
41 3         318 $mod->new(file => $file, passwd => $passwd);
42             };
43 5 100       1096 croak "Something went wrong with our load of passwd module $type:\n$@" if ($@);
44 2         57 return $load;
45             }
46              
47             =head2 input_password
48              
49             my $password = input_password($prompt);
50              
51             Prompts the user for a password then disables local echo on STDIN, reads a
52             line and returns it.
53              
54             =cut
55              
56             sub input_password {
57 0     0 1 0 my $prompt = shift;
58 0   0     0 $prompt ||= '';
59 0         0 my $old_mode;
60             # uncoverable branch true
61 0 0       0 if (!$_mock) {
62 0 0       0 die 'STDIN not a tty' if (!POSIX::isatty(\*STDIN));
63 0         0 $old_mode=IO::Stty::stty(\*STDIN,'-g');
64 0         0 IO::Stty::stty(\*STDIN,'-echo');
65             }
66 0         0 print "Enter password for $prompt: ";
67 0         0 my $password=;
68              
69 0         0 chomp($password);
70             # uncoverable branch true
71 0 0       0 if (!$_mock) {
72 0         0 IO::Stty::stty(\*STDIN,$old_mode);
73             } else {
74 0         0 print "\n";
75             }
76 0         0 return $password;
77             }
78              
79             =head2 keyring
80              
81             my $password = keyring($user, $domain, $group);
82              
83             Reads a password from a keyring using Passwd::Keyring::Auto if it's available.
84             If the password isn't found the user is prompted to enter a password, then we
85             try to store it in the keyring.
86              
87             =cut
88              
89             sub keyring {
90 0     0 1 0 my ($user, $domain, $group) = @_;
91              
92 0         0 my $p = eval {
93 0         0 load Passwd::Keyring::Auto, 'get_keyring';
94 0         0 my $keyring = get_keyring(app=>$appname, group=>$group);
95 0         0 my $pass = $keyring->get_password($user, $domain);
96 0 0       0 if (!$pass) {
97 0         0 $pass = input_password($domain);
98 0         0 $keyring->set_password($user, $pass, $domain);
99             }
100 0         0 return $pass;
101             };
102              
103 0 0       0 warn $@ if ($@);
104 0         0 return $p;
105             }
106              
107             =head2 load_from_profile
108              
109             my $pass = load_from_profile($profile);
110              
111             Given an App::Tel profile, see if it contains entries for Passwd modules. If
112             it does attempt to load them and return the password associated.
113              
114             I'm not too happy with the flexibility of this, but I think it will get the
115             job done for right now.
116              
117             =cut
118              
119             sub load_from_profile {
120 1     1 1 489 my $profile = shift;
121              
122 1         5 foreach my $plugin (@$plugins) {
123 3         5 my $type = lc($plugin);
124 3 100       10 if (defined($profile->{$type .'_file'})) {
125 1         2 my $file = $type . '_file';
126 1         2 my $entry = $type . '_entry';
127 1         2 my $safe_password = $profile->{$type . '_passwd'};
128              
129 1 50       4 if ($safe_password eq 'KEYRING') {
130 0         0 $safe_password = keyring($type,$type,$type);
131             }
132              
133 1         5 my $mod = load_module $plugin, $profile->{$file}, $safe_password;
134 1         13 my $e = $mod->passwd($profile->{$entry});
135 1 50       22 return $e if $e;
136             }
137             }
138             }
139