Apache2-AuthCookieDBI

 view release on metacpan or  search on metacpan

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

        return $session_key;
    }

    my $cipher = $class->_get_cipher_for_type( $dbi_encryption_type, $auth_name,
        $secret_key );
    my $encrypted_key = $cipher->encrypt_hex($session_key);
    return $encrypted_key;
}

#-------------------------------------------------------------------------------
# _log_not_set -- Log that a particular authentication variable was not set.

sub _log_not_set {
    my ( $class, $r, $variable ) = @_;
    my $auth_name = $r->auth_name;
    my $message   = "${class}\t$variable not set for auth realm $auth_name";
    $class->logger( $r, Apache2::Const::LOG_ERR, $message, undef,
        LOG_TYPE_SYSTEM, $r->uri );
    return;
}

#-------------------------------------------------------------------------------
# _dir_config_var -- Get a particular authentication variable.

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

    my ( $class, $r ) = @_;

    my %c;    # config variables hash
    foreach my $variable ( keys %CONFIG_DEFAULT ) {
        my $value_from_config = $class->_dir_config_var( $r, $variable );
        $c{$variable}
            = defined $value_from_config
            ? $value_from_config
            : $CONFIG_DEFAULT{$variable};
        if ( !defined $c{$variable} ) {
            $class->_log_not_set( $r, $variable );
        }
    }

    # If we used encryption we need to pull in Crypt::CBC.
    if ( $c{'DBI_EncryptionType'} ne 'none' ) {
        require Crypt::CBC;
    }

    # Compile module for password encryption, if needed.
    if ( $c{'DBI_CryptType'} =~ /^sha/ ) {

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

    );
    return $password_checker{$crypt_type}->();
}

#-------------------------------------------------------------------------------
# _percent_encode -- Percent-encode (like URI encoding) any non-alphanumberics
# in the supplied string.

sub _percent_encode {
    my ($str) = @_;
    my $not_a_word = qr/ ( \W ) /x;
    $str =~ s/$not_a_word/ uc sprintf '%%%02x', ord $1 /xmeg;
    return $str;
}

#-------------------------------------------------------------------------------
# _percent_decode -- Percent-decode (like URI decoding) any %XX sequences in
# the supplied string.

sub _percent_decode {
    my ($str) = @_;
    my $percent_hex_string_regex = qr/ %([0-9a-fA-F]{2}) /x;

t/utils.t  view on Meta::CPAN

    my $r         = set_up($auth_name);
    my $user      = 'TestUser';

    # The default config has an empty string for DBI_UserActiveField
    my $is_active = CLASS_UNDER_TEST->user_is_active( $r, $user );
    Test::More::ok( $is_active, 'test_user_is_active() for default config' );

    # Now set DBI_UserActiveField so that user status is determined by
    # a call to the database (we'll intercept here using mocks.)
    $r->{'mock_config'}->{"${auth_name}DBI_UserActiveField"} = 'active';
    my $not_active;

    # Simulate a user the database says is not active.
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return;    # simulates user is not active
        };
        $not_active = CLASS_UNDER_TEST->user_is_active( $r, $user );
    }
    Test::More::ok( !$not_active,
        'test_user_is_active() inactive user using DBI_UserActiveField' )
        || Test::More::diag("Expected a non-true value, got '$not_active'");

    # Now simulate an active user whose status is fetch from the database
    my $active_user;
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return 'yes';    # simulates an active user
        };
        $active_user = CLASS_UNDER_TEST->user_is_active( $r, $user );
    }

t/utils24.t  view on Meta::CPAN

    my $r         = set_up($auth_name);
    my $user      = 'TestUser';

    # The default config has an empty string for DBI_UserActiveField
    my $is_active = CLASS_UNDER_TEST->user_is_active( $r, $user );
    Test::More::ok( $is_active, 'test_user_is_active() for default config' );

    # Now set DBI_UserActiveField so that user status is determined by
    # a call to the database (we'll intercept here using mocks.)
    $r->{'mock_config'}->{"${auth_name}DBI_UserActiveField"} = 'active';
    my $not_active;

    # Simulate a user the database says is not active.
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return;    # simulates user is not active
        };
        $not_active = CLASS_UNDER_TEST->user_is_active( $r, $user );
    }
    Test::More::ok( !$not_active,
        'test_user_is_active() inactive user using DBI_UserActiveField' )
        || Test::More::diag("Expected a non-true value, got '$not_active'");

    # Now simulate an active user whose status is fetch from the database
    my $active_user;
    {
        no warnings qw(once redefine);
        local *DBI::Mock::sth::fetchrow_array = sub {
            return 'yes';    # simulates an active user
        };
        $active_user = CLASS_UNDER_TEST->user_is_active( $r, $user );
    }