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__