Apache::DBILogin - authenticates and authorizes via a DBI connection

Apache-DBILogin documentation Contained in the Apache-DBILogin distribution.

Index

Code Index:

NAME

Top

Apache::DBILogin - authenticates and authorizes via a DBI connection

SYNOPSIS

Top

 #in .htaccess
 AuthName MyAuth
 AuthType Basic
 PerlAuthenHandler Apache::DBILogin::authen
 PerlSetVar Auth_DBI_data_source dbi:Oracle:SQLNetAlias
 PerlAuthzHandler Apache::DBILogin::authz

 allow from all
 require group connect resource dba
 satisfy all

 #in startup.pl
 package Apache::DBILogin;

 # is_member function for authz handler
 #  expects request object, database handle, and group for which to test
 #  returns valid response code
 sub is_member {
     my ($r, $dbh, $group) = @_;

     my $sth;
     eval {
         # no, Oracle doesn't support binding in SET ROLE statement
         $sth = $dbh->prepare("SET ROLE $group") or die $DBI::errstr;
     };
     return ( MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR
                  : Apache::Constants::HTTP_INTERNAL_SERVER_ERROR ) if ( $@ );

     return ( defined $sth->execute() ) ? (MP2 ? Apache2::Const::OK
                                               : Apache::Constants::OK)
                                        : (MP2 ? Apache2::Const::HTTP_FORBIDDEN
                                               : Apache::Constants::HTTP_FORBIDDEN);
 }

DESCRIPTION

Top

Apache::DBILogin allows authentication and authorization against a multi-user database.

It is intended to facilitate web-based transactions against a database server as a particular database user. If you wish authenticate against a passwd table instead, please see Edmund Mergl's Apache::AuthDBI module.

Group authorization is handled by your Apache::DBILogin::is_member() function which you must define if you enable the authz handler.

The above example uses Oracle roles to assign group membership. A role is a set of database privileges which can be assigned to users. Unfortunately, roles are vendor specific. Under Oracle you can test membership with "SET ROLE role_name" statement. You could also query the data dictionary, DBA_ROLE_PRIVS, but under Oracle that requires explicit privilege. Documentation patches for other databases are welcome.

ENVIRONMENT

Top

Applications may access the clear text password as well as the data_source via the environment variables HTTP_MODPERL_DBILOGIN_PASSWORD and HTTP_MODPERL_DBILOGIN_DATA_SOURCE.

 #!/usr/bin/perl -wT

 use strict;
 use CGI;
 use DBI;
 my $name = $ENV{REMOTE_USER};
 my $password = $ENV{HTTP_MODPERL_DBILOGIN_PASSWORD};
 my $data_source = $ENV{HTTP_MODPERL_DBILOGIN_DATA_SOURCE};
 my $dbh = DBI->connect($data_source, $name, $password)
 	or die "$DBI::err: $DBI::errstr\n";
 ...

SECURITY

Top

The database user's clear text passwd is made available in the server's environment. Do you trust your developers?

BUGS

Top

Probably lots, I'm not the best programmer in the world.

NOTES

Top

Feel free to email me with comments, suggestions, flames. Its the only way I'll become a better programmer.

SEE ALSO

Top

mod_perl(1), Apache::DBI(3), and Apache::AuthDBI(3)

AUTHOR

Top

John Groenveld <groenveld@acm.org>

Apache-DBILogin documentation Contained in the Apache-DBILogin distribution. 
package Apache::DBILogin;

use strict;

use vars qw($VERSION);
$VERSION = '2.06';

# setting the constants to help identify which version of mod_perl
# is installed
use constant MP2 => eval { require mod_perl2; 1 } || 0;

# test for the version of mod_perl, and use the appropriate libraries
BEGIN {
    if (MP2) {
        require Apache2::Access;
        require Apache2::Connection;
        require Apache2::Const;
        require Apache2::Log;
        require Apache2::RequestRec;
        require Apache2::RequestUtil;
        require APR::Table;
        Apache2::Const->import(-compile => 'HTTP_FORBIDDEN', 'HTTP_UNAUTHORIZED',
                                          'HTTP_INTERNAL_SERVER_ERROR', 'OK');
    } else {
        require mod_perl;
        require Apache::Constants;
        Apache::Constants->import('HTTP_FORBIDDEN', 'HTTP_UNAUTHORIZED',
                                  'HTTP_INTERNAL_SERVER_ERROR', 'OK');
    }
}

use DBI;

my(%Config) = (
    'Auth_DBI_data_source' => '',
    'Auth_DBI_authz_command' => '',
    'DBILogin_Oracle_authz_command' => '',
);
my $prefix = "Apache::DBILogin";

sub authen {
    my $r = shift @_;
 
    my ($res, $sent_pwd) = $r->get_basic_auth_pw;
    return $res if ( $res ); #decline if not Basic

    return (MP2 ? Apache2::Const::OK : Apache::Constants::OK)
        unless $r->is_initial_req;

    my($key,$val);
    my $attr = {};
    while(($key,$val) = each %Config) {
        $val = $r->dir_config($key) || $val;
        $key =~ s/^Auth_DBI_//;
        $attr->{$key} = $val;
    }
    
    return test_authen($r, $attr, $sent_pwd);
}
 
sub test_authen {
    my($r, $attr, $sent_pwd) = @_;

    my $user = MP2 ? $r->user : $r->connection->user;

    unless ( $attr->{data_source} ) {
        $r->log_reason("$prefix is missing the source parameter for database connect", $r->uri);
        return MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR : Apache::Constants::HTTP_INTERNAL_SERVER_ERROR;
    }

    my $dbh = DBI->connect($attr->{data_source}, $user, $sent_pwd, { AutoCommit=>0, RaiseError=>0 });
    unless( defined $dbh ) {
        $r->log_reason("user $user: $DBI::errstr", $r->uri);
        $r->note_basic_auth_failure;
        return MP2 ? Apache2::Const::HTTP_UNAUTHORIZED : Apache::Constants::HTTP_UNAUTHORIZED;
    }

    # to be removed in next version
    if ( $attr->{authz_command} ) {
        unless( defined ($dbh->do($attr->{authz_command})) ) {
            $r->log_reason("user $user: $DBI::errstr", $r->uri);
            $r->note_basic_auth_failure;
            return MP2 ? Apache2::Const::HTTP_UNAUTHORIZED : Apache::Constants::HTTP_UNAUTHORIZED;
        }
    }
           
    $dbh->disconnect;
    $r->headers_in->{'Modperl_DBILogin_Password'} = $sent_pwd;
    $r->headers_in->{'Modperl_Password'} = $sent_pwd;
    $r->headers_in->{'Modperl_DBILogin_data_source'} = $attr->{data_source};
    return MP2 ? Apache2::Const::OK : Apache::Constants::OK;
}

sub authz {
    my $r = shift @_;

    my ($res, $sent_pwd) = $r->get_basic_auth_pw;
    return $res if ( $res ); #decline if not Basic

    return (MP2 ? Apache2::Const::OK : Apache::Constants::OK)
        unless $r->is_initial_req;

    my $user = MP2 ? $r->user : $r->connection->user;

    my($key,$val);
    my $attr = {};
    while(($key,$val) = each %Config) {
        $val = $r->dir_config($key) || $val;
        $key =~ s/^Auth_DBI_//;
        $attr->{$key} = $val;
    }
    
    return test_authz($r, $attr, $sent_pwd);
}

sub test_authz {
    my($r, $attr, $sent_pwd) = @_;

    my $user = MP2 ? $r->user : $r->connection->user;

    unless ( $attr->{data_source} ) {
        $r->log_reason("$prefix is missing the source parameter for database connect", $r->uri);
        return MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR : Apache::Constants::HTTP_INTERNAL_SERVER_ERROR;
    }

    my $dbh = DBI->connect($attr->{data_source}, $user, $sent_pwd, {AutoCommit=>0, RaiseError=>0});
    unless( defined $dbh ) {
        $r->log_reason("user $user: $DBI::errstr", $r->uri);
        return MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR : Apache::Constants::HTTP_INTERNAL_SERVER_ERROR;
    }

    my $authz_result = MP2 ? Apache2::Const::HTTP_FORBIDDEN : Apache::Constants::HTTP_FORBIDDEN;
    my $sth;
    foreach my $requirement ( @{$r->requires} ) {
        my $require = $requirement->{requirement};
        if ( $require eq "valid-user" ) {
            $authz_result = MP2 ? Apache2::Const::OK : Apache::Constants::OK;
        } elsif ( $require =~ s/^user\s+// ) { 
                foreach my $valid_user (split /\s+/, $require) {
                    if ( $user eq $valid_user ) {
                        $authz_result = MP2 ? Apache2::Const::OK : Apache::Constants::OK;
                        last;
                    }
                }
                if ( $authz_result != (MP2 ? Apache2::Const::OK : Apache::Constants::OK) ) {
                    my $explaination = <<END;
<HTML>
<HEAD><TITLE>Unauthorized</TITLE></HEAD>
<BODY>
<H1>Unauthorized</H1>
User must be one of these required users: $require
</BODY>
</HTML>
END
                    $r->custom_response(MP2 ? Apache2::Const::HTTP_FORBIDDEN : Apache::Constants::HTTP_FORBIDDEN, $explaination);
                    $r->log_reason("user $user: not authorized", $r->uri);
                }
            } elsif ( $require =~ s/^group\s+// ) {
                    foreach my $group (split /\s+/, $require) {
                        $authz_result = is_member($r, $dbh, $group);
                        last if ( $authz_result == (MP2 ? Apache2::Const::OK : Apache::Constants::OK) );
                        if ( $authz_result == (MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR : Apache::Constants::HTTP_INTERNAL_SERVER_ERROR) ) {
                            $r->log_reason("user $user: $@", $r->uri);
                            return MP2 ? Apache2::Const::HTTP_INTERNAL_SERVER_ERROR : Apache::Constants::HTTP_INTERNAL_SERVER_ERROR;
                        }
                    }
                    if ( $authz_result == (MP2 ? Apache2::Const::HTTP_FORBIDDEN : Apache::Constants::HTTP_FORBIDDEN) ) {
                        my $explaination = <<END;
<HTML>
<HEAD><TITLE>Unauthorized</TITLE></HEAD>
<BODY>
<H1>Unauthorized</H1>
User must be member of one of these required groups: $require
</BODY>
</HTML>
END
                        $r->custom_response(MP2 ? Apache2::Const::HTTP_FORBIDDEN : Apache::Constants::HTTP_FORBIDDEN, $explaination);
                        $r->log_reason("user $user: not authorized", $r->uri);
                    }
                }
    }

    $dbh->disconnect;
    return $authz_result;
}

1;
 
__END__