From b1fe11c6c9ae79bd8714ba7e627cff1665198fd4 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Sun, 15 Apr 2012 16:32:19 +0200
Subject: Use S-SHA1 by default.

---
 fripost-mkpass          | 36 +++++++++++++------
 lib/Fripost/Password.pm | 96 +++++++++++++++++++++++++++++++++++++++++++------
 2 files changed, 112 insertions(+), 20 deletions(-)

diff --git a/fripost-mkpass b/fripost-mkpass
index c6a261b..c30bd37 100755
--- a/fripost-mkpass
+++ b/fripost-mkpass
@@ -6,7 +6,16 @@ use strict;
 
 =head1 NAME
 
-fripost-mkpass - Create a random new password
+fripost-mkpass - Create a random new password, and returns its hash
+
+=head1 SYNOPSIS
+
+B<fripost-mkpass> [I<password>]
+
+=head1 DESCRIPTION
+
+Use I<password> if given, otherwise generate a random new password, and
+print both the clear copy and a salted SHA-1 hash.
 
 =cut
 
@@ -15,30 +24,37 @@ use lib "$Bin/lib";
 
 our $VERSION = '0.01';
 
+use Getopt::Long qw /:config noauto_abbrev no_ignore_case
+                             gnu_compat bundling permute nogetopt_compat
+                             auto_version auto_help/;
+use Pod::Usage;
 use Fripost::Password;
-use String::MkPasswd qw/mkpasswd/;
+
+GetOptions( "man" => sub { pod2usage(-exitstatus => 0,
+                                     -verbose => 2) }
+    ) or pod2usage(2);
 
 # Generate password
 my $password = $ARGV[0];
+$password //= mkpasswd();
 
-$password //= mkpasswd(
-    -length => 20,
-    -minnum => 5,
-    -minspecial => 3
-);
 
 # Show the information that will be inserted
-say "Password: $password";
-say "Salted MD5: " . smd5($password);
+say "Password:     " . $password;
+say "Salted SHA-1: " . hash(SHA1, undef, $password);
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Stefan Kangas C<< <skangas at skangas.se> >>
 
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
 =head1 COPYRIGHT
 
 Copyright 2010,2011 Stefan Kangas.
 
+Copyright 2012 Guilhem Moulin.
+
 =head1 LICENSE
 
 This program is free software; you can redistribute it and/or modify it
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
-- 
cgit v1.2.3