PMG/LDAPCache.pm

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