[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->{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 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

    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 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 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})];
	68
cad3d400 DM	69	$self->{server1} = $args{server1};
	70	$self->{server2} = $args{server2};
	71	$self->{binddn} = $args{binddn};
	72	$self->{bindpw} = $args{bindpw};
	73	$self->{basedn} = $args{basedn};
	74	$self->{port} = $args{port};
	75	$self->{groupbasedn} = $args{groupbasedn};
	76	$self->{filter} = $args{filter};
	77
	78	if ($args{syncmode} == 1) {
	79	# read local data only
	80	$self->{errors} = '';
	81	$self->loadcache();
	82	return $self;
	83	}
	84
	85	return $self if !($args{server1});
	86
	87	if ($args{syncmode} == 2) {
	88	# force sync
	89	$self->loaddata(1);
	90	} else {
	91	$self->loaddata();
	92	}
	93
	94	return $self;
	95	}
	96
	97	sub lockdir {
	98	my ($id) = @_;
	99
	100	my $dir = "$cachedir/ldapdb_$id";
	101	my $scheme = LockFile::Simple->make(
	102	-warn => 0, -stale => 1, -autoclean => 1);
	103	my $lock = $scheme->lock($dir);
	104
	105	return $lock;
	106	}
	107
	108	sub delete {
	109	my ($class, $id) = @_;
	110
cad3d400 DM	111	if (my $lock = lockdir($id)) {
	112	delete $ldapcache->{$id};
	113	delete $last_atime->{$id};
	114	my $dir = "$cachedir/ldapdb_$id";
	115	rmtree $dir;
	116	$lock->release;
	117	} else {
	118	syslog('err' , "can't lock ldap database '$id'");
	119	}
	120	}
	121
	122	sub update {
	123	my ($self, $syncmode) = @_;
	124
	125	if ($syncmode == 1) {
	126	# read local data only
	127	$self->{errors} = '';
	128	$self->loadcache();
	129	} elsif ($syncmode == 2) {
	130	# force sync
	131	$self->loaddata(1);
	132	} else {
	133	$self->loaddata();
	134	}
	135	}
	136
	137	sub queryusers {
	138	my ($self, $ldap) = @_;
	139
	140	my $filter = '(\|';
	141	foreach my $attr (@{$self->{mailattr}}) {
	142	$filter .= "($attr=*)";
	143	}
	144	$filter .= ')';
	145
	146	if ($self->{filter}) {
	147	my $tmp = $self->{filter};
	148	$tmp = "($tmp)" if $tmp !~ m/^\(.*\)$/;
	149
	150	$filter = "(&${filter}${tmp})";
	151	}
	152
	153	my $page = Net::LDAP::Control::Paged->new(size => 900);
	154
	155	my @args = (
	156	base => $self->{basedn},
	157	scope => "subtree",
	158	filter => $filter,
	159	control => [ $page ],
23b1d0f8	160	attrs => [ @{$self->{mailattr}}, @{$self->{accountattr}}, 'memberOf' ]
cad3d400 DM	161	);
	162
	163	my $cookie;
	164
	165	while(1) {
	166
	167	my $mesg = $ldap->search(@args);
	168
	169	# stop on error
	170	if ($mesg->code) {
	171	my $err = "ldap user search error: " . $mesg->error;
	172	$self->{errors} .= "$err\n";
	173	syslog('err', $err);
	174	last;
	175	}
	176
	177	#foreach my $entry ($mesg->entries) { $entry->dump; }
	178	foreach my $entry ($mesg->entries) {
	179	my $dn = $entry->dn;
	180
	181	my $umails = {};
	182	my $pmail;
	183
	184	foreach my $attr (@{$self->{mailattr}}) {
	185	foreach my $mail ($entry->get_value($attr)) {
	186	$mail = lc($mail);
	187	# Test if the Line starts with one of the following lines:
	188	# proxyAddresses: [smtp\|SMTP]:
	189	# and also discard this starting string, so that $mail is only the
	190	# address without any other characters...
	191
	192	$mail =~ s/^(smtp\|SMTP)[\:\$]//gs;
	193
	194	if ($mail !~ m/[\{\}\\\/]/ && $mail =~ m/^\S+\@\S+$/) {
	195	$umails->{$mail} = 1;
	196	$pmail = $mail if !$pmail;
	197	}
	198	}
	199	}
	200	my $addresses = [ keys %$umails ];
	201
	202	next if !$pmail; # account has no email addresses
	203
	204	my $cuid;
	205	$self->{dbstat}->{dnames}->{dbh}->get($dn, $cuid);
	206	if (!$cuid) {
	207	$cuid = ++$self->{dbstat}->{dnames}->{idcount};
	208	$self->{dbstat}->{dnames}->{dbh}->put($dn, $cuid);
	209	}
	210
23b1d0f8 DC	211	foreach my $attr (@{$self->{accountattr}}) {
	212	my $account = $entry->get_value($attr);
	213	if ($account && ($account =~ m/^\S+$/s)) {
	214	$account = lc($account);
	215	$self->{dbstat}->{accounts}->{dbh}->put($account, $cuid);
	216	my $data = pack('n/a* n/a* n/a*', $pmail, $account, $dn);
	217	$self->{dbstat}->{users}->{dbh}->put($cuid, $data);
	218	}
cad3d400 DM	219	}
cad3d400 DM	220
cad3d400 DM	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
b183e761	380	my $ldap;
cad3d400	381
b183e761 DM	382	eval { $ldap = $self->ldap_connect_and_bind(); };
b183e761 DM	383	if (my $err = $@) {
cad3d400 DM	384	$self->{errors} .= "$err\n";
	385	syslog('err', $err);
	386	return;
	387	}
	388
cad3d400 DM	389	# open temporary database files
	390
	391	my $olddbh = {};
	392
	393	foreach my $db (@dbs) {
	394	$self->{dbstat}->{$db}->{tmpfilename} = "$cachedir/$dir/${db}_tmp$$.db";
	395	$olddbh->{$db} = $self->{dbstat}->{$db}->{dbh};
	396	}
	397
69278505 DM	398	my $error_cleanup = sub {
	399	# close and delete all files
	400	foreach my $db (@dbs) {
	401	undef $self->{dbstat}->{$db}->{dbh};
	402	unlink $self->{dbstat}->{$db}->{tmpfilename};
	403	$self->{dbstat}->{$db}->{dbh} = $olddbh->{$db};
	404	}
	405	};
	406
cad3d400 DM	407	eval {
	408	foreach my $db (@dbs) {
	409	my $filename = $self->{dbstat}->{$db}->{tmpfilename};
	410	$self->{dbstat}->{$db}->{idcount} = 0;
	411	unlink $filename;
	412
	413	if ($db eq 'memberof') {
	414	$self->{dbstat}->{$db}->{dbh} =
	415	tie (my %h, 'DB_File', $filename,
	416	O_CREAT\|O_RDWR, 0666, $DB_BTREE);
	417	} else {
	418	$self->{dbstat}->{$db}->{dbh} =
	419	tie (my %h, 'DB_File', $filename,
	420	O_CREAT\|O_RDWR, 0666, $DB_HASH);
	421	}
	422
	423	die "unable to open database file '$filename': $!\n"
	424	if !$self->{dbstat}->{$db}->{dbh};
	425	}
	426	};
69278505 DM	427	if (my $err = $@) {
69278505 DM	428	$error_cleanup->();
cad3d400 DM	429	$self->{errors} .= $err;
cad3d400 DM	430	syslog('err', $err);
cad3d400 DM	431	return;
	432	}
	433
	434	$self->querygroups ($ldap) if $self->{groupbasedn};
	435
69278505	436	$self->queryusers($ldap) if !$self->{errors};
cad3d400 DM	437
	438	$ldap->unbind;
	439
	440	if ($self->{errors}) {
69278505 DM	441	$error_cleanup->();
	442	return;
	443	}
cad3d400	444
69278505	445	my $lock = lockdir($self->{id});
cad3d400	446
69278505 DM	447	if (!$lock) {
	448	my $err = "unable to get database lock for ldap database '$self->{id}'";
	449	$self->{errors} .= "$err\n";
	450	syslog('err', $err);
	451	$error_cleanup->();
	452	return;
	453	}
cad3d400	454
69278505 DM	455	foreach my $db (@dbs) {
	456	my $filename = $self->{dbstat}->{$db}->{filename} =
	457	"$cachedir/$dir/${db}.db";
	458	$self->{dbstat}->{$db}->{dbh}->sync(); # flush everything
	459	rename $self->{dbstat}->{$db}->{tmpfilename}, $filename;
	460	}
cad3d400	461
69278505	462	$lock->release;
cad3d400	463
69278505	464	$last_atime->{$self->{id}} = time();
cad3d400	465
69278505 DM	466	$self->{gcount} = $self->{dbstat}->{groups}->{idcount};
	467	$self->{ucount} = __count_entries($self->{dbstat}->{accounts}->{dbh});
	468	$self->{mcount} = __count_entries($self->{dbstat}->{mails}->{dbh});
cad3d400 DM	469	}
	470
	471	sub __count_entries {
	472	my ($dbh) = @_;
	473
	474	return 0 if !$dbh;
	475
	476	my $key = 0 ;
	477	my $value = "" ;
	478	my $count = 0;
	479	my $status = $dbh->seq($key, $value, R_FIRST());
	480
	481	while ($status == 0) {
	482	$count++;
	483	$status = $dbh->seq($key, $value, R_NEXT());
	484	}
	485
	486	return $count;
	487	}
	488
	489	sub loadcache {
	490	my ($self, $try) = @_;
	491
	492	my $dir = "ldapdb_" . $self->{id};
	493	mkdir "$cachedir/$dir";
	494
	495	my $filename = "$cachedir/$dir/mails.db";
	496
	497	return if $last_atime->{$self->{id}} &&
	498	PMG::Utils::file_older_than ($filename, $last_atime->{$self->{id}});
	499
	500	eval {
	501	foreach my $db (@dbs) {
	502	my $filename = $self->{dbstat}->{$db}->{filename} =
	503	"$cachedir/$dir/${db}.db";
	504	$self->{dbstat}->{$db}->{idcount} = 0;
	505	if ($db eq 'memberof') {
	506	$self->{dbstat}->{$db}->{dbh} =
	507	tie (my %h, 'DB_File', $filename,
	508	O_RDONLY, 0666, $DB_BTREE);
	509	} else {
	510	$self->{dbstat}->{$db}->{dbh} =
	511	tie (my %h, 'DB_File', $filename,
	512	O_RDONLY, 0666, $DB_HASH);
	513	}
	514
	515	if (!$self->{dbstat}->{$db}->{dbh} && !$try) {
	516	my $err = "ldap error - unable to open database file '$filename': $!";
	517	$self->{errors} .= "$err\n";
	518	syslog('err', $err) if !$self->{dbstat}->{$db}->{dbh};
	519	}
	520	}
	521	};
	522
	523	$last_atime->{$self->{id}} = time();
	524
	525	$self->{gcount} = __count_entries($self->{dbstat}->{groups}->{dbh});
	526	$self->{ucount} = __count_entries($self->{dbstat}->{accounts}->{dbh});
	527	$self->{mcount} = __count_entries($self->{dbstat}->{mails}->{dbh});
	528	}
	529
	530	sub loaddata {
	531	my ($self, $force) = @_;
	532
533	$self->{errors} = '';
534
535	if (!$force) {
536	# only sync if file is older than 1 hour
537
538	my $dir = "ldapdb_" . $self->{id};
539	mkdir "$cachedir/$dir";
540	my $filename = "$cachedir/$dir/mails.db";
541
542	if (-e $filename &&
543	!PMG::Utils::file_older_than($filename, time() - 3600)) {
544	$self->loadcache();
545	return;
546	}
547	}
548
549	$self->sync_database();
550
551	if ($self->{errors}) {
552	$self->loadcache(1);
553	}
554	}
555
c2670481	556	sub list_groups {
cad3d400 DM	557	my ($self) = @_;
cad3d400 DM	558
c2670481 DM	559	my $res = [];
c2670481 DM	560
cad3d400	561	my $dbh = $self->{dbstat}->{groups}->{dbh};
c2670481 DM	562
c2670481 DM	563	return $res if !$dbh;
cad3d400 DM	564
	565	my $key = 0 ;
	566	my $value = "" ;
	567	my $status = $dbh->seq($key, $value, R_FIRST());
	568	my $keys;
	569
	570	while ($status == 0) {
c2670481 DM	571	push @$res, {
	572	dn => $key,
	573	};
cad3d400 DM	574	$status = $dbh->seq($key, $value, R_NEXT());
	575	}
	576
c2670481 DM	577	return $res;
	578	}
	579
	580	sub list_users {
	581	my ($self) = @_;
	582
	583	my $res = [];
	584
	585	my $dbh = $self->{dbstat}->{users}->{dbh};
	586
	587	return $res if !$dbh;
	588
	589	my $key = 0 ;
	590	my $value = "" ;
	591	my $status = $dbh->seq($key, $value, R_FIRST());
	592	my $keys;
	593
	594	while ($status == 0) {
	595	my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $value);
	596	push @$res, {
	597	pmail => $pmail,
	598	account => $account,
	599	dn => $dn,
	600	};
	601	$status = $dbh->seq($key, $value, R_NEXT());
	602	}
	603
	604	return $res;
	605	}
	606
	607	sub list_addresses {
	608	my ($self, $mail) = @_;
	609
	610	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
	611	my $dbhusers = $self->{dbstat}->{users}->{dbh};
	612
	613	return undef if !$dbhmails \|\| !$dbhusers;
	614
	615	$mail = lc($mail);
	616
	617	my $res = [];
	618
	619	my $cuid;
	620	$dbhmails->get($mail, $cuid);
	621	return undef if !$cuid;
	622
	623	my $rdata;
	624	$dbhusers->get($cuid, $rdata);
	625	return undef if !$rdata;
	626
	627	my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);
	628
	629	push @$res, { primary => 1, email => $pmail };
	630
	631	my $key = 0 ;
	632	my $value = "" ;
	633	my $status = $dbhmails->seq($key, $value, R_FIRST());
	634
	635	while ($status == 0) {
	636	if ($value == $cuid && $key ne $pmail) {
	637	push @$res, { primary => 0, email => $key };
	638	}
	639	$status = $dbhmails->seq($key, $value, R_NEXT());
	640	}
641
642	return $res;
cad3d400 DM	643	}
	644
	645	sub mail_exists {
	646	my ($self, $mail) = @_;
	647
	648	my $dbh = $self->{dbstat}->{mails}->{dbh};
	649	return 0 if !$dbh;
	650
	651	$mail = lc($mail);
	652
	653	my $res;
	654	$dbh->get($mail, $res);
	655	return $res;
	656	}
	657
	658	sub account_exists {
	659	my ($self, $account) = @_;
	660
	661	my $dbh = $self->{dbstat}->{accounts}->{dbh};
	662	return 0 if !$dbh;
	663
	664	$account = lc($account);
	665
	666	my $res;
	667	$dbh->get($account, $res);
	668	return $res;
	669	}
	670
d974ca19 DM	671	sub group_exists {
	672	my ($self, $group) = @_;
	673
	674	my $dbh = $self->{dbstat}->{groups}->{dbh};
	675	return 0 if !$dbh;
	676
	677	my $res;
	678	$dbh->get($group, $res);
	679	return $res;
	680	}
	681
cad3d400 DM	682	sub account_has_address {
	683	my ($self, $account, $mail) = @_;
	684
	685	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
	686	my $dbhaccounts = $self->{dbstat}->{accounts}->{dbh};
	687	return 0 if !$dbhmails \|\| !$dbhaccounts;
	688
	689	$account = lc($account);
	690	$mail = lc($mail);
	691
	692	my $accid;
	693	$dbhaccounts->get($account, $accid);
	694	return 0 if !$accid;
	695
	696	my $mailid;
	697	$dbhmails->get($mail, $mailid);
	698	return 0 if !$mailid;
	699
	700	return ($accid == $mailid);
	701	}
	702
	703	sub user_in_group {
	704	my ($self, $mail, $group) = @_;
	705
	706	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
	707	my $dbhgroups = $self->{dbstat}->{groups}->{dbh};
	708	my $dbhmemberof = $self->{dbstat}->{memberof}->{dbh};
	709
	710	return 0 if !$dbhmails \|\| !$dbhgroups \|\| !$dbhmemberof;
	711
	712	$mail = lc($mail);
	713
	714	my $cuid;
	715	$dbhmails->get($mail, $cuid);
	716	return 0 if !$cuid;
	717
	718	my $groupid;
	719	$dbhgroups->get($group, $groupid);
	720	return 0 if !$groupid;
	721
	722	my @gida = $dbhmemberof->get_dup($cuid);
	723
	724	return grep { $_ eq $groupid } @gida;
	725	}
	726
	727	sub account_info {
	728	my ($self, $mail, $scan) = @_;
	729
	730	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
	731	my $dbhusers = $self->{dbstat}->{users}->{dbh};
	732
	733	return undef if !$dbhmails \|\| !$dbhusers;
	734
	735	$mail = lc($mail);
	736
	737	my $res = {};
	738
	739	my $cuid;
	740	$dbhmails->get($mail, $cuid);
	741	return undef if !$cuid;
	742
	743	my $rdata;
	744	$dbhusers->get($cuid, $rdata);
	745	return undef if !$rdata;
746
747	my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);
748
749	$res->{dn} = $dn;
750	$res->{account} = $account;
751	$res->{pmail} = $pmail;
752
753	if ($scan) {
754	my $key = 0 ;
755	my $value = "" ;
756	my $status = $dbhmails->seq($key, $value, R_FIRST());
757	my $mails;
758
759	while ($status == 0) {
760	push @$mails, $key if $value == $cuid;
761	$status = $dbhmails->seq($key, $value, R_NEXT());
762	}
763	$res->{mails} = $mails;
764	}
765
766	return $res;
767	}
768
769	1;