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