File Coverage

blib/lib/Authen/Passphrase/RejectAll.pm
Criterion Covered Total %
statement 26 26 100.0
branch 3 4 75.0
condition n/a
subroutine 10 10 100.0
pod 4 4 100.0
total 43 44 97.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Authen::Passphrase::RejectAll - reject all passphrases
4              
5             =head1 SYNOPSIS
6              
7             use Authen::Passphrase::RejectAll;
8              
9             $ppr = Authen::Passphrase::RejectAll->new;
10              
11             $ppr = Authen::Passphrase::RejectAll
12             ->from_crypt("*");
13              
14             $ppr = Authen::Passphrase::RejectAll
15             ->from_rfc2307("{CRYPT}*");
16              
17             if($ppr->match($passphrase)) { ...
18              
19             $passwd = $ppr->as_crypt;
20             $userPassword = $ppr->as_rfc2307;
21              
22             =head1 DESCRIPTION
23              
24             An object of this class is a passphrase recogniser that accepts any
25             passphrase whatsoever. This is a subclass of L, and
26             this document assumes that the reader is familiar with the documentation
27             for that class.
28              
29             This type of passphrase recogniser is obviously of no use at all in
30             controlling access to any resource. Its use is to permit a resource
31             to be completely inaccessible in a system that expects some type of
32             passphrase access control.
33              
34             =cut
35              
36             package Authen::Passphrase::RejectAll;
37              
38 1     1   56854 { use 5.006; }
  1         4  
  1         213  
39 1     1   7 use warnings;
  1         3  
  1         47  
40 1     1   6 use strict;
  1         3  
  1         37  
41              
42 1     1   1157 use Authen::Passphrase 0.003;
  1         22  
  1         39  
43 1     1   10 use Carp qw(croak);
  1         3  
  1         95  
44              
45             our $VERSION = "0.008";
46              
47 1     1   1038 use parent "Authen::Passphrase";
  1         1686  
  1         6  
48              
49             # There is only one object of this class, and its content is
50             # insignificant.
51              
52             =head1 CONSTRUCTORS
53              
54             =over
55              
56             =item Authen::Passphrase::RejectAll->new
57              
58             Returns a reject-all passphrase recogniser object. The same object is
59             returned from each call.
60              
61             =cut
62              
63             {
64             my $singleton = bless({});
65 3     3 1 19 sub new { $singleton }
66             }
67              
68             =item Authen::Passphrase::RejectAll->from_crypt(PASSWD)
69              
70             Returns a reject-all passphrase recogniser object. The same object is
71             returned from each call. The argument, a crypt string, must be between
72             one and twelve (inclusive) characters long and must not start with "B<$>".
73              
74             =cut
75              
76             sub from_crypt {
77 4     4 1 1382 my($class, $passwd) = @_;
78 4 100       22 if($passwd =~ /\A[^\$].{0,11}\z/s) {
79 2 50       8 $passwd =~ /\A[!-#\%-9;-~][!-9;-~]{0,11}\z/
80             or croak "malformed reject-all crypt data";
81 2         6 return $class->new;
82             }
83 2         16 return $class->SUPER::from_crypt($passwd);
84             }
85              
86             =item Authen::Passphrase::RejectAll->from_rfc2307(USERPASSWORD)
87              
88             Generates a new reject-all passphrase recogniser object from an RFC
89             2307 string. The string must consist of "B<{CRYPT}>" (case insensitive)
90             followed by an acceptable crypt string.
91              
92             =back
93              
94             =head1 METHODS
95              
96             =over
97              
98             =item $ppr->match(PASSPHRASE)
99              
100             =item $ppr->as_crypt
101              
102             =item $ppr->as_rfc2307
103              
104             These methods are part of the standard L interface.
105             The L method always returns false.
106              
107             =cut
108              
109 5     5 1 1905 sub match { 0 }
110              
111 2     2 1 896 sub as_crypt { "*" }
112              
113             =back
114              
115             =head1 SEE ALSO
116              
117             L
118              
119             =head1 AUTHOR
120              
121             Andrew Main (Zefram)
122              
123             =head1 COPYRIGHT
124              
125             Copyright (C) 2006, 2007, 2009, 2010, 2012
126             Andrew Main (Zefram)
127              
128             =head1 LICENSE
129              
130             This module is free software; you can redistribute it and/or modify it
131             under the same terms as Perl itself.
132              
133             =cut
134              
135             1;