File Coverage

blib/lib/Authen/Passphrase/EggdropBlowfish.pm
Criterion Covered Total %
statement 66 67 98.5
branch 15 22 68.1
condition 6 12 50.0
subroutine 14 14 100.0
pod 4 4 100.0
total 105 119 88.2


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 1     1   28093 { use 5.006; }
  1         6  
  1         52  
50 1     1   6 use warnings;
  1         2  
  1         44  
51 1     1   5 use strict;
  1         2  
  1         78  
52              
53 1     1   643 use Authen::Passphrase 0.003;
  1         26  
  1         37  
54 1     1   12 use Carp qw(croak);
  1         2  
  1         83  
55 1     1   100038 use Crypt::Eksblowfish::Uklblowfish 0.008;
  1         3642  
  1         61  
56              
57             our $VERSION = "0.008";
58              
59 1     1   8 use parent "Authen::Passphrase";
  1         2  
  1         5  
60              
61             my $b64_digits =
62             "./0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
63              
64             sub _en_base64($) {
65 9     9   33 my($bytes) = @_;
66 9         22 my $digits = "";
67 9         54 foreach my $word (reverse unpack("N*", $bytes)) {
68 18         56 for(my $i = 6; $i--; $word >>= 6) {
69 108         260 $digits .= substr($b64_digits, $word & 0x3f, 1);
70             }
71             }
72 9         53 return $digits;
73             }
74              
75             sub _de_base64($) {
76 7     7   14 my($digits) = @_;
77 7         11 my @words;
78 7         72 while($digits =~ /(......)/sg) {
79 14         30 my $wdig = $1;
80 14         21 my $word = 0;
81 14         38 for(my $i = 6; $i--; ) {
82 84         83 $word <<= 6;
83 84         207 $word |= index($b64_digits, substr($wdig, $i, 1));
84             }
85 14         51 push @words, $word;
86             }
87 7         77 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 6178 my $class = shift;
121 10         133 my $self = bless({}, $class);
122 10         20 my $passphrase;
123 10         39 while(@_) {
124 10         18 my $attr = shift;
125 10         16 my $value = shift;
126 10 100       49 if($attr eq "hash") {
    100          
    50          
127 1 50 33     10 croak "hash specified redundantly"
128             if exists($self->{hash}) ||
129             defined($passphrase);
130 1 50       5 $value =~ m#\A[\x00-\xff]{8}\z#
131             or croak "not a valid hash";
132 1         5 $self->{hash} = "$value";
133             } elsif($attr eq "hash_base64") {
134 7 50 33     61 croak "hash specified redundantly"
135             if exists($self->{hash}) ||
136             defined($passphrase);
137 7 50       53 $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         27 $self->{hash} = _de_base64($value);
141             } elsif($attr eq "passphrase") {
142 2 50 33     26 croak "passphrase specified redundantly"
143             if exists($self->{hash}) ||
144             defined($passphrase);
145 2 100       223 $value ne "" or croak "can't accept null passphrase";
146 1         4 $passphrase = $value;
147             } else {
148 0         0 croak "unrecognised attribute `$attr'";
149             }
150             }
151 9 100       55 $self->{hash} = $self->_hash_of($passphrase) if defined $passphrase;
152 9 50       30 croak "hash not specified" unless exists $self->{hash};
153 9         97 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 1048 my($self) = @_;
170 3         17 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 5097 my($self) = @_;
181 9         34 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   51 my($self, $passphrase) = @_;
192 38         79 $passphrase = substr($passphrase, 0, 72);
193 38         3282 my $cipher = Crypt::Eksblowfish::Uklblowfish->new($passphrase);
194 38         398 return $cipher->encrypt("\xde\xad\xd0\x61\x23\xf6\xb0\x95");
195             }
196              
197             sub match {
198 43     43 1 20088 my($self, $passphrase) = @_;
199 43   100     176 return $passphrase ne "" &&
200             $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;