Apache-LoggedAuthDBI
view release on metacpan or search on metacpan
Apache->push_handlers(@_);
}
}
# configuration attributes, defaults will be overwritten with values from .htaccess.
my %Config = (
'Auth_DBI_data_source' => '',
'Auth_DBI_username' => '',
'Auth_DBI_password' => '',
'Auth_DBI_pwd_table' => '',
'Auth_DBI_uid_field' => '',
'Auth_DBI_pwd_field' => '',
'Auth_DBI_pwd_whereclause' => '',
'Auth_DBI_grp_table' => '',
'Auth_DBI_grp_field' => '',
'Auth_DBI_grp_whereclause' => '',
'Auth_DBI_log_field' => '',
'Auth_DBI_log_string' => '',
'Auth_DBI_authoritative' => 'on',
'Auth_DBI_nopasswd' => 'off',
'Auth_DBI_encrypted' => 'on',
'Auth_DBI_encryption_salt' => 'password',
'Auth_DBI_encryption_method'=> 'sha1hex/md5/crypt', #Using Two (or more) Methods Will Allow for Fallback to older Methods
'Auth_DBI_uidcasesensitive' => 'on',
'Auth_DBI_pwdcasesensitive' => 'on',
'Auth_DBI_placeholder' => 'off',
);
# stores the configuration of current URL.
# initialized during authentication, eventually re-used for authorization.
my $Attr = { };
# global cache: all records are put into one string.
# record separator is a newline. Field separator is $;.
# every record is a list of id, time of last access, password, groups (authorization only).
# the id is a comma separated list of user_id, data_source, pwd_table, uid_field.
# the first record is a timestamp, which indicates the last run of the CleanupHandler followed by the child counter.
my $Cache = time . "$;0\n";
# unique id which serves as key in $Cache.
# the id is generated during authentication and re-used for authorization.
my $ID;
$type .= 'initial ' if $r->is_initial_req;
$type .= 'main' if $r->is_main;
}
print STDERR "==========\n$prefix request type = >$type< \n";
}
return MP2 ? Apache2::Const::OK() : Apache::Constants::OK() unless $r->is_initial_req; # only the first internal request
print STDERR "REQUEST:\n", $r->as_string if $Apache::AuthDBI::DEBUG > 1;
# here the dialog pops up and asks you for username and password
my($res, $passwd_sent) = $r->get_basic_auth_pw;
print STDERR "$prefix get_basic_auth_pw: res = >$res<, password sent = >$passwd_sent<\n" if $Apache::AuthDBI::DEBUG > 1;
return $res if $res; # e.g. HTTP_UNAUTHORIZED
# get username
my ($user_sent) = $r->user;
print STDERR "$prefix user sent = >$user_sent<\n" if $Apache::AuthDBI::DEBUG > 1;
# do we use shared memory for the global cache ?
print STDERR "$prefix cache in shared memory, shmid $SHMID, shmsize $SHMSIZE, semid $SEMID \n" if ($SHMID and $Apache::AuthDBI::DEBUG > 1);
# get configuration
while(($key, $val) = each %Config) {
$val = $r->dir_config($key) || $val;
$key =~ s/^Auth_DBI_//;
$Attr->{$key} = $val;
printf STDERR "$prefix Config{ %-16s } = %s\n", $key, $val if $Apache::AuthDBI::DEBUG > 1;
}
# parse connect attributes, which may be tilde separated lists
my @data_sources = split(/~/, $Attr->{data_source});
my @usernames = split(/~/, $Attr->{username});
my @passwords = split(/~/, $Attr->{password});
$data_sources[0] = '' unless $data_sources[0]; # use ENV{DBI_DSN} if not defined
# obtain the id for the cache
my $data_src = $Attr->{data_source};
$data_src =~ s/\(.+\)//go; # remove any embedded attributes, because of trouble with regexps
$ID = join ',', $user_sent, $data_src, $Attr->{pwd_table}, $Attr->{uid_field};
# if not configured decline
unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{pwd_field}) {
print STDERR "$prefix not configured, return DECLINED\n" if $Apache::AuthDBI::DEBUG > 1;
return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
}
# do we want Windows-like case-insensitivity?
$user_sent = lc($user_sent) if $Attr->{uidcasesensitive} eq "off";
$passwd_sent = lc($passwd_sent) if $Attr->{pwdcasesensitive} eq "off";
# check whether the user is cached but consider that the password possibly has changed
my $passwd = '';
if ($CacheTime) { # do we use the cache ?
if ($SHMID) { # do we keep the cache in shared memory ?
semop($SEMID, $obtain_lock) or print STDERR "$prefix semop failed \n";
shmread($SHMID, $Cache, 0, $SHMSIZE) or print STDERR "$prefix shmread failed \n";
substr($Cache, index($Cache, "\0")) = '';
semop($SEMID, $release_lock) or print STDERR "$prefix semop failed \n";
}
# find id in cache
my ($last_access, $passwd_cached, $groups_cached);
if ($Cache =~ /$ID$;(\d+)$;(.+)$;(.*)\n/) {
$last_access = $1;
$passwd_cached = $2;
$groups_cached = $3;
print STDERR "$prefix cache: found >$ID< >$last_access< >$passwd_cached< \n" if $Apache::AuthDBI::DEBUG > 1;
my (@passwds_to_check, $passwd_to_check);
@passwds_to_check = &get_passwds_to_check($Attr, user_sent=>$user_sent, passwd_sent=>$passwd_sent, password=>$passwd_cached);
print STDERR "$prefix ". scalar(@passwds_to_check) . " passwords to check\n" if $Apache::AuthDBI::DEBUG > 1;;
foreach $passwd_to_check(@passwds_to_check) {
# match cached password with password sent
$passwd = $passwd_cached if $passwd_to_check eq $passwd_cached;
if ($passwd) {
last;
}
}
}
}
if ($passwd) { # found in cache
print STDERR "$prefix passwd found in cache \n" if $Apache::AuthDBI::DEBUG > 1;
} else { # password not cached or changed
print STDERR "$prefix passwd not found in cache \n" if $Apache::AuthDBI::DEBUG;
# connect to database, use all data_sources until the connect succeeds
my $j;
for ($j = 0; $j <= $#data_sources; $j++) {
last if ($dbh = DBI->connect($data_sources[$j], $usernames[$j], $passwords[$j]));
}
unless ($dbh) {
$r->log_reason("$prefix db connect error with data_source >$Attr->{data_source}<: $DBI::errstr", $r->uri);
return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR();
}
# generate statement
my $user_sent_quoted = $dbh->quote($user_sent);
my $select = "SELECT $Attr->{pwd_field}";
my $from = "FROM $Attr->{pwd_table}";
# fetch result
while ($_ = $sth->fetchrow_array) {
# strip trailing blanks for fixed-length data-type
$_ =~ s/ +$// if $_;
# consider the case with many users sharing the same userid
$passwd .= "$_$;";
}
chop $passwd if $passwd;
undef $passwd if 0 == $sth->rows; # so we can distinguish later on between no password and empty password
if ($sth->err) {
$dbh->disconnect;
return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR();
}
$sth->finish;
# re-use dbh for logging option below
$dbh->disconnect unless ($Attr->{log_field} && $Attr->{log_string});
}
$r->subprocess_env(REMOTE_PASSWORDS => $passwd);
print STDERR "$prefix passwd = >$passwd<\n" if $Apache::AuthDBI::DEBUG > 1;
# check if password is needed
if (!defined($passwd)) { # not found in database
# if authoritative insist that user is in database
if ($Attr->{authoritative} eq 'on') {
$r->log_reason("$prefix password for user $user_sent not found", $r->uri);
$r->note_basic_auth_failure;
return MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED();
} else {
# else pass control to the next authentication module
return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
}
}
# allow any password if nopasswd = on and the retrieved password is empty
if ($Attr->{nopasswd} eq 'on' && !$passwd) {
return MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
# if nopasswd is off, reject user
unless ($passwd_sent && $passwd) {
$r->log_reason("$prefix user $user_sent: empty password(s) rejected", $r->uri);
$r->note_basic_auth_failure;
return MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED();
}
# compare passwords
my $found = 0;
my $password;
foreach $password (split(/$;/, $passwd)) {
# compare all the passwords using as many encryption methods in fallback as needed
my (@passwds_to_check, $passwd_to_check);
@passwds_to_check = &get_passwds_to_check($Attr, user_sent=>$user_sent, passwd_sent=>$passwd_sent, password=>$password);
print STDERR "$prefix ". scalar(@passwds_to_check) . " passwords to check\n" if $Apache::AuthDBI::DEBUG > 1;
foreach $passwd_to_check(@passwds_to_check) {
print STDERR "$prefix user $user_sent: Password after Preparation >$passwd_to_check< - trying for a match with >$password< \n" if $Apache::AuthDBI::DEBUG > 1;
if ($passwd_to_check eq $password) {
$found = 1;
$r->subprocess_env(REMOTE_PASSWORD => $password);
print STDERR "$prefix user $user_sent: Password from Web Server >$passwd_sent< - Password after Preparation >$passwd_to_check< - password match for >$password< \n" if $Apache::AuthDBI::DEBUG > 1;
# update timestamp and cache userid/password if CacheTime is configured
if ($CacheTime) { # do we use the cache ?
if ($SHMID) { # do we keep the cache in shared memory ?
semop($SEMID, $obtain_lock) or print STDERR "$prefix semop failed \n";
shmread($SHMID, $Cache, 0, $SHMSIZE) or print STDERR "$prefix shmread failed \n";
substr($Cache, index($Cache, "\0")) = '';
}
# update timestamp and password or append new record
my $now = time;
if (!($Cache =~ s/$ID$;\d+$;.*$;(.*)\n/$ID$;$now$;$password$;$1\n/)) {
$Cache .= "$ID$;$now$;$password$;\n";
} else {
}
if ($SHMID) { # write cache to shared memory
shmwrite($SHMID, $Cache, 0, $SHMSIZE) or print STDERR "$prefix shmwrite failed \n";
semop($SEMID, $release_lock) or print STDERR "$prefix semop failed \n";
}
}
last;
}
}
#if the passwd matched (encrypted or otherwise), don't check the myriad other passwords that may or may not exist
if ($found > 0) {
last;
}
}
unless ($found) {
$r->log_reason("$prefix user $user_sent: password mismatch", $r->uri);
$r->note_basic_auth_failure;
return MP2 ? Apache2::Const::AUTH_REQUIRED() : Apache::Constants::AUTH_REQUIRED();
}
# logging option
if ($Attr->{log_field} && $Attr->{log_string}) {
if (!$dbh) { # connect to database if not already done
my ($j, $connect);
for ($j = 0; $j <= $#data_sources; $j++) {
if ($dbh = DBI->connect($data_sources[$j], $usernames[$j], $passwords[$j])) {
$connect = 1;
last;
}
}
unless ($connect) {
$r->log_reason("$prefix db connect error with $Attr->{data_source}", $r->uri);
return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR();
}
}
my $user_sent_quoted = $dbh->quote($user_sent);
if ($diff > $CleanupTime) {
print STDERR "$prefix push PerlCleanupHandler \n" if $Apache::AuthDBI::DEBUG > 1;
push_handlers( PerlCleanupHandler => \&cleanup);
}
}
print STDERR "$prefix return OK\n" if $Apache::AuthDBI::DEBUG > 1;
return MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
}
#Encrypts a password in all supported/requested methods and passes back array for comparison
sub get_passwds_to_check {
my ($Attr, %params) = @_;
my ($prefix) = "$$ Apache::AuthDBI::get_passwds_to_check ";
my ($salt, @passwds_to_check);
if ($Attr->{encrypted} eq 'on') {
#SHA1
if ($Attr->{encryption_method} =~ /(^|\/)sha1hex($|\/)/i) {
push (@passwds_to_check, &SHA1_digest(text=>$params{'passwd_sent'}, format=>'hex'));
}
#MD5
if ($Attr->{encryption_method} =~ /(^|\/)md5hex($|\/)/i) {
push (@passwds_to_check, &MD5_digest(text=>$params{'passwd_sent'}, format=>'hex'));
}
#CRYPT
if ($Attr->{encryption_method} =~ /(^|\/)crypt($|\/)/i) {
$salt = $Attr->{encryption_salt} eq 'userid' ? $params{'user_sent'} : $params{'password'};
#Bug Fix in v0.94 (marked as 0.93 in file. salt was NOT being sent to crypt) - KAM - 06-16-2005
push (@passwds_to_check, crypt($params{'passwd_sent'}, $salt));
}
#WE DIDN'T GET ANY PASSWORDS TO CHECK. MUST BE A PROBLEM
if (scalar(@passwds_to_check) < 1) {
print STDERR "$prefix Error: No Valid Encryption Method Specified.\n" if $Apache::AuthDBI::DEBUG > 1;
}
} else {
#IF NO ENCRYPTION, JUST PUSH THE CLEARTEXT PASS
# get username
my ($user_sent) = $r->user;
print STDERR "$prefix user sent = >$user_sent<\n" if $Apache::AuthDBI::DEBUG > 1 ;
# here we could read the configuration, but we re-use the configuration from the authentication
# parse connect attributes, which may be tilde separated lists
my @data_sources = split(/~/, $Attr->{data_source});
my @usernames = split(/~/, $Attr->{username});
my @passwords = split(/~/, $Attr->{password});
$data_sources[0] = '' unless $data_sources[0]; # use ENV{DBI_DSN} if not defined
# if not configured decline
unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{grp_field}) {
print STDERR "$prefix not configured, return DECLINED\n" if $Apache::AuthDBI::DEBUG > 1;
return MP2 ? Apache2::Const::DECLINED() : Apache::Constants::DECLINED();
}
# do we want Windows-like case-insensitivity?
$user_sent = lc($user_sent) if $Attr->{uidcasesensitive} eq "off";
}
if ($groups) { # found in cache
print STDERR "$prefix groups found in cache \n" if $Apache::AuthDBI::DEBUG > 1;
} else { # groups not cached or changed
print STDERR "$prefix groups not found in cache \n" if $Apache::AuthDBI::DEBUG;
# connect to database, use all data_sources until the connect succeeds
my ($j, $connect);
for ($j = 0; $j <= $#data_sources; $j++) {
if ($dbh = DBI->connect($data_sources[$j], $usernames[$j], $passwords[$j])) {
$connect = 1;
last;
}
}
unless ($connect) {
$r->log_reason("$prefix db connect error with $Attr->{data_source}", $r->uri);
return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR();
}
# generate statement
# Authentication and Authorization in .htaccess:
AuthName DBI
AuthType Basic
PerlAuthenHandler Apache::AuthDBI::authen
PerlAuthzHandler Apache::AuthDBI::authz
PerlSetVar Auth_DBI_data_source dbi:driver:dsn
PerlSetVar Auth_DBI_username db_username
PerlSetVar Auth_DBI_password db_password
#DBI->connect($data_source, $username, $password)
PerlSetVar Auth_DBI_pwd_table users
PerlSetVar Auth_DBI_uid_field username
PerlSetVar Auth_DBI_pwd_field password
# authentication: SELECT pwd_field FROM pwd_table WHERE uid_field=$user
PerlSetVar Auth_DBI_grp_field groupname
# authorization: SELECT grp_field FROM pwd_table WHERE uid_field=$user
require valid-user
require user user_1 user_2 ...
require group group_1 group_2 ...
The AuthType is limited to Basic. You may use one or more valid require lines.
For a single require line with the requirement 'valid-user' or with the requirements
=head1 DESCRIPTION
This module allows authentication and authorization against a database
using Perl's DBI. For supported DBI drivers see:
http://dbi.perl.org/
Authentication:
For the given username the password is looked up in the cache. If the cache
is not configured or if the user is not found in the cache, or if the given
password does not match the cached password, it is requested from the database.
If the username does not exist and the authoritative directive is set to 'on',
the request is rejected. If the authoritative directive is set to 'off', the
control is passed on to next module in line.
If the password from the database for the given username is empty and the nopasswd
directive is set to 'off', the request is rejected. If the nopasswd directive is set
to 'on', any password is accepted.
Finally the passwords (multiple passwords per userid are allowed) are
retrieved from the database. The result is put into the environment variable
REMOTE_PASSWORDS. Then it is compared to the password given. If the encrypted
directive is set to 'on', the given password is encrypted using perl's crypt()
function before comparison. If the encrypted directive is set to 'off' the
plain-text passwords are compared.
If this comparison fails the request is rejected, otherwise the request is
accepted and the password is put into the environment variable REMOTE_PASSWORD.
The SQL-select used for retrieving the passwords is as follows:
SELECT pwd_field FROM pwd_table WHERE uid_field = user
If a pwd_whereclause exists, it is appended to the SQL-select.
This module supports in addition a simple kind of logging mechanism. Whenever
the handler is called and a log_string is configured, the log_field will be
updated with the log_string. As log_string - depending upon the database -
macros like TODAY can be used.
The SQL-select used for the logging mechanism is as follows:
UPDATE pwd_table SET log_field = log_string WHERE uid_field = user
Authorization:
When the authorization handler is called, the authentication has already been
done. This means, that the given username/password has been validated.
The handler analyzes and processes the requirements line by line. The request
is accepted if the first requirement is fulfilled.
In case of 'valid-user' the request is accepted.
In case of one or more user-names, they are compared with the given user-name
until the first match.
In case of one or more group-names, all groups of the given username are
in an extra table, if there is an m:n relationship between users and groups.
From all selected groups a comma-separated list is build, which is compared
with the required groups. If you don't like normalized group records you can
put such a comma-separated list of groups (no spaces) into the grp_field
instead of single groups.
If a grp_whereclause exists, it is appended to the SQL-select.
Cache:
The module maintains an optional cash for all passwords/groups. See the
method setCacheTime(n) on how to enable the cache. Every server has it's
own cache. Optionally the cache can be put into a shared memory segment,
so that it can be shared among all servers. See the CONFIGURATION section
on how to enable the usage of shared memory.
In order to prevent the cache from growing indefinitely a CleanupHandler can
be initialized, which skips through the cache and deletes all outdated entries.
This can be done once per request after sending the response, hence without
slowing down response time to the client. The minimum time between two successive
runs of the CleanupHandler is configurable (see the CONFIGURATION section). The
default is 0, which runs the CleanupHandler after every request.
=head1 LIST OF TOKENS
=item *
Auth_DBI_data_source (Authentication and Authorization)
The data_source value has the syntax 'dbi:driver:dsn'. This parameter is
passed to the database driver for processing during connect. The data_source
parameter (as well as the username and the password parameters) may be a
tilde ('~') separated list of several data_sources. All of these triples will
be used until a successful connect is made. This way several backup-servers can
be configured. if you want to use the environment variable DBI_DSN instead of
a data_source, do not specify this parameter at all.
=item *
Auth_DBI_username (Authentication and Authorization)
The username argument is passed to the database driver for processing during
connect. This parameter may be a tilde ('~') separated list. See the data_source
parameter above for the usage of a list.
=item *
Auth_DBI_password (Authentication and Authorization)
The password argument is passed to the database driver for processing during
connect. This parameter may be a tilde ('~') separated list. See the data_source
parameter above for the usage of a list.
=item *
Auth_DBI_pwd_table (Authentication and Authorization)
Contains at least the fields with the username and the (possibly encrypted)
password. The username should be unique.
=item *
Auth_DBI_uid_field (Authentication and Authorization)
Field name containing the username in the Auth_DBI_pwd_table.
=item *
Auth_DBI_pwd_field (Authentication only)
Field name containing the password in the Auth_DBI_pwd_table.
=item *
Auth_DBI_pwd_whereclause (Authentication only)
Use this option for specifying more constraints to the SQL-select.
=item *
Auth_DBI_grp_table (Authorization only)
Contains at least the fields with the username and the groupname.
Auth_DBI_authoritative < on / off> (Authentication and Authorization)
Default is 'on'. When set 'on', there is no fall-through to other
authentication methods if the authentication check fails. When this directive
is set to 'off', control is passed on to any other authentication modules. Be
sure you know what you are doing when you decide to switch it off.
=item *
Auth_DBI_nopasswd < on / off > (Authentication only)
Default is 'off'. When set 'on' the password comparison is skipped if the
password retrieved from the database is empty, i.e. allow any password. This is
'off' by default to ensure that an empty Auth_DBI_pwd_field does not allow people
to log in with a random password. Be sure you know what you are doing when you
decide to switch it on.
=item *
Auth_DBI_encrypted < on / off > (Authentication only)
Default is 'on'. When set to 'on', the password retrieved from the database
is assumed to be crypted. Hence the incoming password will be crypted before
comparison. When this directive is set to 'off', the comparison is done directly
with the plain-text entered password.
=item *
Auth_DBI_encryption_method < sha1hex/md5hex/crypt > (Authentication only)
Default is blank. When set to one or more encryption method, the password retrieved
from the database is assumed to be crypted. Hence the incoming password will be crypted
before comparison. The method supports falling back so specifying 'sha1hex/md5hex' would
allow for a site that is upgrading to sha1 to support both methods. sha1 is the
recommended method.
=item *
Auth_DBI_encryption_salt < password / userid > (Authentication only)
When crypting the given password AuthDBI uses per default the password selected
from the database as salt. Setting this parameter to 'userid', the module uses
the userid as salt.
=item *
Auth_DBI_uidcasesensitive < on / off > (Authentication and Authorization)
Default is 'on'. When set 'off', the entered userid is converted to lower case.
Also the userid in the password select-statement is converted to lower case.
=item *
Auth_DBI_pwdcasesensitive < on / off > (Authentication only)
Default is 'on'. When set 'off', the entered password is converted to lower
case.
=item *
Auth_DBI_placeholder < on / off > (Authentication and Authorization)
Default is 'off'. When set 'on', the select statement is prepared using a
placeholder for the username. This may result in improved performance for
databases supporting this method.
A common usage is to load the module in a startup file via the PerlRequire
directive. See eg/startup.pl for an example.
There are three configurations which are server-specific and which can be done
in a startup file:
Apache::AuthDBI->setCacheTime(0);
This configures the lifetime in seconds for the entries in the cache.
Default is 0, which turns off the cache. When set to any value n > 0, the
passwords/groups of all users will be cached for at least n seconds. After
finishing the request, a special handler skips through the cache and deletes
all outdated entries (entries, which are older than the CacheTime).
Apache::AuthDBI->setCleanupTime(-1);
This configures the minimum time in seconds between two successive runs of the
CleanupHandler, which deletes all outdated entries from the cache. The default
is -1, which disables the CleanupHandler. Setting the interval to 0 runs the
CleanupHandler after every request. For a heavily loaded server this should be
set to a value, which reflects a compromise between scanning a large cache
=head1 PREREQUISITES
Note that this module needs mod_perl-1.08 or higher, apache_1.3.0 or higher
and that mod_perl needs to be configured with the appropriate call-back hooks:
PERL_AUTHEN=1 PERL_AUTHZ=1 PERL_CLEANUP=1 PERL_STACKED_HANDLERS=1
=head1 SECURITY
In some cases it is more secure not to put the username and the password in
the .htaccess file. The following example shows a solution to this problem:
httpd.conf:
<Perl>
my($uid,$pwd) = My::dbi_pwd_fetch();
$Location{'/foo/bar'}->{PerlSetVar} = [
[ Auth_DBI_username => $uid ],
[ Auth_DBI_password => $pwd ],
];
</Perl>
=head1 SEE ALSO
L<Apache>, L<mod_perl>, L<DBI>
=head1 AUTHORS
}
my $connect_meth = $attr->{dbi_connect_method};
$connect_meth ||= $DBI::connect_via; # fallback to default
$dsn ||= $ENV{DBI_DSN} || $ENV{DBI_DBNAME} || '' unless $old_driver;
if ($DBI::dbi_debug) {
local $^W = 0;
pop @_ if $connect_meth ne 'connect';
my @args = @_; $args[2] = '****'; # hide password
DBI->trace_msg(" -> $class->$connect_meth(".join(", ",@args).")\n");
}
Carp::croak('Usage: $class->connect([$dsn [,$user [,$passwd [,\%attr]]]])')
if (ref $old_driver or ($attr and not ref $attr) or ref $pass);
# extract dbi:driver prefix from $dsn into $1
$dsn =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i
or '' =~ /()/; # ensure $1 etc are empty if match fails
my $driver_attrib_spec = $2 || '';
first you need to load the DBI module:
use DBI;
use strict;
(The C<use strict;> isn't required but is strongly recommended.)
Then you need to L</connect> to your data source and get a I<handle> for that
connection:
$dbh = DBI->connect($dsn, $user, $password,
{ RaiseError => 1, AutoCommit => 0 });
Since connecting can be expensive, you generally just connect at the
start of your program and disconnect at the end.
Explicitly defining the required C<AutoCommit> behaviour is strongly
recommended and may become mandatory in a later version. This
determines whether changes are automatically committed to the
database when executed, or need to be explicitly committed later.
$driver is the driver name, possibly defaulted to $ENV{DBI_DRIVER},
and may be undefined. $attr_string is the optional attribute string,
which may be undefined. If $attr_string is true then $attr_hash
is a reference to a hash containing the parsed attribute names and
values. $driver_dsn is the last part of the DBI DSN string.
The parse_dsn() method was added in DBI 1.43.
=item C<connect>
$dbh = DBI->connect($data_source, $username, $password)
or die $DBI::errstr;
$dbh = DBI->connect($data_source, $username, $password, \%attr)
or die $DBI::errstr;
Establishes a database connection, or session, to the requested C<$data_source>.
Returns a database handle object if the connection succeeds. Use
C<$dbh-E<gt>disconnect> to terminate the connection.
If the connect fails (see below), it returns C<undef> and sets both C<$DBI::err>
and C<$DBI::errstr>. (It does I<not> explicitly set C<$!>.) You should generally
test the return status of C<connect> and C<print $DBI::errstr> if it has failed.
driver in C<$data_source> is not "C<Proxy>") then the connect request
will automatically be changed to:
$ENV{DBI_AUTOPROXY};dsn=$data_source
C<DBI_AUTOPROXY> is typically set as "C<dbi:Proxy:hostname=...;port=...>".
If $ENV{DBI_AUTOPROXY} doesn't begin with 'C<dbi:>' then "dbi:Proxy:"
will be prepended to it first. See the DBD::Proxy documentation
for more details.
If C<$username> or C<$password> are undefined (rather than just empty),
then the DBI will substitute the values of the C<DBI_USER> and C<DBI_PASS>
environment variables, respectively. The DBI will warn if the
environment variables are not defined. However, the everyday use
of these environment variables is not recommended for security
reasons. The mechanism is primarily intended to simplify testing.
See below for alternative way to specify the username and password.
C<DBI-E<gt>connect> automatically installs the driver if it has not been
installed yet. Driver installation either returns a valid driver
handle, or it I<dies> with an error message that includes the string
"C<install_driver>" and the underlying problem. So C<DBI-E<gt>connect>
will die
on a driver installation failure and will only return C<undef> on a
connect failure, in which case C<$DBI::errstr> will hold the error message.
Use C<eval { ... }> if you need to catch the "C<install_driver>" error.
The C<$data_source> argument (with the "C<dbi:...:>" prefix removed) and the
C<$username> and C<$password> arguments are then passed to the driver for
processing. The DBI does not define any interpretation for the
contents of these fields. The driver is free to interpret the
C<$data_source>, C<$username>, and C<$password> fields in any way, and supply
whatever defaults are appropriate for the engine being accessed.
(Oracle, for example, uses the ORACLE_SID and TWO_TASK environment
variables if no C<$data_source> is specified.)
The C<AutoCommit> and C<PrintError> attributes for each connection
default to "on". (See L</AutoCommit> and L</PrintError> for more information.)
However, it is strongly recommended that you explicitly define C<AutoCommit>
rather than rely on the default. The C<PrintWarn> attribute defaults to
on if $^W is true, i.e., perl is running with warnings enabled.
The C<\%attr> parameter can be used to alter the default settings of
C<PrintError>, C<RaiseError>, C<AutoCommit>, and other attributes. For example:
$dbh = DBI->connect($data_source, $user, $pass, {
PrintError => 0,
AutoCommit => 0
});
The username and password can also be specified using the attributes
C<Username> and C<Password>, in which case they take precedence
over the C<$username> and C<$password> parameters.
You can also define connection attribute values within the C<$data_source>
parameter. For example:
dbi:DriverName(PrintWarn=>1,PrintError=>0,Taint=>1):...
Individual attributes values specified in this way take precedence over
any conflicting values specified via the C<\%attr> parameter to C<connect>.
The C<dbi_connect_method> attribute can be used to specify which driver
with "C<dbi:driver_name:>". (If it does, the embedded driver_name
will be ignored). Also note that in this older form of C<connect>,
the C<$dbh-E<gt>{AutoCommit}> attribute is I<undefined>, the
C<$dbh-E<gt>{PrintError}> attribute is off, and the old C<DBI_DBNAME>
environment variable is
checked if C<DBI_DSN> is not defined. Beware that this "old-style"
C<connect> will soon be withdrawn in a future version of DBI.
=item C<connect_cached>
$dbh = DBI->connect_cached($data_source, $username, $password)
or die $DBI::errstr;
$dbh = DBI->connect_cached($data_source, $username, $password, \%attr)
or die $DBI::errstr;
C<connect_cached> is like L</connect>, except that the database handle
returned is also
stored in a hash associated with the given parameters. If another call
is made to C<connect_cached> with the same parameter values, then the
corresponding cached C<$dbh> will be returned if it is still valid.
The cached database handle is replaced with a new connection if it
has been disconnected or if the C<ping> method fails.
The following methods are specified for DBI database handles:
=over 4
=item C<clone>
$new_dbh = $dbh->clone();
$new_dbh = $dbh->clone(\%attr);
The C<clone> method duplicates the $dbh connection by connecting
with the same parameters ($dsn, $user, $password) as originally used.
The attributes for the cloned connect are the same as those used
for the original connect, with some other attribute merged over
them depending on the \%attr parameter.
If \%attr is given then the attributes it contains are merged into
the original attributes and override any with the same names.
Effectively the same as doing:
%attribues_used = ( %original_attributes, %attr );
since there are often limits on the maximum size of an C<INSERT>
statement and the L</quote> method generally can't cope with binary
data. See L</Placeholders and Bind Values>.
=head2 Simple Examples
Here's a complete example program to select and fetch some data:
my $data_source = "dbi::DriverName:db_name";
my $dbh = DBI->connect($data_source, $user, $password)
or die "Can't connect to $data_source: $DBI::errstr";
my $sth = $dbh->prepare( q{
SELECT name, phone
FROM mytelbook
}) or die "Can't prepare statement: $DBI::errstr";
my $rc = $sth->execute
or die "Can't execute statement: $DBI::errstr";
print "$name: $phone\n";
}
# check for problems which may have terminated the fetch early
die $sth->errstr if $sth->err;
$dbh->disconnect;
Here's a complete example program to insert some data from a file.
(This example uses C<RaiseError> to avoid needing to check each call).
my $dbh = DBI->connect("dbi:DriverName:db_name", $user, $password, {
RaiseError => 1, AutoCommit => 0
});
my $sth = $dbh->prepare( q{
INSERT INTO table (name, phone) VALUES (?, ?)
});
open FH, "<phone.csv" or die "Unable to open phone.csv: $!";
while (<FH>) {
chomp;
=head2 DBI_USER
The DBI_USER environment variable takes a string value that is used as
the user name if the DBI->connect call is given undef (as distinct from
an empty string) as the username argument.
Be wary of the security implications of using this.
=head2 DBI_PASS
The DBI_PASS environment variable takes a string value that is used as
the password if the DBI->connect call is given undef (as distinct from
an empty string) as the password argument.
Be extra wary of the security implications of using this.
=head2 DBI_DBNAME (obsolete)
The DBI_DBNAME environment variable takes a string value that is used only when the
obsolescent style of DBI->connect (with driver name as fourth parameter) is used, and
when no value is provided for the first (database name) argument.
=head2 DBI_TRACE
=head2 How to create a patch using Subversion
The DBI source code is maintained using Subversion (a replacement
for CVS, see L<http://subversion.tigris.org/>). To access the source
you'll need to install a Subversion client. Then, to get the source
code, do:
svn checkout http://svn.perl.org/modules/dbi/trunk
If it prompts for a username and password use your perl.org account
if you have one, else just 'guest' and 'guest'. The source code will
be in a new subdirectory called C<trunk>.
To keep informed about changes to the source you can send an empty email
to dbi-changes@perl.org after which you'll get an email with the
change log message and diff of each change checked-in to the source.
After making your changes you can generate a patch file, but before
you do, make sure your source is still upto date using:
LoggedAuthDBI.pm view on Meta::CPAN
$val = $r->dir_config($key) || $val;
$key =~ s/^Log_ADBI_//;
$Attr->{$key} = $val;
}
$Attr->{data_source} = $r->dir_config('Auth_DBI_data_source');
# parse connect attributes, which may be tilde separated lists
my @data_sources = split(/~/, $Attr->{data_source});
my @usernames = split(/~/, $Attr->{username});
my @passwords = split(/~/, $Attr->{password});
$data_sources[0] = '' unless $data_sources[0]; # use ENV{DBI_DSN} if not defined
# connect to database, use all data_sources until the connect succeeds
my $j;
my $dbh;
for ($j = 0; $j <= $#data_sources; $j++) {
last if ($dbh = DBI->connect($data_sources[$j], $usernames[$j], $passwords[$j]));
}
unless ($dbh) {
$r->log_reason("db connect error with data_source >$Attr->{data_source}<: $DBI::errstr", $r->uri);
return MP2 ? Apache2::Const::SERVER_ERROR() : Apache::Constants::SERVER_ERROR();
}
# connect to right database
#my $dbh = DBI->connect("DBI:mysql:$DB_CFG{$client.'dbname'}:$DB_CFG{$client.'dbhost'}", $DB_CFG{$client.'dblogin'}, $DB_CFG{$client.'dbpass'});
LoggedAuthDBI.pm view on Meta::CPAN
my $times_declined = 5;
#prevent brute force attacks, has an IPaddress made X attempts in Y seconds
my $seconds_brute_ip = 300;
my $times_brute_ip = 800;
#prevent brute force attacks, has the same username been rejected X times in Y sec?
my $seconds_brute_username = 60;
my $times_brute_username = 3;
#Prevent password sharing, has the same username accessed from X different IPs in Y sec
my $minutes_pw_shared = 180;
my $times_pw_shared = 30;
#SQL Queries to detect brute forcing and or pass sharing
# &get_count will return the number of entries that correspond to the query in $select. the result will be
# compared with the $times_... variable to detect a violation of our rules
#autoreject if an IPaddress made X failed attempts in Y seconds
my $select = "SELECT id FROM ".$Attr->{table}." WHERE ".$Attr->{ip_field}."='$incomingIP' AND ".$Attr->{status_field}."<>'0' AND ".$Attr->{time_field}." > (DATE_SUB(NOW(), INTERVAL '$seconds_declined' SECOND))";
my $declined = &get_count($select, $dbh);
#prevent brute force attacks, has an IPaddress made X attempts in Y seconds
$select = "SELECT id FROM ".$Attr->{table}." WHERE ".$Attr->{ip_field}."='$incomingIP' AND ".$Attr->{time_field}." > (DATE_SUB(NOW(), INTERVAL '$seconds_brute_ip' SECOND))";
my $brute_ip = &get_count($select, $dbh);
#prevent brute force attacks, has the same username been rejected X times in Y sec?
$select = "SELECT id FROM ".$Attr->{table}." WHERE ".$Attr->{un_field}."='$username' AND ".$Attr->{status_field}."<>'0' AND ".$Attr->{time_field}." > (DATE_SUB(NOW(), INTERVAL '$seconds_brute_username' SECOND))";
my $brute_username = &get_count($select, $dbh);
#Prevent password sharing, has the same username accessed from X different IPs in Y sec
$select = "SELECT distinct(".$Attr->{ip_field}.") ".$Attr->{table}." WHERE ".$Attr->{un_field}."='$username' AND ".$Attr->{time_field}. "> (DATE_SUB(NOW(), INTERVAL '$minutes_pw_shared' MINUTE))";
my $password_shared = &get_count($select, $dbh);
#Take Action: in case of a detected violation beyond tolerance level send the user to an error page
if ($declined >= $times_declined) {
$r->filename($errdocpath . 'blocked.html');
$return_value = 'OK';
} elsif ($brute_ip >= $times_brute_ip || $brute_username >= $times_brute_username) {
$r->filename($errdocpath . 'brute_force.html');
$return_value = 'OK';
} elsif ($password_shared >= $times_pw_shared) {
$r->filename($errdocpath . 'pass_sharing.html');
$auth = 'PASS_SHARED';
$return_value = 'OK';
#no brute force/pwsharing pass off to the main DBI authorization thingy...
} else {
$auth = Apache::AuthDBI::authen($r);
$return_value = $auth;
}
LoggedAuthDBI.pm view on Meta::CPAN
# Authentication and Authorization in .htaccess:
AuthName DBI
AuthType Basic
PerlAuthenHandler Apache::AuthDBI::authen
PerlAuthzHandler Apache::AuthDBI::authz
PerlSetVar Auth_DBI_data_source dbi:driver:dsn
PerlSetVar Auth_DBI_username db_username
PerlSetVar Auth_DBI_password db_password
#DBI->connect($data_source, $username, $password)
PerlSetVar Log_ADBI_table login_log
PerlSetVar Log_ADBI_ip_field IPaddress
PerlSetVar Log_ADBI_un_field username
PerlSetVar Log_ADBI_status_field status
PerlSetVar Log_ADBI_time_field timestamped
# data required to access the log table
PerlSetVar Auth_DBI_pwd_table users
PerlSetVar Auth_DBI_uid_field username
PerlSetVar Auth_DBI_pwd_field password
# authentication: SELECT pwd_field FROM pwd_table WHERE uid_field=$user
require valid-user
=head1 DESCRIPTION
This is an extension of Apache::AuthDBI by Edmund Mergl. Its purpose is
to add a degree of protection against brute force attacks and password sharing.
To accomplish this LoggedAuthDBI makes use of a log table that records IP, username,
status and time of any given login attempt handled by this module.
Whenever it is called it will perform four checks:
=over 4
=item *
Did IPaddress 123 make X failed attempts in Y seconds?
(autoreject IP addresses that have too many failed attempts on record)
LoggedAuthDBI.pm view on Meta::CPAN
=item *
Has username foo been rejected X times in Y seconds?
(this check as a means to help against proxy rotation in combination with
brute force attempts)
=item *
Does username foo have logins from X different IPaddresses in Y seconds?
(this would surely indicate password sharing)
=back
Should none of the four checks yield a violation AuthDBI is called and its
return value used without modification.
Otherwise it will redirect to a different filename while returning OK. This
will cause a bruteforce tool to think it was successful in its attempt to
guess a valid login/pass combination and either stop or collect this combination
into its list of valid options.
DESCRIPTION
This is an extension of Apache::AuthDBI by Edmund Mergl. Its purpose is to add a degree of protection against brute force attacks and password sharing. To accomplish this LoggedAuthDBI makes use of a log table that records IP, username, status and ti...
LINCENSE
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
PREREQUISITES
Apache::AuthDBI is required. This implies that minimum requirements for that
module must be met.
pass_sharing.html view on Meta::CPAN
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<HTML>
<HEAD>
<TITLE> Blocked </TITLE>
</HEAD>
<BODY>
requests involving this user name have been blocked due to password sharing
</BODY>
</HTML>
( run in 0.506 second using v1.01-cache-2.11-cpan-49f99fa48dc )