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