File Coverage

blib/lib/Authen/Passphrase/EggdropBlowfish.pm
Criterion Covered Total %
statement 65 66 98.4
branch 15 22 68.1
condition 6 12 50.0
subroutine 14 14 100.0
pod 4 4 100.0
total 104 118 88.1


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Authen::Passphrase::EggdropBlowfish - passphrases using Eggdrop's
4             blowfish.mod
5              
6             =head1 SYNOPSIS
7              
8             use Authen::Passphrase::EggdropBlowfish;
9              
10             $ppr = Authen::Passphrase::EggdropBlowfish->new(
11             hash_base64 => "9tpsG/61YqX/");
12              
13             $ppr = Authen::Passphrase::EggdropBlowfish->new(
14             passphrase => "passphrase");
15              
16             $hash = $ppr->hash;
17             $hash_base64 = $ppr->hash_base64;
18              
19             if($ppr->match($passphrase)) { ...
20              
21             =head1 DESCRIPTION
22              
23             An object of this class encapsulates a passphrase hashed using the
24             Blowfish-based algorithm used in Eggdrop's blowfish.mod. This is a
25             subclass of L, and this document assumes that the
26             reader is familiar with the documentation for that class.
27              
28             This hash scheme uses no salt, and does not accept a zero-length
29             passphrase. It uses the passphrase as a Blowfish key to encrypt a
30             standard plaintext block. The hash is the ciphertext block. The standard
31             Blowfish key schedule only accepts keys from 8 to 56 bytes long; this
32             algorithm relaxes that requirement and accepts any non-zero length.
33             Up to 72 bytes of passphrase/key are significant; any more are ignored.
34              
35             In Eggdrop the hash is represented as a "B<+>" followed by twelve base
36             64 digits. The first six digits encode the second half of the hash,
37             and the last six encode the first half. Within each half the bytes
38             are encoded in reverse order. The base 64 digits are "B<.>", "B",
39             "B<0>" to "B<9>", "B" to "B", "B" to "B" (in that order).
40              
41             I The hash is small by modern standards, and the lack of salt
42             is a weakness in this scheme. For a scheme that makes better use of
43             Blowfish see L.
44              
45             =cut
46              
47             package Authen::Passphrase::EggdropBlowfish;
48              
49 2     2   116777 { use 5.006; }
  2         10  
50 2     2   10 use warnings;
  2         4  
  2         117  
51 2     2   12 use strict;
  2         3  
  2         60  
52              
53 2     2   382 use Authen::Passphrase 0.003;
  2         32  
  2         57  
54 2     2   10 use Carp qw(croak);
  2         4  
  2         211  
55 2     2   1012 use Crypt::Eksblowfish::Uklblowfish 0.008;
  2         2056  
  2         90  
56              
57             our $VERSION = "0.009";
58              
59 2     2   12 use parent "Authen::Passphrase";
  2         7  
  2         9  
60              
61             my $b64_digits =
62             "./0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
63              
64             sub _en_base64($) {
65 9     9   22 my($bytes) = @_;
66 9         18 my $digits = "";
67 9         36 foreach my $word (reverse unpack("N*", $bytes)) {
68 18         49 for(my $i = 6; $i--; $word >>= 6) {
69 108         327 $digits .= substr($b64_digits, $word & 0x3f, 1);
70             }
71             }
72 9         51 return $digits;
73             }
74              
75             sub _de_base64($) {
76 7     7   16 my($digits) = @_;
77 7         13 my @words;
78 7         34 while($digits =~ /(......)/sg) {
79 14         31 my $wdig = $1;
80 14         24 my $word = 0;
81 14         33 for(my $i = 6; $i--; ) {
82 84         133 $word <<= 6;
83 84         251 $word |= index($b64_digits, substr($wdig, $i, 1));
84             }
85 14         54 push @words, $word;
86             }
87 7         63 return pack("N*", reverse @words);
88             }
89              
90             =head1 CONSTRUCTOR
91              
92             =over
93              
94             =item Authen::Passphrase::EggdropBlowfish->new(ATTR => VALUE, ...)
95              
96             Generates a new passphrase recogniser object using the Eggdrop
97             blowfish.mod algorithm. The following attributes may be given:
98              
99             =over
100              
101             =item B
102              
103             The hash, as a string of eight bytes.
104              
105             =item B
106              
107             The hash, as a string of twelve base 64 digits.
108              
109             =item B
110              
111             A passphrase that will be accepted.
112              
113             =back
114              
115             Either the hash or the passphrase must be given.
116              
117             =cut
118              
119             sub new {
120 10     10 1 150500 my $class = shift;
121 10         29 my $self = bless({}, $class);
122 10         29 my $passphrase;
123 10         37 while(@_) {
124 10         18 my $attr = shift;
125 10         21 my $value = shift;
126 10 100       43 if($attr eq "hash") {
    100          
    50          
127             croak "hash specified redundantly"
128 1 50 33     10 if exists($self->{hash}) ||
129             defined($passphrase);
130 1 50       8 $value =~ m#\A[\x00-\xff]{8}\z#
131             or croak "not a valid hash";
132 1         6 $self->{hash} = "$value";
133             } elsif($attr eq "hash_base64") {
134             croak "hash specified redundantly"
135 7 50 33     50 if exists($self->{hash}) ||
136             defined($passphrase);
137 7 50       43 $value =~ m#\A(?:[./0-9a-zA-Z]{5}[./01]){2}\z#
138             or croak "\"$value\" is not a valid ".
139             "base 64 hash";
140 7         21 $self->{hash} = _de_base64($value);
141             } elsif($attr eq "passphrase") {
142             croak "passphrase specified redundantly"
143 2 50 33     15 if exists($self->{hash}) ||
144             defined($passphrase);
145 2 100       236 $value ne "" or croak "can't accept null passphrase";
146 1         3 $passphrase = $value;
147             } else {
148 0         0 croak "unrecognised attribute `$attr'";
149             }
150             }
151 9 100       25 $self->{hash} = $self->_hash_of($passphrase) if defined $passphrase;
152 9 50       26 croak "hash not specified" unless exists $self->{hash};
153 9         38 return $self;
154             }
155              
156             =back
157              
158             =head1 METHODS
159              
160             =over
161              
162             =item $ppr->hash
163              
164             Returns the hash value, as a string of eight bytes.
165              
166             =cut
167              
168             sub hash {
169 3     3 1 1284 my($self) = @_;
170 3         19 return $self->{hash};
171             }
172              
173             =item $ppr->hash_base64
174              
175             Returns the hash value, as a string of twelve base 64 digits.
176              
177             =cut
178              
179             sub hash_base64 {
180 9     9 1 2259 my($self) = @_;
181 9         33 return _en_base64($self->{hash});
182             }
183              
184             =item $ppr->match(PASSPHRASE)
185              
186             This method is part of the standard L interface.
187              
188             =cut
189              
190             sub _hash_of {
191 38     38   81 my($self, $passphrase) = @_;
192 38         106 $passphrase = substr($passphrase, 0, 72);
193 38         2434 my $cipher = Crypt::Eksblowfish::Uklblowfish->new($passphrase);
194 38         521 return $cipher->encrypt("\xde\xad\xd0\x61\x23\xf6\xb0\x95");
195             }
196              
197             sub match {
198 43     43 1 14340 my($self, $passphrase) = @_;
199             return $passphrase ne "" &&
200 43   100     209 $self->_hash_of($passphrase) eq $self->{hash};
201             }
202              
203             =back
204              
205             =head1 SEE ALSO
206              
207             L,
208             L
209              
210             =head1 AUTHOR
211              
212             Andrew Main (Zefram)
213              
214             =head1 COPYRIGHT
215              
216             Copyright (C) 2006, 2007, 2009, 2010, 2012
217             Andrew Main (Zefram)
218              
219             =head1 LICENSE
220              
221             This module is free software; you can redistribute it and/or modify it
222             under the same terms as Perl itself.
223              
224             =cut
225              
226             1;