File Coverage

lib/App/Tel/Passwd.pm
Criterion Covered Total %
statement 26 58 44.8
branch 1 12 8.3
condition 0 2 0.0
subroutine 8 11 72.7
pod 4 4 100.0
total 39 87 44.8


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