[pmg-api.git] / PMG / LDAPCache.pm

package PMG::LDAPCache;

use strict;
use warnings;
use File::Path;
use LockFile::Simple;
use Data::Dumper;
use Net::LDAP;
use Net::LDAP::Control::Paged;
use Net::LDAP::Constant qw (LDAP_CONTROL_PAGED);
use DB_File;

use PVE::SafeSyslog;
use PVE::Tools qw(split_list);

use PMG::Utils;
use PMG::LDAPConfig;

$DB_HASH->{'cachesize'} = 10000;
$DB_RECNO->{'cachesize'} = 10000;
$DB_BTREE->{'cachesize'} = 10000;
$DB_BTREE->{'flags'} = R_DUP ;

my $cachedir = '/var/lib/pmg';

my $last_atime = {};
my $ldapcache = {};

# DB Description
#
# users      (hash): UID -> pmail, account, DN
# dnames     (hash): DN -> UID
# accounts   (hash): account -> UID
# mail       (hash): mail -> UID
# groups     (hash): group -> GID
# memberof  (btree): UID -> GID
#
my @dbs = ('users', 'dnames', 'groups', 'mails', 'accounts', 'memberof');

sub new {
    my ($self, %args) = @_;

    my $type   = ref($self) || $self;

    die "undefined ldap id" if !$args{id};

    my $id = $args{id};

    if ($ldapcache->{$id}) {
	$self = $ldapcache->{$id};
    } else {
	$ldapcache->{$id} = $self = bless {}, $type;
	$self->{id} = $id;
    }

    my $config_properties = PMG::LDAPConfig::properties();

    # set defaults for the fields that have one
    foreach my $property (keys %$config_properties) {
	my $d = $config_properties->{$property};
	next if !defined($d->{default});
	$self->{$property} = $args{$property} || $d->{default};
    }

    # split list returns an array not a reference
    $self->{accountattr} = [split_list($self->{accountattr})];
    $self->{mailattr} = [split_list($self->{mailattr})];
    $self->{groupclass} = [split_list($self->{groupclass})];

    $self->{server1} = $args{server1};
    $self->{server2} = $args{server2};
    $self->{binddn} = $args{binddn};
    $self->{bindpw} = $args{bindpw};
    $self->{basedn} = $args{basedn};
    $self->{port} = $args{port};
    $self->{groupbasedn} = $args{groupbasedn};
    $self->{filter} = $args{filter};

    if ($args{syncmode} == 1) {
	# read local data only
	$self->{errors} = '';
	$self->loadcache();
	return $self;
    }

    return $self if !($args{server1});

    if ($args{syncmode} == 2) {
	# force sync
	$self->loaddata(1);
    } else {
	$self->loaddata();
    }

    return $self;
}

sub lockdir {
    my ($id) = @_;

    my $dir = "$cachedir/ldapdb_$id";
    my $scheme = LockFile::Simple->make(
	-warn => 0, -stale => 1, -autoclean => 1);
    my $lock = $scheme->lock($dir);

    return $lock;
}

sub delete {
    my ($class, $id) = @_;

    if (my $lock = lockdir($id)) {
	delete $ldapcache->{$id};
	delete $last_atime->{$id};
	my $dir = "$cachedir/ldapdb_$id";
	rmtree $dir;
	$lock->release;
    } else {
	syslog('err' , "can't lock ldap database '$id'");
    }
}

sub update {
    my ($self, $syncmode) = @_;

    if ($syncmode == 1) {
	# read local data only
	$self->{errors} = '';
	$self->loadcache();
    } elsif ($syncmode == 2) {
	# force sync
	$self->loaddata(1);
    } else {
	$self->loaddata();
    }
}

sub queryusers {
    my ($self, $ldap) = @_;

    my $filter = '(|';
    foreach my $attr (@{$self->{mailattr}}) {
	$filter .= "($attr=*)";
    }
    $filter .= ')';

    if ($self->{filter}) {
	my $tmp = $self->{filter};
	$tmp = "($tmp)" if $tmp !~ m/^\(.*\)$/;

	$filter = "(&${filter}${tmp})";
    }

    my $page = Net::LDAP::Control::Paged->new(size => 900);

    my @args = (
	base     => $self->{basedn},
	scope    => "subtree",
	filter   => $filter,
	control  => [ $page ],
	attrs  => [ @{$self->{mailattr}}, @{$self->{accountattr}}, 'memberOf' ]
	);

    my $cookie;

    while(1) {

	my $mesg = $ldap->search(@args);

	# stop on error
	if ($mesg->code)  {
	    my $err = "ldap user search error: " . $mesg->error;
	    $self->{errors} .= "$err\n";
	    syslog('err', $err);
	    last;
	}

	#foreach my $entry ($mesg->entries) { $entry->dump; }
	foreach my $entry ($mesg->entries) {
	    my $dn = $entry->dn;

	    my $umails = {};
	    my $pmail;

	    foreach my $attr (@{$self->{mailattr}}) {
		foreach my $mail ($entry->get_value($attr)) {
		    $mail = lc($mail);
		    # Test if the Line starts with one of the following lines:
		    # proxyAddresses: [smtp|SMTP]:
		    # and also discard this starting string, so that $mail is only the
		    # address without any other characters...

		    $mail =~ s/^(smtp|SMTP)[\:\$]//gs;

		    if ($mail !~ m/[\{\}\\\/]/ && $mail =~ m/^\S+\@\S+$/) {
			$umails->{$mail} = 1;
			$pmail = $mail if !$pmail;
		    }
		}
	    }
	    my $addresses = [ keys %$umails ];

	    next if !$pmail; # account has no email addresses

	    my $cuid;
	    $self->{dbstat}->{dnames}->{dbh}->get($dn, $cuid);
	    if (!$cuid) {
		$cuid = ++$self->{dbstat}->{dnames}->{idcount};
		$self->{dbstat}->{dnames}->{dbh}->put($dn, $cuid);
	    }

	    foreach my $attr (@{$self->{accountattr}}) {
		my $account = $entry->get_value($attr);
		if ($account && ($account =~ m/^\S+$/s)) {
		    $account = lc($account);
		    $self->{dbstat}->{accounts}->{dbh}->put($account, $cuid);
		    my $data = pack('n/a* n/a* n/a*', $pmail, $account, $dn);
		    $self->{dbstat}->{users}->{dbh}->put($cuid, $data);
		}
	    }

	    foreach my $mail (@$addresses) {
		$self->{dbstat}->{mails}->{dbh}->put($mail, $cuid);
	    }

	    if (!$self->{groupbasedn}) {
		my @groups = $entry->get_value('memberOf');
		foreach my $group (@groups) {
		    my $cgid;
		    $self->{dbstat}->{groups}->{dbh}->get($group, $cgid);
		    if (!$cgid) {
			$cgid = ++$self->{dbstat}->{groups}->{idcount};
			$self->{dbstat}->{groups}->{dbh}->put($group, $cgid);
		    }
		    $self->{dbstat}->{memberof}->{dbh}->put($cuid, $cgid);
		}
	    }
	}

	# Get cookie from paged control
	my ($resp) = $mesg->control(LDAP_CONTROL_PAGED) or last;
	$cookie = $resp->cookie;

	last if (!defined($cookie) || !length($cookie));

	# Set cookie in paged control
	$page->cookie($cookie);
    }


    if (defined($cookie) && length($cookie)) {
	# We had an abnormal exit, so let the server know we do not want any more
	$page->cookie($cookie);
	$page->size(0);
	$ldap->search(@args);
	my $err = "LDAP user query unsuccessful";
	$self->{errors} .= "$err\n";
	syslog('err', $err);
    }
}

sub querygroups {
    my ($self, $ldap) = @_;

    return undef if !$self->{groupbasedn};

    my $filter = "(|";

    for my $class (@{$self->{groupclass}}) {
	$filter .= "(objectclass=$class)";
    }

    $filter .= ")";

    my $page = Net::LDAP::Control::Paged->new(size => 100);

    my @args = ( base     => $self->{groupbasedn},
		 scope    => "subtree",
		 filter   => $filter,
		 control  => [ $page ],
		 attrs  => [ 'member', 'uniqueMember' ],
		 );

    my $cookie;
    while(1) {

	my $mesg = $ldap->search(@args);

	# stop on error
	if ($mesg->code)  {
	    my $err = "ldap group search error: " . $mesg->error;
	    $self->{errors} .= "$err\n";
	    syslog('err', $err);
	    last;
	}

	foreach my $entry ( $mesg->entries ) {
	    my $group = $entry->dn;
	    my @members = $entry->get_value('member');
	    if (!scalar(@members)) {
		@members = $entry->get_value('uniqueMember');
	    }
	    my $cgid;
	    $self->{dbstat}->{groups}->{dbh}->get($group, $cgid);
	    if (!$cgid) {
		$cgid = ++$self->{dbstat}->{groups}->{idcount};
		$self->{dbstat}->{groups}->{dbh}->put($group, $cgid);
	    }

	    foreach my $m (@members) {

		my $cuid;
		$self->{dbstat}->{dnames}->{dbh}->get($m, $cuid);
		if (!$cuid) {
		    $cuid = ++$self->{dbstat}->{dnames}->{idcount};
		    $self->{dbstat}->{dnames}->{dbh}->put($m, $cuid);
		}

		$self->{dbstat}->{memberof}->{dbh}->put($cuid, $cgid);
	    }
	}

	# Get cookie from paged control
	my ($resp) = $mesg->control(LDAP_CONTROL_PAGED) or last;
	$cookie = $resp->cookie or last;

	# Set cookie in paged control
	$page->cookie($cookie);
    }

    if ($cookie) {
	# We had an abnormal exit, so let the server know we do not want any more
	$page->cookie($cookie);
	$page->size(0);
	$ldap->search(@args);
	my $err = "LDAP group query unsuccessful";
	$self->{errors} .= "$err\n";
	syslog('err', $err);
    }
}

sub ldap_connect {
    my ($self) = @_;

    my $hosts = [ $self->{server1} ];

    push @$hosts, $self->{server2} if $self->{server2};

    my $opts = { timeout => 10, onerror => 'die' };

    $opts->{port} = $self->{port} if $self->{port};
    $opts->{schema} = $self->{mode};

    return Net::LDAP->new($hosts, %$opts);
}

sub ldap_connect_and_bind {
     my ($self) = @_;

     my $ldap = $self->ldap_connect() ||
	 die "Can't bind to ldap server '$self->{id}': $! $@\n";

     my $mesg;

     if ($self->{binddn}) {
	 $mesg = $ldap->bind($self->{binddn}, password => $self->{bindpw});
     } else {
	 $mesg = $ldap->bind(); # anonymous bind
     }

     die "ldap bind failed: " . $mesg->error . "\n" if $mesg->code;

     if (!$self->{basedn}) {
	 my $root = $ldap->root_dse(attrs => [ 'defaultNamingContext' ]);
	 $self->{basedn} = $root->get_value('defaultNamingContext');
     }

     return $ldap;
}

sub sync_database {
    my ($self) = @_;

    my $dir = "ldapdb_" .  $self->{id};
    mkdir "$cachedir/$dir";

    # open ldap connection

    my $ldap;

    eval { $ldap = $self->ldap_connect_and_bind(); };
    if (my $err = $@) {
	$self->{errors} .= "$err\n";
	syslog('err', $err);
	return;
    }

    # open temporary database files

    my $olddbh = {};

    foreach my $db (@dbs) {
	$self->{dbstat}->{$db}->{tmpfilename} = "$cachedir/$dir/${db}_tmp$$.db";
	$olddbh->{$db} = $self->{dbstat}->{$db}->{dbh};
    }

    my $error_cleanup = sub {
	# close and delete all files
	foreach my $db (@dbs) {
	    undef $self->{dbstat}->{$db}->{dbh};
	    unlink $self->{dbstat}->{$db}->{tmpfilename};
	    $self->{dbstat}->{$db}->{dbh} = $olddbh->{$db};
	}
    };

    eval {
	foreach my $db (@dbs) {
	    my $filename = $self->{dbstat}->{$db}->{tmpfilename};
	    $self->{dbstat}->{$db}->{idcount} = 0;
	    unlink $filename;

	    if ($db eq 'memberof') {
		$self->{dbstat}->{$db}->{dbh} =
		    tie (my %h,  'DB_File', $filename,
			 O_CREAT|O_RDWR, 0666, $DB_BTREE);
	    } else {
		$self->{dbstat}->{$db}->{dbh} =
		    tie (my %h,  'DB_File', $filename,
			 O_CREAT|O_RDWR, 0666, $DB_HASH);
	    }

	    die "unable to open database file '$filename': $!\n"
		if !$self->{dbstat}->{$db}->{dbh};
	}
    };
    if (my $err = $@) {
	$error_cleanup->();
	$self->{errors} .= $err;
	syslog('err', $err);
	return;
    }

    $self->querygroups ($ldap) if $self->{groupbasedn};

    $self->queryusers($ldap) if !$self->{errors};

    $ldap->unbind;

    if ($self->{errors}) {
	$error_cleanup->();
	return;
    }

    my $lock = lockdir($self->{id});

    if (!$lock) {
	my $err = "unable to get database lock for ldap database '$self->{id}'";
	$self->{errors} .= "$err\n";
	syslog('err', $err);
	$error_cleanup->();
	return;
    }

    foreach my $db (@dbs) {
	my $filename = $self->{dbstat}->{$db}->{filename} =
	    "$cachedir/$dir/${db}.db";
	$self->{dbstat}->{$db}->{dbh}->sync(); # flush everything
	rename $self->{dbstat}->{$db}->{tmpfilename}, $filename;
    }

    $lock->release;

    $last_atime->{$self->{id}} = time();

    $self->{gcount} = $self->{dbstat}->{groups}->{idcount};
    $self->{ucount} = __count_entries($self->{dbstat}->{accounts}->{dbh});
    $self->{mcount} = __count_entries($self->{dbstat}->{mails}->{dbh});
}

sub __count_entries {
    my ($dbh) = @_;

    return 0 if !$dbh;

    my $key = 0 ;
    my $value = "" ;
    my $count = 0;
    my $status = $dbh->seq($key, $value, R_FIRST());

    while ($status == 0) {
	$count++;
        $status = $dbh->seq($key, $value, R_NEXT());
    }

    return $count;
}

sub loadcache {
    my ($self, $try) = @_;

    my $dir = "ldapdb_" .  $self->{id};
    mkdir "$cachedir/$dir";

    my $filename = "$cachedir/$dir/mails.db";

    return if $last_atime->{$self->{id}} &&
	PMG::Utils::file_older_than ($filename, $last_atime->{$self->{id}});

    eval {
	foreach my $db (@dbs) {
	    my $filename = $self->{dbstat}->{$db}->{filename} =
		"$cachedir/$dir/${db}.db";
	    $self->{dbstat}->{$db}->{idcount} = 0;
	    if ($db eq 'memberof') {
		$self->{dbstat}->{$db}->{dbh} =
		    tie (my %h,  'DB_File', $filename,
			 O_RDONLY, 0666, $DB_BTREE);
	    } else {
		$self->{dbstat}->{$db}->{dbh} =
		    tie (my %h,  'DB_File', $filename,
			 O_RDONLY, 0666, $DB_HASH);
	    }

	    if (!$self->{dbstat}->{$db}->{dbh} && !$try) {
		my $err = "ldap error - unable to open database file '$filename': $!";
		$self->{errors} .= "$err\n";
		syslog('err', $err) if !$self->{dbstat}->{$db}->{dbh};
	    }
	}
    };

    $last_atime->{$self->{id}} = time();

    $self->{gcount} = __count_entries($self->{dbstat}->{groups}->{dbh});
    $self->{ucount} = __count_entries($self->{dbstat}->{accounts}->{dbh});
    $self->{mcount} = __count_entries($self->{dbstat}->{mails}->{dbh});
}

sub loaddata {
    my ($self, $force) = @_;

    $self->{errors} = '';

    if (!$force) {
	# only sync if file is older than 1 hour

	my $dir = "ldapdb_" .  $self->{id};
	mkdir "$cachedir/$dir";
	my $filename = "$cachedir/$dir/mails.db";

	if (-e $filename &&
	    !PMG::Utils::file_older_than($filename, time() - 3600)) {
	    $self->loadcache();
	    return;
	}
    }

    $self->sync_database();

    if ($self->{errors}) {
	$self->loadcache(1);
    }
}

sub get_groups {
    my ($self) = @_;

    my $res = {};

    my $dbh = $self->{dbstat}->{groups}->{dbh};

    return $res if !$dbh;

    my $key = 0 ;
    my $value = "" ;
    my $status = $dbh->seq($key, $value, R_FIRST());

    while ($status == 0) {
	$res->{$value} = $key;
        $status = $dbh->seq($key, $value, R_NEXT());
    }

    return $res;
}

sub get_users {
    my ($self) = @_;

    my $res = {};

    my $dbh = $self->{dbstat}->{users}->{dbh};

    return $res if !$dbh;

    my $key = 0 ;
    my $value = "" ;
    my $status = $dbh->seq($key, $value, R_FIRST());
    my $keys;

    while ($status == 0) {
	my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $value);
	$res->{$key} = {
	    pmail => $pmail,
	    account => $account,
	    dn => $dn,
	};
        $status = $dbh->seq($key, $value, R_NEXT());
    }

    return $res;
}

sub get_gid_uid_map {
    my ($self) = @_;

    my $dbh = $self->{dbstat}->{memberof}->{dbh};

    return [] if !$dbh;

    my $key = 0 ;
    my $value = "" ;

    my $map = {};

    if($dbh->seq($key, $value, R_FIRST()) == 0) {
	do {
	    push @{$map->{$value}}, $key;
	} while($dbh->seq($key, $value, R_NEXT()) == 0);
    }

    return $map;
}

sub list_groups {
    my ($self) = @_;

    my $res = [];

    my $groups = $self->get_groups();

    for my $gid (sort keys %$groups) {
	push @$res, {
	    dn => $groups->{$gid},
	    gid => $gid,
	};
    }

    return $res;
}

sub list_users {
    my ($self, $gid) = @_;

    my $res = [];

    my $users = $self->get_users();

    if (!defined($gid)) {
	$res = [values %$users];
    } else {
	my $gid_uid_map = $self->get_gid_uid_map();
	my $groups = $self->get_groups();
	die "No such Group ID\n"
	    if !defined($groups->{$gid});
	my $memberuids = $gid_uid_map->{$gid};
	for my $uid (@$memberuids) {
	    next if !defined($users->{$uid});
	    push @$res, $users->{$uid};
	}
    }

    return $res;
}

sub list_addresses {
    my ($self, $mail) = @_;

    my $dbhmails = $self->{dbstat}->{mails}->{dbh};
    my $dbhusers = $self->{dbstat}->{users}->{dbh};

    return undef if !$dbhmails || !$dbhusers;

    $mail = lc($mail);

    my $res = [];

    my $cuid;
    $dbhmails->get($mail, $cuid);
    return undef if !$cuid;

    my $rdata;
    $dbhusers->get($cuid, $rdata);
    return undef if !$rdata;

    my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);

    push @$res, { primary => 1, email => $pmail };

    my $key = 0 ;
    my $value = "" ;
    my $status = $dbhmails->seq($key, $value, R_FIRST());

    while ($status == 0) {
	if ($value == $cuid && $key ne $pmail) {
	    push @$res, { primary => 0, email => $key };
	}
	$status = $dbhmails->seq($key, $value, R_NEXT());
    }

    return $res;
}

sub mail_exists {
    my ($self, $mail) = @_;

    my $dbh = $self->{dbstat}->{mails}->{dbh};
    return 0 if !$dbh;

    $mail = lc($mail);

    my $res;
    $dbh->get($mail, $res);
    return $res;
}

sub account_exists {
    my ($self, $account) = @_;

    my $dbh = $self->{dbstat}->{accounts}->{dbh};
    return 0 if !$dbh;

    $account = lc($account);

    my $res;
    $dbh->get($account, $res);
    return $res;
}

sub group_exists {
    my ($self, $group) = @_;

    my $dbh = $self->{dbstat}->{groups}->{dbh};
    return 0 if !$dbh;

    my $res;
    $dbh->get($group, $res);
    return $res;
}

sub account_has_address {
    my ($self, $account, $mail) = @_;

    my $dbhmails = $self->{dbstat}->{mails}->{dbh};
    my $dbhaccounts = $self->{dbstat}->{accounts}->{dbh};
    return 0 if !$dbhmails || !$dbhaccounts;

    $account = lc($account);
    $mail = lc($mail);

    my $accid;
    $dbhaccounts->get($account, $accid);
    return 0 if !$accid;

    my $mailid;
    $dbhmails->get($mail, $mailid);
    return 0 if !$mailid;

    return ($accid == $mailid);
}

sub user_in_group {
    my ($self, $mail, $group) = @_;

    my $dbhmails = $self->{dbstat}->{mails}->{dbh};
    my $dbhgroups = $self->{dbstat}->{groups}->{dbh};
    my $dbhmemberof = $self->{dbstat}->{memberof}->{dbh};

    return 0 if !$dbhmails || !$dbhgroups || !$dbhmemberof;

    $mail = lc($mail);

    my $cuid;
    $dbhmails->get($mail, $cuid);
    return 0 if !$cuid;

    my $groupid;
    $dbhgroups->get($group, $groupid);
    return 0 if !$groupid;

    my @gida  = $dbhmemberof->get_dup($cuid);

    return grep { $_ eq $groupid } @gida;
}

sub account_info {
    my ($self, $mail, $scan) = @_;

    my $dbhmails = $self->{dbstat}->{mails}->{dbh};
    my $dbhusers = $self->{dbstat}->{users}->{dbh};

    return undef if !$dbhmails || !$dbhusers;

    $mail = lc($mail);

    my $res = {};

    my $cuid;
    $dbhmails->get($mail, $cuid);
    return undef if !$cuid;

    my $rdata;
    $dbhusers->get($cuid, $rdata);
    return undef if !$rdata;

    my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);

    $res->{dn} = $dn;
    $res->{account} = $account;
    $res->{pmail} = $pmail;

    if ($scan) {
	my $key = 0 ;
	my $value = "" ;
	my $status = $dbhmails->seq($key, $value, R_FIRST());
	my $mails;

	while ($status == 0) {
	    push @$mails, $key if $value == $cuid;
	    $status = $dbhmails->seq($key, $value, R_NEXT());
	}
	$res->{mails} = $mails;
    }

    return $res;
}

1;
Commit	Line	Data
cad3d400 DM	1	package PMG::LDAPCache;
	2
	3	use strict;
	4	use warnings;
cad3d400 DM	5	use File::Path;
cad3d400 DM	6	use LockFile::Simple;
c2670481	7	use Data::Dumper;
cad3d400 DM	8	use Net::LDAP;
	9	use Net::LDAP::Control::Paged;
	10	use Net::LDAP::Constant qw (LDAP_CONTROL_PAGED);
	11	use DB_File;
	12
	13	use PVE::SafeSyslog;
23b1d0f8	14	use PVE::Tools qw(split_list);
cad3d400 DM	15
cad3d400 DM	16	use PMG::Utils;
23b1d0f8	17	use PMG::LDAPConfig;
cad3d400 DM	18
	19	$DB_HASH->{'cachesize'} = 10000;
	20	$DB_RECNO->{'cachesize'} = 10000;
	21	$DB_BTREE->{'cachesize'} = 10000;
	22	$DB_BTREE->{'flags'} = R_DUP ;
	23
3278b571	24	my $cachedir = '/var/lib/pmg';
cad3d400 DM	25
	26	my $last_atime = {};
	27	my $ldapcache = {};
	28
	29	# DB Description
	30	#
	31	# users (hash): UID -> pmail, account, DN
	32	# dnames (hash): DN -> UID
	33	# accounts (hash): account -> UID
	34	# mail (hash): mail -> UID
	35	# groups (hash): group -> GID
	36	# memberof (btree): UID -> GID
	37	#
	38	my @dbs = ('users', 'dnames', 'groups', 'mails', 'accounts', 'memberof');
	39
	40	sub new {
909eec64	41	my ($self, %args) = @_;
cad3d400 DM	42
	43	my $type = ref($self) \|\| $self;
	44
909eec64	45	die "undefined ldap id" if !$args{id};
cad3d400 DM	46
cad3d400 DM	47	my $id = $args{id};
cad3d400 DM	48
	49	if ($ldapcache->{$id}) {
	50	$self = $ldapcache->{$id};
	51	} else {
	52	$ldapcache->{$id} = $self = bless {}, $type;
	53	$self->{id} = $id;
	54	}
	55
23b1d0f8	56	my $config_properties = PMG::LDAPConfig::properties();
cad3d400	57
23b1d0f8 DC	58	# set defaults for the fields that have one
	59	foreach my $property (keys %$config_properties) {
	60	my $d = $config_properties->{$property};
	61	next if !defined($d->{default});
	62	$self->{$property} = $args{$property} \|\| $d->{default};
cad3d400 DM	63	}
cad3d400 DM	64
23b1d0f8 DC	65	# split list returns an array not a reference
	66	$self->{accountattr} = [split_list($self->{accountattr})];
	67	$self->{mailattr} = [split_list($self->{mailattr})];
b14970ad	68	$self->{groupclass} = [split_list($self->{groupclass})];
23b1d0f8	69
cad3d400 DM	70	$self->{server1} = $args{server1};
	71	$self->{server2} = $args{server2};
	72	$self->{binddn} = $args{binddn};
	73	$self->{bindpw} = $args{bindpw};
	74	$self->{basedn} = $args{basedn};
	75	$self->{port} = $args{port};
	76	$self->{groupbasedn} = $args{groupbasedn};
	77	$self->{filter} = $args{filter};
	78
	79	if ($args{syncmode} == 1) {
	80	# read local data only
	81	$self->{errors} = '';
	82	$self->loadcache();
	83	return $self;
	84	}
	85
	86	return $self if !($args{server1});
	87
	88	if ($args{syncmode} == 2) {
	89	# force sync
	90	$self->loaddata(1);
	91	} else {
	92	$self->loaddata();
	93	}
	94
	95	return $self;
	96	}
	97
	98	sub lockdir {
	99	my ($id) = @_;
	100
	101	my $dir = "$cachedir/ldapdb_$id";
	102	my $scheme = LockFile::Simple->make(
	103	-warn => 0, -stale => 1, -autoclean => 1);
	104	my $lock = $scheme->lock($dir);
	105
	106	return $lock;
	107	}
	108
	109	sub delete {
	110	my ($class, $id) = @_;
	111
cad3d400 DM	112	if (my $lock = lockdir($id)) {
	113	delete $ldapcache->{$id};
	114	delete $last_atime->{$id};
	115	my $dir = "$cachedir/ldapdb_$id";
	116	rmtree $dir;
	117	$lock->release;
	118	} else {
	119	syslog('err' , "can't lock ldap database '$id'");
	120	}
	121	}
	122
	123	sub update {
	124	my ($self, $syncmode) = @_;
	125
	126	if ($syncmode == 1) {
	127	# read local data only
	128	$self->{errors} = '';
	129	$self->loadcache();
	130	} elsif ($syncmode == 2) {
	131	# force sync
	132	$self->loaddata(1);
	133	} else {
	134	$self->loaddata();
	135	}
	136	}
	137
	138	sub queryusers {
	139	my ($self, $ldap) = @_;
	140
	141	my $filter = '(\|';
	142	foreach my $attr (@{$self->{mailattr}}) {
	143	$filter .= "($attr=*)";
	144	}
	145	$filter .= ')';
	146
	147	if ($self->{filter}) {
	148	my $tmp = $self->{filter};
	149	$tmp = "($tmp)" if $tmp !~ m/^\(.*\)$/;
	150
	151	$filter = "(&${filter}${tmp})";
	152	}
	153
	154	my $page = Net::LDAP::Control::Paged->new(size => 900);
	155
	156	my @args = (
	157	base => $self->{basedn},
	158	scope => "subtree",
	159	filter => $filter,
	160	control => [ $page ],
23b1d0f8	161	attrs => [ @{$self->{mailattr}}, @{$self->{accountattr}}, 'memberOf' ]
cad3d400 DM	162	);
	163
	164	my $cookie;
	165
	166	while(1) {
	167
	168	my $mesg = $ldap->search(@args);
	169
	170	# stop on error
	171	if ($mesg->code) {
	172	my $err = "ldap user search error: " . $mesg->error;
	173	$self->{errors} .= "$err\n";
	174	syslog('err', $err);
	175	last;
	176	}
	177
	178	#foreach my $entry ($mesg->entries) { $entry->dump; }
	179	foreach my $entry ($mesg->entries) {
	180	my $dn = $entry->dn;
	181
	182	my $umails = {};
	183	my $pmail;
	184
	185	foreach my $attr (@{$self->{mailattr}}) {
	186	foreach my $mail ($entry->get_value($attr)) {
	187	$mail = lc($mail);
	188	# Test if the Line starts with one of the following lines:
	189	# proxyAddresses: [smtp\|SMTP]:
	190	# and also discard this starting string, so that $mail is only the
	191	# address without any other characters...
	192
	193	$mail =~ s/^(smtp\|SMTP)[\:\$]//gs;
	194
	195	if ($mail !~ m/[\{\}\\\/]/ && $mail =~ m/^\S+\@\S+$/) {
	196	$umails->{$mail} = 1;
	197	$pmail = $mail if !$pmail;
	198	}
	199	}
	200	}
	201	my $addresses = [ keys %$umails ];
	202
	203	next if !$pmail; # account has no email addresses
	204
	205	my $cuid;
	206	$self->{dbstat}->{dnames}->{dbh}->get($dn, $cuid);
	207	if (!$cuid) {
	208	$cuid = ++$self->{dbstat}->{dnames}->{idcount};
	209	$self->{dbstat}->{dnames}->{dbh}->put($dn, $cuid);
	210	}
	211
23b1d0f8 DC	212	foreach my $attr (@{$self->{accountattr}}) {
	213	my $account = $entry->get_value($attr);
	214	if ($account && ($account =~ m/^\S+$/s)) {
	215	$account = lc($account);
	216	$self->{dbstat}->{accounts}->{dbh}->put($account, $cuid);
	217	my $data = pack('n/a* n/a* n/a*', $pmail, $account, $dn);
	218	$self->{dbstat}->{users}->{dbh}->put($cuid, $data);
	219	}
cad3d400 DM	220	}
cad3d400 DM	221
cad3d400 DM	222	foreach my $mail (@$addresses) {
	223	$self->{dbstat}->{mails}->{dbh}->put($mail, $cuid);
	224	}
	225
	226	if (!$self->{groupbasedn}) {
	227	my @groups = $entry->get_value('memberOf');
	228	foreach my $group (@groups) {
	229	my $cgid;
	230	$self->{dbstat}->{groups}->{dbh}->get($group, $cgid);
	231	if (!$cgid) {
	232	$cgid = ++$self->{dbstat}->{groups}->{idcount};
	233	$self->{dbstat}->{groups}->{dbh}->put($group, $cgid);
	234	}
	235	$self->{dbstat}->{memberof}->{dbh}->put($cuid, $cgid);
	236	}
	237	}
	238	}
	239
	240	# Get cookie from paged control
	241	my ($resp) = $mesg->control(LDAP_CONTROL_PAGED) or last;
67390b83 DC	242	$cookie = $resp->cookie;
	243
	244	last if (!defined($cookie) \|\| !length($cookie));
cad3d400 DM	245
	246	# Set cookie in paged control
	247	$page->cookie($cookie);
	248	}
	249
	250
67390b83	251	if (defined($cookie) && length($cookie)) {
cad3d400 DM	252	# We had an abnormal exit, so let the server know we do not want any more
	253	$page->cookie($cookie);
	254	$page->size(0);
	255	$ldap->search(@args);
	256	my $err = "LDAP user query unsuccessful";
	257	$self->{errors} .= "$err\n";
	258	syslog('err', $err);
	259	}
	260	}
	261
	262	sub querygroups {
	263	my ($self, $ldap) = @_;
	264
	265	return undef if !$self->{groupbasedn};
	266
b14970ad DC	267	my $filter = "(\|";
	268
	269	for my $class (@{$self->{groupclass}}) {
	270	$filter .= "(objectclass=$class)";
	271	}
	272
	273	$filter .= ")";
cad3d400 DM	274
	275	my $page = Net::LDAP::Control::Paged->new(size => 100);
	276
	277	my @args = ( base => $self->{groupbasedn},
	278	scope => "subtree",
	279	filter => $filter,
	280	control => [ $page ],
8256da50	281	attrs => [ 'member', 'uniqueMember' ],
cad3d400 DM	282	);
	283
	284	my $cookie;
	285	while(1) {
	286
	287	my $mesg = $ldap->search(@args);
	288
	289	# stop on error
	290	if ($mesg->code) {
	291	my $err = "ldap group search error: " . $mesg->error;
	292	$self->{errors} .= "$err\n";
	293	syslog('err', $err);
	294	last;
	295	}
	296
	297	foreach my $entry ( $mesg->entries ) {
	298	my $group = $entry->dn;
	299	my @members = $entry->get_value('member');
8256da50 DM	300	if (!scalar(@members)) {
	301	@members = $entry->get_value('uniqueMember');
	302	}
cad3d400 DM	303	my $cgid;
	304	$self->{dbstat}->{groups}->{dbh}->get($group, $cgid);
	305	if (!$cgid) {
	306	$cgid = ++$self->{dbstat}->{groups}->{idcount};
	307	$self->{dbstat}->{groups}->{dbh}->put($group, $cgid);
	308	}
	309
	310	foreach my $m (@members) {
	311
	312	my $cuid;
	313	$self->{dbstat}->{dnames}->{dbh}->get($m, $cuid);
	314	if (!$cuid) {
	315	$cuid = ++$self->{dbstat}->{dnames}->{idcount};
	316	$self->{dbstat}->{dnames}->{dbh}->put($m, $cuid);
	317	}
	318
	319	$self->{dbstat}->{memberof}->{dbh}->put($cuid, $cgid);
	320	}
	321	}
	322
	323	# Get cookie from paged control
	324	my ($resp) = $mesg->control(LDAP_CONTROL_PAGED) or last;
	325	$cookie = $resp->cookie or last;
	326
	327	# Set cookie in paged control
	328	$page->cookie($cookie);
	329	}
	330
	331	if ($cookie) {
	332	# We had an abnormal exit, so let the server know we do not want any more
	333	$page->cookie($cookie);
	334	$page->size(0);
	335	$ldap->search(@args);
	336	my $err = "LDAP group query unsuccessful";
	337	$self->{errors} .= "$err\n";
	338	syslog('err', $err);
	339	}
	340	}
	341
	342	sub ldap_connect {
	343	my ($self) = @_;
	344
e0dcec3e DM	345	my $hosts = [ $self->{server1} ];
	346
	347	push @$hosts, $self->{server2} if $self->{server2};
	348
	349	my $opts = { timeout => 10, onerror => 'die' };
	350
	351	$opts->{port} = $self->{port} if $self->{port};
	352	$opts->{schema} = $self->{mode};
cad3d400	353
e0dcec3e	354	return Net::LDAP->new($hosts, %$opts);
cad3d400 DM	355	}
cad3d400 DM	356
b183e761 DM	357	sub ldap_connect_and_bind {
	358	my ($self) = @_;
	359
	360	my $ldap = $self->ldap_connect() \|\|
cfb648f5	361	die "Can't bind to ldap server '$self->{id}': $! $@\n";
b183e761 DM	362
	363	my $mesg;
	364
	365	if ($self->{binddn}) {
	366	$mesg = $ldap->bind($self->{binddn}, password => $self->{bindpw});
	367	} else {
	368	$mesg = $ldap->bind(); # anonymous bind
	369	}
	370
	371	die "ldap bind failed: " . $mesg->error . "\n" if $mesg->code;
	372
	373	if (!$self->{basedn}) {
	374	my $root = $ldap->root_dse(attrs => [ 'defaultNamingContext' ]);
	375	$self->{basedn} = $root->get_value('defaultNamingContext');
	376	}
	377
	378	return $ldap;
	379	}
	380
cad3d400 DM	381	sub sync_database {
	382	my ($self) = @_;
	383
	384	my $dir = "ldapdb_" . $self->{id};
	385	mkdir "$cachedir/$dir";
	386
	387	# open ldap connection
	388
b183e761	389	my $ldap;
cad3d400	390
b183e761 DM	391	eval { $ldap = $self->ldap_connect_and_bind(); };
b183e761 DM	392	if (my $err = $@) {
cad3d400 DM	393	$self->{errors} .= "$err\n";
	394	syslog('err', $err);
	395	return;
	396	}
	397
cad3d400 DM	398	# open temporary database files
	399
	400	my $olddbh = {};
	401
	402	foreach my $db (@dbs) {
	403	$self->{dbstat}->{$db}->{tmpfilename} = "$cachedir/$dir/${db}_tmp$$.db";
	404	$olddbh->{$db} = $self->{dbstat}->{$db}->{dbh};
	405	}
	406
69278505 DM	407	my $error_cleanup = sub {
	408	# close and delete all files
	409	foreach my $db (@dbs) {
	410	undef $self->{dbstat}->{$db}->{dbh};
	411	unlink $self->{dbstat}->{$db}->{tmpfilename};
	412	$self->{dbstat}->{$db}->{dbh} = $olddbh->{$db};
	413	}
	414	};
	415
cad3d400 DM	416	eval {
	417	foreach my $db (@dbs) {
	418	my $filename = $self->{dbstat}->{$db}->{tmpfilename};
	419	$self->{dbstat}->{$db}->{idcount} = 0;
	420	unlink $filename;
	421
	422	if ($db eq 'memberof') {
	423	$self->{dbstat}->{$db}->{dbh} =
	424	tie (my %h, 'DB_File', $filename,
	425	O_CREAT\|O_RDWR, 0666, $DB_BTREE);
	426	} else {
	427	$self->{dbstat}->{$db}->{dbh} =
	428	tie (my %h, 'DB_File', $filename,
	429	O_CREAT\|O_RDWR, 0666, $DB_HASH);
	430	}
	431
	432	die "unable to open database file '$filename': $!\n"
	433	if !$self->{dbstat}->{$db}->{dbh};
	434	}
	435	};
69278505 DM	436	if (my $err = $@) {
69278505 DM	437	$error_cleanup->();
cad3d400 DM	438	$self->{errors} .= $err;
cad3d400 DM	439	syslog('err', $err);
cad3d400 DM	440	return;
	441	}
	442
	443	$self->querygroups ($ldap) if $self->{groupbasedn};
	444
69278505	445	$self->queryusers($ldap) if !$self->{errors};
cad3d400 DM	446
	447	$ldap->unbind;
	448
	449	if ($self->{errors}) {
69278505 DM	450	$error_cleanup->();
	451	return;
	452	}
cad3d400	453
69278505	454	my $lock = lockdir($self->{id});
cad3d400	455
69278505 DM	456	if (!$lock) {
	457	my $err = "unable to get database lock for ldap database '$self->{id}'";
	458	$self->{errors} .= "$err\n";
	459	syslog('err', $err);
	460	$error_cleanup->();
	461	return;
	462	}
cad3d400	463
69278505 DM	464	foreach my $db (@dbs) {
	465	my $filename = $self->{dbstat}->{$db}->{filename} =
	466	"$cachedir/$dir/${db}.db";
	467	$self->{dbstat}->{$db}->{dbh}->sync(); # flush everything
	468	rename $self->{dbstat}->{$db}->{tmpfilename}, $filename;
	469	}
cad3d400	470
69278505	471	$lock->release;
cad3d400	472
69278505	473	$last_atime->{$self->{id}} = time();
cad3d400	474
69278505 DM	475	$self->{gcount} = $self->{dbstat}->{groups}->{idcount};
	476	$self->{ucount} = __count_entries($self->{dbstat}->{accounts}->{dbh});
	477	$self->{mcount} = __count_entries($self->{dbstat}->{mails}->{dbh});
cad3d400 DM	478	}
	479
	480	sub __count_entries {
	481	my ($dbh) = @_;
	482
	483	return 0 if !$dbh;
	484
	485	my $key = 0 ;
	486	my $value = "" ;
	487	my $count = 0;
	488	my $status = $dbh->seq($key, $value, R_FIRST());
	489
	490	while ($status == 0) {
	491	$count++;
	492	$status = $dbh->seq($key, $value, R_NEXT());
	493	}
	494
	495	return $count;
	496	}
	497
	498	sub loadcache {
	499	my ($self, $try) = @_;
	500
	501	my $dir = "ldapdb_" . $self->{id};
	502	mkdir "$cachedir/$dir";
	503
	504	my $filename = "$cachedir/$dir/mails.db";
	505
	506	return if $last_atime->{$self->{id}} &&
	507	PMG::Utils::file_older_than ($filename, $last_atime->{$self->{id}});
	508
	509	eval {
	510	foreach my $db (@dbs) {
	511	my $filename = $self->{dbstat}->{$db}->{filename} =
	512	"$cachedir/$dir/${db}.db";
	513	$self->{dbstat}->{$db}->{idcount} = 0;
	514	if ($db eq 'memberof') {
	515	$self->{dbstat}->{$db}->{dbh} =
	516	tie (my %h, 'DB_File', $filename,
	517	O_RDONLY, 0666, $DB_BTREE);
	518	} else {
	519	$self->{dbstat}->{$db}->{dbh} =
	520	tie (my %h, 'DB_File', $filename,
	521	O_RDONLY, 0666, $DB_HASH);
	522	}
	523
	524	if (!$self->{dbstat}->{$db}->{dbh} && !$try) {
	525	my $err = "ldap error - unable to open database file '$filename': $!";
	526	$self->{errors} .= "$err\n";
	527	syslog('err', $err) if !$self->{dbstat}->{$db}->{dbh};
	528	}
	529	}
	530	};
	531
	532	$last_atime->{$self->{id}} = time();
	533
	534	$self->{gcount} = __count_entries($self->{dbstat}->{groups}->{dbh});
	535	$self->{ucount} = __count_entries($self->{dbstat}->{accounts}->{dbh});
	536	$self->{mcount} = __count_entries($self->{dbstat}->{mails}->{dbh});
	537	}
	538
	539	sub loaddata {
	540	my ($self, $force) = @_;
	541
542	$self->{errors} = '';
543
544	if (!$force) {
545	# only sync if file is older than 1 hour
546
547	my $dir = "ldapdb_" . $self->{id};
548	mkdir "$cachedir/$dir";
549	my $filename = "$cachedir/$dir/mails.db";
550
551	if (-e $filename &&
552	!PMG::Utils::file_older_than($filename, time() - 3600)) {
553	$self->loadcache();
554	return;
555	}
556	}
557
558	$self->sync_database();
559
560	if ($self->{errors}) {
561	$self->loadcache(1);
562	}
563	}
564
1d8a50bb	565	sub get_groups {
cad3d400 DM	566	my ($self) = @_;
cad3d400 DM	567
1d8a50bb	568	my $res = {};
c2670481	569
cad3d400	570	my $dbh = $self->{dbstat}->{groups}->{dbh};
c2670481 DM	571
c2670481 DM	572	return $res if !$dbh;
cad3d400 DM	573
	574	my $key = 0 ;
	575	my $value = "" ;
	576	my $status = $dbh->seq($key, $value, R_FIRST());
cad3d400 DM	577
cad3d400 DM	578	while ($status == 0) {
1d8a50bb	579	$res->{$value} = $key;
cad3d400 DM	580	$status = $dbh->seq($key, $value, R_NEXT());
	581	}
	582
c2670481 DM	583	return $res;
	584	}
	585
1d8a50bb	586	sub get_users {
c2670481 DM	587	my ($self) = @_;
c2670481 DM	588
1d8a50bb	589	my $res = {};
c2670481 DM	590
	591	my $dbh = $self->{dbstat}->{users}->{dbh};
	592
	593	return $res if !$dbh;
	594
	595	my $key = 0 ;
	596	my $value = "" ;
	597	my $status = $dbh->seq($key, $value, R_FIRST());
	598	my $keys;
	599
	600	while ($status == 0) {
	601	my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $value);
1d8a50bb	602	$res->{$key} = {
c2670481 DM	603	pmail => $pmail,
	604	account => $account,
	605	dn => $dn,
	606	};
	607	$status = $dbh->seq($key, $value, R_NEXT());
	608	}
	609
	610	return $res;
	611	}
	612
1d8a50bb DC	613	sub get_gid_uid_map {
	614	my ($self) = @_;
	615
	616	my $dbh = $self->{dbstat}->{memberof}->{dbh};
	617
	618	return [] if !$dbh;
	619
	620	my $key = 0 ;
	621	my $value = "" ;
	622
	623	my $map = {};
	624
	625	if($dbh->seq($key, $value, R_FIRST()) == 0) {
	626	do {
	627	push @{$map->{$value}}, $key;
	628	} while($dbh->seq($key, $value, R_NEXT()) == 0);
	629	}
	630
	631	return $map;
	632	}
	633
	634	sub list_groups {
	635	my ($self) = @_;
	636
	637	my $res = [];
	638
	639	my $groups = $self->get_groups();
	640
	641	for my $gid (sort keys %$groups) {
	642	push @$res, {
	643	dn => $groups->{$gid},
	644	gid => $gid,
	645	};
	646	}
	647
	648	return $res;
	649	}
	650
	651	sub list_users {
	652	my ($self, $gid) = @_;
	653
	654	my $res = [];
	655
	656	my $users = $self->get_users();
	657
	658	if (!defined($gid)) {
	659	$res = [values %$users];
	660	} else {
	661	my $gid_uid_map = $self->get_gid_uid_map();
	662	my $groups = $self->get_groups();
	663	die "No such Group ID\n"
	664	if !defined($groups->{$gid});
	665	my $memberuids = $gid_uid_map->{$gid};
	666	for my $uid (@$memberuids) {
	667	next if !defined($users->{$uid});
	668	push @$res, $users->{$uid};
	669	}
	670	}
	671
	672	return $res;
	673	}
	674
c2670481 DM	675	sub list_addresses {
	676	my ($self, $mail) = @_;
	677
	678	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
	679	my $dbhusers = $self->{dbstat}->{users}->{dbh};
	680
	681	return undef if !$dbhmails \|\| !$dbhusers;
	682
	683	$mail = lc($mail);
	684
	685	my $res = [];
	686
	687	my $cuid;
	688	$dbhmails->get($mail, $cuid);
	689	return undef if !$cuid;
	690
	691	my $rdata;
	692	$dbhusers->get($cuid, $rdata);
	693	return undef if !$rdata;
	694
	695	my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);
	696
	697	push @$res, { primary => 1, email => $pmail };
	698
	699	my $key = 0 ;
	700	my $value = "" ;
	701	my $status = $dbhmails->seq($key, $value, R_FIRST());
	702
	703	while ($status == 0) {
	704	if ($value == $cuid && $key ne $pmail) {
	705	push @$res, { primary => 0, email => $key };
	706	}
	707	$status = $dbhmails->seq($key, $value, R_NEXT());
	708	}
	709
	710	return $res;
cad3d400 DM	711	}
	712
	713	sub mail_exists {
	714	my ($self, $mail) = @_;
	715
	716	my $dbh = $self->{dbstat}->{mails}->{dbh};
	717	return 0 if !$dbh;
	718
	719	$mail = lc($mail);
	720
	721	my $res;
	722	$dbh->get($mail, $res);
	723	return $res;
	724	}
	725
	726	sub account_exists {
	727	my ($self, $account) = @_;
	728
	729	my $dbh = $self->{dbstat}->{accounts}->{dbh};
	730	return 0 if !$dbh;
	731
	732	$account = lc($account);
	733
	734	my $res;
	735	$dbh->get($account, $res);
	736	return $res;
	737	}
	738
d974ca19 DM	739	sub group_exists {
	740	my ($self, $group) = @_;
	741
	742	my $dbh = $self->{dbstat}->{groups}->{dbh};
	743	return 0 if !$dbh;
	744
	745	my $res;
	746	$dbh->get($group, $res);
	747	return $res;
	748	}
	749
cad3d400 DM	750	sub account_has_address {
	751	my ($self, $account, $mail) = @_;
	752
	753	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
	754	my $dbhaccounts = $self->{dbstat}->{accounts}->{dbh};
	755	return 0 if !$dbhmails \|\| !$dbhaccounts;
	756
	757	$account = lc($account);
	758	$mail = lc($mail);
	759
	760	my $accid;
	761	$dbhaccounts->get($account, $accid);
	762	return 0 if !$accid;
	763
	764	my $mailid;
	765	$dbhmails->get($mail, $mailid);
	766	return 0 if !$mailid;
	767
	768	return ($accid == $mailid);
	769	}
	770
	771	sub user_in_group {
	772	my ($self, $mail, $group) = @_;
	773
	774	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
	775	my $dbhgroups = $self->{dbstat}->{groups}->{dbh};
	776	my $dbhmemberof = $self->{dbstat}->{memberof}->{dbh};
	777
	778	return 0 if !$dbhmails \|\| !$dbhgroups \|\| !$dbhmemberof;
	779
	780	$mail = lc($mail);
	781
	782	my $cuid;
	783	$dbhmails->get($mail, $cuid);
	784	return 0 if !$cuid;
	785
	786	my $groupid;
	787	$dbhgroups->get($group, $groupid);
	788	return 0 if !$groupid;
	789
	790	my @gida = $dbhmemberof->get_dup($cuid);
	791
	792	return grep { $_ eq $groupid } @gida;
	793	}
	794
	795	sub account_info {
	796	my ($self, $mail, $scan) = @_;
	797
	798	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
	799	my $dbhusers = $self->{dbstat}->{users}->{dbh};
	800
	801	return undef if !$dbhmails \|\| !$dbhusers;
	802
	803	$mail = lc($mail);
	804
	805	my $res = {};
	806
	807	my $cuid;
	808	$dbhmails->get($mail, $cuid);
	809	return undef if !$cuid;
	810
	811	my $rdata;
	812	$dbhusers->get($cuid, $rdata);
	813	return undef if !$rdata;
814
815	my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);
816
817	$res->{dn} = $dn;
818	$res->{account} = $account;
819	$res->{pmail} = $pmail;
820
821	if ($scan) {
822	my $key = 0 ;
823	my $value = "" ;
824	my $status = $dbhmails->seq($key, $value, R_FIRST());
825	my $mails;
826
827	while ($status == 0) {
828	push @$mails, $key if $value == $cuid;
829	$status = $dbhmails->seq($key, $value, R_NEXT());
830	}
831	$res->{mails} = $mails;
832	}
833
834	return $res;
835	}
836
837	1;