package Fripost::Password; use 5.010_000; use strict; =head1 NAME Password.pm - Generate passwords =cut our $VERSION = '0.02'; use Exporter; use MIME::Base64; use String::MkPasswd qw/mkpasswd/; use constant { CLEARTEXT => 0, CRYPT => 1, MD5 => 2, SHA1 => 3, }; our @EXPORT = qw/hash CLEARTEXT CRYPT MD5 SHA1 mkpasswd/; our @ISA = qw(Exporter); # 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 ($pw, $h, $salt) = @_; $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 24 to 31 bytes. sub make_salt { my $len = 31 - int( rand(8) ); my @bytes = (); for my $i ( 1 .. $len ) { push( @bytes, rand(255) ); } 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 ) { $b64_digest .= '='; } return $b64_digest; } # Our policy for automatically generated passwords. sub mkpasswd { return String::MkPasswd::mkpasswd( -length => 20, -minnum => 5, -minspecial => 3 ); } =head1 AUTHORS Stefan Kangas C<< >> Guilhem Moulin C<< >> =head1 BUGS Please report any bugs to C<< >> =head1 COPYRIGHT Copyright (c) 2010 Dominik Schulz (dominik.schulz@gauner.org). All rights reserved. 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 the same terms as Perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut 1; # End of Password.pm __END__