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