view release on metacpan or  search on metacpan

AuthzLDAP.pm  view on Meta::CPAN

  foreach $group (@grouplist) {
    # Look up the group
    my $filter = qq(($groupattrtype=$group));
    $r->log->debug("check_group: Iterating over group $group");
    $r->log->debug("check_group: Using filter: $filter");
    $r->log->debug("check_group: Using base: $basedn");
    # Want to just validate group's existence, not get its contents
    my $msg = $ld->search(base => $basedn, filter => $filter,
			  attrs => [ $nestedattrtype ]);
    unless ($msg->code == LDAP_SUCCESS) {
      $r->note_basic_auth_failure;
      $r->log_reason("user $userinfo: Could not search for $group: " .
		     $msg->code . " " . $msg->error, $r->uri);
      next unless $requirement == 3;
      return AUTH_REQUIRED;
    }

    # Did we get any entries?
    unless ($msg->count) {
      $r->log->debug("check_group: user $userinfo: could not find $group");
      return AUTH_REQUIRED if $requirement == 3;
      next;
    }

    # Check the group
    my $entry = $msg->first_entry; # Only want one
    my $dn = $entry->dn;
    $r->log->debug("check_group: Checking group $dn for $userinfo");
    $msg = $ld->compare($dn, attr => $memberattrtype, value => $userinfo);

    if ($msg->code == LDAP_COMPARE_TRUE) {
      return (OK, $group) unless $recursion_depth == 1;
      if ($requirement == 1) {
	$r->log->debug("LDAP compare inAGroup user found; returning");
	return (OK, "\"$group\"");
      } elsif ($foundgroups eq '') {
	$r->log->debug("LDAP compare inManyGroups or inAllGroups user found; appending");
	$foundgroups = "\"$group\"";
      } else {
	$r->log->debug("LDAP compare inManyGroups or inAllGroups user found; appending");
	$foundgroups .= " \"$group\"";
      }
      next;
    }

    # Return undef if nested groups is not set
    $r->log->debug("check_group: Could not find $userinfo in $group");
    next unless $nested_groups =~ /on/i;

    # If we did not find the person in the group let's check the
    # group's members
    foreach $member ($entry->get($nestedattrtype)) {
      $r->log->debug("check_group: Checking $member");
      # We just want the group's name
      if ($member =~ /^[^=]+="([^"]+)",/) {
	$member = $1;
	$r->log->debug("check_group: Setting quoted $member");
      } elsif ($member =~ /^[^=]+=([^,]+),/) {
	$member = $1;
	$r->log->debug("check_group: Examining escaped $member");
	$member =~ s/\\(.)/$1/g;
	$r->log->debug("check_group: Setting escaped $member");
      }

      $r->log->debug("check_group: Member now $member");
      my ($result, $child_group) = check_group($r, $ld, $basedn, $groupattrtype,
					       $memberattrtype, $userinfo,
					       "\"$member\"", $nestedattrtype,
					       $nested_groups, $requirement,
					       $recursion_depth + 1);
      if ($recursion_depth != 1 && $result == OK) {
	$r->log->debug("Recursion of $recursion_depth; returning OK");
	return (OK, $group);
      } elsif ($result == OK) {
	if ($requirement == 1) {
	  $r->log->debug("Requirement inAGroup; returning");
	  return (OK, "\"$group\"");
	} elsif ($foundgroups eq '') {
	  $r->log->debug("Requirement inManyGroups or inAllGroups; appending");
	  $foundgroups = "\"$group\"";
	} else {
	  $r->log->debug("Requirement inManyGroups or inAllGroups; appending");
	  $foundgroups .= " \"$group\"";
	}
	next;
      }
    }
    $r->log->debug("Requirement inAllGroups failed; returning"),
      return AUTH_REQUIRED if $requirement == 3 &&
	!($entry->exists($nestedattrtype));
  }

  # This case happens when inManyGroups is required
  $r->log->debug("inManyGroups success"),
    return(OK, $foundgroups) if $foundgroups ne '';

  # We've fallen through without finding the user in the group
  $r->log_reason("Could not find $userinfo in $groups", $r->uri);
  return AUTH_REQUIRED;
}


###############################################################################
###############################################################################
# handler: hook into Apache/mod_perl API
###############################################################################
###############################################################################
sub handler {
  my $r = shift;
  return OK unless $r->is_initial_req; # only the first internal request
  my $requires = $r->requires;
  return OK unless $requires;

  my $username = $r->connection->user;

  # The required patch was not introduced in 1.26. It is no longer
  # promised to be included in any timeframe. Commenting out.
  # if ($mod_perl::VERSION < 1.26) {
    # I shouldn't need to use the below lines as this module
    # should never be called if there was a cache hit.  Since
    # set_handlers() doesn't work properly until 1.26 (according
    # to Doug MacEachern) I have to work around it by cobbling