[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 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)(objectclass=univentionGroup))";

    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

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

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

    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 list_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());
    my $keys;

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

    return $res;
}

sub list_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);
	push @$res, {
	    pmail => $pmail,
	    account => $account,
	    dn => $dn,
	};
        $status = $dbh->seq($key, $value, R_NEXT());
    }

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