Apache-AuthCookieDBI
view release on metacpan or search on metacpan
AuthCookieDBI.pm view on Meta::CPAN
#===============================================================================
#
# $Id: AuthCookieDBI.pm,v 1.22.2.4 2007/02/03 19:22:24 matisse Exp $
#
# Apache::AuthCookieDBI
#
# An AuthCookie module backed by a DBI database.
#
# Copyright (C) 2000-2003 SF Interactive.
#
# Author: Jacob Davies <jacob@well.com>
#
# Incomplete list of additional contributors:
# Matisse Enzer
# Nick Phillips
# William McKee
#
AuthCookieDBI.pm view on Meta::CPAN
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#===============================================================================
package Apache::AuthCookieDBI;
use strict;
use warnings;
use 5.004_04;
our $VERSION = 2.10;
use Apache;
use Apache::AuthCookie;
use Apache::DBI;
use Apache::Constants;
use Apache::File;
use Digest::MD5 qw( md5_hex );
use Date::Calc qw( Today_and_Now Add_Delta_DHMS );
# Also uses Crypt::CBC if you're using encrypted cookies.
use base qw( Apache::AuthCookie );
my $EMPTY_STRING = q{};
#===============================================================================
# F U N C T I O N D E C L A R A T I O N S
#===============================================================================
#===============================================================================
# P A C K A G E G L O B A L S
AuthCookieDBI.pm view on Meta::CPAN
}
}
}
#===============================================================================
# P E R L D O C
#===============================================================================
=head1 NAME
Apache::AuthCookieDBI - An AuthCookie module backed by a DBI database.
=head1 VERSION
$Revision: 1.22.2.4 $
=head1 SYNOPSIS
# In httpd.conf or .htaccess
# This PerlSetVar MUST precede the PerlModule line because the
# key is read in a BEGIN block when the module is loaded.
PerlSetVar WhatEverDBI_SecretKeyFile /etc/httpd/acme.com.key
PerlModule Apache::AuthCookieDBI
PerlSetVar WhatEverPath /
PerlSetVar WhatEverLoginScript /login.pl
# 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"
AuthCookieDBI.pm view on Meta::CPAN
PerlSetVar WhatEverDBI_UsersTable "users"
PerlSetVar WhatEverDBI_UserField "user"
PerlSetVar WhatEverDBI_PasswordField "password"
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>
AuthType Apache::AuthCookieDBI
AuthName WhatEver
PerlAuthenHandler Apache::AuthCookieDBI->authenticate
PerlAuthzHandler Apache::AuthCookieDBI->authorize
require valid-user
# or you can require users:
require user jacob
# You can optionally require groups.
require group system
</Directory>
# Login location.
<Files LOGIN>
AuthType Apache::AuthCookieDBI
AuthName WhatEver
SetHandler perl-script
PerlHandler Apache::AuthCookieDBI->login
</Files>
=head1 DESCRIPTION
This module is an authentication handler that uses the basic mechanism provided
by Apache::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
AuthCookieDBI.pm view on Meta::CPAN
# P R I V A T E F U N C T I O N S
#===============================================================================
#-------------------------------------------------------------------------------
# _log_not_set -- Log that a particular authentication variable was not set.
sub _log_not_set {
my ( $r, $variable ) = @_;
my $auth_name = $r->auth_name;
return $r->log_error(
"Apache::AuthCookieDBI: $variable not set for auth realm
$auth_name", $r->uri
);
}
#-------------------------------------------------------------------------------
# _dir_config_var -- Get a particular authentication variable.
sub _dir_config_var {
my ( $r, $variable ) = @_;
my $auth_name = $r->auth_name;
AuthCookieDBI.pm view on Meta::CPAN
=head1 APACHE CONFIGURATION DIRECTIVES
All configuration directives for this module are passed in PerlSetVars. These
PerlSetVars must begin with the AuthName that you are describing, so if your
AuthName is PrivateBankingSystem they will look like:
PerlSetVar PrivateBankingSystemDBI_DSN "DBI:mysql:database=banking"
See also L<Apache::Authcookie> for the directives required for any kind
of Apache::AuthCookie-based authentication system.
In the following descriptions, replace "WhatEver" with your particular
AuthName. The available configuration directives are as follows:
=over 4
=item C<WhatEverDBI_DSN>
Specifies the DSN for DBI for the database you wish to connect to retrieve
user information. This is required and has no default value.
AuthCookieDBI.pm view on Meta::CPAN
|| 'none';
# If we used encryption we need to pull in Crypt::CBC.
if ( $c{DBI_encryptiontype} ne 'none' ) {
require Crypt::CBC;
}
=item C<WhatEverDBI_SessionLifetime>
How long tickets are good for after being issued. Note that presently
Apache::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
this value. This can be 'forever' or a life time specified as:
DD-hh-mm-ss -- Days, hours, minute and seconds to live.
This is not required and defaults to '00-24-00-00' or 24 hours.
=cut
AuthCookieDBI.pm view on Meta::CPAN
# If there is a problem, return a bogus session key.
sub authen_cred {
my ( $self, $r, @credentials ) = @_;
my ( $user, $password, @extra_credentials ) = @credentials;
my $auth_name = $r->auth_name;
( $user, $password ) = _defined_or_empty( $user, $password );
if ( !length $user ) {
$r->log_reason(
"Apache::AuthCookieDBI: no username supplied for auth realm $auth_name",
$r->uri
);
return;
}
if ( !length $password ) {
$r->log_reason(
"Apache::AuthCookieDBI: no password supplied for auth realm $auth_name",
$r->uri
);
return;
}
# get the configuration information.
my %c = _dbi_config_vars $r;
# get the crypted password from the users database for this user.
my $dbh = DBI->connect( $c{DBI_DSN}, $c{DBI_user}, $c{DBI_password} );
unless ( defined $dbh ) {
$r->log_reason(
"Apache::AuthCookieDBI: couldn't connect to $c{ DBI_DSN } for auth realm $auth_name",
$r->uri
);
return;
}
my $sth = $dbh->prepare( <<"EOS" );
SELECT $c{ DBI_passwordfield }
FROM $c{ DBI_userstable }
WHERE $c{ DBI_userfield } = ?
EOS
$sth->execute($user);
my ($crypted_password) = $sth->fetchrow_array;
unless ( defined $crypted_password ) {
$r->log_reason(
"Apache::AuthCookieDBI: couldn't select password from $c{ DBI_DSN }, $c{ DBI_userstable }, $c{ DBI_userfield } for user $user for auth realm $auth_name",
$r->uri
);
return;
}
# now return unless the passwords match.
if ( lc $c{DBI_crypttype} eq 'none' ) {
unless ( $password eq $crypted_password ) {
$r->log_reason(
"Apache::AuthCookieDBI: plaintext passwords didn't match for user $user for auth realm $auth_name",
$r->uri
);
return;
}
}
elsif ( lc $c{DBI_crypttype} eq 'crypt' ) {
my $salt = substr $crypted_password, 0, 2;
unless ( crypt( $password, $salt ) eq $crypted_password ) {
$r->log_reason(
"Apache::AuthCookieDBI: crypted passwords didn't match for user $user for auth realm $auth_name",
$r->uri
);
return;
}
}
elsif ( lc $c{DBI_crypttype} eq 'md5' ) {
unless ( md5_hex($password) eq $crypted_password ) {
$r->log_reason(
"Apache::AuthCookieDBI: MD5 passwords didn't match for user $user for auth realm $auth_name",
$r->uri
);
return;
}
}
# Create the expire time for the ticket.
my $expire_time;
# expire time in a zillion years if it's forever.
AuthCookieDBI.pm view on Meta::CPAN
# time 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";
$public_part .= $self->extra_session_info( $r, @credentials );
# Now we calculate the hash of this and the secret key and then
# calculate the hash of *that* and the secret key again.
my $secret_key = $SECRET_KEYS{$auth_name};
unless ( defined $secret_key ) {
$r->log_reason(
"Apache::AuthCookieDBI: didn't have the secret key for auth realm $auth_name",
$r->uri
);
return;
}
my $hash =
md5_hex( join ':', $secret_key,
md5_hex( join ':', $public_part, $secret_key ) );
# Now we add this hash to the end of the public part.
my $session_key = "$public_part:$hash";
AuthCookieDBI.pm view on Meta::CPAN
my $auth_name = $r->auth_name;
# Get the configuration information.
my %c = _dbi_config_vars $r;
# Get the secret key.
my $secret_key = $SECRET_KEYS{$auth_name};
unless ( defined $secret_key ) {
$r->log_reason(
"Apache::AuthCookieDBI: didn't have the secret key from for auth realm $auth_name",
$r->uri
);
return;
}
# Decrypt the session key.
my $session_key;
if ( $c{DBI_encryptiontype} eq 'none' ) {
$session_key = $encrypted_session_key;
}
else {
# Check that this looks like an encrypted hex-encoded string.
unless ( $encrypted_session_key =~ /^[0-9a-fA-F]+$/ ) {
$r->log_reason(
"Apache::AuthCookieDBI: encrypted session key $encrypted_session_key doesn't look like it's properly hex-encoded for auth realm $auth_name",
$r->uri
);
return;
}
# Get the cipher from the cache, or create a new one if the
# cached cipher hasn't been created, & decrypt the session key.
my $cipher;
if ( lc $c{DBI_encryptiontype} eq 'des' ) {
$cipher = $CIPHERS{"des:$auth_name"} ||=
AuthCookieDBI.pm view on Meta::CPAN
elsif ( lc $c{DBI_encryptiontype} eq 'blowfish' ) {
$cipher = $CIPHERS{"blowfish:$auth_name"} ||=
Crypt::CBC->new( $secret_key, 'Blowfish' );
}
elsif ( lc $c{DBI_encryptiontype} eq 'blowfish_pp' ) {
$cipher = $CIPHERS{"blowfish_pp:$auth_name"} ||=
Crypt::CBC->new( $secret_key, 'Blowfish_PP' );
}
else {
$r->log_reason(
"Apache::AuthCookieDBI: unknown encryption type $c{ DBI_encryptiontype } for auth realm $auth_name",
$r->uri
);
return;
}
$session_key = $cipher->decrypt_hex($encrypted_session_key);
}
# Break up the session key.
my ( $enc_user, $issue_time, $expire_time, @rest ) =
( split /:/, $session_key );
my $supplied_hash = pop @rest;
( $enc_user, $issue_time, $expire_time, $supplied_hash ) =
_defined_or_empty( $enc_user, $issue_time, $expire_time, $supplied_hash );
# Let's check that we got passed sensible values in the cookie.
unless ( $enc_user =~ /^[a-zA-Z0-9_\%]+$/ ) {
$r->log_reason(
"Apache::AuthCookieDBI: bad percent-encoded user $enc_user recovered from session ticket for auth_realm $auth_name",
$r->uri
);
return;
}
# decode the user
my $user = _percent_decode($enc_user);
unless ( $issue_time =~ /^\d{4}-\d{2}-\d{2}-\d{2}-\d{2}-\d{2}$/ ) {
$r->log_reason(
"Apache::AuthCookieDBI: bad issue time $issue_time recovered from ticket for user $user for auth_realm $auth_name",
$r->uri
);
return;
}
unless ( $expire_time =~ /^\d{4}-\d{2}-\d{2}-\d{2}-\d{2}-\d{2}$/ ) {
$r->log_reason(
"Apache::AuthCookieDBI: bad expire time $expire_time recovered from ticket for user $user for auth_realm $auth_name",
$r->uri
);
return;
}
unless ( $supplied_hash =~ /^[0-9a-fA-F]{32}$/ ) {
$r->log_reason(
"Apache::AuthCookieDBI: bad hash $supplied_hash recovered from ticket for user $user for auth_realm $auth_name",
$r->uri
);
return;
}
# Calculate the hash of the user, issue time, expire_time and
# the secret key and then the hash of that and the secret key again.
my $hash = md5_hex(
join ':',
$secret_key,
md5_hex(
join ':', $enc_user, $issue_time,
$expire_time, @rest, $secret_key
)
);
# Compare it to the hash they gave us.
unless ( $hash eq $supplied_hash ) {
$r->log_reason(
"Apache::AuthCookieDBI: hash in cookie did not match calculated hash of contents for user $user for auth realm $auth_name",
$r->uri
);
return;
}
# Check that their session hasn't timed out.
if ( _now_year_month_day_hour_minute_second gt $expire_time ) {
$r->log_reason(
"Apache:AuthCookieDBI: expire time $expire_time has passed for user $user for auth realm $auth_name",
$r->uri
);
return;
}
# If we're being paranoid about timing-out long-lived sessions,
# check that the issue time + the current (server-set) session lifetime
# hasn't passed too (in case we issued long-lived session tickets
# in the past that we want to get rid of). *** TODO ***
# if ( lc $c{ DBI_AlwaysUseCurrentSessionLifetime } eq 'on' ) {
AuthCookieDBI.pm view on Meta::CPAN
# Get the configuration information.
my %c = _dbi_config_vars $r;
my $user = $r->connection->user;
# See if we have a row in the groups table for this user/group.
my $dbh = DBI->connect( $c{DBI_DSN}, $c{DBI_user}, $c{DBI_password} );
unless ( defined $dbh ) {
$r->log_reason(
"Apache::AuthCookieDBI: couldn't connect to $c{ DBI_DSN } for auth realm $auth_name",
$r->uri
);
return;
}
# Now loop through all the groups to see if we're a member of any:
my $sth = $dbh->prepare( <<"EOS" );
SELECT $c{ DBI_groupuserfield }
FROM $c{ DBI_groupstable }
WHERE $c{ DBI_groupfield } = ?
AND $c{ DBI_groupuserfield } = ?
EOS
foreach my $group (@groups) {
$sth->execute( $group, $user );
return OK if ( $sth->fetchrow_array );
}
$r->log_reason(
"Apache::AuthCookieDBI: user $user was not a member of any of the required groups @groups for auth realm $auth_name",
$r->uri
);
return FORBIDDEN;
}
# Takes a list and returns a list of the same size.
# Any element in the inputs that is defined is returned unchanged. Elements that
# were undef are returned as empty strings.
sub _defined_or_empty {
my @args = @_;
AuthCookieDBI.pm view on Meta::CPAN
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
=head1 AUTHOR
Jacob Davies
<jacob@well.com>
=head1 SEE ALSO
Apache::AuthCookie(1)
=cut
Revision history for Perl extension Apache::AuthCookieDBI.
2.10 Sat Feb 3 11:21:00 PST 2007
- Changed VERSION to 2.10 to get properly indexed by CPAN
No other changes.
1.24 Thu Feb 1 09:48:50 PST 2007
- Applied fixes for http://rt.cpan.org/Ticket/Display.html?id=3673
- use warnings pragma
- use base instead of modifying @ISA
- Changed 'return undef' to 'return'
AuthCookieDBI.pm
Changes
MANIFEST
MANIFEST.SKIP
README
LICENSE
Makefile.PL
test.pl
generic_reg_auth_scheme.txt
techspec.txt
schema.sql
# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: Apache-AuthCookieDBI
version: 2.1
version_from: AuthCookieDBI.pm
installdirs: site
requires:
Apache: 0
Apache::AuthCookie: 0
Apache::Constants: 0
Apache::DBI: 0
Date::Calc: 0
DBI: 0
Digest::MD5: 0
distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.17
Makefile.PL view on Meta::CPAN
# $Id: Makefile.PL,v 1.3.2.1 2007/02/01 18:29:21 matisse Exp $
use ExtUtils::MakeMaker;
WriteMakefile(
'AUTHOR' => 'Matisse Enzer (matisse@cpan.org)',
# 'ORIGINAL_AUTHOR' => 'Jacob Davies (jacob@well.com)',
'NAME' => 'Apache::AuthCookieDBI',
'VERSION_FROM' => 'AuthCookieDBI.pm', # finds $VERSION
'PREREQ_PM' => {
'Apache::AuthCookie' => '0',
'Date::Calc' => '0',
'Digest::MD5' => '0',
'Apache::DBI' => '0',
'Apache::Constants' => '0',
'Apache' => '0',
'DBI' => '0',
}
);
Apache::AuthCookieDBI is a module that subclasses Apache::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.
eg/public-pl/login.pl view on Meta::CPAN
my $t = new Text::TagTemplate;
my $r = Apache2::RequestRec->request();
my $destination;
my $authcookiereason;
if ( $r->prev() ) { # we are called as a subrequest.
$destination = $r->prev()->args()
? $r->prev()->uri() . '?' . $r->prev->args()
: $r->prev()->uri();
$authcookiereason = $r->prev()->subprocess_env( 'AuthCookieReason' );
} else {
my %args = $r->args;
$destination = $args{ 'destination' };
$authcookiereason = $args{ 'AuthCookieReason' };
$t->add_tag( CREDENTIAL_0 => $r->prev->args('credential_0');
}
$t->add_tag( DESTINATION => $destination );
unless ( $authcookiereason eq 'bad_cookie' ) {
$t->template_file( "../html/login.html" );
} else {
$t->template_file( "../html/login-failed.html" );
}
generic_reg_auth_scheme.txt view on Meta::CPAN
Must be installable and configurable by someone with only basic Perl and
Apache skills. E.g. only slightly more involved than setting up BasicAuth
and writing a simple CGI program.
Jacob> This could be accomplished by making a little script to install
the necessary CGI scripts and stuff.
Configuration features:
In global section of virtualhost:
PerlModule Apache::AuthCookieDBI
PerlSetVar AuthNamePath /
# this login script must use another cookie to set the destination
# and we probably need to hack authcookie to look at the cookie
# too. the action should be /LOGIN. the alternative is to always
# make the login scripts look at the cookie if they don't get it in
# the hidden field, which is probably right.
PerlSetVar AuthNameLoginScript /cgi-bin/ACD/login
# don't know if this is worth implementing, need to re-authenticate
# and regenerate the token with every hit (or maybe we can just trust
# the previous one and just update the expire time and rebuild
# the MD5 checksum; probably requires hacks to AuthCookie either way).
PerlSetVar AuthNameCookieExpirePolicy [ renew | time-to-live ]
# or we could do it on the server side by updating a last-visit
# table with every hit (ouch). if we don't have this we use the time
# in the cookie'd info, if we do have this we use that ticket as a key
# into this database to see when their last hit was.
PerlSetVar AuthNameDBI_SessionTable tablename
# do we need more stuff on the field names and blah blah?
# this determines how long the cookie is good for (ie how long
# after the MD5'd date in the cookie (or the last entry in the session
# database if we use one) we still take it)
PerlSetVar AuthNameDBI_SessionLifetime [ forever | time-to-live ]
# time-to-live is formatted as a time delta:
# 01-00-00-00-00 - 1 day.
# 00-01-00-00-00 - 1 hour.
# 00-00-15-00-00 - 15 minute
# this is probably set by AuthCookie somewhere.
PerlSetVar AuthNameCookieName name-of-cookie
# this is the key we use in the MD5'd checksum. root should change
# this every day because it has to be nobody-readable and is therefore
# not all that secure.
PerlSetVar AuthNameDBI_SecretKeyfile /path/to/secret/key
In <Directory> or <Location> sections (server config or .htaccess):
AuthType Apache::AuthCookieDBI
# set this to whatever, but the PerlSetVar's must match it.
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'
generic_reg_auth_scheme.txt view on Meta::CPAN
# 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
credentials and log them in at the same point that we redirect them off to
the login form?):
<Location /LOGIN>
AuthType Apache::AuthCookieDBI
AuthName AuthName
SetHandler perl-script
PerlHandler Apache::AuthCookieDBI->login
</Location>
Save TARGET Check requirements Send page that is appropriate.
Possibly clear TARGET.
Group Table
+---------------------+
| group | username |
+---------------------+
| group_1 | matisse |
techspec.txt view on Meta::CPAN
$Id: techspec.txt,v 1.1.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
# $Id: test.pl,v 1.2.2.1 2007/02/01 18:29:21 matisse Exp $
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
use strict;
use warnings;
use Test::More tests => 1;
use_ok('Apache::AuthCookieDBI');
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
package Apache;
use Carp qw(carp);
sub server {
return bless {}, 'Mock::Apache::Server';
( run in 1.979 second using v1.01-cache-2.11-cpan-e9199f4ba4c )