File Coverage

lib/Mozilla/Persona/Validate/Table.pm
Criterion Covered Total %
statement 18 56 32.1
branch 0 28 0.0
condition n/a
subroutine 6 11 54.5
pod 3 5 60.0
total 27 100 27.0


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;