view release on metacpan or  search on metacpan

lib/Apache2/API.pm  view on Meta::CPAN

    return( $self->error( "No password was provided." ) ) if( !defined( $pwd ) );
    $self->{create}        = 0     if( !exists( $self->{create} ) );
    # md5 | bcrypt | sha256 | sha512
    $self->{algo}          = 'md5' if( !exists( $self->{algo} ) );
    # 04..31
    $self->{bcrypt_cost}   = 12    if( !exists( $self->{bcrypt_cost} ) );
    # undef => default (5000)
    $self->{sha_rounds}    = undef if( !exists( $self->{sha_rounds} ) );
    # By default, like Apache does, we use Apache md5 algorithm
    # Other possibilities are bcrypt (Blowfish)
    $self->SUPER::init( @_ ) ||
        return( $self->pass_error );
    if( $self->{create} )
    {
        my $hash = $self->make( $pwd ) ||
            return( $self->pass_error );
        $self->hash( $hash );
    }
    # Existing hash path: validate by known prefixes, also extract salt into ->salt
    elsif( $pwd =~ /\A$APR1_RE\z/ ||
           $pwd =~ /\A$BCRYPT_RE\z/ ||
           $pwd =~ /\A$SHA_RE\z/ )
    {
        $self->hash( $pwd );
    }
    else
    {
        return( $self->error(
            "Value provided is not a recognized hash (APR1/bcrypt/SHA-crypt). " .
            "If you want to create one from clear text, use the 'create' option."
        ) );
    }
    return( $self );
}

sub algo { return( shift->_set_get_enum({
    field => 'algo',
    allowed => [qw( md5 bcrypt sha256 sha512 )],
}, @_ ) ); }

sub bcrypt_cost { return( shift->_set_get_scalar({
    field => 'bcrypt_cost',
    check => sub
    {
        my( $self, $v ) = @_;
        return(1) unless( defined( $v ) );
        unless( $v =~ /^\d+$/ && 
                $v >= 4 &&
                $v <= 31 )
        {
            return( $self->error( "bcrypt_cost must be between 4 and 31" ) );
        }
        return(1);
    },
}, @_ ) ); }

sub create { return( shift->_set_get_boolean( 'create', @_ ) ); }

sub hash { return( shift->_set_get_scalar({
    field => 'hash',
    callbacks =>
    {
        set => sub
        {
            my( $self, $v ) = @_;
            if( $v =~ /\A$APR1_RE\z/ )
            {
                $self->{salt} = $+{salt}
            }
            elsif( $v =~ /\A$BCRYPT_RE\z/ )
            {
                $self->{salt} = $+{salt};
                $self->{bcrypt_cost} = $+{bcrypt_cost};
            }
            elsif( $v =~ /\A$SHA_RE\z/ )
            {
                $self->{salt} = $+{salt};
                $self->{sha_rounds} = $+{rounds} if( defined( $+{rounds} ) );
            }
            else
            {
                return( $self->error( "Not a valid Apache hash (APR1/bcrypt/SHA-crypt)" ) );
            }
            return( $v );
        },
    },
}, @_ ) ); }

sub make
{
    my $self = shift( @_ );
    my( $passwd, $salt ) = @_;

    my $algo = lc( $self->{algo} || 'md5' );
    # md5, bcrypt, sha256, sha512
    my $code = $self->can( "make_${algo}" ) ||
        return( $self->error( "No method defined to handle algorithm '$algo'." ) );
    return( $code->( $self, $passwd, $salt ) );
}

sub make_bcrypt
{
    my $self = shift( @_ );
    my $passwd = shift( @_ );
    my $salt = shift( @_ ) || $self->{salt};

    my $cost = $self->bcrypt_cost;
    $cost = 12 if( !defined( $cost ) || $cost < 4 || $cost > 31 );

    # Generate a 22-char bcrypt-base64 salt. Easiest: draw from allowed alphabet.
    # (Most libc crypt() accept any 22 chars in the bcrypt alphabet.)

    # 22 chars from [./A-Za-z0-9]
    # $salt //= $self->_make_salt(22);
    $salt //= $self->_make_salt_bcrypt;
    if( !defined( $salt ) )
    {
        return( $self->pass_error );
    }
    elsif( $salt =~ m,[^./0-9A-Za-z], )
    {