1 files changed, 133 insertions, 0 deletions
diff --git a/lib/Fripost/Schema/Password.pm b/lib/Fripost/Schema/Password.pm
new file mode 100644
index 0000000..cb2ac49
--- /dev/null
+++ b/lib/Fripost/Schema/Password.pm
@@ -0,0 +1,133 @@
+package Fripost::Schema::Password;
+
+use 5.010_000;
+use strict;
+use warnings;
+
+=head1 NAME
+
+Password.pm - Hash and generate passwords
+
+=cut
+
+our $VERSION = '0.02';
+
+use Exporter 'import';
+use String::MkPasswd;
+use Digest::SHA;
+use MIME::Base64;
+
+our @EXPORT_OK = qw/hash pwgen/;
+
+
+=head1 FUNCTIONS
+
+=over 4
+
+=item B<hash> ([I<salt>])
+
+SHA-1 hash the given password. I<salt>, if defined and not empty, is
+used to salt the password. If I<salt> is not defined, a random 4 bytes
+salt is used. If I<salt> is the empty string, the hash is not salted.
+
+The used scheme precedes the hash, so the output is ready to be inserted
+in a LDAP entry for instance.
+
+=cut
+
+sub hash {
+    my ($pw, $salt) = @_;
+
+    $salt //= &_make_salt();
+    my $str = 'SHA';
+    $str = 'SSHA' if &_is_salted( $salt );
+
+    { no strict "refs";
+      $str = '{' .$str. '}' .
+        &_pad_base64( MIME::Base64::encode(
+                        Digest::SHA::sha1( $pw.$salt ) . $salt,
+                        '' ) );
+    };
+    return $str;
+}
+
+
+sub _is_salted { return ( not ( defined $_[0] ) or $_[0] ne '' ) };
+
+
+# Generate a (random) 4 bytes salt. We only generates 4 bytes here to
+# match the other way to hash & salt passwords (`slappasswd' and the
+# RoundCube passwords).
+sub _make_salt {
+    my $len   = 4;
+    my @bytes = ();
+    for my $i ( 1 .. $len ) {
+        push( @bytes, rand(255) );
+    }
+    return pack( 'C*', @bytes );
+}
+
+
+# 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;
+}
+
+
+=item B<pwgen>
+
+Generate a random password that complies to B<Fripost>'s password
+policy.
+
+=cut
+
+sub pwgen {
+    return String::MkPasswd::mkpasswd(
+        -length => 12,
+        -minnum => 2,
+        -minspecial => 1
+    );
+}
+
+=back
+
+=cut
+
+
+=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> >>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2010 Dominik Schulz (dominik.schulz@gauner.org). All rights reserved.
+
+Copyright 2010,2011 Stefan Kangas, all rights reserved.
+
+Copyright 2012,2013 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__