File: //usr/share/perl5/vendor_perl/Amavis/Lookup/LDAPattr.pm
# SPDX-License-Identifier: GPL-2.0-or-later
package Amavis::Lookup::LDAPattr;
use strict;
use re 'taint';
BEGIN {
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION);
$VERSION = '2.412';
@ISA = qw(Exporter);
}
use Amavis::Conf qw($trim_trailing_space_in_lookup_result_fields);
use Amavis::Util qw(ll do_log);
sub new($$$;$) {
my($class, $ldap_query, $attrname, $attrtype) = @_;
my $self =
bless { attrname => $attrname, attrtype => $attrtype }, $class;
$self->{ldap_query} = $ldap_query if defined $ldap_query;
$self;
}
# attrtype: B=boolean, N=numeric, S=string, L=list
# N-: numeric, nonexistent field returns undef without complaint
# S-: string, nonexistent field returns undef without complaint
# L-: list, nonexistent field returns undef without complaint
# B-: boolean, nonexistent field returns undef without complaint
# B0: boolean, nonexistent field treated as false
# B1: boolean, nonexistent field treated as true
sub lookup_ldap_attr($$$%) {
my($self, $addr, $get_all, %options) = @_;
my(@result, @matchingkey, $ldap_query, $attr);
if ($self) { $ldap_query = $self->{ldap_query}; $attr = $self->{attrname} }
$ldap_query = $Amavis::ldap_lookups if !defined $ldap_query; # global dflt
if (!defined $self) {
do_log(5, 'lookup_ldap_attr - no attr query object, "%s" no match',$addr);
} elsif (!defined $attr || $attr eq '') {
do_log(5, 'lookup_ldap_attr() - no attribute name, "%s" no match', $addr);
} elsif (!defined $ldap_query) {
do_log(5, 'lookup_ldap_attr(%s) - no ldap_lookups object, "%s" no match',
$attr, $addr);
} else {
# result attribute names are case-sensitive
# LDAP attribute names are case-INsensitive
my(@result_attr_names) = !ref $attr ? ( $attr )
: ref $attr eq 'ARRAY' ? @$attr
: ref $attr eq 'HASH' ? keys %$attr : ();
my(%attr_name_to_ldapattr_name) =
ref $attr eq 'HASH' ? %$attr
: map( ($_,$_), @result_attr_names);
my $attrtype = $self->{attrtype};
$attrtype = 'S-' if !defined $attrtype;
my($res_ref,$mk_ref) = $ldap_query->lookup_ldap($addr,1, %options,
!exists($self->{args}) ? () : (ExtraArguments => $self->{args}));
if (!defined $res_ref || !@$res_ref) {
ll(5) && do_log(5, 'lookup_ldap_attr(%s), "%s" no matching entries',
join(',', map(lc($_) eq lc($attr_name_to_ldapattr_name{$_}) ? $_
: $_ . '/' . lc($attr_name_to_ldapattr_name{$_}),
@result_attr_names)), $addr);
} else {
my %nosuchattr;
for my $ind (0 .. $#$res_ref) {
my($any_attr_matches, @match_values_by_ind);
my $h_ref = $res_ref->[$ind]; my $mk = $mk_ref->[$ind];
for my $result_attr_ind (0 .. $#result_attr_names) {
my $result_attr_name = $result_attr_names[$result_attr_ind];
next if !defined $result_attr_name;
my $attrname = $attr_name_to_ldapattr_name{$result_attr_name};
next if !defined $attrname || $attrname eq '';
my $match;
if (!exists($h_ref->{lc $attrname})) {
$nosuchattr{$attrname} = 1;
# LDAP entry found, but no attribute with that name in it
if ($attrtype =~ /^.-/s) { # allowed to not exist
# this type is almost universally in use now, continue searching
} elsif ($attrtype =~ /^B1/) { # defaults to true
# only used for the 'local' attr
$match = 1; # nonexistent attribute treated as 1
} elsif ($attrtype =~ /^B0/) { # boolean, defaults to false
# no longer in use
$match = 0; # nonexistent attribute treated as 0
} else {
# treated as 'no match', returns undef
}
} else { # attribute exists
# attrtype: B=boolean, N=numeric, S=string
$match = $h_ref->{lc $attrname};
if (!defined $match) {
# NULL attribute values represented as undef
} elsif ($attrtype =~ /^B/) { # boolean
$match = $match eq 'TRUE' ? 1 : 0; # convert TRUE|FALSE to 1|0
} elsif ($attrtype =~ /^N/) { # numeric
$match = $match + 0; # unify different numeric forms
} elsif ($attrtype =~ /^S/) { # string
$match =~ s/ +\z// # trim trailing spaces
if $trim_trailing_space_in_lookup_result_fields;
} elsif ($self->{attrtype} =~ /^L/) { # list
#$match = join(', ',@$match);
}
}
$match_values_by_ind[$result_attr_ind] = $match;
$any_attr_matches = 1 if defined $match;
}
ll(5) && do_log(5, 'lookup_ldap_attr(%s) rec=%d, "%s" result: %s',
join(',', map(lc($_) eq lc($attr_name_to_ldapattr_name{$_}) ? $_
: $_ . '/' . lc($attr_name_to_ldapattr_name{$_}),
@result_attr_names)),
$ind, $addr,
join(', ', map(defined $_ ? '"'.$_.'"' : 'undef',
@match_values_by_ind)) );
if ($any_attr_matches) {
push(@matchingkey, $mk);
push(@result, !ref $attr ? $match_values_by_ind[0] :
{ map( ($result_attr_names[$_], $match_values_by_ind[$_]),
grep(defined $match_values_by_ind[$_],
(0 .. $#result_attr_names) )) } );
last if !$get_all;
}
}
do_log(5, 'lookup_ldap_attr, no such attrs: %s',
join(', ', keys %nosuchattr)) if ll(5) && %nosuchattr;
}
}
if (!$get_all) { !wantarray ? $result[0] : ($result[0], $matchingkey[0]) }
else { !wantarray ? \@result : (\@result, \@matchingkey) }
}
1;