Apache2-AuthCookieDBI
view release on metacpan or search on metacpan
- Eliminated duplicate calls of _dbi_config_vars() to improve efficiency.
- Added docker directory that contains Dockerfiles for Apache 2.2 and 2.4
Changes by Ed Sabol https://github.com/esabol
2.18 - Sat Aug 17 12:35:38 PDT 2019
- Fix https://github.com/matisse/Apache-AuthCookieDBI/issues/3
"DBI_CryptType crypt does not appear to work"
Changes by Ed Sabol https://github.com/esabol
2.17 - Thu Dec 6 03:41:41 GMT 2012
- Added support for Digest::SHA::sha256/384/512_hex digests for passwords.
This is a response to https://rt.cpan.org/Ticket/Display.html?id=79333
which requested sha256_base64 but because base64 digests are not
properly padded. I chose to go with sha256/384/512_hex instead.
- Quote all database column and field names in SQL queries.
https://rt.cpan.org/Ticket/Display.html?id=79341
'Table column names may confict with sql key words'
2.16 - Sun May 27 00:23:41 PDT 2012
- Fix 'wrong method names in calls to apache request logging' for https://rt.cpan.org/Ticket/Display.html?id=77464
Incorporated bug fix for authen_ses_key() provided by
Carl Gustafsson. authen_ses_key() was not properly handling
any extra_session_info - the fix is to get $hashed_string with
my $hashed_string = pop @rest;
Also releasing the work done between April 26, 2005 and February 4, 2007,
plus bug fix for authen_ses_key
- Added basic framework for unit tests.
- Factored out some of the DBI code into new methods:
- _dbi_connect()
- _get_crypted_password()
- Changes to satisfy Perl::Critic, e.g.
- Removed function prototypes (they are ignored for methods.)
- Cleaned up regular expressions: use /x, etc.
2.03 - Mon Apr 25 10:01:04 PDT 2005
Incorporated Lance P Cleveland's changes porting module to mod_perl 1.999_22
(That is, Version 2.0.0-RC5 - April 14, 2005)
Mainly involves changing almost all references to Apache:: to Apache2::
Apache2::AuthCookieDBI is a module that subclasses Apache2::AuthCookie and is
designed to be directly used for authentication in a mod_perl server.
It is a ticket-issuing system that looks up username/passwords in a DBI
database using generic SQL and issues MD5-checksummed tickets valid for
a configurable time period. Incoming requests with tickets are
checksummed and expire-time checked.
Version 2.03 and later: mod_perl 1.999_22 and later. Apache::*
replaced by Apache2::
Latest distribution at: https://metacpan.org/pod/Apache2::AuthCookieDBI
Source code at: https://github.com/matisse/Apache-AuthCookieDBI/
generic_reg_auth_scheme.txt view on Meta::CPAN
AuthName AuthName
PerlAuthenHandler Apache::AuthCookieDBI->authenticate
PerlAuthzHandler Apache::AuthCookieDBI->authorize
Require [ valid-user, user username, group groupname ]
# you must set this.
PerlSetVar AuthNameDBI_DSN databasename
# all these are optional.
PerlSetVar AuthNameDBI_User username # default undef
PerlSetVar AuthNameDBI_Password password # default undef
PerlSetVar AuthNameDBI_UsersTable tablename # default 'users'
PerlSetVar AuthNameDBI_UserField fieldname # default 'user'
PerlSetVar AuthNameDBI_PasswordField fieldname # default 'password'
PerlSetVar AuthNameDBI_CryptType [ none, crypt, MD5 ] # default 'none'
PerlSetVar AuthNameDBI_GroupsTable tablename # default 'groups'
PerlSetVar AuthNameDBI_GroupField fieldname # default 'group'
PerlSetVar AuthNameDBI_GroupUserField fieldname # default 'user'
# dunno what this is.
DefaultTarget partial or full URL
You also need this to get people to log in (although I'm not exactly sure
why; I guess it's so that login() gets called, but why can't we check for
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
# Optional, to share tickets between servers.
PerlSetVar WhatEverDomain .domain.com
# These must be set
PerlSetVar WhatEverDBI_DSN "DBI:mysql:database=test"
PerlSetVar WhatEverDBI_SecretKey "489e5eaad8b3208f9ad8792ef4afca73598ae666b0206a9c92ac877e73ce835c"
# These are optional, the module sets sensible defaults.
PerlSetVar WhatEverDBI_User "nobody"
PerlSetVar WhatEverDBI_Password "password"
PerlSetVar WhatEverDBI_UsersTable "users"
PerlSetVar WhatEverDBI_UserField "user"
PerlSetVar WhatEverDBI_PasswordField "password"
PerlSetVar WhatEverDBI_UserActiveField "" # Default is skip this feature
PerlSetVar WhatEverDBI_CryptType "none"
PerlSetVar WhatEverDBI_GroupsTable "groups"
PerlSetVar WhatEverDBI_GroupField "grp"
PerlSetVar WhatEverDBI_GroupUserField "user"
PerlSetVar WhatEverDBI_EncryptionType "none"
PerlSetVar WhatEverDBI_SessionLifetime 00-24-00-00
# Protected by AuthCookieDBI.
<Directory /www/domain.com/authcookiedbi>
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
# If the directopry you are protecting is the DocumentRoot directory
# then uncomment the following directive:
#Satisfy any
</Files>
=head1 DESCRIPTION
This module is an authentication handler that uses the basic mechanism provided
by Apache2::AuthCookie with a DBI database for ticket-based protection. It
is based on two tokens being provided, a username and password, which can
be any strings (there are no illegal characters for either). The username is
used to set the remote user as if Basic Authentication was used.
On an attempt to access a protected location without a valid cookie being
provided, the module prints an HTML login form (produced by a CGI or any
other handler; this can be a static file if you want to always send people
to the same entry page when they log in). This login form has fields for
username and password. On submitting it, the username and password are looked
up in the DBI database. The supplied password is checked against the password
in the database; the password in the database can be plaintext, or a crypt()
or md5_hex() checksum of the password. If this succeeds, the user is issued
a ticket. This ticket contains the username, an issue time, an expire time,
and an MD5 checksum of those and a secret key for the server. It can
optionally be encrypted before returning it to the client in the cookie;
encryption is only useful for preventing the client from seeing the expire
time. If you wish to protect passwords in transport, use an SSL-encrypted
connection. The ticket is given in a cookie that the browser stores.
After a login the user is redirected to the location they originally wished
to view (or to a fixed page if the login "script" was really a static file).
On this access and any subsequent attempt to access a protected document, the
browser returns the ticket to the server. The server unencrypts it if
encrypted tickets are enabled, then extracts the username, issue time, expire
time and checksum. A new checksum is calculated of the username, issue time,
expire time and the secret key again; if it agrees with the checksum that
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
# had errors or a hash of the values if they were all OK. Takes a request
# object.
my %CONFIG_DEFAULT = (
DBI_DSN => undef,
DBI_SecretKey => undef,
DBI_User => undef,
DBI_Password => undef,
DBI_UsersTable => 'users',
DBI_UserField => 'user',
DBI_PasswordField => 'password',
DBI_UserActiveField => EMPTY_STRING, # Default is don't use this feature
DBI_CryptType => 'none',
DBI_GroupsTable => 'groups',
DBI_GroupField => 'grp',
DBI_GroupUserField => 'user',
DBI_EncryptionType => 'none',
DBI_SessionLifetime => '00-24-00-00',
DBI_sessionmodule => 'none',
);
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
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/ ) {
require Digest::SHA;
}
return %c;
}
=head1 APACHE CONFIGURATION DIRECTIVES
All configuration directives for this module are passed in PerlSetVars. These
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
See also L</"COMPATIBILITY"> in this man page.
=item C<WhatEverDBI_User>
The user to log into the database as. This is not required and
defaults to undef.
=item C<WhatEverDBI_Password>
The password to use to access the database. This is not required
and defaults to undef.
Make sure that the Perl environment variables are
not publically available, for example via the /perl-status handler since the
password could be exposed.
=item C<WhatEverDBI_UsersTable>
The table that user names and passwords are stored in. This is not
required and defaults to 'users'.
=item C<WhatEverDBI_UserField>
The field in the above table that has the user name. This is not
required and defaults to 'user'.
=item C<WhatEverDBI_PasswordField>
The field in the above table that has the password. This is not
required and defaults to 'password'.
=item C<WhatEverDBI_UserActiveField>
The field in the users' table that has a value indicating if the users' account
is "active". This is optional and the default is to not use this field.
If used then users will fail authentication if the value in this field
is not a Perlish true value, so NULL, 0, and the empty string are all false
values. The I<user_is_active> class method exposes this setting (and may be
overidden in a subclass.)
=item C<WhatEverDBI_CryptType>
What kind of hashing is used on the password field in the database. This can
be 'none', 'crypt', 'md5', 'sha256', 'sha384', or 'sha512'.
C<md5> will use Digest::MD5::md5hex() and C<sha...> will use
Digest::SHA::sha{n}_hex().
This is not required and defaults to 'none'.
=item C<WhatEverDBI_GroupsTable>
The table that has the user / group information. This is not required and
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
=item C<WhatEverDBI_GroupUserField>
The field in the above table that has the user name. This is not required
and defaults to 'user'.
=item C<WhatEverDBI_EncryptionType>
What kind of encryption to use to prevent the user from looking at the fields
in the ticket we give them. This is almost completely useless, so don't
switch it on unless you really know you need it. It does not provide any
protection of the password in transport; use SSL for that. It can be 'none',
'des', 'idea', 'blowfish', or 'blowfish_pp'.
This is not required and defaults to 'none'.
=item C<WhatEverDBI_SessionLifetime>
How long tickets are good for after being issued. Note that presently
Apache2::AuthCookie does not set a client-side expire time, which means that
most clients will only keep the cookie until the user quits the browser.
However, if you wish to force people to log in again sooner than that, set
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
=cut
#-------------------------------------------------------------------------------
# _now_year_month_day_hour_minute_second -- Return a string with the time in
# this order separated by dashes.
sub _now_year_month_day_hour_minute_second {
return sprintf '%04d-%02d-%02d-%02d-%02d-%02d', Today_and_Now;
}
sub _check_password {
my ( $class, $password, $crypted_password, $crypt_type ) = @_;
return
if not $crypted_password
; # https://rt.cpan.org/Public/Bug/Display.html?id=62470
my %password_checker = (
'none' => sub { return $password eq $crypted_password; },
'crypt' => sub {
return crypt( $password, $crypted_password ) eq $crypted_password;
},
'md5' => sub { return md5_hex($password) eq $crypted_password; },
'sha256' => sub {
return Digest::SHA::sha256_hex($password) eq $crypted_password;
},
'sha384' => sub {
return Digest::SHA::sha384_hex($password) eq $crypted_password;
},
'sha512' => sub {
return Digest::SHA::sha512_hex($password) eq $crypted_password;
},
);
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;
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
my ( $pkg, $file, $line, $sub ) = caller(1);
my $info_message = "${class}\t_dbi_connect called in $sub at line $line";
$class->logger( $r, Apache2::Const::LOG_INFO, $info_message, undef,
LOG_TYPE_SYSTEM, $r->uri );
my %c = $config_hash ? %$config_hash : $class->_dbi_config_vars($r);
my $auth_name = $r->auth_name;
# get the crypted password from the users database for this user.
my $dbh = DBI->connect_cached( $c{'DBI_DSN'}, $c{'DBI_User'},
$c{'DBI_Password'} );
if ( defined $dbh ) {
my $info_message
= "${class}\tconnect to $c{'DBI_DSN'} for auth realm $auth_name";
$class->logger( $r, Apache2::Const::LOG_INFO, $info_message, undef,
LOG_TYPE_SYSTEM, $r->uri );
return $dbh;
}
else {
my $error_message
= "${class}\tcouldn't connect to $c{'DBI_DSN'} for auth realm $auth_name";
$class->logger( $r, Apache2::Const::LOG_ERR, $error_message,
LOG_TYPE_SYSTEM, undef, $r->uri );
return;
}
}
#-------------------------------------------------------------------------------
# _get_crypted_password -- Get the users' password from the database.
sub _get_crypted_password {
my ( $class, $r, $user, $config_hash ) = @_;
my %c = $config_hash ? %$config_hash : $class->_dbi_config_vars($r);
my $dbh = $class->_dbi_connect($r, \%c) || return;
my $auth_name = $r->auth_name;
if ( !$class->user_is_active( $r, $user, \%c ) ) {
my $message
= "${class}\tUser '$user' is not active for auth realm $auth_name.";
$class->logger( $r, Apache2::Const::LOG_NOTICE, $message, $user,
LOG_TYPE_AUTH, $r->uri );
return;
}
my $crypted_password = EMPTY_STRING;
my $PasswordField = $dbh->quote_identifier($c{'DBI_PasswordField'});
my $UsersTable = $dbh->quote_identifier($c{'DBI_UsersTable'});
my $UserField = $dbh->quote_identifier($c{'DBI_UserField'});
my $sql_query = <<"SQL";
SELECT $PasswordField
FROM $UsersTable
WHERE $UserField = ?
AND ($PasswordField != ''
AND $PasswordField IS NOT NULL)
SQL
my $sth = $dbh->prepare_cached($sql_query);
unless ( defined $sth ) {
my $message = "${class}\tcouldn\'t prepare statement handle to $c{'DBI_DSN'} for auth realm $auth_name";
$class->logger( $r, Apache2::Const::LOG_ERR, $message, $user,
LOG_TYPE_AUTH, $r->uri );
return;
}
$sth->execute($user);
($crypted_password) = $sth->fetchrow_array();
$sth->finish();
if ( _is_empty($crypted_password) ) {
my $message
= "${class}\tCould not select password using SQL query '$sql_query'";
$class->logger( $r, Apache2::Const::LOG_ERR, $message, $user,
LOG_TYPE_AUTH, $r->uri );
return;
}
return $crypted_password;
}
#-------------------------------------------------------------------------------
# _prepare_group_query -- Prepare the database query used to determine whether
# the authenticated user is a member of a group.
sub _prepare_group_query {
my ( $class, $dbh, $config_hash ) = @_;
# Get the configuration information.
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
return TRUE if not defined $string;
return TRUE if $string eq EMPTY_STRING;
return;
}
#===============================================================================
# P U B L I C F U N C T I O N S
#===============================================================================
sub extra_session_info {
my ( $class, $r, $user, $password, @extra_data ) = @_;
return EMPTY_STRING;
}
sub authen_cred {
my ( $class, $r, $user, $password, @extra_data ) = @_;
my $auth_name = $r->auth_name;
( $user, $password ) = _defined_or_empty( $user, $password );
if ( !length $user ) {
my $message
= "${class}\tno username supplied for auth realm $auth_name";
$class->logger( $r, Apache2::Const::LOG_NOTICE, $message, $user,
LOG_TYPE_AUTH, $r->uri );
return;
}
if ( !length $password ) {
my $message
= "${class}\tno password supplied for auth realm $auth_name";
$class->logger( $r, Apache2::Const::LOG_NOTICE, $message, $user,
LOG_TYPE_AUTH, $r->uri );
return;
}
# get the configuration information.
my %c = $class->_dbi_config_vars($r);
# get the crypted password from the users database for this user.
my $crypted_password = $class->_get_crypted_password( $r, $user, \%c );
return unless ( defined $crypted_password );
# now return unless the passwords match.
my $crypt_type = lc $c{'DBI_CryptType'};
if ( !$class->_check_password( $password, $crypted_password, $crypt_type ) )
{
my $message
= "${class}\tcrypt_type: '$crypt_type' - passwords didn't match for user '$user' for auth realm $auth_name";
$class->logger( $r, Apache2::Const::LOG_NOTICE, $message, $user,
LOG_TYPE_AUTH, $r->uri );
return;
}
# Successful login
my $message = "${class}\tSuccessful login for $user";
$class->logger( $r, Apache2::Const::LOG_DEBUG, $message, $user,
LOG_TYPE_AUTH, $r->uri );
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
$r->pnotes( $auth_name, $session );
$session_id = $session->{_session_id};
}
# OK, now we stick the username and the current time and the expire
# time and the session id (if any) together to make the public part
# of the session key:
my $current_time = _now_year_month_day_hour_minute_second;
my $public_part = "$enc_user:$current_time:$expire_time:$session_id";
$public_part
.= $class->extra_session_info( $r, $user, $password, @extra_data );
# Now we calculate the hash of this and the secret key and then
# calculate the hash of *that* and the secret key again.
my $secretkey = $c{'DBI_SecretKey'};
if ( !defined $secretkey ) {
my $message
= "${class}\tdidn't have the secret key for auth realm $auth_name";
$class->logger( $r, Apache2::Const::LOG_ERR, $message, $user,
LOG_TYPE_SYSTEM, $r->uri );
return;
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
__END__
=head1 SUBCLASSING
You can subclass this module to override public functions and change
their behaviour.
=head1 CLASS METHODS
=head2 authen_cred($r, $user, $password, @extra_data)
Take the credentials for a user and check that they match; if so, return
a new session key for this user that can be stored in the cookie.
If there is a problem, return a bogus session key.
=head2 authen_ses_key($r, $encrypted_session_key)
Take a session key and check that it is still valid; if so, return the user.
=head2 decrypt_session_key($r, $encryptiontype, $encrypted_session_key, $secret_key)
Returns the decrypted session key or false on failure.
=head2 extra_session_info($r, $user, $password, @extra_data)
A stub method that you may want to override in a subclass.
This method returns extra fields to add to the session key.
It should return a string consisting of ":field1:field2:field3"
(where each field is preceded by a colon).
The default implementation returns an empty string.
=head2 group($r, $groups_string)
lib/Apache2/AuthCookieDBI.pm view on Meta::CPAN
returns true without checking the database (this is
the default behavior).
If C<DBI_UserActiveField> is set then this method checks the
database and returns the value in that field for this user.
=head1 DATABASE SCHEMAS
For this module to work, the database tables must be laid out at least somewhat
according to the following rules: the user field must be a UNIQUE KEY
so there is only one row per user; the password field must be NOT NULL. If
you're using MD5 passwords the password field must be 32 characters long to
allow enough space for the output of md5_hex(). If you're using crypt()
passwords you need to allow 13 characters. If you're using sha256_hex()
then you need to allow for 64 characters, for sha384_hex() allow 96 characters,
and for sha512_hex() allow 128.
An minimal CREATE TABLE statement might look like:
CREATE TABLE users (
user VARCHAR(16) PRIMARY KEY,
password VARCHAR(32) NOT NULL
)
For the groups table, the access table is actually going to be a join table
between the users table and a table in which there is one row per group
if you have more per-group data to store; if all you care about is group
membership though, you only need this one table. The only constraints on
this table are that the user and group fields be NOT NULL.
A minimal CREATE TABLE statement might look like:
# $Id: schema.sql,v 1.3 2010/11/29 04:00:53 matisse Exp $
#
# Schema for creating the database tables for an authentication system.
CREATE TABLE users (
user CHAR(16) PRIMARY KEY,
password CHAR(24),
active BOOLEAN
);
CREATE TABLE groups (
group CHAR(16),
user CHAR(16)
);
use Mock::Tieable;
use Test::More tests => 71;
use constant CLASS_UNDER_TEST => 'Apache2::AuthCookieDBI';
use constant EMPTY_STRING => q{};
use constant TRUE => 1;
use_ok(CLASS_UNDER_TEST);
test_authen_cred();
test_check_password();
test_defined_or_empty();
test_decrypt_session_key();
test_encrypt_session_key();
test_dir_config_var();
test_authen_ses_key();
test_get_cipher_for_type();
test_group();
test__dbi_connect();
test_get_crypted_password();
test_user_is_active();
test__get_new_session();
exit;
sub set_up {
my $auth_name = shift;
my $mock_config = shift || _mock_config_for_auth_name($auth_name);
my $r = Apache2::RequestRec->new(
auth_name => $auth_name,
return \%mock_config;
}
sub test_authen_cred {
my $auth_name = 'testing_authen_cred';
my $secret_key = 'test secret key';
my $mock_config = {
$auth_name . 'DBI_DSN' => 'test DSN',
$auth_name . 'DBI_SecretKey' => $secret_key,
$auth_name . 'DBI_User' => $auth_name,
$auth_name . 'DBI_Password' => 'test DBI password',
$auth_name . 'DBI_UsersTable' => 'users',
$auth_name . 'DBI_UserField' => 'user',
$auth_name . 'DBI_passwordfield' => 'password',
$auth_name . 'DBI_crypttype' => 'none',
$auth_name . 'DBI_groupstable' => 'groups',
$auth_name . 'DBI_groupfield' => 'grp',
$auth_name . 'DBI_groupuserfield' => 'user',
$auth_name . 'DBI_encryptiontype' => 'none',
$auth_name . 'DBI_sessionlifetime' => '00-24-00-00',
$auth_name . 'DBI_sessionmodule' => 'none',
};
my $r = set_up( $auth_name, $mock_config );
my $empty_user = EMPTY_STRING;
my $test_password = 'test password';
my @extra_data = qw(extra_1 extra_2);
my $got_session_key
= CLASS_UNDER_TEST->authen_cred( $r, $empty_user, $test_password,
@extra_data );
Test::More::is( $got_session_key, undef,
'authen_cred returns undef when user is an empty string.' );
my $test_user = 'username';
my $empty_password = EMPTY_STRING;
$got_session_key
= CLASS_UNDER_TEST->authen_cred( $r, $test_user, $empty_password,
@extra_data );
Test::More::is( $got_session_key, undef,
'authen_cred returns undef when password is an empty string.' );
$r = set_up( $auth_name, $mock_config );
{
my $stub_get_crypted_password = sub { return $test_password };
no warnings qw(redefine);
local *Apache2::AuthCookieDBI::_get_crypted_password
= $stub_get_crypted_password;
$got_session_key
= CLASS_UNDER_TEST->authen_cred( $r, $test_user, $test_password,
@extra_data );
}
Test::More::like(
$got_session_key,
qr/\A ${test_user}:/x,
'authen_cred returns session key starting with username when all OK.'
)
|| Test::More::diag( 'Mock request object contains: ',
Data::Dumper::Dumper($r) );
}
sub test_authen_ses_key {
my $auth_name = 'testing_authen_ses_key';
my $secret_key = 'test secret key';
my $mock_config = {
$auth_name . 'DBI_DSN' => 'test DSN',
$auth_name . 'DBI_SecretKey' => $secret_key,
$auth_name . 'DBI_User' => $auth_name,
$auth_name . 'DBI_Password' => 'test DBI password',
$auth_name . 'DBI_UsersTable' => 'users',
$auth_name . 'DBI_UserField' => 'user',
$auth_name . 'DBI_passwordfield' => 'password',
$auth_name . 'DBI_crypttype' => 'none',
$auth_name . 'DBI_groupstable' => 'groups',
$auth_name . 'DBI_groupfield' => 'grp',
$auth_name . 'DBI_groupuserfield' => 'user',
$auth_name . 'DBI_encryptiontype' => 'none',
$auth_name . 'DBI_sessionlifetime' => '00-24-00-00',
$auth_name . 'DBI_sessionmodule' => 'Mock::Tieable',
};
my $r = set_up( $auth_name, $mock_config );
my $expected_user = 'expected_username';
|| Test::More::diag("Expected a false value, got: '$got_user'");
my $class = CLASS_UNDER_TEST;
Test::More::like(
$r->log->error->[0],
qr/${class}\tfailed to tie session hash/,
'authen_ses_key() logs failure to tie session hash.'
);
return TRUE;
}
sub test_check_password {
test_check_password_digest_none();
test_check_password_digest_crypt();
test_check_password_digest_md5();
test_check_password_digest_sha256();
test_check_password_digest_sha384();
test_check_password_digest_sha512();
return TRUE;
}
sub test_check_password_digest_none {
my $plaintext_password = 'plaintext password';
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, undef, 'any'
),
'_check_password() return false when encrypted password is undef'
);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $plaintext_password, 'none'
),
'_check_password() success case with no encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'none'
),
'_check_password() failure case with no encryption'
);
return TRUE;
}
sub test_check_password_digest_crypt {
my $plaintext_password = 'plaintext password';
my $salt = join('',
(('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
my $crypted_password = crypt( $plaintext_password, $salt );
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $crypted_password, 'crypt'
),
'_check_password() success case with crypt'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'crypt'
),
'_check_password() failure case with crypt'
);
return TRUE;
}
sub test_check_password_digest_md5 {
my $plaintext_password = 'plaintext password';
my $md5_encrypted = Digest::MD5::md5_hex($plaintext_password);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $md5_encrypted, 'md5'
),
'_check_password() success case with md5 encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'md5'
),
'_check_password() failure case with md5 encryption'
);
return TRUE;
}
sub test_check_password_digest_sha256 {
my $plaintext_password = 'plaintext password';
my $sha256_hex_encrypted = Digest::SHA::sha256_hex($plaintext_password);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $sha256_hex_encrypted, 'sha256'
),
'_check_password() success case with sha256 encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'sha256'
),
'_check_password() failure case with sha256 encryption'
);
return TRUE;
}
sub test_check_password_digest_sha384 {
my $plaintext_password = 'plaintext password';
my $sha384_hex_encrypted = Digest::SHA::sha384_hex($plaintext_password);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $sha384_hex_encrypted, 'sha384'
),
'_check_password() success case with sha384 encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'sha384'
),
'_check_password() failure case with sha384 encryption'
);
return TRUE;
}
sub test_check_password_digest_sha512 {
my $plaintext_password = 'plaintext password';
my $sha512_hex_encrypted = Digest::SHA::sha512_hex($plaintext_password);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $sha512_hex_encrypted, 'sha512'
),
'_check_password() success case with sha512 encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'sha512'
),
'_check_password() failure case with sha512 encryption'
);
return TRUE;
}
sub test_dir_config_var {
my $auth_name = 'testing_dir_config_var';
my $variable_wanted = 'Arbitrary_Variable_Name';
my $config_key = $auth_name . $variable_wanted;
my $mock_config
"Got decrypted key for '$encryption_type'" )
|| Test::More::diag( join "\n", @{ $r->log->error() } );
$r->{'_error_messages'} = [];
}
}
sub test_defined_or_empty {
my $user = 'matisse';
my $password; # undef
my @other_stuff = qw( a b c );
my @args = ( $user, $password, @other_stuff );
my $expected = scalar @args + 1; # Add 1 for the class argument
is( CLASS_UNDER_TEST->_defined_or_empty( $user, $password, @other_stuff ),
$expected, '_defined_or_empty returns expected number of items.' );
return TRUE;
}
sub test_encrypt_session_key {
my $session_key = 'mock_session_key';
my $secret_key = 'mock secret key';
my $auth_name = 'test_encrypt_session_key';
my $expected = {
none => $session_key,
$secret_key, );
};
Test::More::like(
$EVAL_ERROR,
qr/Unsupported encryption type: '$unsupported_type'/,
'_get_cipher_for_type() throws exception on unsupported encryption type.'
);
return TRUE;
}
sub test_get_crypted_password {
my $auth_name = 'test_get_crypted_password';
my $user = 'test_user';
my $r = set_up($auth_name);
my $expected_password = 'mock_crypted_password';
my $got_password;
{
no warnings qw(once redefine);
local *DBI::Mock::sth::fetchrow_array = sub {
return ($expected_password);
};
$got_password = CLASS_UNDER_TEST->_get_crypted_password( $r, $user );
}
Test::More::is( $got_password, $expected_password,
'_get_crypted_password() with default config.' );
# Simulate password not found
{
no warnings qw(once redefine);
local *DBI::Mock::sth::fetchrow_array = sub {
return () # empty array, password not found;
};
$got_password = CLASS_UNDER_TEST->_get_crypted_password( $r, $user );
}
Test::More::ok( !$got_password,
'_get_crypted_password() with password not found' );
my $got_errrors = $r->log->error(); # from the mock request object
Test::More::is( scalar @$got_errrors,
1, '_get_crypted_password() logs password not found' );
my $class = CLASS_UNDER_TEST;
Test::More::like(
$got_errrors->[0],
qr/\A${class}\tCould not select password/,
'_get_crypted_password() error message for password not found'
);
return TRUE;
}
sub test_group {
my $auth_name = 'test_group';
my $r = set_up($auth_name);
my $user = 'test_user';
$r->{'user'} = $user;
t/utils24.t view on Meta::CPAN
use Mock::Tieable;
use Test::More tests => 72;
use constant CLASS_UNDER_TEST => 'Apache2_4::AuthCookieDBI';
use constant EMPTY_STRING => q{};
use constant TRUE => 1;
use_ok(CLASS_UNDER_TEST);
test_authen_cred();
test_check_password();
test_defined_or_empty();
test_decrypt_session_key();
test_encrypt_session_key();
test_dir_config_var();
test_authen_ses_key();
test_get_cipher_for_type();
test_group();
test__dbi_connect();
test_get_crypted_password();
test_user_is_active();
test__get_new_session();
exit;
sub set_up {
my $auth_name = shift;
my $mock_config = shift || _mock_config_for_auth_name($auth_name);
my $r = Apache2::RequestRec->new(
auth_name => $auth_name,
t/utils24.t view on Meta::CPAN
return \%mock_config;
}
sub test_authen_cred {
my $auth_name = 'testing_authen_cred';
my $secret_key = 'test secret key';
my $mock_config = {
$auth_name . 'DBI_DSN' => 'test DSN',
$auth_name . 'DBI_SecretKey' => $secret_key,
$auth_name . 'DBI_User' => $auth_name,
$auth_name . 'DBI_Password' => 'test DBI password',
$auth_name . 'DBI_UsersTable' => 'users',
$auth_name . 'DBI_UserField' => 'user',
$auth_name . 'DBI_passwordfield' => 'password',
$auth_name . 'DBI_crypttype' => 'none',
$auth_name . 'DBI_groupstable' => 'groups',
$auth_name . 'DBI_groupfield' => 'grp',
$auth_name . 'DBI_groupuserfield' => 'user',
$auth_name . 'DBI_encryptiontype' => 'none',
$auth_name . 'DBI_sessionlifetime' => '00-24-00-00',
$auth_name . 'DBI_sessionmodule' => 'none',
};
my $r = set_up( $auth_name, $mock_config );
my $empty_user = EMPTY_STRING;
my $test_password = 'test password';
my @extra_data = qw(extra_1 extra_2);
my $got_session_key
= CLASS_UNDER_TEST->authen_cred( $r, $empty_user, $test_password,
@extra_data );
Test::More::is( $got_session_key, undef,
'authen_cred returns undef when user is an empty string.' );
my $test_user = 'username';
my $empty_password = EMPTY_STRING;
$got_session_key
= CLASS_UNDER_TEST->authen_cred( $r, $test_user, $empty_password,
@extra_data );
Test::More::is( $got_session_key, undef,
'authen_cred returns undef when password is an empty string.' );
$r = set_up( $auth_name, $mock_config );
{
my $stub_get_crypted_password = sub { return $test_password };
no warnings qw(redefine);
local *Apache2::AuthCookieDBI::_get_crypted_password
= $stub_get_crypted_password;
$got_session_key
= CLASS_UNDER_TEST->authen_cred( $r, $test_user, $test_password,
@extra_data );
}
Test::More::like(
$got_session_key,
qr/\A ${test_user}:/x,
'authen_cred returns session key starting with username when all OK.'
)
|| Test::More::diag( 'Mock request object contains: ',
Data::Dumper::Dumper($r) );
}
sub test_authen_ses_key {
my $auth_name = 'testing_authen_ses_key';
my $secret_key = 'test secret key';
my $mock_config = {
$auth_name . 'DBI_DSN' => 'test DSN',
$auth_name . 'DBI_SecretKey' => $secret_key,
$auth_name . 'DBI_User' => $auth_name,
$auth_name . 'DBI_Password' => 'test DBI password',
$auth_name . 'DBI_UsersTable' => 'users',
$auth_name . 'DBI_UserField' => 'user',
$auth_name . 'DBI_passwordfield' => 'password',
$auth_name . 'DBI_crypttype' => 'none',
$auth_name . 'DBI_groupstable' => 'groups',
$auth_name . 'DBI_groupfield' => 'grp',
$auth_name . 'DBI_groupuserfield' => 'user',
$auth_name . 'DBI_encryptiontype' => 'none',
$auth_name . 'DBI_sessionlifetime' => '00-24-00-00',
$auth_name . 'DBI_sessionmodule' => 'Mock::Tieable',
};
my $r = set_up( $auth_name, $mock_config );
my $expected_user = 'expected_username';
t/utils24.t view on Meta::CPAN
|| Test::More::diag("Expected a false value, got: '$got_user'");
my $class = CLASS_UNDER_TEST;
Test::More::like(
$r->log->error->[0],
qr/${class}\tfailed to tie session hash/,
'authen_ses_key() logs failure to tie session hash.'
);
return TRUE;
}
sub test_check_password {
test_check_password_digest_none();
test_check_password_digest_crypt();
test_check_password_digest_md5();
test_check_password_digest_sha256();
test_check_password_digest_sha384();
test_check_password_digest_sha512();
return TRUE;
}
sub test_check_password_digest_none {
my $plaintext_password = 'plaintext password';
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, undef, 'any'
),
'_check_password() return false when encrypted password is undef'
);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $plaintext_password, 'none'
),
'_check_password() success case with no encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'none'
),
'_check_password() failure case with no encryption'
);
return TRUE;
}
sub test_check_password_digest_crypt {
my $plaintext_password = 'plaintext password';
my $salt = join('',
(('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64]));
my $crypted_password = crypt( $plaintext_password, $salt );
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $crypted_password, 'crypt'
),
'_check_password() success case with crypt'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'crypt'
),
'_check_password() failure case with crypt'
);
return TRUE;
}
sub test_check_password_digest_md5 {
my $plaintext_password = 'plaintext password';
my $md5_encrypted = Digest::MD5::md5_hex($plaintext_password);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $md5_encrypted, 'md5'
),
'_check_password() success case with md5 encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'md5'
),
'_check_password() failure case with md5 encryption'
);
return TRUE;
}
sub test_check_password_digest_sha256 {
my $plaintext_password = 'plaintext password';
my $sha256_hex_encrypted = Digest::SHA::sha256_hex($plaintext_password);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $sha256_hex_encrypted, 'sha256'
),
'_check_password() success case with sha256 encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'sha256'
),
'_check_password() failure case with sha256 encryption'
);
return TRUE;
}
sub test_check_password_digest_sha384 {
my $plaintext_password = 'plaintext password';
my $sha384_hex_encrypted = Digest::SHA::sha384_hex($plaintext_password);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $sha384_hex_encrypted, 'sha384'
),
'_check_password() success case with sha384 encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'sha384'
),
'_check_password() failure case with sha384 encryption'
);
return TRUE;
}
sub test_check_password_digest_sha512 {
my $plaintext_password = 'plaintext password';
my $sha512_hex_encrypted = Digest::SHA::sha512_hex($plaintext_password);
Test::More::ok(
CLASS_UNDER_TEST->_check_password(
$plaintext_password, $sha512_hex_encrypted, 'sha512'
),
'_check_password() success case with sha512 encryption'
);
Test::More::ok(
!CLASS_UNDER_TEST->_check_password(
$plaintext_password, 'no match', 'sha512'
),
'_check_password() failure case with sha512 encryption'
);
return TRUE;
}
sub test_dir_config_var {
my $auth_name = 'testing_dir_config_var';
my $variable_wanted = 'Arbitrary_Variable_Name';
my $config_key = $auth_name . $variable_wanted;
my $mock_config
t/utils24.t view on Meta::CPAN
"Got decrypted key for '$encryption_type'" )
|| Test::More::diag( join "\n", @{ $r->log->error() } );
$r->{'_error_messages'} = [];
}
}
sub test_defined_or_empty {
my $user = 'matisse';
my $password; # undef
my @other_stuff = qw( a b c );
my @args = ( $user, $password, @other_stuff );
my $expected = scalar @args + 1; # Add 1 for the class argument
is( CLASS_UNDER_TEST->_defined_or_empty( $user, $password, @other_stuff ),
$expected, '_defined_or_empty returns expected number of items.' );
return TRUE;
}
sub test_encrypt_session_key {
my $session_key = 'mock_session_key';
my $secret_key = 'mock secret key';
my $auth_name = 'test_encrypt_session_key';
my $expected = {
none => $session_key,
t/utils24.t view on Meta::CPAN
$secret_key, );
};
Test::More::like(
$EVAL_ERROR,
qr/Unsupported encryption type: '$unsupported_type'/,
'_get_cipher_for_type() throws exception on unsupported encryption type.'
);
return TRUE;
}
sub test_get_crypted_password {
my $auth_name = 'test_get_crypted_password';
my $user = 'test_user';
my $r = set_up($auth_name);
my $expected_password = 'mock_crypted_password';
my $got_password;
{
no warnings qw(once redefine);
local *DBI::Mock::sth::fetchrow_array = sub {
return ($expected_password);
};
$got_password = CLASS_UNDER_TEST->_get_crypted_password( $r, $user );
}
Test::More::is( $got_password, $expected_password,
'_get_crypted_password() with default config.' );
# Simulate password not found
{
no warnings qw(once redefine);
local *DBI::Mock::sth::fetchrow_array = sub {
return () # empty array, password not found;
};
$got_password = CLASS_UNDER_TEST->_get_crypted_password( $r, $user );
}
Test::More::ok( !$got_password,
'_get_crypted_password() with password not found' );
my $got_errrors = $r->log->error(); # from the mock request object
Test::More::is( scalar @$got_errrors,
1, '_get_crypted_password() logs password not found' );
my $class = CLASS_UNDER_TEST;
Test::More::like(
$got_errrors->[0],
qr/\A${class}\tCould not select password/,
'_get_crypted_password() error message for password not found'
);
return TRUE;
}
sub test_group {
my $auth_name = 'test_group';
my $r = set_up($auth_name);
my $user = 'test_user';
$r->{'user'} = $user;
techspec.txt view on Meta::CPAN
$Id: techspec.txt,v 1.1 2003/10/10 20:13:33 jacob Exp $
Apache::AuthCookieDBI Technical Specification
* Description.
This module will allow cookie-based authentication backed by a DBI database,
using usernames and passwords for authentication.
* Authentication.
Authentication is based on a username and password. These are supplied in
plaintext by the user in a form submission through Apache::AuthCookie. These
are compared against values in a users table in a DBI database. The password
field in the database may be plaintext, or hashed with crypt() or md5_hex().
* Tickets.
When a user successfully authenticates, they are issued a cookie with a
session value. This value consists of a serialized version of
the userid, an issue time, an expiration date, and a two-round MD5 checksum
of the userid and times and a server secret key. This checksum
ensures that when the ticket is returned we can see that it has not been
tampered with since in order to generate the checksum you must have the secret
( run in 0.668 second using v1.01-cache-2.11-cpan-49f99fa48dc )