]>
git.proxmox.com Git - pmg-api.git/blob - PMG/LDAPCache.pm
1 package PMG
::LDAPCache
;
9 use Net
::LDAP
::Control
::Paged
;
10 use Net
::LDAP
::Constant qw
(LDAP_CONTROL_PAGED
);
14 use PVE
::Tools
qw(split_list);
19 $DB_HASH->{'cachesize'} = 10000;
20 $DB_RECNO->{'cachesize'} = 10000;
21 $DB_BTREE->{'cachesize'} = 10000;
22 $DB_BTREE->{'flags'} = R_DUP
;
24 my $cachedir = '/var/lib/pmg';
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
38 my @dbs = ('users', 'dnames', 'groups', 'mails', 'accounts', 'memberof');
41 my ($self, %args) = @_;
43 my $type = ref($self) || $self;
45 die "undefined ldap id" if !$args{id
};
49 if ($ldapcache->{$id}) {
50 $self = $ldapcache->{$id};
52 $ldapcache->{$id} = $self = bless {}, $type;
56 my $config_properties = PMG
::LDAPConfig
::properties
();
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};
65 # split list returns an array not a reference
66 $self->{accountattr
} = [split_list
($self->{accountattr
})];
67 $self->{mailattr
} = [split_list
($self->{mailattr
})];
68 $self->{groupclass
} = [split_list
($self->{groupclass
})];
70 $self->{server1
} = $args{server1
};
71 $self->{server2
} = $args{server2
};
72 $self->{binddn
} = $args{binddn
};
73 $self->{bindpw
} = $args{bindpw
};
74 $self->{basedn
} = $args{basedn
};
75 $self->{port
} = $args{port
};
76 $self->{groupbasedn
} = $args{groupbasedn
};
77 $self->{filter
} = $args{filter
};
79 if ($args{syncmode
} == 1) {
80 # read local data only
86 return $self if !($args{server1
});
88 if ($args{syncmode
} == 2) {
101 my $dir = "$cachedir/ldapdb_$id";
102 my $scheme = LockFile
::Simple-
>make(
103 -warn => 0, -stale
=> 1, -autoclean
=> 1);
104 my $lock = $scheme->lock($dir);
110 my ($class, $id) = @_;
112 if (my $lock = lockdir
($id)) {
113 delete $ldapcache->{$id};
114 delete $last_atime->{$id};
115 my $dir = "$cachedir/ldapdb_$id";
119 syslog
('err' , "can't lock ldap database '$id'");
124 my ($self, $syncmode) = @_;
126 if ($syncmode == 1) {
127 # read local data only
128 $self->{errors
} = '';
130 } elsif ($syncmode == 2) {
139 my ($self, $ldap) = @_;
142 foreach my $attr (@{$self->{mailattr
}}) {
143 $filter .= "($attr=*)";
147 if ($self->{filter
}) {
148 my $tmp = $self->{filter
};
149 $tmp = "($tmp)" if $tmp !~ m/^\(.*\)$/;
151 $filter = "(&${filter}${tmp})";
154 my $page = Net
::LDAP
::Control
::Paged-
>new(size
=> 900);
157 base
=> $self->{basedn
},
160 control
=> [ $page ],
161 attrs
=> [ @{$self->{mailattr
}}, @{$self->{accountattr
}}, 'memberOf' ]
168 my $mesg = $ldap->search(@args);
172 my $err = "ldap user search error: " . $mesg->error;
173 $self->{errors
} .= "$err\n";
178 #foreach my $entry ($mesg->entries) { $entry->dump; }
179 foreach my $entry ($mesg->entries) {
185 foreach my $attr (@{$self->{mailattr
}}) {
186 foreach my $mail ($entry->get_value($attr)) {
188 # Test if the Line starts with one of the following lines:
189 # proxyAddresses: [smtp|SMTP]:
190 # and also discard this starting string, so that $mail is only the
191 # address without any other characters...
193 $mail =~ s/^(smtp|SMTP)[\:\$]//gs;
195 if ($mail !~ m/[\{\}\\\/]/ && $mail =~ m/^\S
+\
@\S+$/) {
196 $umails->{$mail} = 1;
197 $pmail = $mail if !$pmail;
201 my $addresses = [ keys %$umails ];
203 next if !$pmail; # account has no email addresses
206 $self->{dbstat
}->{dnames
}->{dbh
}->get($dn, $cuid);
208 $cuid = ++$self->{dbstat
}->{dnames
}->{idcount
};
209 $self->{dbstat
}->{dnames
}->{dbh
}->put($dn, $cuid);
212 foreach my $attr (@{$self->{accountattr
}}) {
213 my $account = $entry->get_value($attr);
214 if ($account && ($account =~ m/^\S+$/s)) {
215 $account = lc($account);
216 $self->{dbstat
}->{accounts
}->{dbh
}->put($account, $cuid);
217 my $data = pack('n/a* n/a* n/a*', $pmail, $account, $dn);
218 $self->{dbstat
}->{users
}->{dbh
}->put($cuid, $data);
222 foreach my $mail (@$addresses) {
223 $self->{dbstat
}->{mails
}->{dbh
}->put($mail, $cuid);
226 if (!$self->{groupbasedn
}) {
227 my @groups = $entry->get_value('memberOf');
228 foreach my $group (@groups) {
230 $self->{dbstat
}->{groups
}->{dbh
}->get($group, $cgid);
232 $cgid = ++$self->{dbstat
}->{groups
}->{idcount
};
233 $self->{dbstat
}->{groups
}->{dbh
}->put($group, $cgid);
235 $self->{dbstat
}->{memberof
}->{dbh
}->put($cuid, $cgid);
240 # Get cookie from paged control
241 my ($resp) = $mesg->control(LDAP_CONTROL_PAGED
) or last;
242 $cookie = $resp->cookie;
244 last if (!defined($cookie) || !length($cookie));
246 # Set cookie in paged control
247 $page->cookie($cookie);
251 if (defined($cookie) && length($cookie)) {
252 # We had an abnormal exit, so let the server know we do not want any more
253 $page->cookie($cookie);
255 $ldap->search(@args);
256 my $err = "LDAP user query unsuccessful";
257 $self->{errors
} .= "$err\n";
263 my ($self, $ldap) = @_;
265 return undef if !$self->{groupbasedn
};
269 for my $class (@{$self->{groupclass
}}) {
270 $filter .= "(objectclass=$class)";
275 my $page = Net
::LDAP
::Control
::Paged-
>new(size
=> 100);
277 my @args = ( base
=> $self->{groupbasedn
},
280 control
=> [ $page ],
281 attrs
=> [ 'member', 'uniqueMember' ],
287 my $mesg = $ldap->search(@args);
291 my $err = "ldap group search error: " . $mesg->error;
292 $self->{errors
} .= "$err\n";
297 foreach my $entry ( $mesg->entries ) {
298 my $group = $entry->dn;
299 my @members = $entry->get_value('member');
300 if (!scalar(@members)) {
301 @members = $entry->get_value('uniqueMember');
304 $self->{dbstat
}->{groups
}->{dbh
}->get($group, $cgid);
306 $cgid = ++$self->{dbstat
}->{groups
}->{idcount
};
307 $self->{dbstat
}->{groups
}->{dbh
}->put($group, $cgid);
310 foreach my $m (@members) {
313 $self->{dbstat
}->{dnames
}->{dbh
}->get($m, $cuid);
315 $cuid = ++$self->{dbstat
}->{dnames
}->{idcount
};
316 $self->{dbstat
}->{dnames
}->{dbh
}->put($m, $cuid);
319 $self->{dbstat
}->{memberof
}->{dbh
}->put($cuid, $cgid);
323 # Get cookie from paged control
324 my ($resp) = $mesg->control(LDAP_CONTROL_PAGED
) or last;
325 $cookie = $resp->cookie or last;
327 # Set cookie in paged control
328 $page->cookie($cookie);
332 # We had an abnormal exit, so let the server know we do not want any more
333 $page->cookie($cookie);
335 $ldap->search(@args);
336 my $err = "LDAP group query unsuccessful";
337 $self->{errors
} .= "$err\n";
345 my $hosts = [ $self->{server1
} ];
347 push @$hosts, $self->{server2
} if $self->{server2
};
349 my $opts = { timeout
=> 10, onerror
=> 'die' };
351 $opts->{port
} = $self->{port
} if $self->{port
};
352 $opts->{schema
} = $self->{mode
};
354 return Net
::LDAP-
>new($hosts, %$opts);
357 sub ldap_connect_and_bind
{
360 my $ldap = $self->ldap_connect() ||
361 die "Can't bind to ldap server '$self->{id}': $!\n";
365 if ($self->{binddn
}) {
366 $mesg = $ldap->bind($self->{binddn
}, password
=> $self->{bindpw
});
368 $mesg = $ldap->bind(); # anonymous bind
371 die "ldap bind failed: " . $mesg->error . "\n" if $mesg->code;
373 if (!$self->{basedn
}) {
374 my $root = $ldap->root_dse(attrs
=> [ 'defaultNamingContext' ]);
375 $self->{basedn
} = $root->get_value('defaultNamingContext');
384 my $dir = "ldapdb_" . $self->{id
};
385 mkdir "$cachedir/$dir";
387 # open ldap connection
391 eval { $ldap = $self->ldap_connect_and_bind(); };
393 $self->{errors
} .= "$err\n";
398 # open temporary database files
402 foreach my $db (@dbs) {
403 $self->{dbstat
}->{$db}->{tmpfilename
} = "$cachedir/$dir/${db}_tmp$$.db";
404 $olddbh->{$db} = $self->{dbstat
}->{$db}->{dbh
};
407 my $error_cleanup = sub {
408 # close and delete all files
409 foreach my $db (@dbs) {
410 undef $self->{dbstat
}->{$db}->{dbh
};
411 unlink $self->{dbstat
}->{$db}->{tmpfilename
};
412 $self->{dbstat
}->{$db}->{dbh
} = $olddbh->{$db};
417 foreach my $db (@dbs) {
418 my $filename = $self->{dbstat
}->{$db}->{tmpfilename
};
419 $self->{dbstat
}->{$db}->{idcount
} = 0;
422 if ($db eq 'memberof') {
423 $self->{dbstat
}->{$db}->{dbh
} =
424 tie
(my %h, 'DB_File', $filename,
425 O_CREAT
|O_RDWR
, 0666, $DB_BTREE);
427 $self->{dbstat
}->{$db}->{dbh
} =
428 tie
(my %h, 'DB_File', $filename,
429 O_CREAT
|O_RDWR
, 0666, $DB_HASH);
432 die "unable to open database file '$filename': $!\n"
433 if !$self->{dbstat
}->{$db}->{dbh
};
438 $self->{errors
} .= $err;
443 $self->querygroups ($ldap) if $self->{groupbasedn
};
445 $self->queryusers($ldap) if !$self->{errors
};
449 if ($self->{errors
}) {
454 my $lock = lockdir
($self->{id
});
457 my $err = "unable to get database lock for ldap database '$self->{id}'";
458 $self->{errors
} .= "$err\n";
464 foreach my $db (@dbs) {
465 my $filename = $self->{dbstat
}->{$db}->{filename
} =
466 "$cachedir/$dir/${db}.db";
467 $self->{dbstat
}->{$db}->{dbh
}->sync(); # flush everything
468 rename $self->{dbstat
}->{$db}->{tmpfilename
}, $filename;
473 $last_atime->{$self->{id
}} = time();
475 $self->{gcount
} = $self->{dbstat
}->{groups
}->{idcount
};
476 $self->{ucount
} = __count_entries
($self->{dbstat
}->{accounts
}->{dbh
});
477 $self->{mcount
} = __count_entries
($self->{dbstat
}->{mails
}->{dbh
});
480 sub __count_entries
{
488 my $status = $dbh->seq($key, $value, R_FIRST
());
490 while ($status == 0) {
492 $status = $dbh->seq($key, $value, R_NEXT
());
499 my ($self, $try) = @_;
501 my $dir = "ldapdb_" . $self->{id
};
502 mkdir "$cachedir/$dir";
504 my $filename = "$cachedir/$dir/mails.db";
506 return if $last_atime->{$self->{id
}} &&
507 PMG
::Utils
::file_older_than
($filename, $last_atime->{$self->{id
}});
510 foreach my $db (@dbs) {
511 my $filename = $self->{dbstat
}->{$db}->{filename
} =
512 "$cachedir/$dir/${db}.db";
513 $self->{dbstat
}->{$db}->{idcount
} = 0;
514 if ($db eq 'memberof') {
515 $self->{dbstat
}->{$db}->{dbh
} =
516 tie
(my %h, 'DB_File', $filename,
517 O_RDONLY
, 0666, $DB_BTREE);
519 $self->{dbstat
}->{$db}->{dbh
} =
520 tie
(my %h, 'DB_File', $filename,
521 O_RDONLY
, 0666, $DB_HASH);
524 if (!$self->{dbstat
}->{$db}->{dbh
} && !$try) {
525 my $err = "ldap error - unable to open database file '$filename': $!";
526 $self->{errors
} .= "$err\n";
527 syslog
('err', $err) if !$self->{dbstat
}->{$db}->{dbh
};
532 $last_atime->{$self->{id
}} = time();
534 $self->{gcount
} = __count_entries
($self->{dbstat
}->{groups
}->{dbh
});
535 $self->{ucount
} = __count_entries
($self->{dbstat
}->{accounts
}->{dbh
});
536 $self->{mcount
} = __count_entries
($self->{dbstat
}->{mails
}->{dbh
});
540 my ($self, $force) = @_;
542 $self->{errors
} = '';
545 # only sync if file is older than 1 hour
547 my $dir = "ldapdb_" . $self->{id
};
548 mkdir "$cachedir/$dir";
549 my $filename = "$cachedir/$dir/mails.db";
552 !PMG
::Utils
::file_older_than
($filename, time() - 3600)) {
558 $self->sync_database();
560 if ($self->{errors
}) {
570 my $dbh = $self->{dbstat
}->{groups
}->{dbh
};
572 return $res if !$dbh;
576 my $status = $dbh->seq($key, $value, R_FIRST
());
578 while ($status == 0) {
579 $res->{$value} = $key;
580 $status = $dbh->seq($key, $value, R_NEXT
());
591 my $dbh = $self->{dbstat
}->{users
}->{dbh
};
593 return $res if !$dbh;
597 my $status = $dbh->seq($key, $value, R_FIRST
());
600 while ($status == 0) {
601 my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $value);
607 $status = $dbh->seq($key, $value, R_NEXT
());
613 sub get_gid_uid_map
{
616 my $dbh = $self->{dbstat
}->{memberof
}->{dbh
};
625 if($dbh->seq($key, $value, R_FIRST
()) == 0) {
627 push @{$map->{$value}}, $key;
628 } while($dbh->seq($key, $value, R_NEXT
()) == 0);
639 my $groups = $self->get_groups();
641 for my $gid (sort keys %$groups) {
643 dn
=> $groups->{$gid},
652 my ($self, $gid) = @_;
656 my $users = $self->get_users();
658 if (!defined($gid)) {
659 $res = [values %$users];
661 my $gid_uid_map = $self->get_gid_uid_map();
662 my $groups = $self->get_groups();
663 die "No such Group ID\n"
664 if !defined($groups->{$gid});
665 my $memberuids = $gid_uid_map->{$gid};
666 for my $uid (@$memberuids) {
667 next if !defined($users->{$uid});
668 push @$res, $users->{$uid};
676 my ($self, $mail) = @_;
678 my $dbhmails = $self->{dbstat
}->{mails
}->{dbh
};
679 my $dbhusers = $self->{dbstat
}->{users
}->{dbh
};
681 return undef if !$dbhmails || !$dbhusers;
688 $dbhmails->get($mail, $cuid);
689 return undef if !$cuid;
692 $dbhusers->get($cuid, $rdata);
693 return undef if !$rdata;
695 my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);
697 push @$res, { primary
=> 1, email
=> $pmail };
701 my $status = $dbhmails->seq($key, $value, R_FIRST
());
703 while ($status == 0) {
704 if ($value == $cuid && $key ne $pmail) {
705 push @$res, { primary
=> 0, email
=> $key };
707 $status = $dbhmails->seq($key, $value, R_NEXT
());
714 my ($self, $mail) = @_;
716 my $dbh = $self->{dbstat
}->{mails
}->{dbh
};
722 $dbh->get($mail, $res);
727 my ($self, $account) = @_;
729 my $dbh = $self->{dbstat
}->{accounts
}->{dbh
};
732 $account = lc($account);
735 $dbh->get($account, $res);
740 my ($self, $group) = @_;
742 my $dbh = $self->{dbstat
}->{groups
}->{dbh
};
746 $dbh->get($group, $res);
750 sub account_has_address
{
751 my ($self, $account, $mail) = @_;
753 my $dbhmails = $self->{dbstat
}->{mails
}->{dbh
};
754 my $dbhaccounts = $self->{dbstat
}->{accounts
}->{dbh
};
755 return 0 if !$dbhmails || !$dbhaccounts;
757 $account = lc($account);
761 $dbhaccounts->get($account, $accid);
765 $dbhmails->get($mail, $mailid);
766 return 0 if !$mailid;
768 return ($accid == $mailid);
772 my ($self, $mail, $group) = @_;
774 my $dbhmails = $self->{dbstat
}->{mails
}->{dbh
};
775 my $dbhgroups = $self->{dbstat
}->{groups
}->{dbh
};
776 my $dbhmemberof = $self->{dbstat
}->{memberof
}->{dbh
};
778 return 0 if !$dbhmails || !$dbhgroups || !$dbhmemberof;
783 $dbhmails->get($mail, $cuid);
787 $dbhgroups->get($group, $groupid);
788 return 0 if !$groupid;
790 my @gida = $dbhmemberof->get_dup($cuid);
792 return grep { $_ eq $groupid } @gida;
796 my ($self, $mail, $scan) = @_;
798 my $dbhmails = $self->{dbstat
}->{mails
}->{dbh
};
799 my $dbhusers = $self->{dbstat
}->{users
}->{dbh
};
801 return undef if !$dbhmails || !$dbhusers;
808 $dbhmails->get($mail, $cuid);
809 return undef if !$cuid;
812 $dbhusers->get($cuid, $rdata);
813 return undef if !$rdata;
815 my ($pmail, $account, $dn) = unpack('n/a* n/a* n/a*', $rdata);
818 $res->{account
} = $account;
819 $res->{pmail
} = $pmail;
824 my $status = $dbhmails->seq($key, $value, R_FIRST
());
827 while ($status == 0) {
828 push @$mails, $key if $value == $cuid;
829 $status = $dbhmails->seq($key, $value, R_NEXT
());
831 $res->{mails
} = $mails;