Apache2-API

 view release on metacpan or  search on metacpan

CHANGES  view on Meta::CPAN

    - Changed the method length() in Apache2::API::Request from wrongly using bytes_sent() to using the incoming headers field 'Content-Length'

v0.4.1 2025-10-07T08:09:10+0900
    - Corrected the key support method _try so that it honours the list call context

v0.4.0 2025-09-30T20:30:14+0900
    - Adding the log method to access the Apache2::Log::Request object
    - Added the methods is_initial_req and psignature to Apache2::API::Request
    - Added the method 'apr1_md5' to generate htpasswd
    - Added the method 'htpasswd' to instantiate new Apache2::API::Password objects
    - Added class Apache2::API::Password to handle md5, blowfish (bcrypt), and SHA-256, SHA-512 Apache passwords

v0.3.1 2024-09-04T20:28:56+0900
    - Removed dependency on Devel::Confess. Best added by the user himself

v0.3.0 2024-04-10T06:34:12+0900
    - Improved method bailout.
    - Added method is_aborted in Apache2::API::Request

v0.2.0 2024-02-22T19:04:51+0900
    - Improved method reply()

README.md  view on Meta::CPAN

    }) );
    # Apache2::API::Request
    my $req = $api->request;
    # Apache2::API::Response
    my $req = $api->response;
    my $server = $api->server;
    my $version = $api->server_version;
    $api->set_handlers( $name => $code_reference );
    $api->warn( @some_warnings );

    my $hash = apr1_md5( $clear_password );
    my $hash = apr1_md5( $clear_password, $salt );
    my $ht = $api->htpasswd( $clear_password );
    my $ht = $api->htpasswd( $clear_password, salt => $salt );
    my $hash = $ht->hash;
    say "Does our password match ? ", $ht->matches( $user_clear_password ) ? "yes" : "not";

# VERSION

    v0.4.0

# DESCRIPTION

This module provides a comprehensive, powerful, yet simple framework to access [Apache mod\_perl's API](https://perl.apache.org/docs/2.0/api/) and documented appropriately.

Apache mod\_perl is an awesome framework, but quite complexe with a steep learning curve and methods all over the place. So much so that [they have developed a module dedicated to find appropriate methods](https://perl.apache.org/docs/2.0/user/coding...

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

# Compile the regular expression once
our $APR1_RE   = qr/\$apr1\$(?<salt>[.\/0-9A-Za-z]{1,8})\$[.\/0-9A-Za-z]{22}/;
our $BCRYPT_RE = qr/\$2[aby]\$(?<bcrypt_cost>\d{2})\$(?<salt>[A-Za-z0-9.\/]{22})[A-Za-z0-9.\/]{31}/;
our $SHA_RE    = qr/\$(?<sha_size>[56])\$(?:rounds=(?<rounds>\d+)\$)?(?<salt>[A-Za-z0-9.\/]{1,16})\$[A-Za-z0-9.\/]+/;
our $VERSION   = 'v0.1.0';

sub init
{
    my $self = shift( @_ );
    my $pwd  = shift( @_ );
    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( @_ ) ||

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

    $salt //= $self->_make_salt(8);
    if( $salt =~ m,[^./0-9A-Za-z], )
    {
        return( $self->error( "Salt value provided contains illegal characters." ) );
    }
    $salt = substr( $salt, 0, 8 );
    $self->_load_class( 'Digest::MD5' ) ||
        return( $self->pass_error );

    my $magic = '$apr1$';
    # 1) initial ctx: password + magic + salt
    my $ctx = Digest::MD5->new;
    local $@;
    # try-catch
    eval
    {
        $ctx->add( $passwd, $magic, $salt );
    };
    if( $@ )
    {
        return( $self->error( "Error adding string to create MD5 hash: $@" ) );
    }

    # 2) alternate sum: md5(password + salt + password)
    my $alt = Digest::MD5->new;
    eval
    {
        $alt->add( $passwd, $salt, $passwd );
    };
    if( $@ )
    {
        return( $self->error( "Error adding string to create MD5 hash: $@" ) );
    }
    # 16 bytes

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

        eval
        {
            $ctx->add( substr( $alt_result, 0, $i < 16 ? $i : 16 ) );
        };
        if( $@ )
        {
            return( $self->error( "Error adding string to create MD5 hash: $@" ) );
        }
    }

    # 4) mix in bytes based on bits of password length
    for( my $i = $plen; $i > 0; $i >>= 1 )
    {
        eval
        {
            if( $i & 1 )
            {
                $ctx->add( pack( 'C', 0 ) );
            }
            else
            {

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

            # Fallback 2: Crypt::Bcrypt
            elsif( $self->_load_class( 'Crypt::Bcrypt' ) )
            {
                # try-catch
                my $bool = eval
                {
                    Crypt::Bcrypt::bcrypt_check( $pwd => $hash );
                };
                if( $@ )
                {
                    return( $self->error( "Error checking if password matches using Crypt::Bcrypt: $@" ) );
                }
                return( $bool );
            }
            # Fallback 3: Crypt::Eksblowfish::Bcrypt (settings must have bcrypt-base64 salt)
            elsif( $self->_load_class( 'Crypt::Eksblowfish::Bcrypt' ) )
            {
                # try-catch
                $out = eval
                {
                    Crypt::Eksblowfish::Bcrypt::bcrypt( $pwd, $hash );
                };
                if( $@ )
                {
                    return( $self->error( "Error generating bcrypt hash with Crypt::Eksblowfish::Bcrypt: $@" ) );
                }
                return( defined( $out ) && $out eq $hash );
            }
            elsif( $crypt_error )
            {
                return( $self->error( "Error checking bcrypt password: $crypt_error" ) );
            }
        }
        return( defined( $out ) && $out eq $hash );
    }
    elsif( $hash =~ /\A$SHA_RE\z/ )
    {
        # try-catch
        my $out = eval
        {
            crypt( $pwd, $hash );

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

    
        if( $self->_load_class( 'Crypt::Passwd::XS' ) )
        {
            # try-catch
            $out = eval
            {
                Crypt::Passwd::XS::crypt( $pwd, $hash );
            };
            if( $@ )
            {
                return( $self->error( "Error checking the password using Crypt::Passwd::XS: $@" ) );
            }
            return( defined( $out ) && $out eq $hash );
        }
        elsif( $crypt_error )
        {
            return( $self->error( "Error checking SHA password: $crypt_error" ) );
        }
        return(0);
    }
    else
    {
        return(0);
    }
}

sub salt { return( shift->_set_get_scalar( 'salt', @_ ) ); }

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

    }) );
    # Apache2::API::Request
    my $req = $api->request;
    # Apache2::API::Response
    my $req = $api->response;
    my $server = $api->server;
    my $version = $api->server_version;
    $api->set_handlers( $name => $code_reference );
    $api->warn( @some_warnings );

    my $hash = apr1_md5( $clear_password );
    my $hash = apr1_md5( $clear_password, $salt );
    my $ht = $api->htpasswd( $clear_password );
    my $ht = $api->htpasswd( $clear_password, salt => $salt );
    my $hash = $ht->hash;
    say "Does our password match ? ", $ht->matches( $user_clear_password ) ? "yes" : "not";

=head1 VERSION

    v0.5.0

=head1 DESCRIPTION

This module provides a comprehensive, powerful, yet simple framework to access L<Apache mod_perl's API|https://perl.apache.org/docs/2.0/api/> and documented appropriately.

Apache mod_perl is an awesome framework, but quite complexe with a steep learning curve and methods all over the place. So much so that L<they have developed a module dedicated to find appropriate methods|https://perl.apache.org/docs/2.0/user/coding/...

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

Get the localised version of the string passed as an argument.

This is supposed to be superseded by the package inheriting from L<Apache2::API>, if any.

=head2 header_datetime( DateTime object )

Given a L<DateTime> object, this sets it to GMT time zone and set the proper formatter (L<Apache2::API::DateTime>) so that the stringification is compliant with HTTP headers standard.

=head2 htpasswd

    my $ht = $api->htpasswd( $clear_password, create => 1 );
    my $ht = $api->htpasswd( $clear_password, create => 1, salt => $salt );
    my $ht = $api->htpasswd( $md5_password );
    my $bool = $ht->matches( $user_input_password );

This instantiates a new L<Apache2::API::Password> object by providing its constructor whatever arguments was received.

It returns a new L<Apache2::API::Password> object, or, upon error, C<undef> in scalar context, or an empty list in list context.

=head2 is_perl_option_enabled

Checks if perl option is enabled in the Virtual Host and returns a boolean value

=head2 json

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

=head2 _try( $object_type, $method_name, @_ )

Given an object type, a method name and optional parameters, this attempts to call it, passing it whatever arguments were provided and return its return values.

Apache2 methods are designed to die upon error, whereas our model is based on returning C<undef> and setting an exception with L<Module::Generic::Exception>, because we believe that only the main program should be in control of the flow and decide wh...

=head1 CLASS FUNCTIONS

=head2 apr1_md5

    my $md5_password = apr1_md5( $clear_password );
    my $md5_password = apr1_md5( $clear_password, $salt );

This class function is exported by default.

It takes a clear password, and optionally a salt, and returns an Apache md5 encoded password.

This function merely instantiates a new L<Apache2::API::Password> object, and calls the method L<hash|Apache2::API::Password/hash> to return the encoded password.

The password returned is suitable to be used and saved in an Apache password file used in web basic authentication.

Upon error, this will die.

=head1 CONSTANTS

C<mod_perl> provides constants through L<Apache2::Constant> and L<APR::Constant>. L<Apache2::API> makes all those constants available using their respective package name, such as:

    use Apache2::API;
    say Apache2::Const::HTTP_BAD_REQUEST; # 400

lib/Apache2/API/Password.pod  view on Meta::CPAN

=encoding utf8

=head1 NAME

Apache2::API::Password - Create and verify HTTP Basic Auth password hashes (APR1/bcrypt/SHA-crypt)

=head1 SYNOPSIS

	use Apache2::API::Password;
    # Create a new hash from a cleartext password (random salt)
    # MD5-crypt (APR1, "$apr1$") — default
    my $ht = Apache2::API::Password->new( 'secret', create => 1 );
    my $hash = $ht->hash; # "$apr1$abcd1234$...."

    # Create APR1 with a provided salt (max 8 chars; [./0-9A-Za-z])
    my $ht2 = Apache2::API::Password->new( 'secret', create => 1, salt => 'hfT7jp2q' );
    say $ht2->hash;

    # Wrap an existing APR1 ($apr1$) hash and verify user input
    my $ht3 = Apache2::API::Password->new( '$apr1$hfT7jp2q$DcU1Hf5w2Q/9G8yqv1hbl.' );

lib/Apache2/API/Password.pod  view on Meta::CPAN


    # Bcrypt ($2y$), choose a cost (04..31); defaults to 12
    my $b  = Apache2::API::Password->new('s3cret', create => 1, algo => 'bcrypt', bcrypt_cost => 12);
    say $b->hash; # "$2y$12$..."

    # SHA-crypt ($5$ = SHA-256, $6$ = SHA-512), optionally set rounds
    my $s6 = Apache2::API::Password->new('s3cret', create => 1, algo => 'sha512', sha_rounds => 150000);
    say $s6->hash; # "$6$rounds=150000$..."

    # Accessors
	my $hahs_password = $ht->hash;
	# parsed from the hash
    my $salt = $ht3->salt;

=head1 VERSION

    v0.1.0

=head1 DESCRIPTION

C<Apache2::API::Password> creates and verifies password hashes used by Apache HTTP Basic Authentication. It supports:

=over 4

=item * APR1 / MD5-crypt (C<$apr1$>) — same as C<htpasswd -m>

This implements the full APR1 algorithm (password + magic + salt, alternate sum, bit-mixing, 1000 rounds, and the crypt-style 64-symbol encoding) and is fully compatible with Apache’s C<htpasswd -m> and L<Crypt::PasswdMD5/ apache_md5_crypt>.

=item * bcrypt (C<$2y$>) — same as C<htpasswd -B>

Generated via the system C<crypt(3)> when available; otherwise falls back to C<Authen::Passphrase::BlowfishCrypt>, C<Crypt::Bcrypt>, or
C<Crypt::Eksblowfish::Bcrypt>.

=item * SHA-crypt (C<$5$ = SHA-256, $6$ = SHA-512>) — same as C<htpasswd -2> / C<-5>

Generated via the system C<crypt(3)> when available; otherwise falls back to C<Crypt::Passwd::XS>.

=back

This class handles existing Apache password or create new ones, and makes it possible to retrieve the encoded password, or to test if a user-provided clear password matches.

When constructing from an existing hash, the scheme is auto-detected by prefix (C<$apr1$>, C<$2y$>, C<$5$>, C<$6$>) and C<matches> uses the appropriate verifier.

=head2 CONSTRUCTOR

=head2 new

    my $ht = Apache2::API::Password->new( $clear, create => 1 );
    my $ht = Apache2::API::Password->new( $clear, create => 1, salt => $salt );
    my $ht = Apache2::API::Password->new( $apr1_hash );

    # Multi-algorithm creation:
    my $b  = Apache2::API::Password->new( $clear, create => 1, algo => 'bcrypt', bcrypt_cost => 12 );
    my $s5 = Apache2::API::Password->new( $clear, create => 1, algo => 'sha256', sha_rounds => 6000 );
    my $s6 = Apache2::API::Password->new( $clear, create => 1, algo => 'sha512', sha_rounds => 150000 );

This creates an instance either from:

=over 4

=item * a cleartext password (C<$clear>) with C<create =E<gt> 1>

Generates a new hash. If C<salt> is provided:

=over 8

=item * APR1: clamped to C<[./0-9A-Za-z]>, truncated to 8 chars.

=item * bcrypt: 22 chars in C<[./0-9A-Za-z]> (bcrypt base64).

=item * SHA-crypt: up to 16 chars in C<[./0-9A-Za-z]>.

lib/Apache2/API/Password.pod  view on Meta::CPAN


If omitted, a random salt is generated from a cryptographic RNG when available.

=item * an existing modular-crypt hash string

E.g. the right-hand side of a C<.htpasswd> line: C<$apr1$...>, C<$2y$...>,
C<$5$...>, or C<$6$...>. The salt (and rounds/cost where applicable) are parsed.

=back

Note that the Apache algorithm to generate md5 password is not the same as simply using L<Digest::MD5>. Apache algorithm uses a more enhanced approach with a thousand iterations.

This constructor returns the newly instantiated object upon succes, or, upon error, returns C<undef> in scalar context, or an empty list in list context.

=head1 METHODS

=head2 algo

    # or 'bcrypt', 'sha256', 'sha512'
    $ht->algo( 'md5' );
    my $which = $ht->algo;

lib/Apache2/API/Password.pod  view on Meta::CPAN


=head2 sha_rounds

    $ht->sha_rounds(150000);
    my $r = $ht->sha_rounds;

Sets or gets the number of rounds for C<SHA-256/512> (1000–999999999). Default is 5000.

=head2 make

    my $hash = $ht->make( $clear_password );
    my $hash = $ht->make( $clear_password, $salt );

Generates a hash using the selected L<algorithm|/algo>. If C<$salt> is omitted, the value stored in L</salt> is used or a random C<salt> is generated. The C<salt> is clamped to the valid alphabet and truncated to the appropriate number of characters ...

Returns the generated hash on success, or, upon error, C<undef> in scalar context, or an empty list in list context.

=head2 make_md5

    my $hash = $ht->make_md5( $clear_password, $salt );

Generates an APR1 MD5 hash (C<$apr1$<salt>$<hash>). Salt is 1–8 chars, default random.

=head2 make_bcrypt

    my $hash = $ht->make_bcrypt( $clear_password, $salt );

Generates a bcrypt hash (C<$2y$<cost>$<salt-and-hash>). Salt is 22 chars, default random. Uses C<bcrypt_cost>.

=head2 make_sha256

    my $hash = $ht->make_sha256( $clear_password, $salt );

Generates a SHA-256 crypt hash (C<$5$[rounds=<n>$]<salt>$<hash>). Salt is 1–16 chars, default random. Uses C<sha_rounds>.

=head2 make_sha512

    my $hash = $ht->make_sha512( $clear_password, $salt );

Generates a SHA-512 crypt hash (C<$6$[rounds=<n>$]<salt>$<hash>). Salt is 1–16 chars, default random. Uses C<sha_rounds>.

=head2 matches

    my $ok = $ht->matches( $user_input_password );

Compute a fresh hash using the instance salt and compare with the stored L<hash|/hash>.

Returns true if the cleartext password matches.

=head1 EXAMPLES

=head2 Creating a C<.htpasswd> line

    my $user = 'john';
    my $ht   = Apache2::API::Password->new( 's3cret', create => 1 );
    say join( ':', $user, $ht->hash );

=head2 Verifying a login

    my $stored = '$apr1$hfT7jp2q$DcU1Hf5w2Q/9G8yqv1hbl.';
    my $ht     = Apache2::API::Password->new( $stored );
    if( $ht->matches( $input_password ) )
    {
        # ok
    }

=head1 THREAD SAFETY

This module keeps per-object state only (C<algo>, C<salt>, C<bcrypt_cost>, C<sha_rounds>, C<hash>) and uses no mutable global variables except precompiled regex constants. As such, it is I<re-entrant> and safe to use from multiple Perl L<ithreads|per...

For bcrypt/SHA-crypt, verification/generation prefers the system C<crypt(3)>; on modern libcs this is thread-safe. When the system lacks support, fallbacks are used:

lib/Apache2/API/Password.pod  view on Meta::CPAN

=item * SHA-crypt output is compatible with C<htpasswd -2> (C<$5$>) and C<-5> (C<$6$>).

=back

All 64 encoding symbols (including trailing C<.> or C</>) are valid.

=head1 SECURITY NOTES

=over 4

=item * Empty passwords

All algorithms accept empty strings. An empty password will verify successfully if you store its hash. Avoid this in production.

=item * Legacy algorithm

APR1/MD5-crypt is legacy and weak by modern standards. Prefer C<bcrypt> (with a cost appropriate to your CPU budget) or C<sha512> (SHA-crypt) where bcrypt is not available; retain C<APR1> only for Apache compatibility. For bcrypt, remember the 72-byt...

=back

=head1 AUTHOR

Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>

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

        }
    }
    if( $vers )
    {
        $self->{_server_version} = $SERVER_VERSION = version->parse( $vers );
        return( $self->{_server_version} );
    }
    return( '' );
}

# e.g. set_basic_credentials( $user, $password );
sub set_basic_credentials { return( shift->_try( 'request', 'set_basic_credentials', @_ ) ); }

# set_handlers( PerlCleanupHandler => [] );
# $ok = $r->set_handlers($hook_name => \&handler);
# $ok = $r->set_handlers($hook_name => ['Foo::Bar::handler', \&handler2]);
# $ok = $r->set_handlers($hook_name => []);
# $ok = $r->set_handlers($hook_name => undef);
# https://perl.apache.org/docs/2.0/api/Apache2/RequestUtil.html#C_set_handlers_
sub set_handlers { return( shift->_try( 'request', 'set_handlers', @_ ) ); }

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

    my $server = $req->server;
    my $addr = $req->server_addr;
    my $admin = $req->server_admin;
    my $hostname = $req->server_hostname;
    my $name = $req->server_name;
    my $port = $req->server_port;
    my $proto = $req->server_protocol;
    my $sig = $req->server_signature;
    my $software = $req->server_software;
    my $vers = $req->server_version;
    $req->set_basic_credentials( $user => $password );
    $req->set_handlers( $name => $code_ref );
    my $data = $req->slurp_filename;
    # Apache2::Connection object
    my $socket = $req->socket;
    my $status = $req->status;
    my $line = $req->status_line;

    my $dt = $req->str2datetime( $http_date_string );
    my $rc = $req->subnet_of( $ip, $mask );
    # APR::Table object

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

    my( $rc, $passwd ) = $req->basic_auth_passwd;

Get the details from the basic authentication, by calling L<Apache2::Access/get_basic_auth_pw>

It returns:

=over 4

=item 1. the value of an Apache constant

This would be C<Apache2::Const::OK> if the password value is set (and assured a correct value in L</user>); otherwise it returns an error code, either C<Apache2::Const::HTTP_INTERNAL_SERVER_ERROR> if things are really confused, C<Apache2::Const::HTTP...

=item 2. the password as set in the headers (decoded)

=back

Note that if C<AuthType> is not set, L<Apache2::Access/get_basic_auth_pw> first sets it to C<Basic>.

=head2 body

Returns an L<APR::Request::Param::Table|APR::Request::Param> object containing the C<POST> data parameters of the L<Apache2::Request> object.

    my $body = $req->body;

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

If this does not work too, it will try to call the Apache binary (C<apache2> or C<httpd>) like:

    apache2 -v

and extract the version.

It returns the version found as a L<version> object, or an empty string if nothing could be found.

=head2 set_basic_credentials

Provided with a user name and a password, this populates the incoming request headers table (C<headers_in>) with authentication headers for Basic Authorization as if the client has submitted those in first place:

    $req->set_basic_credentials( $username, $password );

See L<Apache2::RequestUtil> for more information.

=head2 set_handlers

Set a list of handlers to be called for a given phase. Any previously set handlers are forgotten.

See L<Apache2::RequestUtil/set_handlers> for more information.

     $ok = $req->set_handlers( $hook_name => \&handler );

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


    HTTP/1.1 401 Unauthorized
    WWW-Authenticate: Basic; realm="Dev zone", Bearer

which equates to:

    HTTP/1.1 401 Unauthorized
    WWW-Authenticate: Basic; realm="Dev zone"
    WWW-Authenticate: Bearer

So, for example, a user C<aladdin> with password C<opensesame> would result in the following request:

    GET / HTTP/1.1
    Authorization: Basic YWxhZGRpbjpvcGVuc2VzYW1l

See also L<Mozilla documentation on Authorization header|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Authorization>

=head2 HTTP_PAYMENT_REQUIRED (402)

See L<rfc 7231, section 6.5.2|https://tools.ietf.org/html/rfc7231#section-6.5.2>

t/06.apr1.t  view on Meta::CPAN


    my $alphabet = qr/[.\/0-9A-Za-z]/;
    ok( ( $salt =~ /\A$alphabet+\z/ ), 'salt chars in alphabet' );
    ok( ( $body =~ /\A$alphabet+\z/ ), 'body chars in alphabet' );
};

subtest 'determinism for fixed salt' => sub
{
    my $h1 = apr1_md5( 'secret', 'hfT7jp2q' );
    my $h2 = apr1_md5( 'secret', 'hfT7jp2q' );
    is( $h1, $h2, 'same password+salt => same hash' );
    like( $h1, qr/\A\$apr1\$hfT7jp2q\$[.\/0-9A-Za-z]{22}\z/, 'hash contains given salt' );
};

subtest 'verify positive/negative' => sub
{
    my $h = apr1_md5( 'opensesame', 'AB12.Cd/' );
    ok( verify_apr1( 'opensesame', $h ), 'verify succeeds on correct password' );
    ok( !verify_apr1( 'wrong',     $h ), 'verify fails on wrong password' );

    ok( !verify_apr1( 'opensesame', '$apr1$bad*salt$xxxxxxxxxxxxxxxxxxxxxx' ), 'rejects invalid salt chars' );
    ok( !verify_apr1( 'opensesame', '$apr1$short$too_short' ),                 'rejects invalid body length' );
};

subtest 'random salt uniqueness' => sub
{
    my %seen;
    my $collisions = 0;
    for( 1..50 )

t/06.apr1.t  view on Meta::CPAN

        my( $s ) = $h =~ /\A\$apr1\$([.\/0-9A-Za-z]{1,8})\$/;
        $collisions++ if( $seen{ $s }++ );
    }
    ok( $collisions == 0, 'no salt collisions in 50 samples (probabilistic)' );
};

subtest 'cross-check with Crypt::PasswdMD5 (if available)' => sub
{
    my @cases = (
        [ 'secret',    'hfT7jp2q' ],
        [ 'password',  'abcd1234' ],
        [ 'pässwörd',  'S1.Salt/' ],  # UTF-8 input
        [ '',          'emptyslt' ],  # empty password
    );

    SKIP:
    {
        skip( 'Crypt::PasswdMD5 not installed', scalar( @cases ) ) unless( $HAVE_REF );
        for my $c ( @cases )
        {
            my( $pw, $salt ) = @$c;
            my $mine = apr1_md5( $pw, $salt );
            my $ref  = Crypt::PasswdMD5::apache_md5_crypt( $pw, $salt );



( run in 0.530 second using v1.01-cache-2.11-cpan-ff066701436 )