Use S-SHA1 by default.

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