I've been experimenting with Apache::AuthDBI 0.93, and ran into a few problems using it under mod_perl 2:
- The "use constant MP2" does not pick up the version correctly unless I explicitly "use mod_perl" before loading AuthDBI. use()'ing Apache2 or any of the modules in the example startup script (from perl.apache.org) doesn't do it.
- The log_reason() routine is gone from mod_perl 2. Any authentication errors result in a server error, unless Apache::compat is in use.
To use Apache::AuthDBI without Apache::compat, I added the changes below to my local copy. Ask, feel free to use these in the next version of Apache::AuthDBI, unless someone here finds out that I've done something horribly horribly wrong. ;)
- Jeremiah
diff -u -r orig/Apache/AuthDBI.pm new/Apache/AuthDBI.pm --- orig/Apache/AuthDBI.pm Mon Mar 8 21:08:02 2004 +++ new/Apache/AuthDBI.pm Mon Mar 8 21:37:52 2004 @@ -33,6 +33,19 @@ }
+# This subroutine encapsulates log_reason vs. log_error
+# changes in mod_perl 2.
+
+sub log_reason {
+ my ($r, $msg, $file) = @_;
+ if (MP2) {
+ $r->log_error("$msg (at $file)");
+ } else {
+ $r->log_reason($msg, $file);
+ }
+}
+
+
# configuration attributes, defaults will be overwritten with values from .htaccess.
my %Config = (
@@ -256,7 +269,7 @@
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);
+ log_reason($r, "$prefix db connect error with data_source >$Attr->{data_source}<: $DBI::errstr", $r->uri);
return SERVER_ERROR;
}
@@ -273,7 +286,7 @@
# prepare statement
my $sth;
unless ($sth = $dbh->prepare($statement)) {
- $r->log_reason("$prefix can not prepare statement: $DBI::errstr", $r->uri);
+ log_reason($r, "$prefix can not prepare statement: $DBI::errstr", $r->uri);
$dbh->disconnect;
return SERVER_ERROR;
}
@@ -281,7 +294,7 @@
# execute statement
my $rv;
unless ($rv = ($Attr->{placeholder} eq "on") ? $sth->execute($user_sent) : $sth->execute) {
- $r->log_reason("$prefix can not execute statement: $DBI::errstr", $r->uri);
+ log_reason($r, "$prefix can not execute statement: $DBI::errstr", $r->uri);
$dbh->disconnect;
return SERVER_ERROR;
}
@@ -314,7 +327,7 @@
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);
+ log_reason($r, "$prefix password for user $user_sent not found", $r->uri);
$r->note_basic_auth_failure;
return AUTH_REQUIRED;
} else {
@@ -330,7 +343,7 @@
# if nopasswd is off, reject user
unless ($passwd_sent && $passwd) {
- $r->log_reason("$prefix user $user_sent: empty password(s) rejected", $r->uri);
+ log_reason($r, "$prefix user $user_sent: empty password(s) rejected", $r->uri);
$r->note_basic_auth_failure;
return AUTH_REQUIRED;
}
@@ -368,7 +381,7 @@
}
}
unless ($found) {
- $r->log_reason("$prefix user $user_sent: password mismatch", $r->uri);
+ log_reason($r, "$prefix user $user_sent: password mismatch", $r->uri);
$r->note_basic_auth_failure;
return AUTH_REQUIRED;
}
@@ -384,7 +397,7 @@
}
}
unless ($connect) {
- $r->log_reason("$prefix db connect error with $Attr->{data_source}", $r->uri);
+ log_reason($r, "$prefix db connect error with $Attr->{data_source}", $r->uri);
return SERVER_ERROR;
}
}
@@ -392,7 +405,7 @@
my $statement = "UPDATE $Attr->{pwd_table} SET $Attr->{log_field} = $Attr->{log_string} WHERE $Attr->{uid_field}=$user_sent_quoted";
print STDERR "$prefix statement: $statement\n" if $Apache::AuthDBI::DEBUG > 1;
unless ($dbh->do($statement)) {
- $r->log_reason("$prefix can not do statement: $DBI::errstr", $r->uri);
+ log_reason($r, "$prefix can not do statement: $DBI::errstr", $r->uri);
$dbh->disconnect;
return SERVER_ERROR;
}
@@ -465,7 +478,7 @@
my ($ary_ref) = $r->requires;
unless ($ary_ref) {
if ($Attr->{authoritative} eq 'on') {
- $r->log_reason("user $user_sent denied, no access rules specified (DBI-Authoritative)", $r->uri);
+ log_reason($r, "user $user_sent denied, no access rules specified (DBI-Authoritative)", $r->uri);
$r->note_basic_auth_failure if $authz_denied == AUTH_REQUIRED;
return $authz_denied;
}
@@ -553,7 +566,7 @@
}
}
unless ($connect) {
- $r->log_reason("$prefix db connect error with $Attr->{data_source}", $r->uri);
+ log_reason($r, "$prefix db connect error with $Attr->{data_source}", $r->uri);
return SERVER_ERROR;
}
@@ -570,7 +583,7 @@
# prepare statement
my $sth;
unless ($sth = $dbh->prepare($statement)) {
- $r->log_reason("can not prepare statement: $DBI::errstr", $r->uri);
+ log_reason($r, "can not prepare statement: $DBI::errstr", $r->uri);
$dbh->disconnect;
return SERVER_ERROR;
}
@@ -578,7 +591,7 @@
# execute statement
my $rv;
unless ($rv = ($Attr->{placeholder} eq "on") ? $sth->execute($user_sent) : $sth->execute) {
- $r->log_reason("can not execute statement: $DBI::errstr", $r->uri);
+ log_reason($r, "can not execute statement: $DBI::errstr", $r->uri);
$dbh->disconnect;
return SERVER_ERROR;
}
@@ -634,7 +647,7 @@
my $reason;
$reason .= " USER" if $user_result == AUTH_REQUIRED;
$reason .= " GROUP" if $group_result == AUTH_REQUIRED;
- $r->log_reason("DBI-Authoritative: Access denied on $reason rule(s)", $r->uri);
+ log_reason($r, "DBI-Authoritative: Access denied on $reason rule(s)", $r->uri);
$r->note_basic_auth_failure if $authz_denied == AUTH_REQUIRED;
return $authz_denied;
}
-- Report problems: http://perl.apache.org/bugs/ Mail list info: http://perl.apache.org/maillist/modperl.html List etiquette: http://perl.apache.org/maillist/email-etiquette.html
