[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)(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 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
8256da50	263	my $filter = "(\|(objectclass=group)(objectclass=univentionGroup))";
cad3d400 DM	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 ],
8256da50	271	attrs => [ 'member', 'uniqueMember' ],
cad3d400 DM	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');
8256da50 DM	290	if (!scalar(@members)) {
	291	@members = $entry->get_value('uniqueMember');
	292	}
cad3d400 DM	293	my $cgid;
	294	$self->{dbstat}->{groups}->{dbh}->get($group, $cgid);
	295	if (!$cgid) {
	296	$cgid = ++$self->{dbstat}->{groups}->{idcount};
	297	$self->{dbstat}->{groups}->{dbh}->put($group, $cgid);
	298	}
	299
	300	foreach my $m (@members) {
	301
	302	my $cuid;
	303	$self->{dbstat}->{dnames}->{dbh}->get($m, $cuid);
	304	if (!$cuid) {
	305	$cuid = ++$self->{dbstat}->{dnames}->{idcount};
	306	$self->{dbstat}->{dnames}->{dbh}->put($m, $cuid);
	307	}
	308
	309	$self->{dbstat}->{memberof}->{dbh}->put($cuid, $cgid);
	310	}
	311	}
	312
	313	# Get cookie from paged control
	314	my ($resp) = $mesg->control(LDAP_CONTROL_PAGED) or last;
	315	$cookie = $resp->cookie or last;
	316
	317	# Set cookie in paged control
	318	$page->cookie($cookie);
	319	}
	320
	321	if ($cookie) {
	322	# We had an abnormal exit, so let the server know we do not want any more
	323	$page->cookie($cookie);
	324	$page->size(0);
	325	$ldap->search(@args);
	326	my $err = "LDAP group query unsuccessful";
	327	$self->{errors} .= "$err\n";
	328	syslog('err', $err);
	329	}
	330	}
	331
	332	sub ldap_connect {
	333	my ($self) = @_;
	334
e0dcec3e DM	335	my $hosts = [ $self->{server1} ];
	336
	337	push @$hosts, $self->{server2} if $self->{server2};
	338
	339	my $opts = { timeout => 10, onerror => 'die' };
	340
	341	$opts->{port} = $self->{port} if $self->{port};
	342	$opts->{schema} = $self->{mode};
cad3d400	343
e0dcec3e	344	return Net::LDAP->new($hosts, %$opts);
cad3d400 DM	345	}
cad3d400 DM	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
69278505 DM	399	my $error_cleanup = sub {
	400	# close and delete all files
	401	foreach my $db (@dbs) {
	402	undef $self->{dbstat}->{$db}->{dbh};
	403	unlink $self->{dbstat}->{$db}->{tmpfilename};
	404	$self->{dbstat}->{$db}->{dbh} = $olddbh->{$db};
	405	}
	406	};
	407
cad3d400 DM	408	eval {
	409	foreach my $db (@dbs) {
	410	my $filename = $self->{dbstat}->{$db}->{tmpfilename};
	411	$self->{dbstat}->{$db}->{idcount} = 0;
	412	unlink $filename;
	413
	414	if ($db eq 'memberof') {
	415	$self->{dbstat}->{$db}->{dbh} =
	416	tie (my %h, 'DB_File', $filename,
	417	O_CREAT\|O_RDWR, 0666, $DB_BTREE);
	418	} else {
	419	$self->{dbstat}->{$db}->{dbh} =
	420	tie (my %h, 'DB_File', $filename,
	421	O_CREAT\|O_RDWR, 0666, $DB_HASH);
	422	}
	423
	424	die "unable to open database file '$filename': $!\n"
	425	if !$self->{dbstat}->{$db}->{dbh};
	426	}
	427	};
69278505 DM	428	if (my $err = $@) {
69278505 DM	429	$error_cleanup->();
cad3d400 DM	430	$self->{errors} .= $err;
cad3d400 DM	431	syslog('err', $err);
cad3d400 DM	432	return;
	433	}
	434
	435	$self->querygroups ($ldap) if $self->{groupbasedn};
	436
69278505	437	$self->queryusers($ldap) if !$self->{errors};
cad3d400 DM	438
	439	$ldap->unbind;
	440
	441	if ($self->{errors}) {
69278505 DM	442	$error_cleanup->();
	443	return;
	444	}
cad3d400	445
69278505	446	my $lock = lockdir($self->{id});
cad3d400	447
69278505 DM	448	if (!$lock) {
	449	my $err = "unable to get database lock for ldap database '$self->{id}'";
	450	$self->{errors} .= "$err\n";
	451	syslog('err', $err);
	452	$error_cleanup->();
	453	return;
	454	}
cad3d400	455
69278505 DM	456	foreach my $db (@dbs) {
	457	my $filename = $self->{dbstat}->{$db}->{filename} =
	458	"$cachedir/$dir/${db}.db";
	459	$self->{dbstat}->{$db}->{dbh}->sync(); # flush everything
	460	rename $self->{dbstat}->{$db}->{tmpfilename}, $filename;
	461	}
cad3d400	462
69278505	463	$lock->release;
cad3d400	464
69278505	465	$last_atime->{$self->{id}} = time();
cad3d400	466
69278505 DM	467	$self->{gcount} = $self->{dbstat}->{groups}->{idcount};
	468	$self->{ucount} = __count_entries($self->{dbstat}->{accounts}->{dbh});
	469	$self->{mcount} = __count_entries($self->{dbstat}->{mails}->{dbh});
b183e761	470
69278505	471	syslog('info', "ldap sync '$self->{id}' successful ($self->{mcount})");
cad3d400 DM	472	}
	473
	474	sub __count_entries {
	475	my ($dbh) = @_;
	476
	477	return 0 if !$dbh;
	478
	479	my $key = 0 ;
	480	my $value = "" ;
	481	my $count = 0;
	482	my $status = $dbh->seq($key, $value, R_FIRST());
	483
	484	while ($status == 0) {
	485	$count++;
	486	$status = $dbh->seq($key, $value, R_NEXT());
	487	}
	488
	489	return $count;
	490	}
	491
	492	sub loadcache {
	493	my ($self, $try) = @_;
	494
	495	my $dir = "ldapdb_" . $self->{id};
	496	mkdir "$cachedir/$dir";
	497
	498	my $filename = "$cachedir/$dir/mails.db";
	499
	500	return if $last_atime->{$self->{id}} &&
	501	PMG::Utils::file_older_than ($filename, $last_atime->{$self->{id}});
	502
	503	eval {
	504	foreach my $db (@dbs) {
	505	my $filename = $self->{dbstat}->{$db}->{filename} =
	506	"$cachedir/$dir/${db}.db";
	507	$self->{dbstat}->{$db}->{idcount} = 0;
	508	if ($db eq 'memberof') {
	509	$self->{dbstat}->{$db}->{dbh} =
	510	tie (my %h, 'DB_File', $filename,
	511	O_RDONLY, 0666, $DB_BTREE);
	512	} else {
	513	$self->{dbstat}->{$db}->{dbh} =
	514	tie (my %h, 'DB_File', $filename,
	515	O_RDONLY, 0666, $DB_HASH);
	516	}
	517
	518	if (!$self->{dbstat}->{$db}->{dbh} && !$try) {
	519	my $err = "ldap error - unable to open database file '$filename': $!";
	520	$self->{errors} .= "$err\n";
	521	syslog('err', $err) if !$self->{dbstat}->{$db}->{dbh};
	522	}
	523	}
	524	};
	525
	526	$last_atime->{$self->{id}} = time();
	527
	528	$self->{gcount} = __count_entries($self->{dbstat}->{groups}->{dbh});
	529	$self->{ucount} = __count_entries($self->{dbstat}->{accounts}->{dbh});
	530	$self->{mcount} = __count_entries($self->{dbstat}->{mails}->{dbh});
	531	}
	532
	533	sub loaddata {
	534	my ($self, $force) = @_;
	535
536	$self->{errors} = '';
537
538	if (!$force) {
539	# only sync if file is older than 1 hour
540
541	my $dir = "ldapdb_" . $self->{id};
542	mkdir "$cachedir/$dir";
543	my $filename = "$cachedir/$dir/mails.db";
544
545	if (-e $filename &&
546	!PMG::Utils::file_older_than($filename, time() - 3600)) {
547	$self->loadcache();
548	return;
549	}
550	}
551
552	$self->sync_database();
553
554	if ($self->{errors}) {
555	$self->loadcache(1);
556	}
557	}
558
559	sub groups {
560	my ($self) = @_;
561
562	my $dbh = $self->{dbstat}->{groups}->{dbh};
563	return [] if !$dbh;
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) {
571	push @$keys, $key;
572	$status = $dbh->seq($key, $value, R_NEXT());
573	}
574
575	return $keys;
576	}
577
578	sub mail_exists {
579	my ($self, $mail) = @_;
580
581	my $dbh = $self->{dbstat}->{mails}->{dbh};
582	return 0 if !$dbh;
583
584	$mail = lc($mail);
585
586	my $res;
587	$dbh->get($mail, $res);
588	return $res;
589	}
590
591	sub account_exists {
592	my ($self, $account) = @_;
593
594	my $dbh = $self->{dbstat}->{accounts}->{dbh};
595	return 0 if !$dbh;
596
597	$account = lc($account);
598
599	my $res;
600	$dbh->get($account, $res);
601	return $res;
602	}
603
604	sub account_has_address {
605	my ($self, $account, $mail) = @_;
606
607	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
608	my $dbhaccounts = $self->{dbstat}->{accounts}->{dbh};
609	return 0 if !$dbhmails \|\| !$dbhaccounts;
610
611	$account = lc($account);
612	$mail = lc($mail);
613
614	my $accid;
615	$dbhaccounts->get($account, $accid);
616	return 0 if !$accid;
617
618	my $mailid;
619	$dbhmails->get($mail, $mailid);
620	return 0 if !$mailid;
621
622	return ($accid == $mailid);
623	}
624
625	sub user_in_group {
626	my ($self, $mail, $group) = @_;
627
628	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
629	my $dbhgroups = $self->{dbstat}->{groups}->{dbh};
630	my $dbhmemberof = $self->{dbstat}->{memberof}->{dbh};
631
632	return 0 if !$dbhmails \|\| !$dbhgroups \|\| !$dbhmemberof;
633
634	$mail = lc($mail);
635
636	my $cuid;
637	$dbhmails->get($mail, $cuid);
638	return 0 if !$cuid;
639
640	my $groupid;
641	$dbhgroups->get($group, $groupid);
642	return 0 if !$groupid;
643
644	my @gida = $dbhmemberof->get_dup($cuid);
645
646	return grep { $_ eq $groupid } @gida;
647	}
648
649	sub account_info {
650	my ($self, $mail, $scan) = @_;
651
652	my $dbhmails = $self->{dbstat}->{mails}->{dbh};
653	my $dbhusers = $self->{dbstat}->{users}->{dbh};
654
655	return undef if !$dbhmails \|\| !$dbhusers;
656
657	$mail = lc($mail);
658
659	my $res = {};
660
661	my $cuid;
662	$dbhmails->get($mail, $cuid);
663	return undef if !$cuid;
664
665	my $rdata;
666	$dbhusers->get($cuid, $rdata);
667	return undef if !$rdata;
668
669	my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);
670
671	$res->{dn} = $dn;
672	$res->{account} = $account;
673	$res->{pmail} = $pmail;
674
675	if ($scan) {
676	my $key = 0 ;
677	my $value = "" ;
678	my $status = $dbhmails->seq($key, $value, R_FIRST());
679	my $mails;
680
681	while ($status == 0) {
682	push @$mails, $key if $value == $cuid;
683	$status = $dbhmails->seq($key, $value, R_NEXT());
684	}
685	$res->{mails} = $mails;
686	}
687
688	return $res;
689	}
690
691	1;