view release on metacpan or  search on metacpan

lib/Apache/AuthDBI.pm  view on Meta::CPAN

BEGIN {
  my @constants = qw( OK AUTH_REQUIRED FORBIDDEN DECLINED SERVER_ERROR );
  if (MP2) {
	require Apache2::Access;
    require Apache2::Const;
    require Apache2::RequestRec;
    require Apache2::RequestUtil;
    require Apache2::Log;
    import Apache2::Const @constants;
  }
  else {
    require Apache::Constants;
    import Apache::Constants @constants;
  }
}

use strict;
use DBI ();
use Digest::SHA1 ();
use Digest::MD5 ();

sub debug {
    print STDERR "$_[1]\n" if $_[0] <= $Apache::AuthDBI::DEBUG;
}

sub push_handlers {
  if (MP2) {
		require Apache2::ServerUtil;
		my $s = Apache2::ServerUtil->server;
		$s->push_handlers(@_);
  }
  else {
    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',
              #Using Two (or more) Methods Will Allow for Fallback to older Methods
              'Auth_DBI_encryption_method'=> 'sha1hex/md5/crypt',
              'Auth_DBI_uidcasesensitive' => 'on',
              'Auth_DBI_pwdcasesensitive' => 'on',
              'Auth_DBI_placeholder'      => 'off',
              'Auth_DBI_expeditive'       => 'on',
             );

# 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;

# minimum lifetimes of cache entries in seconds.
# setting the CacheTime to 0 will not use the cache at all.
my $CacheTime = 0;

# supposed to be called in a startup script.
# sets CacheTime to a user defined value.
sub setCacheTime {
    my $class      = shift;
    my $cache_time = shift;

    # sanity check
    $CacheTime = $cache_time if $cache_time =~ /\d+/;
}

# minimum time interval in seconds between two runs of the PerlCleanupHandler.
# setting CleanupTime to 0 will run the PerlCleanupHandler after every request.
# setting CleanupTime to a negative value will disable the PerlCleanupHandler.
my $CleanupTime = -1;

# supposed to be called in a startup script.
# sets CleanupTime to a user defined value.
sub setCleanupTime {
    my $class        = shift;
    my $cleanup_time = shift;

    # sanity check
    $CleanupTime = $cleanup_time if $cleanup_time =~ /\-*\d+/;
}

# optionally the string with the global cache can be stored in a shared memory
# segment. the segment will be created from the first child and it will be
# destroyed if the last child exits. the reason for not handling everything
# in the main server is simply, that there is no way to setup
# an ExitHandler which runs in the main server and which would remove the
# shared memory and the semaphore.hence we have to keep track about the
# number of children, so that the last one can do all the cleanup.
# creating the shared memory in the first child also has the advantage,
# that we don't have to cope  with changing the ownership. if a shm-function
# fails, the global cache will automatically fall back to one string
# per process.

lib/Apache/AuthDBI.pm  view on Meta::CPAN

    return (@passwds_to_check);
}

# authorization handler, it is called immediately after the authentication
sub authz {
    my $r = shift;

    my ($key, $val, $dbh);
    my $prefix = "$$ Apache::AuthDBI::authz ";

    if ($Apache::AuthDBI::DEBUG > 1) {
        my $type = '';
        if (MP2) {
          $type .= 'initial ' if $r->is_initial_req();
          $type .= 'main'     if $r->main();
        }
        else {
          $type .= 'initial ' if $r->is_initial_req;
          $type .= 'main'     if $r->is_main;
        }
        debug(1, "==========\n$prefix request type = >$type<");
    }

    # only the first internal request
    unless ($r->is_initial_req) {
      return MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
    }

    my $user_result  = MP2 ? Apache2::Const::DECLINED() :
        Apache::Constants::DECLINED();
    my $group_result = MP2 ? Apache2::Const::DECLINED() :
        Apache::Constants::DECLINED();

    # get username
    my $user_sent = $r->user;
    debug(2, "$prefix user sent = >$user_sent<");

    # 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};
    # use ENV{DBI_DSN} if not defined
    $data_sources[0] = '' unless $data_sources[0];

    # if not configured decline
    unless ($Attr->{pwd_table} && $Attr->{uid_field} && $Attr->{grp_field}) {
        debug(2, "$prefix not configured, return DECLINED");
        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";

    # select code to return if authorization is denied:
    my $authz_denied;
    if (MP2) {
      $authz_denied = $Attr->{expeditive} eq 'on' ?
          Apache2::Const::FORBIDDEN() : Apache2::Const::AUTH_REQUIRED();
    }
    else {
      $authz_denied = $Attr->{expeditive} eq 'on' ?
          Apache::Constants::FORBIDDEN() : Apache::Constants::AUTH_REQUIRED();
    }

    # check if requirements exists
    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);
            if ($authz_denied == (MP2 ? Apache2::Const::AUTH_REQUIRED() :
                Apache::Constants::AUTH_REQUIRED())) {
                $r->note_basic_auth_failure;
            }
            return $authz_denied;
        }
        debug (2, "$prefix no requirements and not authoritative, return DECLINED");
        return MP2 ? Apache2::Const::DECLINED() :
            Apache::Constants::DECLINED();
    }

    # iterate over all requirement directives and store them according to
    # their type (valid-user, user, group)
    my($valid_user, $user_requirements, $group_requirements);
    foreach my $hash_ref (@$ary_ref) {
        while (($key,$val) = each %$hash_ref) {
            last if $key eq 'requirement';
        }
        $val =~ s/^\s*require\s+//;

        # handle different requirement-types
        if ($val =~ /valid-user/) {
            $valid_user = 1;
        }
        elsif ($val =~ s/^user\s+//g) {
            $user_requirements .= " $val";
        }
        elsif ($val =~ s/^group\s+//g) {
            $group_requirements .= " $val";
        }
    }
    $user_requirements  =~ s/^ //g if $user_requirements;
    $group_requirements =~ s/^ //g if $group_requirements;

    {
        no warnings qw(uninitialized);

                                      debug(
                                            2,
                                            "$prefix requirements: [valid-user=>$valid_user<] [user=>" .
                                            "$user_requirements<] [group=>$group_requirements<]"
                                           );
    }

    # check for valid-user
    if ($valid_user) {
        $user_result = MP2 ? Apache2::Const::OK() : Apache::Constants::OK();
        debug(2, "$prefix user_result = OK: valid-user");
    }

    # check for users
    if (($user_result != (MP2 ? Apache2::Const::OK() :