fusiondirectory-setup

#!/usr/bin/perl

########################################################################
#
#  fusiondirectory-setup
#
#  Manage fusiondirectory installs from the command line
#
#  This code is part of FusionDirectory (http://www.fusiondirectory.org/)
#  Copyright (C) 2011-2017  FusionDirectory
#
#  This program is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
#
########################################################################

use strict;
use warnings;
use 5.008;

# used to manage files
use Path::Class;

# used for checking config dirs rights (make the translation for lstat output)
use Fcntl ':mode';

# used to handle ldap connections
use Net::LDAP;

# used to base64 encode
use MIME::Base64;

# used to generate {SSHA} password (for LDAP)
use Digest::SHA;
use Crypt::CBC;

# used to uncompress tar.gz
use Archive::Extract;

# used to copy files
use File::Copy::Recursive qw(rcopy);

#XML parser
use XML::Twig;

# To hide password input
use Term::ReadKey;

use Data::Dumper;

# fd's directory and class.cache file's path declaration
my %vars = (
 fd_home          => "/var/www/fusiondirectory",
 fd_cache         => "/var/cache/fusiondirectory",
 fd_config_dir    => "/etc/fusiondirectory",
 fd_smarty_dir    => "/usr/share/php/smarty3",
 fd_spool_dir     => "/var/spool/fusiondirectory",
 ldap_conf        => "/etc/ldap/ldap.conf",
 config_file      => "fusiondirectory.conf",
 secrets_file     => "fusiondirectory.secrets",
 locale_dir       => "locale",
 class_cache      => "class.cache",
 locale_cache_dir => "locale",
 tmp_dir          => "tmp",
 fai_log_dir      => "fai",
 template_dir     => "template"
);

my ($fd_config,$fd_secrets,$locale_dir,$class_cache,$locale_cache_dir,$tmp_dir,$fai_log_dir,$template_dir);

my (@root_config_dirs,@apache_config_dirs,@config_dirs);

my @plugin_types = qw(addons admin personal);
my $yes_flag = 0;

my %classes_hash_result = ();
my %i18n_hash_result = ();

my $configrdn   = "cn=config,ou=fusiondirectory";
my $userrdn     = "ou=people";
my $aclrolerdn  = "ou=aclroles";
my $grouprdn    = "ou=groups";
my $systemrdn   = "ou=systems";
my $dnsrdn      = "ou=dns";
my $dhcprdn     = "ou=dhcp";
my $workstationrdn  = "ou=workstations,ou=systems";

#################################################################################################################################################

# ask a question send as parameter, and return true if the answer is "yes"
sub ask_yn_question {
  return 1 if ($yes_flag);
  my ($question) = @_;
  print ( "$question [Yes/No]?\n" );

  while ( my $input = <STDIN> ) {
    # remove the \n at the end of $input
    chomp $input;

    # if user's answer is "yes"
    if ( lc($input) eq "yes" || lc($input) eq "y") {
      return 1;
    # else if he answer "no"
    } elsif ( lc($input) eq "no" || lc($input) eq "n") {
      return 0;
    }
  }
}

# function that ask for an user input and do some checks
sub ask_user_input {
 my ($thing_to_ask, $default_answer, $hide_input) = @_;
 my $answer;

 if (defined $default_answer) {
   $thing_to_ask .= " [$default_answer]";
 }
 print $thing_to_ask.":\n";

 if (defined $hide_input && $hide_input) {
   ReadMode('noecho');
 }

 do
 {
   if ($answer = <STDIN>) {
     chomp $answer;
     $answer =~ s/^\s+|\s+$//g;
   } else {
     $answer = "";
   }
 } while (($answer eq "") && (not defined $default_answer));

 ReadMode('restore');

 if ($answer eq "") {
   return $default_answer;
 }
 return $answer;
}

# Die on all LDAP error except for «No such object»
sub die_on_ldap_errors
{
  my ($mesg) = @_;
  if (($mesg->code != 0) && ($mesg->code != 32)) {
    die $mesg->error;
  }
}

{
  my $indice = 0;
  sub find_free_role_dn {
    my ($ldap,$base,$prefix) = @_;
    my ($cn,$dn,$mesg);
    do {
      $cn = $prefix.'-'.$indice;
      $dn = "cn=$cn,$aclrolerdn,$base";
      $indice++;
      $mesg = $ldap->search(
        base    => "$dn",
        scope   => 'base',
        filter  => '(objectClass=*)'
      );
      die_on_ldap_errors($mesg);
    } while ($mesg->count);
    return $cn;
  }
}

sub create_role {
  my ($ldap,$base,$cn,$acl) = @_;
  my %role = (
    'cn'              => "$cn",
    'objectclass'     => [ 'top', 'gosaRole' ],
    'gosaAclTemplate' => "0:$acl"
  );

  if (!branch_exists($ldap, "$aclrolerdn,$base")) {
    create_branch($ldap, $base, $aclrolerdn);
  }

  my $role_dn = "cn=$cn,$aclrolerdn,$base";
  # Add the administator role object
  my @options = %role;
  my $role_add = $ldap->add( $role_dn, attr => \@options );
  # send a warning if the ldap's admin's add didn't gone well
  $role_add->code && die "\n! failed to add LDAP's $role_dn entry - ".$role_add->error_name.": ".$role_add->error_text;
  return $role_dn;
}

###################################################### Password encryption #########################################################################

sub cred_encrypt {
  my ($input, $password) = @_;
  my $cipher = Crypt::CBC->new(
                -key    =>  $password,
                -cipher => 'Rijndael',
                -salt   => 1,
                -header => 'salt',
              ) || die "Couldn't create CBC object";
  return $cipher->encrypt_hex($input);
}

sub cred_decrypt {
  my ($input, $password) = @_;
  my $cipher = Crypt::CBC->new(
                -key    =>  $password,
                -cipher => 'Rijndael',
                -salt   => 1,
                -header => 'salt',
              ) || die "Couldn't create CBC object";
  return $cipher->decrypt_hex($input);
}

sub get_random_string {
  my ($size) = @_;
  $size = 32 if !$size;
  my @chars = ("A".."Z", "a".."z", '.', '/', 0..9);
  my $string;
  $string .= $chars[rand @chars] for 1..$size;
  return $string;
}

sub encrypt_passwords {
  if (!-e $fd_config) {
    die "Cannot find a valid configuration file ($fd_config)!\n";
  }
  if (-e $fd_secrets) {
    die "There's already a file '$fd_secrets'. Cannot convert your existing fusiondirectory.conf - aborted\n";
  }
  print "Starting password encryption\n";
  print "* generating random master key\n";
  my $master_key = get_random_string();
  print "* creating '$fd_secrets'\n";
  my $fp_file = file($fd_secrets);
  my $fp = $fp_file->openw() or die "! Unable to open '$fd_secrets' in write mode\n";
  $fp->print("RequestHeader set FDKEY $master_key\n");
  $fp->close or die "! Can't close '$fd_secrets'\n";
  chmod 0600, $fd_secrets or die "! Unable to change '$fd_secrets' rights\n";
  my $root_uid = getpwnam("root");
  my $root_gid = getgrnam("root");
  chown $root_uid,$root_gid,$fd_secrets or die "! Unable to change '$fd_secrets' owner\n";

  # Move original fusiondirectory.conf out of the way and make it unreadable for the web user
  print "* creating backup in '$fd_config.orig'\n";
  rcopy($fd_config, "$fd_config.orig");
  chmod 0600, "$fd_config.orig" or die "! Unable to change '$fd_config.orig' rights\n";
  chown $root_uid,$root_gid,"$fd_config.orig" or die "! Unable to change '$fd_config.orig' owner\n";

  print "* loading '$fd_config'\n";
  my $twig = XML::Twig->new();    # create the twig
  $twig->parsefile($fd_config); # build it
  # Locate all passwords inside the fusiondirectory.conf
  my @locs = $twig->root->first_child('main')->children('location');
  foreach my $loc (@locs) {
    my $ref = $loc->first_child('referral');
    print "* encrypting FusionDirectory password for: ".$ref->{'att'}->{'adminDn'}."\n";
    $ref->set_att('adminPassword' => cred_encrypt($ref->{'att'}->{'adminPassword'}, $master_key));
  }

  # Save
  print "* saving modified '$fd_config'\n";
  $twig->print_to_file($fd_config, pretty_print => 'indented') or die "Cannot write modified $fd_config - aborted\n";
  print "OK\n\n";

  # Print reminder
  print "
Please adapt your http fusiondirectory location declaration to include the newly
created $fd_secrets.

Example:

Alias /fusiondirectory /usr/share/fusiondirectory/html

<Location /fusiondirectory>
  php_admin_flag engine on
  php_admin_flag register_globals off
  php_admin_flag allow_call_time_pass_reference off
  php_admin_flag expose_php off
  php_admin_flag zend.ze1_compatibility_mode off
  php_admin_flag register_long_arrays off
  php_admin_value upload_tmp_dir /var/spool/fusiondirectory/
  php_admin_value session.cookie_lifetime 0
  include /etc/fusiondirectory/fusiondirectory.secrets
</Location>


Please reload your httpd configuration after you've modified anything.\n";
}

####################################################### class.cache update #########################################################################

# function that scan recursivly a directory to find .inc and . php
# then return a hash with class => path to the class file
sub get_classes {

    my ($path) = @_;

    # if this function has been called without a parameter
    die ("! function get_classes called without parameter\n") if ( !defined($path) );

    # create a "dir" object with the path
    my $dir = dir ($path) or die ("! Can't open $path\n");

    my $contrib_dir = dir($vars{fd_home},"contrib");
    if ("$dir" eq "$contrib_dir") {
        return;
    }

    # create an array with the content of $dir
    my @dir_files = $dir->children;

    foreach my $file (@dir_files) {
        # recursive call if $file is a directory
        if ( -d $file ) {
            get_classes($file);
            next;
        }

        # only process if $file is a .inc or a .php file
        if ( ( $file =~ /.*\.inc$/ ) && ( $file !~ /.*smarty.*/ ) ) {
          # put the entire content of the file pointed by $file in $data
          my @lines = $file->slurp;

          # modifing $file, to contains relative path, not complete one
          $file =~ s/^$vars{fd_home}//;

          foreach my $line ( @lines ) {
            # remove \n from the end of each line
            chomp $line;

            # only process for lines beginning with "class", and extracting the 2nd word (the class name)
            if ( $line =~ /^class\s*(\w+).*/ ) {
              # adding the values (class name and file path) to the hash
              $classes_hash_result{$1} = $file;
            }
          }
        }
    }
    return %classes_hash_result;
}

# call get_classes and create /var/cache/fusiondirectory/class.cache
sub rescan_classes {

  # hash that will contain the result of the "get_classes" function
  my %get_classes_result = get_classes ($vars{fd_home});

  # create a "file" object with the $class_cache path
  my $file_class = file ($class_cache);

  # create the handler (write mode) for the file previoulsy created
  my $fhw = $file_class->openw() or die ("! Unable to open $class_cache in write mode\n");

  # first lines of class.cache
  $fhw->print ("<?php\n\t\$class_mapping= array(\n");

  # for each $key/$value, writting a new line to $class_cache
  while ( my($key,$value) = each %get_classes_result ) {
    $fhw->print ("\t\t\"$key\" => \"$value\",\n");
  }

  # last line of classe.cache
  $fhw->print ("\t);\n?>");

  $fhw->close or die ("! Can't close $class_cache\n");
}

###################################################### Internalisation's update ####################################################################################

# function that create .mo files with .po for each language
sub get_i18n {

    my ($path) = @_;

    # if this function has been called without a parameter
    die ("! function get_i18n called without parameter" ) if ( !defined($path) );

    # create a "dir" object
    my $dir = dir ($path) or die ("! Can't open $path\n");

    # create an array with the content of $dir
    my @dir_files = $dir->children;

    foreach my $file (@dir_files) {
      # recursive call if $file is a directory
      if (-d $file) {
        %i18n_hash_result = get_i18n ($file);
        next;
      }

      # if the file's directory is ???/language/fusiondirectory.po
      if ($file =~ qr{^.*/(\w+)/fusiondirectory.po$}) {
        # push the file's path in the language (fr/en/es/it...) array (wich is inside the hash pointed by $ref_result
        push @{$i18n_hash_result{$1}}, $file;
      }
    }
  return %i18n_hash_result;
}

# call get_i18n with the FusionDirectory's locales's directory and the hash that will contain the result in parameter
sub rescan_i18n {

  # hash that will contain the result of the "get_i18n" function
  my %get_i18n_result = get_i18n ($locale_dir);

  while ( my ($lang, $files) = each %get_i18n_result ) {

    # directory wich will contain the .mo file for each language
    my $lang_cache_dir = dir ("$locale_cache_dir/$lang/LC_MESSAGES");

    # if $lang_cache_dir doesn't already exists, creating it
    if ( !-d $lang_cache_dir ) {
      $lang_cache_dir->mkpath or die ("! Can't create $locale_cache_dir/$lang/LC_MESSAGES");
    }

    # glue .po files's names
    my $po_files = join(" ", @{$files});
    chomp $po_files;

    # merging .po files
    system ( "msgcat --use-first ".$po_files.">".$lang_cache_dir."/fusiondirectory.po" ) and die ("! Unable to merge .po files for $lang with msgcat, is it already installed?\n");

    # compiling .po files in .mo files
    system ( "msgfmt -o $lang_cache_dir/fusiondirectory.mo $lang_cache_dir/fusiondirectory.po && rm $lang_cache_dir/fusiondirectory.po" ) and die ("! Unable to compile .mo files with msgfmt, is it already installed?\n");
  }
}

############################################################# Directories checking ###################################################################################

#get the apache user group name
sub get_apache_group {
  my $apache_group = "";

  # try to identify the running distribution, if it's not debian or rehat like, script ask for user input
  if (-e "/etc/debian_version") {
    $apache_group = "www-data";
  } elsif ((-e "/etc/redhat-release") || (-e "/etc/mageia-release")) {
    $apache_group = "apache";
  } elsif (-e "/etc/SuSE-release") {
    $apache_group = "www";
  } elsif (-e "/etc/arch-release") {
    $apache_group = "http";
  } else {
    print ("! Looks like you are not a Debian, Suse, Redhat or Mageia, I don't know your distribution !\n");
    $apache_group = ask_user_input ("What is your apache group?");
  }
  return $apache_group;
}

#check the rights of a directory or file, creates missing directory if needed
sub check_rights {
  my ($dir,$user,$group,$rights,$create) = @_;
  my $user_uid = getpwnam ( $user );
  my $group_gid = getgrnam ( $group );

  # if the current dir exists
  if (-e $dir) {
    print("$dir exists…\n");
    # retrieve dir's informations
    my @lstat = lstat ($dir);

    # extract the owner and the group of the directory
    my $dir_owner = getpwuid ( $lstat[4] );
    my $dir_group = getgrgid ( $lstat[5] );

    # extract the dir's rights
    my $dir_rights = S_IMODE( $lstat[2] );

    if ( ($dir_owner ne $user) || ($dir_group ne $group) || ($dir_rights ne $rights) ) {
      if ( ask_yn_question ("$dir is not set properly, do you want to fix it ?: ") ) {
        chown ($user_uid,$group_gid,$dir) or die ("! Unable to change $dir owner\n") if ( ($dir_owner ne $user) || ($dir_group ne $group) );
        chmod ( $rights, $dir ) or die ("! Unable to change $dir rights\n") if ($dir_rights ne $rights);
      } else {
        print ("Skipping...\n");
      }
    } else {
      print("Rights on $dir are correct\n");
    }
  } elsif ($create) {

    if ( ask_yn_question("Directory $dir doesn't exists, do you want to create it ?: ") ) {
      my $conf_dir = dir ($dir);

      # create the directory, and change the rights
      $conf_dir->mkpath (0,$rights);
      chmod ($rights, $dir);
      chown ($user_uid,$group_gid,$dir) or die ("Unable to change $dir rights\n");

    } else {
      print ( "Skipping...\n" );
    }
  } else {
    return 0;
  }
  return 1;
}

# function that check FusionDirectory's directories
sub check_directories {
  my $apache_group = get_apache_group();

  # for each config directory
  foreach my $dir (@config_dirs) {

      # if $dir is one of the dirs that remains to root
      if ( grep (/.*$dir.*/, @root_config_dirs) ) {
        check_rights($dir,"root","root",oct(755),1);

      # else if $dir is one of the dirs that remains to apache's user group, and the dir's owner is not root or the group is not the apache's user group, modifying owner
      } elsif ( grep ( /.*$dir.*/, @apache_config_dirs) ) {
        check_rights($dir,"root",$apache_group,oct(770),1);
      }
  }
}

# function that check FusionDirectory's config file
sub check_config {
  my $apache_group = get_apache_group();

  # check config file
  check_rights($fd_config,"root",$apache_group,oct(640),0) or die 'The config file does not exists!';
}

############################################################# Change install directories #################################################################################

sub write_vars {
  my $filecontent = <<eof;
<?php
require_once('variables_common.inc');

/*! \\file
 * Define common locations and variables
 * Generated by fusiondirectory-setup */

if (!defined("CONFIG_DIR")) {
  define ("CONFIG_DIR", "$vars{fd_config_dir}/"); /* FusionDirectory etc path */
}

/* Allow setting the config file in the apache configuration
    e.g.  SetEnv CONFIG_FILE fusiondirectory.conf 1.0
 */
if (!defined("CONFIG_FILE")) {
  define ("CONFIG_FILE", "$vars{config_file}"); /* FusionDirectory filename */
}

/* Path for smarty3 libraries */
define("SMARTY", "$vars{fd_smarty_dir}");

/* Smarty compile dir */
define ("SPOOL_DIR", "$vars{fd_spool_dir}/"); /* FusionDirectory spool directory */

/* Global cache dir */
define ("CACHE_DIR", "$vars{fd_cache}/"); /* FusionDirectory var directory */

/* Global locale cache dir */
define ("LOCALE_DIR", "$locale_cache_dir/"); /* FusionDirectory locale directory */

/* Global tmp dir */
define ("TEMP_DIR", "$tmp_dir/"); /* FusionDirectory tmp directory */

/* Directory containing the configuration template */
define ("CONFIG_TEMPLATE_DIR", "$template_dir/"); /* FusionDirectory template directory */

/* Directory containing the fai logs */
define ("FAI_LOG_DIR", "$fai_log_dir/"); /* FusionDirectory fai directory */

/* Directory containing the supann files
define ("SUPANN_DIR", "$vars{fd_config_dir}/supann/"); /* FusionDirectory supann template directory */

/* name of the class.cache file */
define("CLASS_CACHE", "$vars{class_cache}"); /* name of the class cache */
?>
eof

  my $variables_path = "$vars{fd_home}/include/variables.inc";
  my $variables_file = file ($variables_path);
  my $vars_file = $variables_file->openw() or die ("! Unable to open $variables_path in write mode\n");
  $vars_file->print($filecontent);
  $vars_file->close or die ("! Can't close $variables_file\n");
}

############################################################# LDAP conformity check #################################################################################

# function that add the FusionDirectory's admin account
# return nothing is it a problem?
sub add_ldap_admin {
  my ($base, $ldap, $admindns, $people_entries, $roles) = @_;

  # Get the configuration to know which attribute must be used in the dn
  my $mesg = $ldap->search(
    base => "$base",
    filter => "(&(objectClass=fusionDirectoryConf)(cn=fusiondirectory))",
    attrs => ['fdAccountPrimaryAttribute', 'fdForcePasswordDefaultHash', 'fdPasswordDefaultHash']
  );
  $mesg->code && die $mesg->error;
  my $attr;
  if ($mesg->count <= 0) {
    print "Could not find configuration object, using default value\n";
    $attr = 'uid';
  } elsif (($mesg->entries)[0]->exists('fdAccountPrimaryAttribute')) {
    $attr = ($mesg->entries)[0]->get_value('fdAccountPrimaryAttribute');
  } else {
    $attr = 'uid';
  }
  if ($mesg->count > 0) {
    if (($mesg->entries)[0]->exists('fdForcePasswordDefaultHash') && ($mesg->entries)[0]->exists('fdPasswordDefaultHash')) {
      if ((($mesg->entries)[0]->get_value('fdForcePasswordDefaultHash') eq 'TRUE') &&
          (($mesg->entries)[0]->get_value('fdPasswordDefaultHash') ne 'ssha')) {
        warn "Warning: Administator password will be hashed with ssha instead of forced default ".($mesg->entries)[0]->get_value('fdPasswordDefaultHash')."\n";
      }
    }
  }

  my $fd_admin_uid = ask_user_input ("Please enter a login for FusionDirectory's admin", "fd-admin");
  # Does this user exists?
  my $dn = "";
  foreach my $entry (@$people_entries) {
    my $mesg = $ldap->search(
      base => "$entry",
      filter => "(&(objectClass=inetOrgPerson)(uid=$fd_admin_uid))",
      attrs => ['uid']
    );
    $mesg->code && die $mesg->error;
    if ($mesg->count) {
      print "User $fd_admin_uid already existing, adding admin acl to it\n";
      $dn = ($mesg->entries)[0]->dn;
      last;
    }
  }

  if ($dn eq "") {
    my $fd_admin_pwd = ask_user_input ("Please enter FusionDirectory's admin password", undef, 1);
    my $fd_admin_pwd_confirm = ask_user_input ("Please enter it again", undef, 1);

    # while the confirmation password is not the same than the first one
    while ( ($fd_admin_pwd_confirm ne $fd_admin_pwd) && ($fd_admin_pwd_confirm ne "quit" ) ) {
      $fd_admin_pwd_confirm = ask_user_input ("! Inputs don't match, try again or type 'quit' to end this function");
    }
    return -1 if ($fd_admin_pwd_confirm eq "quit");

    my $ctx = Digest::SHA->new(1);
    my $salt = get_random_string(8);
    $ctx->add($fd_admin_pwd);
    $ctx->add($salt);
    my $hashedPasswd = '{SSHA}'.encode_base64($ctx->digest.$salt, '');
    my %obj = (
      'cn'  =>  'System Administrator',
      'sn'  =>  'Administrator',
      'uid' =>  $fd_admin_uid,
      'givenname'     =>  'System',
      'objectclass'   =>  [ 'top', 'person', 'organizationalPerson', 'inetOrgPerson' ],
      'userPassword'  =>  $hashedPasswd
    );
    if (not defined $obj{$attr}) {
      print "Error : invalid account primary attribute $attr, using uid\n";
      $attr = 'uid';
    }
    $dn = "$attr=".$obj{$attr}.",$userrdn,$base";

    # Add the administator user object
    my @options = %obj;
    my $admin_add = $ldap->add( $dn, attr => \@options );
    # send a warning if the ldap's admin's add didn't gone well
    $admin_add->code && die "\n! failed to add LDAP's $dn entry - ".$admin_add->error_name.": ".$admin_add->error_text;
  }

  # Create admin role if not existing
  my $role;
  if (scalar @$roles == 0) {
    my $role_dn = create_role($ldap,$base,'admin','all;cmdrw');
    $role = encode_base64($role_dn, '');
  } else {
    $role = shift(@$roles);
  }

  # Add the assignment that make him an administrator
  my $acls = $ldap->search (
    base    => "$base",
    scope   => 'base',
    filter  => "(objectClass=*)",
    attrs   => ['objectClass', 'gosaAclEntry']
  );
  $acls->code && die "\n! failed to search acls in '$base' - ".$acls->error_name.": ".$acls->error_text;
  ($acls->count == 0) && die "\n! failed to search acls in '$base' - base not found";
  my $oclass = ($acls->entries)[0]->get_value("objectClass", asref => 1);
  # Add admin acl
  my $newacl = ["0:subtree:$role:".encode_base64($dn, '')];
  if (not (grep $_ eq 'gosaAcl', @$oclass)) {
    push (@$oclass, 'gosaAcl');
  } else {
    my $acl = ($acls->entries)[0]->get_value("gosaAclEntry", asref => 1);
    my $i = 1;
    if (defined $acl) {
      foreach my $line (@$acl) {
        # Reorder existing non-admin acls
        $line =~ s/^\d+:/$i:/;
        push (@$newacl, $line);
        $i++;
      }
    }
  }
  my $result = $ldap->modify (
    $base,
    replace => {
      'objectClass'   => $oclass,
      'gosaAclEntry'  => $newacl
    }
  );
  $result->code && warn "\n! failed to add ACL for admin on '$base' - ".$result->error_name.": ".$result->error_text;
}

# function that initiate the ldap connexion, and bind as the ldap's admin
sub get_ldap_connexion {
  my %hash_result = ();
  my $bind_dn = "";
  my $bind_pwd = "";
  my $uri = "";
  my $base = "";
  my $tls = 0;

  # read ldap's server's info from /etc/fusiondirectory/fusiondirectory.conf
  if (-e $fd_config) {
    my $twig = XML::Twig->new();    # create the twig
    $twig->safe_parsefile($fd_config) or die("There is an error in $fd_config XML code: ".(split /\n/, $@)[1]."\n");
    my @locs = $twig->root->first_child('main')->children('location');
    my %locations = ();
    foreach my $loc (@locs) {
      my $ref = $loc->first_child('referral');
      $locations{$loc->{'att'}->{'name'}} = {
        'tls'       => 0,
        'uri'       => $ref->{'att'}->{'URI'},
        'bind_dn'   => $ref->{'att'}->{'adminDn'},
        'bind_pwd'  => $ref->{'att'}->{'adminPassword'}
      };
      if (defined $loc->{'att'}->{'ldapTLS'} and $loc->{'att'}->{'ldapTLS'} =~ m/true/i) {
        $locations{$loc->{'att'}->{'name'}}->{'tls'} = 1
      }
    }

    my ($location) = keys(%locations);
    if (scalar(keys(%locations)) > 1) {
      my $question = "There are several locations in your config file, which one should be used : (".join(',',keys(%locations)).")";
      my $answer;
      do {
        $answer = ask_user_input ($question, $location);
      } while (not exists($locations{$answer}));
      $location = $answer;
    }

    if ($locations{$location}->{'uri'} =~ qr|^(.*)/([^/]+)$|) {
      $uri  = $1;
      $base = $2;
    } else {
      die '"'.$locations{$location}->{'uri'}.'" does not contain any base!';
    }
    $bind_dn  = $locations{$location}->{'bind_dn'};
    $bind_pwd = $locations{$location}->{'bind_pwd'};
    $tls      = $locations{$location}->{'tls'};

  # if can't find fusiondirectory.conf
  } else {

    if ( ask_yn_question ("Can't find fusiondirectory.conf, do you want to specify LDAP's information yourself ?: ") ) {
      $uri = ask_user_input ("LDAP server's URI");
      $base = ask_user_input ("Search base");
      $hash_result{base} = $base;

      $bind_dn = ask_user_input ("Bind DN");
      $bind_pwd = ask_user_input("Bind password", undef, 1);
    } else {
      return;
    }
  }

  # ldap connection
  my $ldap = Net::LDAP->new ($uri) or die ("! Can't contact LDAP server $uri\n");

  $hash_result{ldap} = $ldap;
  $hash_result{base} = $base;

  # bind to the LDAP server
  if (-e $fd_secrets) {
    open(my $secrets, q{<}, $fd_secrets) || die ("Could not open $fd_secrets");
    my $key = "";
    while(<$secrets>) {
      if ($_ =~ m/RequestHeader set FDKEY ([^ \n]+)\n/) {
        $key = $1;
        last;
      }
    }
    close($secrets);
    $bind_pwd = cred_decrypt($bind_pwd, $key);
  }

  if ($tls) {
    # Read LDAP config file
    open (my $ldapconf, q{<}, $vars{ldap_conf}) or die ("! Failed to open ldap config file '$vars{ldap_conf}': $!\n");

    my %tls_options = (
      'REQCERT'   => 'require',
      'CERT'      => '',
      'KEY'       => '',
      'CACERTDIR' => '',
      'CACERT'    => '',
    );
    # Scan LDAP config
    while (<$ldapconf>) {
      /^\s*(#|$)/ && next;
      chomp;
      if (m/^TLS_(REQCERT|CERT|KEY|CACERTDIR|CACERT)\s+(.*)\s*$/i) {
        $tls_options{uc $1} = $2;
      }
    }
    close($ldapconf);

    $ldap->start_tls(
      verify      => $tls_options{'REQCERT'},
      clientcert  => $tls_options{'CERT'},
      clientkey   => $tls_options{'KEY'},
      capath      => $tls_options{'CACERTDIR'},
      cafile      => $tls_options{'CACERT'}
    );
  }

  my $bind = $ldap->bind ($bind_dn, password => $bind_pwd);

  # send a warning if the bind didn't gone well
  $bind->code && die ("! Failed to bind to LDAP server: ", $bind->error."\n");

  return %hash_result;
}

# function that check if there is an admin
sub check_admin {
  my ($base, $ldap, $people_entries) = @_;

  # search for FusionDirectory's admin account

  # search for admin role
  my $admin_roles = $ldap->search (
    base => "$base",
    filter => "(&(objectClass=gosaRole)(gosaAclTemplate=*:all;cmdrw))",
    attrs => ['gosaAclTemplate']
  );
  $admin_roles->code && die $admin_roles->error;
  my @dns = ();
  my @roles = ();
  my $count = 0;
  while (my $entry = $admin_roles->shift_entry) {
    my $role_dn64 = encode_base64($entry->dn, '');
    push @roles, $role_dn64;
    print ("Role ".$entry->dn." is an admin ACL role\n");
    # Search for base-wide assignments
    my $assignments = $ldap->search (
      base    => "$base",
      scope   => 'base',
      filter  => "(&(objectClass=gosaAcl)(gosaAclEntry=*:subtree:$role_dn64:*))",
      attrs   => ['gosaAclEntry']
    );
    $assignments->code && die $assignments->error;
    while (my $assignment = $assignments->shift_entry) {
      my $acl = $assignment->get_value("gosaAclEntry", asref => 1);
      foreach my $line (@$acl) {
        if ($line =~ m/^.:subtree:\Q$role_dn64\E/) {
          my @parts = split(':',$line,4);
          my @members = split(",",$parts[3]);
          foreach my $member (@members) {
            # Is this an existing user?
            my $dn = decode_base64($member);
            my $member_node = $ldap->search(
              base    => $dn,
              scope   => 'base',
              filter  => "(objectClass=inetOrgPerson)"
            );
            if ($member_node->count == 1) {
              print ("$dn is a valid admin\n");
              return;
            }
            # Is this a group?
            $member_node = $ldap->search(
              base    => $dn,
              scope   => 'base',
              filter  => "(objectClass=posixGroup)",
              attrs   => ['memberUid']
            );
            if ($member_node->count == 1) {
              # Find group members
              my $member_entry  = $member_node->shift_entry;
              my $memberUids    = $member_entry->get_value("memberUid", asref => 1);
              my $filter = '(&(objectClass=inetOrgPerson)(|(uid='.join(')(uid=', @$memberUids).')))';
              my $group_members = $ldap->search(
                base    => $base,
                filter  => $filter,
              );
              $group_members->code && die $group_members->error;
              if (my $group_member_entry = $group_members->shift_entry) {
                print ($group_member_entry->dn." is a valid admin\n");
                return;
              }
            } else {
              push @dns, $dn;
            }
          }
        }
      }
    }
    $count++;
  }
  if ($count < 1) {
    print ("! There is no admin ACL role\n");
  }
  foreach my $dn (@dns) {
    print ("! $dn is supposed to be admin but does not exists\n");
  }
  if (ask_yn_question("No valid admin account found, do you want to create it ?")) {
    return add_ldap_admin($base, $ldap, \@dns, $people_entries, \@roles);
  }
}

sub create_branch {
  my ($ldap, $base, $ou) = @_;
  $ou =~ m/^ou=([^,]*),?$/ or die "Can’t create branch of unknown type $ou\n";
  my $branch_add = $ldap->add( "$ou,$base",
    attr => [
      'ou'  => $1,
      'objectClass' =>  'organizationalUnit'
      ]
  );

  $branch_add->code && die "! failed to add LDAP's $ou,$base branch: ".$branch_add->error."\n";
}

sub branch_exists {
  my ($ldap, $branch) = @_;

  # search for branch
  my $branch_mesg = $ldap->search (base => $branch, filter => '(objectClass=*)', scope => 'base');
  if ($branch_mesg->code == 32) {
    return 0;
  }
  $branch_mesg->code && die $branch_mesg->error;

  my @entries = $branch_mesg->entries;
  return (defined ($entries[0]));
}

# function that check LDAP configuration
sub check_ldap {
  read_ldap_config();

  # initiate the LDAP connexion
  my %hash_ldap_param = get_ldap_connexion();

  # LDAP's connection's parameters
  my $base = $hash_ldap_param{base};
  my $ldap = $hash_ldap_param{ldap};

  my $admin_add = "";

  # Collect existing people branches (even if main one may not exists);
  my $people = $ldap->search (base => $base, filter => $userrdn);
  $people->code && die $people->error;
  my @people_entries = $people->entries;
  @people_entries = map {$_->dn} @people_entries;

  # if people branch exists
  if ( branch_exists($ldap, "$userrdn,$base") ) {
    check_admin($base, $ldap, \@people_entries);

  # if ou=people doesn't exists
  } else {
    print ( "! $userrdn,$base not found in your LDAP directory\n" );

    # if user's answer is "yes", creating ou=people branch
    if ( ask_yn_question("Do you want to create it ?: ") ) {
      create_branch($ldap, $base, $userrdn);
      push @people_entries, "$userrdn,$base";
      check_admin($base, $ldap, \@people_entries);
    } else {
      print ("Skipping...\n");
    }
  }

  # if groups branch does not exist
  if (!branch_exists($ldap, "$grouprdn,$base")) {
    print ("! $grouprdn,$base not found in your LDAP directory\n");