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
|
|
|
|
|
|
|
|