src/PMG/LDAPCache.pm

   1 package PMG::LDAPCache;
   2
   3 use strict;
   4 use warnings;
   5 use File::Path;
   6 use LockFile::Simple;
   7 use Data::Dumper;
   8 use DB_File;
   9 use Encode qw(encode decode);
  10
  11 use PVE::SafeSyslog;
  12 use PVE::Tools qw(split_list);
  13 use PVE::LDAP;
  14
  15 use PMG::Utils;
  16 use PMG::LDAPConfig;
  17
  18 $DB_HASH->{'cachesize'} = 10000;
  19 $DB_RECNO->{'cachesize'} = 10000;
  20 $DB_BTREE->{'cachesize'} = 10000;
  21 $DB_BTREE->{'flags'} = R_DUP ;
  22
  23 my $cachedir = '/var/lib/pmg';
  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 {
  40     my ($self, %args) = @_;
  41
  42     my $type   = ref($self) || $self;
  43
  44     die "undefined ldap id" if !$args{id};
  45
  46     my $id = $args{id};
  47
  48     if ($ldapcache->{$id}) {
  49         $self = $ldapcache->{$id};
  50     } else {
  51         $ldapcache->{$id} = $self = bless {}, $type;
  52         $self->{id} = $id;
  53     }
  54
  55     my $config_properties = PMG::LDAPConfig::properties();
  56
  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};
  62     }
  63
  64     # split list returns an array not a reference
  65     $self->{accountattr} = [split_list($self->{accountattr})];
  66     $self->{mailattr} = [split_list($self->{mailattr})];
  67     $self->{groupclass} = [split_list($self->{groupclass})];
  68
  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     $self->{verify} = $args{verify};
  78     $self->{cafile} = $args{cafile};
  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
 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
 142
 143     my $attrs = [ @{$self->{mailattr}}, @{$self->{accountattr}}, 'memberOf' ];
 144
 145
 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     }
 152
 153     foreach my $user (@$users) {
 154         my $dn = $user->{dn};
 155
 156         my $umails = {};
 157         my $pmail;
 158
 159         foreach my $attr (@{$self->{mailattr}}) {
 160             next if !$user->{attributes}->{$attr};
 161             foreach my $mail (@{$user->{attributes}->{$attr}}) {
 162                 $mail = lc($mail);
 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
 165                 $mail =~ s/^smtp[\:\$]//gs;
 166
 167                 next if $mail =~ m/[\{\}\\\/]/ || $mail !~ m/^\S+\@\S+$/;
 168                 # exclude sip and x500 addresses in proxyAddresses http://archive.today/XIerB
 169                 next if $mail =~ m/^(sip|x500)[\:\$]/;
 170
 171                 $umails->{$mail} = 1;
 172                 $pmail = $mail if !$pmail; # use first one as primary mail
 173             }
 174         }
 175         my $addresses = [ keys %$umails ];
 176
 177         next if !$pmail; # account has no email addresses
 178
 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         }
 185
 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);
 190
 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);
 195             }
 196         }
 197
 198         foreach my $mail (@$addresses) {
 199             $self->{dbstat}->{mails}->{dbh}->put($mail, $cuid);
 200         }
 201
 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);
 209                 }
 210                 $self->{dbstat}->{memberof}->{dbh}->put($cuid, $cgid);
 211             }
 212         }
 213     }
 214 }
 215
 216 sub querygroups {
 217     my ($self, $ldap) = @_;
 218
 219     return undef if !$self->{groupbasedn};
 220
 221     my $groups = eval { PVE::LDAP::query_groups($ldap, $self->{groupbasedn}, $self->{groupclass}) };
 222     if (my $err = $@) {
 223         $self->{errors} .= "$err\n";
 224         syslog('err', $err);
 225         return;
 226     }
 227
 228     foreach my $group (@$groups) {
 229         my $dn = $group->{dn};
 230
 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         }
 237
 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             }
 245
 246             $self->{dbstat}->{memberof}->{dbh}->put($cuid, $cgid);
 247         }
 248     }
 249 }
 250
 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
 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';
 265         }
 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
 277 sub ldap_connect_and_bind {
 278      my ($self) = @_;
 279
 280      my $ldap =  eval { $self->ldap_connect() };
 281      die "Can't bind to ldap server '$self->{id}': " . ($@) . "\n" if $@;
 282
 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);
 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
 297 sub sync_database {
 298     my ($self) = @_;
 299
 300     my $dir = "ldapdb_" .  $self->{id};
 301     mkdir "$cachedir/$dir";
 302
 303     # open ldap connection
 304
 305     my $ldap;
 306
 307     eval { $ldap = $self->ldap_connect_and_bind(); };
 308     if (my $err = $@) {
 309         $self->{errors} .= "$err\n";
 310         syslog('err', $err);
 311         return;
 312     }
 313
 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
 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
 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     };
 352     if (my $err = $@) {
 353         $error_cleanup->();
 354         $self->{errors} .= $err;
 355         syslog('err', $err);
 356         return;
 357     }
 358
 359     $self->querygroups ($ldap) if $self->{groupbasedn};
 360
 361     $self->queryusers($ldap) if !$self->{errors};
 362
 363     $ldap->unbind;
 364
 365     if ($self->{errors}) {
 366         $error_cleanup->();
 367         return;
 368     }
 369
 370     my $lock = lockdir($self->{id});
 371
 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     }
 379
 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     }
 386
 387     $lock->release;
 388
 389     $last_atime->{$self->{id}} = time();
 390
 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});
 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
 481 sub get_groups {
 482     my ($self) = @_;
 483
 484     my $res = {};
 485
 486     my $dbh = $self->{dbstat}->{groups}->{dbh};
 487
 488     return $res if !$dbh;
 489
 490     my $key = 0 ;
 491     my $value = "" ;
 492     my $status = $dbh->seq($key, $value, R_FIRST());
 493
 494     while ($status == 0) {
 495         $res->{$value} = PMG::Utils::try_decode_utf8($key);
 496         $status = $dbh->seq($key, $value, R_NEXT());
 497     }
 498
 499     return $res;
 500 }
 501
 502 sub get_users {
 503     my ($self) = @_;
 504
 505     my $res = {};
 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);
 518         $res->{$key} = {
 519             pmail => PMG::Utils::try_decode_utf8($pmail),
 520             account => PMG::Utils::try_decode_utf8($account),
 521             dn => PMG::Utils::try_decode_utf8($dn),
 522         };
 523         $status = $dbh->seq($key, $value, R_NEXT());
 524     }
 525
 526     return $res;
 527 }
 528
 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
 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
 599     $mail = encode('UTF-8', lc($mail));
 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
 613     push @$res, { primary => 1, email => PMG::Utils::try_decode_utf8($pmail) };
 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) {
 621             push @$res, { primary => 0, email => PMG::Utils::try_decode_utf8($key) };
 622         }
 623         $status = $dbhmails->seq($key, $value, R_NEXT());
 624     }
 625
 626     return $res;
 627 }
 628
 629 sub mail_exists {
 630     my ($self, $mail) = @_;
 631
 632     my $dbh = $self->{dbstat}->{mails}->{dbh};
 633     return 0 if !$dbh;
 634
 635     $mail = encode('UTF-8', lc($mail));
 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
 648     $account = encode('UTF-8', lc($account));
 649
 650     my $res;
 651     $dbh->get($account, $res);
 652     return $res;
 653 }
 654
 655 sub group_exists {
 656     my ($self, $group) = @_;
 657
 658     my $dbh = $self->{dbstat}->{groups}->{dbh};
 659     return 0 if !$dbh;
 660
 661     $group = encode('UTF-8', $group);
 662
 663     my $res;
 664     $dbh->get($group, $res);
 665     return $res;
 666 }
 667
 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
 675     $account = encode('UTF-8', lc($account));
 676     $mail = encode('UTF-8', lc($mail));
 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
 698     $mail = encode('UTF-8', lc($mail));
 699
 700     my $cuid;
 701     $dbhmails->get($mail, $cuid);
 702     return 0 if !$cuid;
 703
 704     $group = encode('UTF-8', $group);
 705
 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
 723     $mail = encode('UTF-8', lc($mail));
 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;