ldap-server/ldap-server-lib.pl

   1 # Functions for configuring and talking to an LDAP server
   2
   3 BEGIN { push(@INC, ".."); };
   4 use WebminCore;
   5 &init_config();
   6 %access = &get_module_acl();
   7
   8 eval "use Net::LDAP";
   9 if ($@) { $net_ldap_error = $@; }
  10
  11 @search_attrs = ( 'objectClass', 'cn', 'dn', 'uid' );
  12 @acl_dn_styles = ( 'regex', 'base', 'one', 'subtree', 'children' );
  13 @acl_access_levels = ( 'none', 'auth', 'compare', 'search', 'read', 'write' );
  14
  15 # connect_ldap_db()
  16 # Attempts to connect to an LDAP server. Returns a handle on success or an
  17 # error message string on failure.
  18 sub connect_ldap_db
  19 {
  20 return $connect_ldap_db_cache if (defined($connect_ldap_db_cache));
  21
  22 # Do we have the module?
  23 if ($net_ldap_error) {
  24         local $msg = &text('connect_emod', "<tt>Net::LDAP</tt>",
  25                      "<pre>".&html_escape($net_ldap_error)."</pre>");
  26         if (foreign_available("cpan")) {
  27                 $msg .= "<p>\n";
  28                 $msg .= &text('connect_cpan', "Net::LDAP",
  29                       "../cpan/download.cgi?source=3&cpan=Net::LDAP&".
  30                       "cpan=Convert::ASN1&".
  31                       "return=../$module_name/&returndesc=".
  32                       &urlize($module_info{'desc'}));
  33                 }
  34         return $msg;
  35         }
  36
  37 # Work out server name, login and TLS mode
  38 local ($server, $port, $user, $pass, $ssl);
  39 if ($config{'server'}) {
  40         # Remote box .. everything must be set
  41         $server = $config{'server'};
  42         &to_ipaddress($server) || return &text('connect_eserver',
  43                                                "<tt>$server</tt>");
  44         $port = $config{'port'};
  45         $user = $config{'user'};
  46         $user || return $text{'connect_euser'};
  47         $pass = $config{'pass'};
  48         $pass || return $text{'connect_epass'};
  49         }
  50 else {
  51         # Get from slapd.conf
  52         -e $config{'config_file'} || return &text('connect_efile',
  53                                         "<tt>$config{'config_file'}</tt>");
  54         $server = "127.0.0.1";
  55         $port = $config{'port'};
  56         $user = $config{'user'};
  57         $pass = $config{'pass'};
  58         if (&get_config_type() == 1) {
  59                 # Find defaults from slapd.conf
  60                 local $conf = &get_config();
  61                 $port ||= &find_value("port", $conf);
  62                 $user ||= &find_value("rootdn", $conf);
  63                 $pass ||= &find_value("rootpw", $conf);
  64                 }
  65         else {
  66                 # Find defaults from LDIF-format data
  67                 local $conf = &get_ldif_config();
  68                 $defdb = &get_default_db();
  69                 $port ||= &find_ldif_value("olcPort", $conf, $defdb);
  70                 $user ||= &find_ldif_value("olcRootDN", $conf, $defdb);
  71                 $pass ||= &find_ldif_value("olcRootPW", $conf, $defdb);
  72                 }
  73         $user || return $text{'connect_euser2'};
  74         $pass =~ /^\{/ && return $text{'connect_epass3'};
  75         }
  76 $ssl = $config{'ssl'};
  77
  78 # Call generic LDAP client function to connect
  79 &foreign_require("ldap-client", "ldap-client-lib.pl");
  80 local @ssls = $ssl eq "" ? ( 1, 2, 0 ) : ( $ssl );
  81 local $ldap;
  82 foreach $ssl (@ssls) {
  83         my $sslport = $port ? $port : $ssl == 1 ? 636 : 389;
  84         $ldap = &ldap_client::generic_ldap_connect($server, $sslport, $ssl,
  85                                                    $user, $pass);
  86         if (!ref($ldap)) {
  87                 # Failed .. but try again in other SSL mode
  88                 if ($ssl == $ssls[$#ssls]) {
  89                         return $ldap;
  90                         }
  91                 }
  92         }
  93 $ldap || return "This can't happen!";
  94
  95 $connect_ldap_db = $ldap;
  96 return $ldap;
  97 }
  98
  99 # get_default_db()
 100 # For LDIF format configs, returns the config DN for the default database
 101 sub get_default_db
 102 {
 103 local @poss = ( "olcDatabase={1}bdb,cn=config",
 104                 "olcDatabase={1}hdb,cn=config" );
 105 foreach my $p (@poss) {
 106         local @w = split(/,/, $p);
 107         if (-r $config{'config_file'}."/".join("/", reverse(@w)).".ldif") {
 108                 return $p;
 109                 }
 110         }
 111 return $poss[$#poss];
 112 }
 113
 114 sub get_config_db
 115 {
 116 return "cn=config";
 117 }
 118
 119 # local_ldap_server()
 120 # Returns 1 if OpenLDAP is installed locally and we are configuring it, 0 if
 121 # remote, or -1 the binary is missing, -2 if the config is missing
 122 sub local_ldap_server
 123 {
 124 if (!$config{'server'} || &to_ipaddress($config{'server'}) eq '127.0.0.1' ||
 125     &to_ipaddress($config{'server'}) eq &to_ipaddress(&get_system_hostname())) {
 126         # Local .. but is it installed?
 127         if (!-r $config{'config_file'} &&
 128             -r $config{'alt_config_file'}) {
 129                 &copy_source_dest($config{'alt_config_file'},
 130                                   $config{'config_file'});
 131                 }
 132         return !&has_command($config{'slapd'}) ? -1 :
 133                !&get_config_type() ? -2 : 1;
 134         }
 135 return 0;
 136 }
 137
 138 # get_ldap_server_version()
 139 # Returns the local LDAP server version number
 140 sub get_ldap_server_version
 141 {
 142 return undef if (&local_ldap_server() != 1);
 143 local $out = &backquote_with_timeout(
 144                 "$config{'slapd'} -V -d 1 2>&1 </dev/null", 1, 1, 1);
 145 if ($out =~ /slapd\s+([0-9\.]+)/) {
 146         return $1;
 147         }
 148 # Fall back to -d flag
 149 local $out = &backquote_with_timeout("$config{'slapd'} -d 255 2>&1 </dev/null",
 150                                      1, 1, 1);
 151 if ($out =~ /slapd\s+([0-9\.]+)/) {
 152         return $1;
 153         }
 154 return undef;
 155 }
 156
 157 # get_config_type()
 158 # Returns 2 for new-style LDIF format directory, 1 for slapd.conf, 0 if unknown
 159 sub get_config_type
 160 {
 161 if (-d $config{'config_file'} && -r "$config{'config_file'}/cn=config.ldif") {
 162         return 2;
 163         }
 164 elsif (-r $config{'config_file'}) {
 165         return 1;
 166         }
 167 else {
 168         return 0;
 169         }
 170 }
 171
 172 # get_config([file])
 173 # Returns an array ref of LDAP server configuration settings
 174 sub get_config
 175 {
 176 local $file = $_[0] || $config{'config_file'};
 177 if (defined($get_config_cache{$file})) {
 178         return $get_config_cache{$file};
 179         }
 180 local @rv;
 181 local $lnum = 0;
 182 open(CONF, $file);
 183 while(<CONF>) {
 184         s/\r|\n//g;
 185         s/^\s*#.*$//;
 186         if (/^(\S+)\s*(.*)$/) {
 187                 # Found a directive
 188                 local $dir = { 'name' => $1,
 189                                'line' => $lnum,
 190                                'eline' => $lnum,
 191                                'file' => $file };
 192                 local $value = $2;
 193                 $dir->{'values'} = [ &split_quoted_string($value) ];
 194                 push(@rv, $dir);
 195                 }
 196         elsif (/^\s+(\S.*)$/ && @rv) {
 197                 # Found a continuation line, with extra values
 198                 local $value = $1;
 199                 push(@{$rv[$#rv]->{'values'}}, &split_quoted_string($value));
 200                 $rv[$#rv]->{'eline'} = $lnum;
 201                 }
 202         $lnum++;
 203         }
 204 close(CONF);
 205 $get_config_cache{$file} = \@rv;
 206 return \@rv;
 207 }
 208
 209 # find(name, &config)
 210 # Returns the structure(s) with some name
 211 sub find
 212 {
 213 local ($name, $conf) = @_;
 214 local @rv = grep { lc($_->{'name'}) eq lc($name) } @$conf;
 215 return wantarray ? @rv : $rv[0];
 216 }
 217
 218 # find_value(name, &config)
 219 # Returns the directive values with some name
 220 sub find_value
 221 {
 222 local ($name, $conf) = @_;
 223 local @rv = map { $_->{'values'}->[0] } &find(@_);
 224 return wantarray ? @rv : $rv[0];
 225 }
 226
 227 # find_ldif(name, &config, [class])
 228 # Returns the structures with some name and optionally class in the LDIF
 229 # configuration array ref
 230 sub find_ldif
 231 {
 232 local ($name, $conf, $cls) = @_;
 233 local @rv = grep { lc($_->{'name'}) eq lc($name) } @$conf;
 234 if ($cls) {
 235         @rv = grep { lc($_->{'class'}) eq lc($cls) } @rv;
 236         }
 237 return wantarray ? @rv : $rv[0];
 238 }
 239
 240 # find_ldif_value(name, &config, [class])
 241 # Returns the values with some name and optionally class in the LDIF
 242 # configuration array ref
 243 sub find_ldif_value
 244 {
 245 local ($name, $conf, $cls) = @_;
 246 local @rv = map { $_->{'values'}->[0] } &find_ldif(@_);
 247 return wantarray ? @rv : $rv[0];
 248 }
 249
 250 # get_ldif_config()
 251 # Parses the new LDIF-format config files into a list ref
 252 sub get_ldif_config
 253 {
 254 if (defined($get_ldif_config_cache)) {
 255         return $get_ldif_config_cache;
 256         }
 257 local @rv;
 258 foreach my $file (&recursive_find_ldif($config{'config_file'})) {
 259         local $lnum = 0;
 260         local $cls = $file;
 261         $cls =~ s/^\Q$config{'config_file'}\/\E//;
 262         $cls =~ s/\.ldif$//;
 263         $cls = join(",", reverse(split(/\//, $cls)));
 264         open(CONFIG, $file);
 265         while(<CONFIG>) {
 266                 s/\r|\n//g;
 267                 s/^#.*$//;
 268                 if (/^(\S+):\s*(.*)/) {
 269                         # Start of a directive
 270                         local $dir = { 'file' => $file,
 271                                        'line' => $lnum,
 272                                        'eline' => $lnum,
 273                                        'class' => $cls,
 274                                        'name' => $1 };
 275                         local $value = $2;
 276                         $dir->{'values'} = [ &split_quoted_string($value) ];
 277                         $dir->{'value'} = $value;
 278                         push(@rv, $dir);
 279                         }
 280                 elsif (/^\s(\s*\S.*)$/ && @rv && $rv[$#rv]->{'file'} eq $file) {
 281                         # Continuation line
 282                         local $dir = $rv[$#rv];
 283                         $dir->{'value'} .= $1;
 284                         $dir->{'values'} =
 285                                 [ &split_quoted_string($dir->{'value'}) ];
 286                         $dir->{'eline'} = $lnum;
 287                         }
 288                 $lnum++;
 289                 }
 290         close(CONFIG);
 291         }
 292 $get_ldif_config_cache = \@rv;
 293 return $get_ldif_config_cache;
 294 }
 295
 296 # recursive_find_ldif(dir)
 297 # Find all .ldif files under some directory
 298 sub recursive_find_ldif
 299 {
 300 local ($dir) = @_;
 301 local @rv;
 302 opendir(LDIFDIR, $dir);
 303 local @files = readdir(LDIFDIR);
 304 closedir(LDIFDIR);
 305 foreach my $f (@files) {
 306         next if ($f eq "." || $f eq "..");
 307         local $path = "$dir/$f";
 308         if (-r $path && $path =~ /\.ldif$/) {
 309                 push(@rv, $path);
 310                 }
 311         elsif (-d $path) {
 312                 push(@rv, &recursive_find_ldif($path));
 313                 }
 314         }
 315 return @rv;
 316 }
 317
 318 # save_directive(&config, name, value|&values|&directive, ...)
 319 # Update the value(s) of some entry in the config file
 320 sub save_directive
 321 {
 322 local ($conf, $name, @values) = @_;
 323 local @old = &find($name, $conf);
 324 local $lref = &read_file_lines(@old ? $old[0]->{'file'}
 325                                     : $config{'config_file'});
 326 local $changed;
 327 for(my $i=0; $i<@old || $i<@values; $i++) {
 328         local ($line, @unqvalues, @qvalues, $len);
 329         if (defined($values[$i])) {
 330                 # Work out new line
 331                 @unqvalues = ref($values[$i]) eq 'ARRAY' ?
 332                                 @{$values[$i]} :
 333                              ref($values[$i]) eq 'HASH' ?
 334                                 @{$values[$i]->{'values'}} :
 335                                 ( $values[$i] );
 336                 @qvalues = map { /^[^'" ]+$/ ? $_ :
 337                                  /"/ ? "'$_'" : "\"$_\"" } @unqvalues;
 338                 $line = join(" ", $name, @qvalues);
 339                 }
 340         if (defined($old[$i])) {
 341                 $len = $old[$i]->{'eline'} - $old[$i]->{'line'} + 1;
 342                 }
 343         if (defined($old[$i]) && defined($values[$i])) {
 344                 # Update some directive
 345                 splice(@$lref, $old[$i]->{'line'}, $len, $line);
 346                 if (&indexof($values[$i], @$conf) < 0) {
 347                         $old[$i]->{'values'} = \@unqvalues;
 348                         }
 349                 $old[$i]->{'eline'} = $old[$i]->{'line'};
 350                 $changed = $old[$i];
 351                 if ($len != 1) {
 352                         # Renumber to account for shrunked directive
 353                         foreach my $c (@$conf) {
 354                                 if ($c->{'line'} > $old[$i]->{'line'}) {
 355                                         $c->{'line'} -= $len-1;
 356                                         $c->{'eline'} -= $len-1;
 357                                         }
 358                                 }
 359                         }
 360                 }
 361         elsif (defined($old[$i]) && !defined($values[$i])) {
 362                 # Remove some directive (from cache too)
 363                 splice(@$lref, $old[$i]->{'line'}, $len);
 364                 local $idx = &indexof($old[$i], @$conf);
 365                 splice(@$conf, $idx, 1) if ($idx >= 0);
 366                 foreach my $c (@$conf) {
 367                         if ($c->{'line'} > $old[$i]->{'line'}) {
 368                                 $c->{'line'} -= $len;
 369                                 $c->{'eline'} -= $len;
 370                                 }
 371                         }
 372                 }
 373         elsif (!defined($old[$i]) && defined($values[$i])) {
 374                 # Add some directive
 375                 if ($changed) {
 376                         # After last one of the same name
 377                         local $newdir = { 'name' => $name,
 378                                           'line' => $changed->{'line'}+1,
 379                                           'eline' => $changed->{'line'}+1,
 380                                           'values' => \@unqvalues };
 381                         foreach my $c (@$conf) {
 382                                 $c->{'line'}++ if ($c->{'line'} >
 383                                                    $changed->{'line'});
 384                                 }
 385                         $changed = $newdir;
 386                         splice(@$lref, $newdir->{'line'}, 0, $line);
 387                         push(@$conf, $newdir);
 388                         }
 389                 else {
 390                         # At end of file, or over commented directive
 391                         my $cmtline = undef;
 392                         for(my $i=0; $i<@$lref; $i++) {
 393                                 if ($lref->[$i] =~ /^\s*\#+\s*(\S+)/ &&
 394                                     $1 eq $name) {
 395                                         $cmtline = $i;
 396                                         last;
 397                                         }
 398                                 }
 399                         if (defined($cmtline)) {
 400                                 # Over comment
 401                                 local $newdir = { 'name' => $name,
 402                                                   'line' => $cmtline,
 403                                                   'eline' => $cmtline,
 404                                                   'values' => \@unqvalues };
 405                                 $lref->[$cmtline] = $line;
 406                                 push(@$conf, $newdir);
 407                                 }
 408                         else {
 409                                 # Really at end
 410                                 local $newdir = { 'name' => $name,
 411                                                   'line' => scalar(@$lref),
 412                                                   'eline' => scalar(@$lref),
 413                                                   'values' => \@unqvalues };
 414                                 push(@$lref, $line);
 415                                 push(@$conf, $newdir);
 416                                 }
 417                         }
 418                 }
 419         }
 420 }
 421
 422 # save_ldif_directive(&config, name, class, value|&values|&directive, ...)
 423 # Update the value(s) of some entry in the LDIF format config file
 424 sub save_ldif_directive
 425 {
 426 local ($conf, $name, $cls, @values) = @_;
 427 local @old = &find_ldif($name, $conf, $cls);
 428 local $file;
 429 if (@old) {
 430         $file = $old[0]->{'file'};
 431         }
 432 else {
 433         local ($first) = grep { lc($_->{'class'}) eq lc($cls) } @$conf;
 434         $first || &error("No LDIF-format config file found for $cls");
 435         $file = $first->{'file'};
 436         }
 437 local $lref = &read_file_lines($file);
 438 for(my $i=0; $i<@old || $i<@values; $i++) {
 439         local ($line, @unqvalues, @qvalues, $len);
 440         local $oldlen = defined($old[$i]) ?
 441                 $old[$i]->{'eline'} - $old[$i]->{'line'} + 1 : undef;
 442         if (defined($values[$i])) {
 443                 # Work out new line
 444                 @unqvalues = ref($values[$i]) eq 'ARRAY' ?
 445                                 @{$values[$i]} :
 446                              ref($values[$i]) eq 'HASH' ?
 447                                 @{$values[$i]->{'values'}} :
 448                                 ( $values[$i] );
 449                 $line = $name.": ".join(" ", @unqvalues);
 450                 }
 451         if (defined($old[$i]) && defined($values[$i])) {
 452                 # Update some directive
 453                 $lref->[$old[$i]->{'line'}] = $line;
 454                 if (&indexof($values[$i], @$conf) < 0) {
 455                         $old[$i]->{'values'} = \@unqvalues;
 456                         }
 457                 $old[$i]->{'eline'} = $old[$i]->{'line'};
 458                 if ($oldlen > 1) {
 459                         # Remove extra old lines
 460                         splice(@$lref, $old[$i]->{'line'}+1, $oldlen-1);
 461                         foreach my $c (@$conf) {
 462                                 if ($c->{'line'} > $old[$i]->{'line'}) {
 463                                         $c->{'line'} -= $oldlen - 1;
 464                                         $c->{'eline'} -= $oldlen - 1;
 465                                         }
 466                                 }
 467                         }
 468                 }
 469         elsif (defined($old[$i]) && !defined($values[$i])) {
 470                 # Remove some directive (from cache too)
 471                 splice(@$lref, $old[$i]->{'line'}, $oldlen);
 472                 local $idx = &indexof($old[$i], @$conf);
 473                 splice(@$conf, $idx, 1) if ($idx >= 0);
 474                 foreach my $c (@$conf) {
 475                         if ($c->{'line'} > $old[$i]->{'line'}) {
 476                                 $c->{'line'} -= $oldlen;
 477                                 $c->{'eline'} -= $oldlen;
 478                                 }
 479                         }
 480                 }
 481         elsif (!defined($old[$i]) && defined($values[$i])) {
 482                 # Add some directive
 483                 local $newdir = { 'name' => $name,
 484                                   'line' => scalar(@$lref),
 485                                   'eline' => scalar(@$lref),
 486                                   'file' => $file,
 487                                   'values' => \@unqvalues };
 488                 push(@$lref, $line);
 489                 push(@$conf, $newdir);
 490                 }
 491         }
 492 }
 493
 494 # start_ldap_server()
 495 # Attempts to start the LDAP server process. Returns undef on success or an
 496 # error message on failure.
 497 sub start_ldap_server
 498 {
 499 local $cmd = $config{'start_cmd'} || $config{'slapd'};
 500 local $out = &backquote_logged("$cmd 2>&1 </dev/null");
 501 return $? || $out =~ /line\s+(\d+)/ ?
 502         &text('start_ecmd', "<tt>$cmd</tt>",
 503               "<pre>".&html_escape($out)."</pre>") : undef;
 504 }
 505
 506 # stop_ldap_server()
 507 # Attempts to stop the running LDAP server. Returns undef on success or an
 508 # error message on failure.
 509 sub stop_ldap_server
 510 {
 511 if ($config{'stop_cmd'}) {
 512         local $out = &backquote_logged("$config{'stop_cmd'} 2>&1 </dev/null");
 513         return $? ? &text('stop_ecmd', "<tt>$cmd</tt>",
 514                           "<pre>".&html_escape($out)."</pre>") : undef;
 515         }
 516 else {
 517         local $pid = &is_ldap_server_running();
 518         $pid || return $text{'stop_egone'};
 519         return kill('TERM', $pid) ? undef : &text('stop_ekill', $!);
 520         }
 521 }
 522
 523 # apply_configuration()
 524 # Apply the current LDAP server configuration with a HUP signal
 525 sub apply_configuration
 526 {
 527 if ($config{'apply_cmd'}) {
 528         local $out = &backquote_logged("$config{'apply_cmd'} 2>&1 </dev/null");
 529         return $? ? &text('apply_ecmd', "<tt>$cmd</tt>",
 530                           "<pre>".&html_escape($out)."</pre>") : undef;
 531         }
 532 else {
 533         local $err = &stop_ldap_server();
 534         return $err if ($err);
 535         return &start_ldap_server();
 536         }
 537 }
 538
 539 # get_ldap_server_pidfile()
 540 # Returns the LDAP server's PID file, or undef if not found
 541 sub get_ldap_server_pidfile
 542 {
 543 if (&get_config_type() == 1) {
 544         local $conf = &get_config();
 545         return &find_value("pidfile", $conf);
 546         }
 547 else {
 548         local $conf = &get_ldif_config();
 549         return &find_value("olcPidFile", $conf);
 550         }
 551 }
 552
 553 # is_ldap_server_running()
 554 # Returns the process ID of the running LDAP server, or undef
 555 sub is_ldap_server_running
 556 {
 557 local $pidfile = &get_ldap_server_pidfile();
 558 if ($pidfile) {
 559         return &check_pid_file($pidfile);
 560         }
 561 return undef;
 562 }
 563
 564 # ldap_error(rv)
 565 # Converts a bad LDAP response into an error message
 566 sub ldap_error
 567 {
 568 local ($rv) = @_;
 569 if (!$rv) {
 570         return $text{'euknown'};
 571         }
 572 elsif ($rv->code) {
 573         return $rv->error || "Code ".$rv->code;
 574         }
 575 else {
 576         return undef;
 577         }
 578 }
 579
 580 # valid_pem_file(file, type)
 581 sub valid_pem_file
 582 {
 583 local ($file, $type) = @_;
 584 local $data = &read_file_contents($file);
 585 if ($type eq 'key') {
 586         return $data =~ /\-{5}BEGIN RSA PRIVATE KEY\-{5}/ &&
 587                $data =~ /\-{5}END RSA PRIVATE KEY\-{5}/;
 588         }
 589 else {
 590         return $data =~ /\-{5}BEGIN CERTIFICATE\-{5}/ &&
 591                $data =~ /\-{5}END CERTIFICATE\-{5}/;
 592         }
 593 }
 594
 595 sub get_config_dir
 596 {
 597 if (-d $config{'config_file'}) {
 598         return $config{'config_file'};
 599         }
 600 if ($config{'config_file'} =~ /^(\S+)\/([^\/]+)$/) {
 601         return $1;
 602         }
 603 return undef;
 604 }
 605
 606 # list_schema_files()
 607 # Returns a list of hashes, each of which describes one possible schema file
 608 sub list_schema_files
 609 {
 610 local @rv;
 611 opendir(SCHEMA, $config{'schema_dir'});
 612 foreach my $f (readdir(SCHEMA)) {
 613         if ($f =~ /^(\S+)\.schema$/) {
 614                 local $name = $1;
 615                 local $lref = &read_file_lines("$config{'schema_dir'}/$f", 1);
 616                 local $desc;
 617                 foreach my $l (@$lref) {
 618                         if ($l !~ /^\#+\s*\$/ && $l =~ /^\#+\s*([^#]\S.*)/) {
 619                                 $desc .= $1." ";        # Comment
 620                                 }
 621                         elsif ($l !~ /\S/) {
 622                                 last;                   # End of header
 623                                 }
 624                         else {
 625                                 last if ($desc);        # End of comment
 626                                 }
 627                         }
 628                 $desc ||= $text{'schema_desc_'.$name};
 629                 push(@rv, { 'file' => "$config{'schema_dir'}/$f",
 630                             'name' => $name,
 631                             'desc' => $desc,
 632                             'core' => $name eq 'core' });
 633                 }
 634         }
 635 closedir(SCHEMA);
 636 return sort { $b->{'core'} <=> $a->{'core'} ||
 637               $a->{'name'} cmp $b->{'name'} } @rv;
 638 }
 639
 640 # check_ldap_permissions()
 641 # Returns 1 if ownership of the data dir is correct, 0 if not, -1 if not known
 642 sub check_ldap_permissions
 643 {
 644 local @uinfo;
 645 if ($config{'data_dir'} && $config{'ldap_user'} &&
 646     scalar(@uinfo = getpwnam($config{'ldap_user'}))) {
 647         opendir(DATADIR, $config{'data_dir'});
 648         local @datafiles = grep { !/^\./ } readdir(DATADIR);
 649         closedir(DATADIR);
 650         if (@datafiles) {
 651                 local @st = stat("$config{'data_dir'}/$datafiles[0]");
 652                 if ($st[4] != $uinfo[2]) {
 653                         return 0;
 654                         }
 655                 }
 656         return 1;
 657         }
 658 else {
 659         return -1;
 660         }
 661 }
 662
 663 # parse_ldap_access(&directive)
 664 # Convert a slapd.conf directive into a more usable access control rule hash
 665 sub parse_ldap_access
 666 {
 667 local ($a) = @_;
 668 local @v = @{$a->{'values'}};
 669 local $p = { };
 670 if ($v[0] =~ /^\{(\d+)\}/) {
 671         $p->{'order'} = $1;
 672         }
 673 shift(@v);                      # Remove to or {x}to
 674 if ($v[0] !~ /^(filter|attrs)=/) {
 675         $p->{'what'} = shift(@v);       # Object
 676         }
 677 if ($v[0] =~ /^filter=(\S+)/) {
 678         # Filter added to what
 679         $p->{'filter'} = $1;
 680         shift(@v);
 681         }
 682 if ($v[0] =~ /^attrs=(\S+)/) {
 683         # Attributes added to what
 684         $p->{'attrs'} = $1;
 685         shift(@v);
 686         }
 687 local @descs;
 688 while(@v) {
 689         shift(@v);              # Remove by
 690         local $by = { 'who' => shift(@v),
 691                       'access' => shift(@v) };
 692         while(@v && $v[0] ne 'by') {
 693                 push(@{$by->{'control'}}, shift(@v));
 694                 }
 695         local $whodesc = $by->{'who'} eq 'self' ? $text{'access_self'} :
 696                          $by->{'who'} eq 'users' ? $text{'access_users'} :
 697                          $by->{'who'} eq 'anonymous' ? $text{'access_anon'} :
 698                          $by->{'who'} eq '*' ? $text{'access_all'} :
 699                                                "<tt>$by->{'who'}</tt>";
 700         local $adesc = $text{'access_'.$by->{'access'}} ||
 701                        "<tt>$by->{'access'}</tt>";
 702         $adesc = ucfirst($adesc) if (!@descs);
 703         push(@descs, &text('access_desc', $whodesc, $adesc));
 704         push(@{$p->{'by'}}, $by);
 705         }
 706 $p->{'bydesc'} = join(", ", @descs);
 707 if ($p->{'what'} eq '*' || $p->{'what'} eq '') {
 708         $p->{'whatdesc'} = $text{'access_any'};
 709         }
 710 elsif ($p->{'what'} =~ /^dn(\.[^=]+)?="(.*)"$/ ||
 711        $p->{'what'} =~ /^dn(\.[^=]+)?=(.*)$/) {
 712         $p->{'whatdesc'} = $2 ne '' ? "<tt>$2</tt>" : $text{'access_nodn'};
 713         }
 714 else {
 715         $p->{'whatdesc'} = $p->{'what'};
 716         }
 717 return $p;
 718 }
 719
 720 # store_ldap_access(&directive, &acl-struct)
 721 # Updates the values of a directive from an ACL structure
 722 sub store_ldap_access
 723 {
 724 local ($a, $p) = @_;
 725 local @v = ( 'to' );
 726 if ($p->{'order'}) {
 727         $v[0] = "{".$p->{'order'}."}".$v[0];
 728         }
 729 push(@v, $p->{'what'});
 730 if ($p->{'filter'}) {
 731         push(@v, "filter=$p->{'filter'}");
 732         }
 733 if ($p->{'attrs'}) {
 734         push(@v, "attrs=$p->{'attrs'}");
 735         }
 736 foreach my $b (@{$p->{'by'}}) {
 737         push(@v, "by");
 738         push(@v, $b->{'who'});
 739         push(@v, $b->{'access'});
 740         push(@v, @{$b->{'control'}});
 741         }
 742 $a->{'values'} = \@v;
 743 }
 744
 745 # can_get_ldap_protocols()
 746 # Returns 1 if we can get the protocols this LDAP server will serve. Depends
 747 # on the OS, as this is often set in the init script.
 748 sub can_get_ldap_protocols
 749 {
 750 return $gconfig{'os_type'} eq 'redhat-linux' &&
 751         -r "/etc/sysconfig/ldap" ||
 752        $gconfig{'os_type'} eq 'debian-linux' &&
 753         -r "/etc/default/slapd" &&
 754         &get_ldap_protocols();
 755 }
 756
 757 # get_ldap_protocols()
 758 # Returns a hash from known LDAP protcols (like ldap, ldaps and ldapi) to
 759 # flags indicating if they are enabled
 760 sub get_ldap_protocols
 761 {
 762 if ($gconfig{'os_type'} eq 'redhat-linux') {
 763         # Stored in /etc/sysconfig/ldap file
 764         local %ldap;
 765         &read_env_file("/etc/init.d/ldap", \%ldap);
 766         &read_env_file("/etc/sysconfig/ldap", \%ldap);
 767         if (!$ldap{'SLAPD_LDAP'} &&
 768             !$ldap{'SLAPD_LDAPI'} &&
 769             !$ldap{'SLAPD_LDAPS'}) {
 770                 &read_env_file("/etc/sysconfig/ldap", \%ldap, 1);
 771                 }
 772         return { 'ldap' => $ldap{'SLAPD_LDAP'} eq 'yes' ? 1 : 0,
 773                  'ldapi' => $ldap{'SLAPD_LDAPI'} eq 'yes' ? 1 : 0,
 774                  'ldaps' => $ldap{'SLAPD_LDAPS'} eq 'yes' ? 1 : 0,
 775                };
 776         }
 777 elsif ($gconfig{'os_type'} eq 'debian-linux') {
 778         # Stored in /etc/default/slapd, in SLAPD_SERVICES line
 779         local %ldap;
 780         &read_env_file("/etc/default/slapd", \%ldap);
 781         if ($ldap{'SLAPD_SERVICES'}) {
 782                 local @servs = split(/\s+/, $ldap{'SLAPD_SERVICES'});
 783                 local $rv = { 'ldap' => 0, 'ldaps' => 0, 'ldapi' => 0 };
 784                 foreach my $w (@servs) {
 785                         if ($w =~ /^(ldap|ldaps|ldapi):\/\/\/$/) {
 786                                 $rv->{$1} = 1;
 787                                 }
 788                         else {
 789                                 # Unknown protocol spec .. ignore
 790                                 return undef;
 791                                 }
 792                         }
 793                 return $rv;
 794                 }
 795         else {
 796                 # Default is non-encrypted only
 797                 return { 'ldap' => 1, 'ldaps' => 0, 'ldapi' => 0 };
 798                 }
 799         }
 800 }
 801
 802 # save_ldap_protocols(&protos)
 803 # Updates the OS-specific file containing enabled LDAP protocols. Also does
 804 # locking on the file.
 805 sub save_ldap_protocols
 806 {
 807 local ($protos) = @_;
 808 if ($gconfig{'os_type'} eq 'redhat-linux') {
 809         # Stored in /etc/sysconfig/ldap file
 810         local %ldap;
 811         &lock_file("/etc/sysconfig/ldap");
 812         &read_env_file("/etc/sysconfig/ldap", \%ldap);
 813         $ldap{'SLAPD_LDAP'} = $protos->{'ldap'} ? 'yes' : 'no'
 814                 if (defined($protos->{'ldap'}));
 815         $ldap{'SLAPD_LDAPI'} = $protos->{'ldapi'} ? 'yes' : 'no'
 816                 if (defined($protos->{'ldapi'}));
 817         $ldap{'SLAPD_LDAPS'} = $protos->{'ldaps'} ? 'yes' : 'no'
 818                 if (defined($protos->{'ldaps'}));
 819         &write_env_file("/etc/sysconfig/ldap", \%ldap);
 820         &unlock_file("/etc/sysconfig/ldap");
 821         }
 822 elsif ($gconfig{'os_type'} eq 'debian-linux') {
 823         # Update /etc/default/slapd SLAPD_SERVICES line
 824         local %ldap;
 825         &lock_file("/etc/default/slapd");
 826         &read_env_file("/etc/default/slapd", \%ldap);
 827         $ldap{'SLAPD_SERVICES'} =
 828             join(" ", map { $_.":///" } grep { $protos->{$_} } keys %$protos);
 829         &write_env_file("/etc/default/slapd", \%ldap);
 830         &unlock_file("/etc/default/slapd");
 831         }
 832 }
 833
 834 sub get_ldap_base
 835 {
 836 if (&get_config_type() == 1) {
 837         my $conf = &get_config();
 838         my $base = &find_value("suffix", $conf);
 839         return $base;
 840         }
 841 elsif (&get_config_type() == 2) {
 842         my $conf = &get_ldif_config();
 843         my $base = &find_ldif_value("olcSuffix", $conf, &get_default_db());
 844         return $base;
 845         }
 846 return undef;
 847 }
 848
 849 # lock_slapd_files()
 850 # Lock all LDAP config file(s)
 851 sub lock_slapd_files
 852 {
 853 if (&get_config_type() == 2) {
 854         @ldap_lock_files = &recursive_find_ldif($config{'config_file'});
 855         }
 856 else {
 857         @ldap_lock_files = ( $config{'config_file'} );
 858         }
 859 foreach my $f (@ldap_lock_files) {
 860         &lock_file($f);
 861         }
 862 }
 863
 864 # unlock_slapd_files()
 865 # Un-lock all LDAP config file(s)
 866 sub unlock_slapd_files
 867 {
 868 foreach my $f (@ldap_lock_files) {
 869         &unlock_file($f);
 870         }
 871 @ldap_lock_files = ( );
 872 }
 873
 874 1;
 875