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