1package Crypt::GeneratePassword; 2$Crypt::GeneratePassword::VERSION = '0.05'; 3# ABSTRACT: generate secure random pronounceable passwords 4 5use 5.006; 6use strict; 7use warnings; 8 9=encoding utf-8 10 11=head1 NAME 12 13Crypt::GeneratePassword - generate secure random pronounceable passwords 14 15=head1 SYNOPSIS 16 17 use Crypt::GeneratePassword qw(word chars); 18 $word = word($minlen,$maxlen); 19 $word = chars($minlen,$maxlen); 20 *Crypt::GeneratePassword::restrict = \&my_restriction_filter; 21 *Crypt::GeneratePassword::random_number = \&my_random_number_generator; 22 23=head1 DESCRIPTION 24 25Crypt::GeneratePassword generates random passwords that are 26(more or less) pronounceable. Unlike Crypt::RandPasswd, it 27doesn't use the FIPS-181 NIST standard, which is proven to be 28insecure. It does use a similar interface, so it should be a 29drop-in replacement in most cases. 30 31If you want to use passwords from a different language than english, 32you can use one of the packaged alternate unit tables or generate 33your own. See below for details. 34 35For details on why FIPS-181 is insecure and why the solution 36used in this module is reasonably secure, see "A New Attack on 37Random Pronounceable Password Generators" by Ravi Ganesan and 38Chris Davies, available online in may places - use your 39favourite search engine. 40 41This module improves on FIPS-181 using a true random selection with 42the word generator as mere filter. Other improvements are 43better pronounceability using third order approximation instead 44of second order and multi-language support. 45Drawback of this method is that it is usually slower. Then again, 46computer speed has improved a little since 1977. 47 48=head1 Functions 49 50=cut 51 52require Exporter; 53our @ISA = ('Exporter'); 54our @EXPORT_OK = qw(word word3 analyze analyze3 chars generate_language load_language); 55our %EXPORT_TAGS = ( 'all' => [ @Crypt::GeneratePassword::EXPORT_OK ] ); 56 57my $default_language = 'en'; 58our %languages = (); 59 60=head2 chars 61 62 $word = chars($minlen, $maxlen [, $set [, $characters, $maxcount ] ... ] ); 63 64Generates a completely random word between $minlen and $maxlen in length. 65If $set is given, it must be an array ref of characters to use. You can 66restrict occurrence of some characters by providing ($characters, $maxcount) 67pairs, as many as you like. $characters must be a string consisting of those 68characters which may appear at most $maxcount times in the word. 69 70Note that the length is determined via relative probability, not uniformly. 71 72=cut 73 74my @signs = ('0'..'9', '%', '$', '_', '-', '+', '*', '&', '/', '=', '!', '#'); 75my $signs = join('',@signs); 76my @caps = ('A' .. 'Z'); 77my $caps = join('',@caps); 78 79my @set = ( 80 [ ["\x00",'a'..'z'], ["\x00",'a'..'z',@caps] ], 81 [ ["\x00",'a'..'z',@signs], ["\x00",'a'..'z',@caps,@signs] ] 82 ); 83 84sub chars($$;$@) { 85 my ($minlen, $maxlen, $set, @restrict) = @_; 86 $set ||= $set[1][1]; 87 my $res; 88 my $diff = $maxlen-$minlen; 89 WORD: { 90 $res = join '', map { $$set[random_number(scalar(@$set))] } 1..$maxlen; 91 $res =~ s/\x00{0,$diff}$//; 92 redo if $res =~ m/\x00/; 93 for (my $i = 0; $i < @restrict; $i+=2) { 94 my $match = $restrict[$i]; 95 my $more = int($restrict[$i+1])+1; 96 redo WORD if $res =~ m/([\Q$match\E].*){$more,}/; 97 } 98 } 99 return $res; 100} 101 102=head2 word 103 104 $word = word($minlen, $maxlen [, $lang [, $numbers [, $caps [, $minfreq, $avgfreq ] ] ] ); 105 $word = word3($minlen, $maxlen [, $lang [, $numbers [, $caps [, $minfreq, $avgfreq ] ] ] ); 106 107Generates a random pronounceable word. The length of the returned 108word will be between $minlen and $maxlen. If you supply a non-zero 109value for $numbers, up to that many numbers and special characters 110will occur in the password. If you specify a non-zero value for $caps, 111up to this many characters will be upper case. $lang is the language 112description to use, loaded via load_language or built-in. Built-in 113languages are: 'en' (english) and 'de' (german). Contributions 114welcome. The default language is 'en' but may be changed by calling 115load_language with a true value as third parameter. Pass undef as 116language to select the current default language. $minfreq and $minsum 117determine quality of the password: $minfreq and $avgfreq are the minimum 118frequency each quad/trigram must have and the average frequency that the 119quad/trigrams must have for a word to be selected. Both are values between 0.0 120and 1.0, specifying the percentage of the maximum frequency. Higher 121values create less secure, better pronounceable passwords and are slower. 122Useful $minfreq values are usually between 0.001 and 0.0001, useful $avgfreq 123values are around 0.05 for trigrams (word3) and 0.001 for quadgrams (word). 124 125=cut 126 127our $total; 128 129sub word($$;$$$$$) 130{ 131 my $language = splice(@_,2,1) || ''; 132 $language =~ s/[^a-zA-Z_]//g; 133 $language ||= $default_language; 134 eval "require Crypt::GeneratePassword::$language"; 135 my $lang = $languages{$language}; 136 die "language '${language}' not found" if !$lang; 137 138 my ($minlen, $maxlen, $numbers, $capitals, $minfreq, $avgfreq) = map { int($_) } @_; 139 $minfreq ||= 0; 140 $avgfreq ||= 0.001; 141 $minfreq = int($$lang{'maxquad'}*$minfreq) || 1; 142 $avgfreq = int($$lang{'maxquad'}*$avgfreq); 143 144 WORD: { 145 my $randword = chars($minlen,$maxlen,$set[$numbers?1:0][$capitals?1:0],($numbers?($signs,$numbers):()),($capitals?($caps,$capitals):())); 146 $total++; 147 my $stripped = lc($randword); 148 $stripped =~ s/[\Q$signs\E]//g; 149 redo WORD if length($stripped) == 0; 150 151 my $sum = 0; 152 my $k0 = -1; 153 my $k1 = -1; 154 my $k2 = -1; 155 my $k3 = -1; 156 157 foreach my $char (split(//,$stripped)) { 158 $k3 = $char; 159 if ($k3 gt 'Z') { 160 $k3 = ord($k3) - ord('a'); 161 } else { 162 $k3 = ord($k3) - ord('A'); 163 } 164 165 if ($k0 > 0) { 166 redo WORD if $$lang{'quads'}[$k0][$k1][$k2][$k3] < $minfreq; 167 $sum += $$lang{'quads'}[$k0][$k1][$k2][$k3]; 168 } 169 170 $k0 = $k1; 171 $k1 = $k2; 172 $k2 = $k3; 173 } 174 redo if $sum/length($stripped) < $avgfreq; 175 redo if (restrict($stripped,$language)); 176 return $randword; 177 } 178} 179 180sub word3($$;$$$$$) 181{ 182 my $language = splice(@_,2,1) || ''; 183 $language =~ s/[^a-zA-Z_]//g; 184 $language ||= $default_language; 185 eval "require Crypt::GeneratePassword::$language"; 186 my $lang = $languages{$language}; 187 die "language '${language}' not found" if !$lang; 188 189 my ($minlen, $maxlen, $numbers, $capitals, $minfreq, $avgfreq) = map { int($_) } @_; 190 $minfreq ||= 0.01; 191 $avgfreq ||= 0.05; 192 $minfreq = int($$lang{'maxtri'}*$minfreq) || 1; 193 $avgfreq = int($$lang{'maxtri'}*$avgfreq); 194 195 WORD: { 196 my $randword = chars($minlen,$maxlen,$set[$numbers?1:0][$capitals?1:0],($numbers?($signs,$numbers):()),($capitals?($caps,$capitals):())); 197 $total++; 198 my $stripped = lc($randword); 199 $stripped =~ s/[\Q$signs\E]//g; 200 redo WORD if length($stripped) == 0; 201 202 my $sum = 0; 203 my $k1 = -1; 204 my $k2 = -1; 205 my $k3 = -1; 206 207 foreach my $char (split(//,$stripped)) { 208 $k3 = $char; 209 if ($k3 gt 'Z') { 210 $k3 = ord($k3) - ord('a'); 211 } else { 212 $k3 = ord($k3) - ord('A'); 213 } 214 215 if ($k1 > 0) { 216 redo WORD if $$lang{'tris'}[$k1][$k2][$k3] < $minfreq; 217 $sum += $$lang{'tris'}[$k1][$k2][$k3]; 218 } 219 220 $k1 = $k2; 221 $k2 = $k3; 222 } 223 redo if $sum/length($stripped) < $avgfreq; 224 redo if (restrict($stripped,$language)); 225 return $randword; 226 } 227} 228 229=head2 analyze 230 231 $ratio = analyze($count,@word_params); 232 $ratio = analyze3($count,@word_params); 233 234Returns a statistical(!) security ratio to measure password 235quality. $ratio is the ratio of passwords chosen among all 236possible ones, e.g. a ratio of 0.0149 means 1.49% of the 237theoretical password space was actually considered a 238pronounceable password. Since this analysis is only 239statistical, it proves absolutely nothing if you are deeply 240concerned about security - but in that case you should use 241chars(), not word() anyways. In reality, it says a lot 242about your chosen parameters if you use large values for 243$count. 244 245=cut 246 247sub analyze($@) { 248 my $count = shift; 249 $total = 0; 250 for (1..$count) { 251 my $word = &word(@_); 252 } 253 return $count/$total; 254} 255 256sub analyze3($@) { 257 my $count = shift; 258 $total = 0; 259 for (1..$count) { 260 my $word = &word3(@_); 261 } 262 return $count/$total; 263} 264 265=head2 generate_language 266 267 $language_description = generate_language($wordlist); 268 269Generates a language description which can be saved in a file and/or 270loaded with load_language. $wordlist can be a string containing 271whitespace separated words, an array ref containing one word per 272element or a file handle or name to read words from, one word per line7. 273Alternatively, you may pass an array directly, not as reference. 274A language description is about 1MB in size. 275 276If you generate a general-purpose language description for a 277language not yet built-in, feel free to contribute it for inclusion 278into this package. 279 280=cut 281 282sub generate_language($@) { 283 my ($wordlist) = @_; 284 if (@_ > 1) { 285 $wordlist = \@_; 286 } elsif (!ref($wordlist)) { 287 $wordlist = [ split(/\s+/,$wordlist) ]; 288 if (@$wordlist == 1) { 289 local *FH; 290 open(FH,'<'.$$wordlist[0]); 291 $wordlist = [ <FH> ]; 292 close(FH); 293 } 294 } elsif (ref($wordlist) ne 'ARRAY') { 295 $wordlist = [ <$wordlist> ]; 296 } 297 298 my @quads = map { [ map { [ map { [ map { 0 } 1..26 ] } 1..26 ] } 1..26 ] } 1..26; 299 my @tris = map { [ map { [ map { 0 } 1..26 ] } 1..26 ] } 1..26; 300 my $sigmaquad = 0; 301 my $maxquad = 0; 302 my $sigmatri = 0; 303 my $maxtri = 0; 304 305 foreach my $word (@$wordlist) { 306 my $k0 = -1; 307 my $k1 = -1; 308 my $k2 = -1; 309 my $k3 = -1; 310 311 foreach my $char (split(//,$word)) { 312 $k3 = $char; 313 if ($k3 gt 'Z') { 314 $k3 = ord($k3) - ord('a'); 315 } else { 316 $k3 = ord($k3) - ord('A'); 317 } 318 319 next unless ($k3 >= 0 && $k3 <= 25); 320 321 if ($k0 >= 0) { 322 $quads[$k0][$k1][$k2][$k3]++; 323 $sigmaquad++; 324 if ($quads[$k0][$k1][$k2][$k3] > $maxquad) { 325 $maxquad = $quads[$k0][$k1][$k2][$k3]; 326 } 327 } 328 329 if ($k1 >= 0) { 330 $tris[$k1][$k2][$k3]++; 331 $sigmatri++; 332 if ($tris[$k1][$k2][$k3] > $maxtri) { 333 $maxtri = $tris[$k1][$k2][$k3]; 334 } 335 } 336 337 $k0 = $k1; 338 $k1 = $k2; 339 $k2 = $k3; 340 } 341 } 342 343 { 344 require Data::Dumper; 345 no warnings 'once'; 346 local $Data::Dumper::Indent = 0; 347 local $Data::Dumper::Purity = 0; 348 local $Data::Dumper::Pad = ''; 349 local $Data::Dumper::Deepcopy = 1; 350 local $Data::Dumper::Terse = 1; 351 352 my $res = Data::Dumper::Dumper( 353 { 354 maxtri => $maxtri, 355 sigmatri => $sigmatri, 356 maxquad => $maxquad, 357 sigmaquad => $sigmaquad, 358 tris => \@tris, 359 quads => \@quads, 360 } 361 ); 362 $res =~ s/[' ]//g; 363 return $res; 364 } 365} 366 367=head2 load_language 368 369 load_language($language_description, $name [, $default]); 370 371Loads a language description which is then available in words(). 372$language_description is a string returned by generate_language, 373$name is a name of your choice which is used to select this 374language as the fifth parameter of words(). You should use the 375well-known ISO two letter language codes if possible, for best 376interoperability. 377 378If you specify $default with a true value, this language will 379be made global default language. If you give undef as 380$language_description, only the default language will be changed. 381 382=cut 383 384sub load_language($$;$) { 385 my ($desc,$name,$default) = @_; 386 $languages{$name} = eval $desc if $desc; 387 $default_language = $name if $default; 388} 389 390=head2 random_number 391 392 $number = random_number($limit); 393 394Returns a random integer between 0 (inclusive) and C<$limit> (exclusive). 395Change this to a function of your choice by doing something like this: 396 397 sub my_rng ($) { 398 ... 399 } 400 401 { 402 # suppress warning about function being redefined 403 no warnings 'redefine'; 404 *Crypt::GeneratePassword::random_number = \&my_rng; 405 } 406 407The default implementation uses perl's rand(), 408which might not be appropriate for some sites. 409 410=cut 411 412sub random_number($) { 413 return int(rand()*$_[0]); 414} 415 416=head2 restrict 417 418 $forbidden = restrict($word,$language); 419 420Filters undesirable words. Returns false if the $word is allowed 421in language $lang, false otherwise. Change this to a function of 422your choice by doing something like this: 423 424 sub my_filter ($$) { 425 ... 426 } 427 428 { 429 no warnings 'redefine'; 430 *Crypt::GeneratePassword::restrict = \&my_filter; 431 } 432 433The default implementation scans for a few letter sequences that 434english or german people might find offending, mostly because of 435their sexual nature. You might want to hook up a regular password 436checker here, or a wordlist comparison. 437 438=cut 439 440sub restrict($$) { 441 return ($_[0] =~ m/f.ck|ass|rsch|tit|cum|ack|asm|orn|eil|otz|oes/i); 442} 443 444=head1 SEE ALSO 445 446L<Crypt::RandPasswd> 447 448=head1 REPOSITORY 449 450L<https://github.com/neilb/Crypt-GeneratePassword> 451 452=head1 AUTHOR 453 454Copyright 2002 by Jörg Walter <jwalt@cpan.org>, 455inspired by ideas from Tom Van Vleck and Morris 456Gasser/FIPS-181. 457 458Now maintained by Neil Bowers E<lt>neilb@cpan.orgE<gt> 459 460=head1 COPYRIGHT 461 462This perl module is free software; it may be redistributed and/or modified 463under the same terms as Perl itself. 464 465 466=cut 467 4681; 469