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

package PMG::LDAPCache;

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

use PVE::SafeSyslog;

use PMG::Utils;

$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;
    }

    if (!$args{mailattr}) {
	$args{mailattr} = "mail, userPrincipalName, proxyAddresses, othermailbox";
    }
    $args{mailattr} =~ s/[\,\;]/ /g;
    $args{mailattr} =~ s/\s+/,/g;

    if ($args{mode} && ($args{mode} eq 'ldap' ||  $args{mode} eq 'ldaps')) {
	$self->{mode} = $args{mode};
    } else {
	$self->{mode} = 'ldap';
    }

    $self->{accountattr} = $args{accountattr} || 'sAMAccountName';
    @{$self->{mailattr}} = split(/,/, $args{mailattr});
    $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);
	    }

	    my $account = $entry->get_value($self->{accountattr});
	    if ($account && ($account =~ m/^\S+$/s)) {
		$account = lc($account);
		$self->{dbstat}->{accounts}->{dbh}->put($account, $cuid);
	    } else {
		$account = '';
	    }

	    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 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 user query unsuccessful";
	$self->{errors} .= "$err\n";
	syslog('err', $err);
    }
}

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

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

    my $filter = "(objectclass=group)";

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

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

    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');

	    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 $mode = $self->{mode};
    my $portstr = '';
    $portstr = ':' . $self->{port} if $self->{port};

    my $serverstr = "$mode://$self->{server1}${portstr}/";
    my $ldap = Net::LDAP->new($serverstr);
    if(!$ldap && $self->{server2} && $self->{server2} ne '127.0.0.1')  {
	$serverstr = "$mode://$self->{server2}${portstr}/";
	$ldap = Net::LDAP->new($serverstr);
    }

    return $ldap;
}

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

    syslog('info', "syncing ldap database '$self->{id}'");

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

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

    my $err = $@;

    if ($err) {
	# 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};
	}
	$self->{errors} .= $err;
	syslog('err', $err);

	return;
    }

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

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

    $ldap->unbind;

    if ($self->{errors}) {
	# 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};
	}
    } else {

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

	    # 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};
	    }
	} else {
	    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});

	    syslog('info', "ldap sync '$self->{id}' successful ($self->{mcount})");
	}
    }
}

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 groups {
    my ($self) = @_;

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

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

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

    return $keys;
}

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