diff options
Diffstat (limited to 'lib')
| -rwxr-xr-x | lib/Fripost/Password.pm | 96 |
1 files changed, 86 insertions, 10 deletions
diff --git a/lib/Fripost/Password.pm b/lib/Fripost/Password.pm index 038d835..595502d 100755 --- a/lib/Fripost/Password.pm +++ b/lib/Fripost/Password.pm @@ -9,24 +9,77 @@ Password.pm - Generate passwords =cut -our $VERSION = '0.01'; +our $VERSION = '0.02'; -use Data::Dumper; -use Digest::MD5; use Exporter; use MIME::Base64; +use String::MkPasswd qw/mkpasswd/; -our @EXPORT = qw/smd5 make_salt/; +use constant { + CLEARTEXT => 0, + CRYPT => 1, + MD5 => 2, + SHA1 => 3, +}; + +our @EXPORT = qw/hash CLEARTEXT CRYPT MD5 SHA1 mkpasswd/; our @ISA = qw(Exporter); -sub smd5 { - my $pw = shift; - my $salt = shift || &make_salt(); - return "{SMD5}" . pad_base64( MIME::Base64::encode( Digest::MD5::md5( $pw . $salt ) . $salt, '' ) ); + +# Hashes the given password using the given hashing function and salt. +# If the scheme is `undef', the best available one (currently SHA-1) is +# chosen. +# If `$salt' is the empty string, no salt is used (unless the scheme is +# CRYPT - since it requires salt). +# If `$salt' is `undef', the salt is automatically generated, using the +# subroutine `&make_salt' below. +sub hash ($$$) { + + my ($h, $salt, $pw) = @_; + $h //= SHA1; + + # Treat the schemes that don't use Digest::.. separetely. + if ( $h == CLEARTEXT ) { + return $pw; + } + elsif ( $h == CRYPT ) { + $salt = &make_salt() if not (defined $salt) or $salt eq ''; + $salt = sprintf ( '$1$%.8s', MIME::Base64::encode( $salt ) ); + return '{CRYPT}' . crypt( $pw, $salt ); + } + + $salt //= &make_salt(); + my $hash_function; + my $str; + + if ( $h == MD5 ) { + use Digest::MD5 qw /md5/; + $hash_function = "Digest::MD5::md5"; + $str = 'MD5'; + $str = 'SMD5' if &is_salted( $salt ); + } + elsif ( $h == SHA1 ) { + use Digest::SHA qw /sha1/; + $hash_function = "Digest::SHA::sha1"; + $str = 'SHA'; + $str = 'SSHA' if &is_salted( $salt ); + } + else { + die "Error: Unknown scheme `" .$h. "'.\n"; + } + + no strict "refs"; + return '{' .$str. '}' . + pad_base64( MIME::Base64::encode( &$hash_function( $pw . $salt ) . $salt + , '' ) ); } +sub is_salted { return ( not ( defined $_[0] ) or $_[0] ne '' ) }; + + +# Generate (random) salt, with a (random) length of 23 to 31 bytes. sub make_salt { - my $len = 8 + int( rand(8) ); + my $len = 31 - int( rand(8) ); my @bytes = (); for my $i ( 1 .. $len ) { push( @bytes, rand(255) ); @@ -34,6 +87,14 @@ sub make_salt { return pack( 'C*', @bytes ); } +sub random_string { + my ($len, $range) = @_; + return join '', @$range[ map {rand $#$range} (1..$len) ]; +} + + +# Add trailing `='s to the input string to ensure its length is a +# multiple of 4. sub pad_base64 { my $b64_digest = shift; while ( length($b64_digest) % 4 ) { @@ -42,10 +103,23 @@ sub pad_base64 { return $b64_digest; } -=head1 AUTHOR + +# Our policy for automatically generated passwords. +sub mkpasswd { + return String::MkPasswd::mkpasswd( + -length => 20, + -minnum => 5, + -minspecial => 3 + ); +} + + +=head1 AUTHORS Stefan Kangas C<< <skangas at skangas.se> >> +Guilhem Moulin C<< <guilhem at fripost.org> >> + =head1 BUGS Please report any bugs to C<< <skangas at skangas.se> >> @@ -56,6 +130,8 @@ Copyright (c) 2010 Dominik Schulz (dominik.schulz@gauner.org). All rights reserv Copyright 2010,2011 Stefan Kangas, all rights reserved. +Copyright 2012 Guilhem Moulin, all rights reserved. + =head1 LICENSE This program is free software; you can redistribute it and/or modify it under |