| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# Copyrights 2012 by [Mark Overmeer]. |
|
2
|
|
|
|
|
|
|
# For other contributors see ChangeLog. |
|
3
|
|
|
|
|
|
|
# See the manual pages for details on the licensing terms. |
|
4
|
|
|
|
|
|
|
# Pod stripped from pm file by OODoc 2.00. |
|
5
|
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
1178
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
31
|
|
|
7
|
1
|
|
|
1
|
|
5
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
39
|
|
|
8
|
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Mozilla::Persona::Validate::Table; |
|
10
|
1
|
|
|
1
|
|
4
|
use vars '$VERSION'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
48
|
|
|
11
|
|
|
|
|
|
|
$VERSION = '0.12'; |
|
12
|
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
6
|
use base 'Mozilla::Persona::Validate'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
83
|
|
|
14
|
|
|
|
|
|
|
|
|
15
|
1
|
|
|
1
|
|
6
|
use Log::Report qw/persona/; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
16
|
|
|
16
|
1
|
|
|
1
|
|
305
|
use Digest (); |
|
|
1
|
|
|
|
|
3
|
|
|
|
1
|
|
|
|
|
749
|
|
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub init($) |
|
20
|
0
|
|
|
0
|
0
|
|
{ my ($self, $args) = @_; |
|
21
|
|
|
|
|
|
|
|
|
22
|
0
|
0
|
|
|
|
|
my $fn = $args->{pwfile} or panic; |
|
23
|
0
|
|
|
|
|
|
$self->openFile($fn); # pre-load |
|
24
|
0
|
|
|
|
|
|
$self->{MPVT_domain} = $args->{domain}; |
|
25
|
0
|
|
|
|
|
|
$self; |
|
26
|
|
|
|
|
|
|
} |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
#------------ |
|
29
|
|
|
|
|
|
|
|
|
30
|
0
|
|
|
0
|
1
|
|
sub pwfile() {shift->{MPVT_fn}} |
|
31
|
0
|
|
|
0
|
1
|
|
sub domain() {shift->{MPVT_domain}} |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub openFile(;$) |
|
34
|
0
|
|
|
0
|
0
|
|
{ my ($self, $fn) = @_; |
|
35
|
|
|
|
|
|
|
|
|
36
|
0
|
0
|
|
|
|
|
if($fn) { $self->{MPVT_fn} = $fn } |
|
|
0
|
|
|
|
|
|
|
|
37
|
0
|
|
|
|
|
|
else { $fn = $self->{MPVT_fn} } |
|
38
|
|
|
|
|
|
|
|
|
39
|
0
|
|
|
|
|
|
my $mtime = (stat $fn)[9]; |
|
40
|
0
|
0
|
|
|
|
|
defined $mtime |
|
41
|
|
|
|
|
|
|
or fault __x"passwd file {file}", file => $fn; |
|
42
|
|
|
|
|
|
|
|
|
43
|
0
|
0
|
|
|
|
|
if(my $last_mtime = $self->{MPVT_mtime}) |
|
44
|
0
|
0
|
|
|
|
|
{ return $self->{MPVT_info} if $mtime eq $last_mtime; |
|
45
|
|
|
|
|
|
|
} |
|
46
|
|
|
|
|
|
|
|
|
47
|
0
|
|
|
|
|
|
my $domain = $self->domain; |
|
48
|
0
|
|
|
|
|
|
my %info; |
|
49
|
0
|
0
|
|
|
|
|
open PASSWD, '<:raw', $fn |
|
50
|
|
|
|
|
|
|
or fault __x"cannot read file {file}", file => $fn; |
|
51
|
|
|
|
|
|
|
|
|
52
|
0
|
|
|
|
|
|
while() |
|
53
|
0
|
0
|
|
|
|
|
{ next if m/^#|^\s*$/; |
|
54
|
0
|
|
|
|
|
|
chomp; |
|
55
|
0
|
|
|
|
|
|
my ($user, $algo, $passwd) = split /\:/; |
|
56
|
0
|
0
|
|
|
|
|
if(index $user, '@' < 0) |
|
|
|
0
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
{ # abbreviated usedname |
|
58
|
0
|
|
|
|
|
|
$user .= '@' . $domain; |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
elsif($user !~ m/\@\Q$domain\E$/i) |
|
61
|
|
|
|
|
|
|
{ # account for other domain |
|
62
|
0
|
|
|
|
|
|
next; |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
|
|
65
|
0
|
0
|
|
|
|
|
defined $passwd |
|
66
|
|
|
|
|
|
|
or warning __x"not enough fields in {file} line {linenr}" |
|
67
|
|
|
|
|
|
|
, file => $fn, linenr => $.; |
|
68
|
|
|
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
|
!$info{$user} |
|
70
|
|
|
|
|
|
|
or warning __x"found user {user} again in {file} line {linenr}" |
|
71
|
|
|
|
|
|
|
, file => $fn, linenr => $.; |
|
72
|
|
|
|
|
|
|
|
|
73
|
0
|
|
|
|
|
|
$info{$user} = [$algo, $passwd]; |
|
74
|
|
|
|
|
|
|
} |
|
75
|
0
|
0
|
|
|
|
|
close PASSWD |
|
76
|
|
|
|
|
|
|
or fault __x"read errors in {file}", file => $fn; |
|
77
|
|
|
|
|
|
|
|
|
78
|
0
|
|
|
|
|
|
$self->{MPVT_mtime} = $mtime; |
|
79
|
0
|
|
|
|
|
|
$self->{MPVT_info} = \%info; |
|
80
|
|
|
|
|
|
|
} |
|
81
|
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
sub isValid($$) |
|
83
|
0
|
|
|
0
|
1
|
|
{ my ($self, $user, $password) = @_; |
|
84
|
|
|
|
|
|
|
|
|
85
|
0
|
0
|
|
|
|
|
my $info = $self->openFile->{$user} |
|
86
|
|
|
|
|
|
|
or return 0; # unknown user |
|
87
|
|
|
|
|
|
|
|
|
88
|
0
|
|
|
|
|
|
my ($algo, $expect) = @$info; |
|
89
|
0
|
|
|
|
|
|
my $digester = eval { Digest->new($algo) }; |
|
|
0
|
|
|
|
|
|
|
|
90
|
0
|
0
|
|
|
|
|
error __x"unsupported digest algorithm {name} for {user}" |
|
91
|
|
|
|
|
|
|
, name => $algo, user => $user |
|
92
|
|
|
|
|
|
|
if $@; |
|
93
|
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
|
$expect eq $digester->add($password)->b64digest; |
|
95
|
|
|
|
|
|
|
} |
|
96
|
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
1; |