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<< <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 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__