File Coverage

blib/lib/Authen/Passphrase/Clear.pm
Criterion Covered Total %
statement 33 33 100.0
branch 4 6 66.6
condition n/a
subroutine 11 11 100.0
pod 5 5 100.0
total 53 55 96.3


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Authen::Passphrase::Clear - cleartext passphrases
4              
5             =head1 SYNOPSIS
6              
7             use Authen::Passphrase::Clear;
8              
9             $ppr = Authen::Passphrase::Clear->new("passphrase");
10              
11             if($ppr->match($passphrase)) { ...
12              
13             $passphrase = $ppr->passphrase;
14              
15             $userPassword = $ppr->as_rfc2307;
16              
17             =head1 DESCRIPTION
18              
19             An object of this class is a passphrase recogniser that accepts
20             some particular passphrase which it knows. This is a subclass of
21             L, and this document assumes that the reader is
22             familiar with the documentation for that class.
23              
24             I Storing a passphrase in cleartext, as this class does,
25             is a very bad idea. It means that anyone who sees the passphrase file
26             immediately knows all the passphrases. Do not use this unless you really
27             know what you're doing.
28              
29             =cut
30              
31             package Authen::Passphrase::Clear;
32              
33 2     2   85688 { use 5.006; }
  2         8  
34 2     2   12 use warnings;
  2         8  
  2         108  
35 2     2   10 use strict;
  2         35  
  2         70  
36              
37 2     2   379 use Authen::Passphrase 0.003;
  2         40  
  2         73  
38 2     2   13 use Carp qw(croak);
  2         3  
  2         136  
39              
40             our $VERSION = "0.009";
41              
42 2     2   315 use parent "Authen::Passphrase";
  2         273  
  2         12  
43              
44             # An object of this class is a blessed scalar containing the passphrase.
45              
46             =head1 CONSTRUCTORS
47              
48             =over
49              
50             =item Authen::Passphrase::Clear->new(PASSPHRASE)
51              
52             Returns a passphrase recogniser object that stores the specified
53             passphrase in cleartext and accepts only that passphrase.
54              
55             =cut
56              
57             sub new {
58 6     6 1 2570 my($class, $passphrase) = @_;
59 6         7 $passphrase = "$passphrase";
60 6         21 return bless(\$passphrase, $class);
61             }
62              
63             =item Authen::Passphrase::Clear->from_rfc2307(USERPASSWORD)
64              
65             Generates a cleartext passphrase recogniser from the supplied RFC2307
66             encoding. The string must consist of "B<{CLEARTEXT}>" (case insensitive)
67             followed by the passphrase.
68              
69             =cut
70              
71             sub from_rfc2307 {
72 2     2 1 149808 my($class, $userpassword) = @_;
73 2 100       8 if($userpassword =~ /\A\{(?i:cleartext)\}/) {
74 1 50       6 $userpassword =~ /\A\{.*?\}([!-~]*)\z/
75             or croak "malformed {CLEARTEXT} data";
76 1         2 my $text = $1;
77 1         13 return $class->new($text);
78             }
79 1         8 return $class->SUPER::from_rfc2307($userpassword);
80             }
81              
82             =back
83              
84             =head1 METHODS
85              
86             =over
87              
88             =item $ppr->match(PASSPHRASE)
89              
90             =item $ppr->passphrase
91              
92             =item $ppr->as_rfc2307
93              
94             These methods are part of the standard L interface.
95             The L method trivially works.
96              
97             =cut
98              
99             sub match {
100 25     25 1 4815 my($self, $passphrase) = @_;
101 25         50 return $passphrase eq $$self;
102             }
103              
104 6     6 1 1405 sub passphrase { ${$_[0]} }
  6         24  
105              
106             sub as_rfc2307 {
107 5     5 1 10 my($self) = @_;
108 5 50       18 croak "can't put this passphrase into an RFC 2307 string"
109             if $$self =~ /[^!-~]/;
110 5         18 return "{CLEARTEXT}".$$self;
111             }
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;