-
bmortier authored
Merge branch '5773-change-the-url-for-the-bug-tracker-into-the-fusiondirectory-manpages' into '1.3-dev' Resolve "Change the url for the bug tracker into the fusiondirectory manpages" Closes #5773 See merge request fusiondirectory/fd!140 (cherry picked from commit 0432aab6) fa775a3a
fix(manpages): Change the url for the bug tracker into the fusiondirectory manpagesc59594ee
#!/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-2018 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",
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
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";
my $winstationrdn = "ou=computers,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;
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
} 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',
211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280
-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 "
281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350
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;
}
}
351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420
}
}
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 ) {
421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490
# 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 {
491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560
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 */
561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630
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 = "";
631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700
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
701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770
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'};
771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840
$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);
841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910
# 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) {
911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980
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 {
# 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);
981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050
# 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");
# if user's answer is "yes", creating groups branch
if ( ask_yn_question("Do you want to create it ?: ") ) {
create_branch($ldap, $base, $grouprdn);
} else {
print ("Skipping...\n");
}
}
# search for workstations and object groups
my $faiclasses = $ldap->search (base => "$base",
filter => "(&(FAIclass=*)(!(objectClass~=FAIprofile)))" );
$faiclasses->code && die $faiclasses->error;
my @faiclass_entries = $faiclasses->entries;
foreach my $entry (@faiclass_entries) {
my $faiclass = $entry->get_value('FAIclass');
my (@profiles) = split(' ',$faiclass);
if (scalar @profiles > 2) {
print "! System or group ".$entry->get_value('cn')." have more than one FAI profile : ".$faiclass."\n";
} elsif (scalar @profiles < 2) {
print "! System or group ".$entry->get_value('cn')." have no release set in its FAIclass : ".$faiclass."\n";
}
}
# search for old config dn
if (branch_exists($ldap, "cn=fusiondirectory,ou=configs,$base")) {
print ("! There is a configuration in cn=fusiondirectory,ou=configs,$base in your LDAP directory\n");
print ("! The correct configuration dn is now cn=config,ou=fusiondirectory,$base\n");
print ("! FusionDirectory will not read your configuration at its current dn\n");
if ( ask_yn_question("Do you want to move and rename this entry? ") ) {
if (!branch_exists($ldap, "ou=fusiondirectory,$base")) {
create_branch($ldap, $base, 'ou=fusiondirectory');
}
my $result = $ldap->moddn (
"cn=fusiondirectory,ou=configs,$base",
newrdn => 'cn=config',
deleteoldrdn => '1',
newsuperior => "ou=fusiondirectory,$base"
);
$result->code && die "Migration of configuration entry failed, LDAP error: ".$result->error."\n";
} else {
print ("Skipping...\n");
}
}
# unbind to the LDAP server
my $unbind = $ldap->unbind;
$unbind->code && warn "! Unable to unbind from LDAP server: ", $unbind->error."\n";
}
1051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120
# function that check for duplicated uid or gid numbers
sub check_id_numbers {
# initiate the LDAP connexion
my %hash_ldap_param = get_ldap_connexion();
# LDAP's connection's parameters
my $ldap = $hash_ldap_param{ldap};
my $base = $hash_ldap_param{base};
check_id_numbers_generic($ldap, $base, 'posixAccount','uidNumber','users');
check_id_numbers_generic($ldap, $base, 'posixGroup','gidNumber','groups');
}
sub check_id_numbers_generic {
my ($ldap, $base, $objectClass, $attribute, $type) = @_;
my $mesg = $ldap->search(
filter => "(&(objectClass=$objectClass)($attribute=*))",
base => $base,
attrs => [$attribute]
);
$mesg->code && die $mesg->error;
my @entries = $mesg->entries;
my %tmp = ();
foreach my $entry (@entries) {
if (not defined $tmp{$entry->get_value($attribute)}) {
$tmp{$entry->get_value($attribute)} = ();
}
push @{$tmp{$entry->get_value($attribute)}}, $entry->dn();
}
my $dups = 0;
while (my ($id, $dns) = each %tmp) {
if (scalar(@$dns) > 1) {
$dups = 1;
print "The following $type use the same $attribute $id:\n";
foreach my $dn (@$dns) {
print "\t$dn\n";
}
}
}
if ($dups == 0) {
print "There are no duplicated ${attribute}s\n";
}
}
# function that create a directory and copy plugin files in it
sub create_and_copy_plugin_dir {
my ($plugin_dir,$dest_dir) = @_;
if ( -e $plugin_dir ){
my $dir = dir ($dest_dir);
$dir->mkpath() or warn ("! Unable to make ".$dest_dir."\n") if ( !-e $dest_dir);
my $files_dirs_copied = rcopy($plugin_dir."/*", $dest_dir);
}
}
# function that install all the FD's plugins from a directory
sub install_plugins {
# ask for the plugins archive
my $plugins_archive = ask_user_input ("Where is your plugins archive ?");
die ("! ".$plugins_archive." doesn't exists") if (!-e $plugins_archive);
# check the archive format
$plugins_archive =~ /^.*\/(.*).tar.gz$/;
my $name = $1 or die ("! Unkwnow archive $plugins_archive");
1121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190
# where the extract files will go
my $tmp_plugins_dir = "/tmp";
print ("Installing plugins into $vars{fd_home}, please wait...\n");
my $dir = dir ($tmp_plugins_dir."/".$name);
# extract the plugins archive
my $archive = Archive::Extract->new (archive => $plugins_archive);
my $extract = $archive->extract( to => "$tmp_plugins_dir" ) or die ("! Unable to extract $plugins_archive\n");
my @plugins = $dir->children;
chdir ($dir) or die ("! Unable to move to $dir\n");
foreach my $plugin_path (@plugins) {
$plugin_path =~ /^$tmp_plugins_dir\/$name\/(.*)$/;
my $plugin = $1;
# copy addons into plugins
create_and_copy_plugin_dir($plugin_path."/addons/", $vars{fd_home}."/plugins/addons/");
# copy admin into plugins
create_and_copy_plugin_dir($plugin_path."/admin/", $vars{fd_home}."/plugins/admin/");
# copy config into plugins
create_and_copy_plugin_dir($plugin_path."/config/", $vars{fd_home}."/plugins/config/");
# copy personal into plugins
create_and_copy_plugin_dir($plugin_path."/personal/", $vars{fd_home}."/plugins/personal/");
# copy extra HTML and images
create_and_copy_plugin_dir($plugin_path."/html/", $vars{fd_home}."/html/");
# copy extra theme templates
create_and_copy_plugin_dir($plugin_path."/ihtml/", $vars{fd_home}."/ihtml/");
# copy includes
create_and_copy_plugin_dir($plugin_path."/include/", $vars{fd_home}."/include/");
# copy ldap schema
create_and_copy_plugin_dir($plugin_path."/contrib/openldap/", $vars{fd_home}."/contrib/openldap/");
# copy etc files
create_and_copy_plugin_dir($plugin_path."/contrib/etc/", $vars{fd_config_dir}."/".$plugin."/");
# copy doc
create_and_copy_plugin_dir($plugin_path."/contrib/doc/", $vars{fd_home}."/contrib/doc/");
# copy the locales
create_and_copy_plugin_dir($plugin_path."/locale/", $vars{fd_home}."/locale/plugins/".$plugin."/locale/");
}
#finally update FusionDirectory's class.cache and locales
rescan_classes();
rescan_i18n();
}
# function that add object classes to people branch users
sub migrate_users {
# 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 $mesg = $ldap->search(
filter => '(&'.
'(|'.
1191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260
'(objectClass=posixAccount)'.
'(objectClass=person)'.
'(objectClass=OpenLDAPperson)'.
')'.
'(!(objectClass=ipHost))'.
'(!(objectClass=inetOrgPerson))'.
'(uid=*)'.
')',
base => $base
);
$mesg->code && die $mesg->error;
if ($mesg->count > 0) {
print ("The following users are missing objectClasses:\n");
my @entries = $mesg->entries;
foreach my $entry (@entries) {
print $entry->dn()."\n";
}
if (ask_yn_question("Add the inetOrgPerson objectClass to all these entries?")) {
foreach my $entry (@entries) {
$mesg = $ldap->modify($entry->dn(), add => { "objectClass" => ["person","organizationalPerson","inetOrgPerson"]});
$mesg->code && print $mesg->error."\n";
}
}
}
# unbind to the LDAP server
my $unbind = $ldap->unbind;
$unbind->code && warn "! Unable to unbind from LDAP server: ", $unbind->error."\n";
}
# function that moves DHCP configurations from systems to ou=dhcp
sub migrate_dhcp {
# 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};
# Search for DHCP configurations
my $mesg = $ldap->search(
base => "$base",
filter => "(objectClass=dhcpService)",
attrs => ['cn']
);
$mesg->code && die $mesg->error;
my @entries = $mesg->entries;
print "There are ".$mesg->count." DHCP configurations in the LDAP\n";
my @baddns = ();
foreach my $entry (@entries) {
if ($entry->dn() !~ m/$dhcprdn/) {
if (scalar(@baddns) == 0) {
print "The following are not in the DHCP branch ($dhcprdn):\n";
}
print $entry->dn()."\n";
push @baddns, $entry->dn();
}
}
if (scalar(@baddns) == 0) {
print "They all already are in the DHCP branch ($dhcprdn):\n";
} else {
1261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330
if (ask_yn_question("Move these entries to the DHCP branch ($dhcprdn)?")) {
foreach my $entrydn (@baddns) {
$entrydn =~ m/^([^,]+),(cn=([^,]+),.*$systemrdn,(.+))$/ or die "Could not parse dn ".$entrydn."\n";
my $rdn = $1;
my $systemdn = $2;
my $systemcn = $3;
my $entrybase = $4;
if (!branch_exists($ldap, "$dhcprdn,$entrybase")) {
create_branch($ldap, $entrybase, $dhcprdn);
}
my $result = $ldap->moddn (
$entrydn,
newrdn => "$rdn-$systemcn",
deleteoldrdn => '1',
newsuperior => "$dhcprdn,$entrybase"
);
$result->code && die "Migration of DHCP configuration entry failed, LDAP error: ".$result->error."\n";
my $configDn = "$rdn-$systemcn,$dhcprdn,$entrybase";
# Add DHCP service on server
$mesg = $ldap->search(
base => $systemdn,
scope => 'base',
filter => '(objectClass=*)'
);
$mesg->code && die $mesg->error;
my $system_entry = $mesg->shift_entry;
$system_entry->get_value('objectClass');
my @classes = $system_entry->get_value('objectClass');
if (grep {$_ eq 'dhcpServer'} @classes) {
$result = $ldap->modify (
"$systemdn",
replace => {
'dhcpServiceDN' => $configDn,
}
);
} else {
$result = $ldap->modify (
"$systemdn",
replace => {
'dhcpServiceDN' => $configDn,
},
add => {
'objectClass' => 'dhcpServer'
}
);
}
$result->code && print "Could not add DHCP service on $systemdn, LDAP error: ".$result->error."\nYou'll need to activate it yourself\n";
}
}
}
}
sub delete_gosa_locks {
# 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};
# Search for old formatted ACLs
my $mesg = $ldap->search(
base => "$base",
filter => "(objectClass=gosaLockEntry)",
attrs => ['dn']
);
$mesg->code && die $mesg->error;
1331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400
my @entries = $mesg->entries;
foreach my $entry (@entries) {
$mesg = $ldap->delete($entry);
if ($mesg->code) {
print "Failed to delete lock '".$entry->dn."': ".$mesg->error."\n";
} else {
print "Deleted lock '".$entry->dn."'\n";
}
}
}
# Get LDAP attributes which have been deprecated
sub get_deprecated {
# 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 $schema_info = $ldap->schema();
my @attributes = $schema_info->all_attributes();
my @obsolete_attrs = ();
foreach my $attribute (@attributes) {
if ($attribute->{'obsolete'}) {
push @obsolete_attrs, $attribute;
}
}
my @ocs = $schema_info->all_objectclasses();
my @obsolete_classes = ();
foreach my $oc (@ocs) {
if ($oc->{'obsolete'}) {
push @obsolete_classes, $oc;
}
}
return (\@obsolete_attrs, \@obsolete_classes);
}
# function that migrates systems from FD<1.1 to FD>=1.1
sub migrate_systems {
# 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 @oldOCs = ('gotoWorkstation', 'goServer', 'gotoTerminal', 'gotoDevice');
my @newOCs = ('fdWorkstation', 'fdServer', 'fdTerminal', 'device');
foreach my $i (0 .. $#oldOCs) {
my $oldOC = $oldOCs[$i];
my $newOC = $newOCs[$i];
my $mesg = $ldap->search(
filter => "(objectClass=$oldOC)",
base => $base
);
$mesg->code && die $mesg->error;
if ($mesg->count > 0) {
print ("The following systems are using the obsolete $oldOC objectClass:\n");
my @entries = $mesg->entries;
foreach my $entry (@entries) {
print $entry->dn()."\n";
1401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470
}
if (ask_yn_question("Migrate these entries to $newOC objectClass?")) {
foreach my $entry (@entries) {
my $tmprdn = "cn=".$entry->get_value('cn')."+ipHostNumber=".$entry->get_value('ipHostNumber');
my $newrdn = "cn=".$entry->get_value('cn');
my $dn_old = $entry->dn();
my $dn_new = $entry->dn();
$dn_new =~ s/^[^,]+,/$tmprdn,/;
$entry->dn($dn_new);
my @replace = ('ieee802Device', 'ipHost', $newOC);
my @classes = $entry->get_value('objectClass');
foreach my $class (@classes) {
if (($class ne $oldOC) && ($class ne 'GOhard')) {
push(@replace, "$class");
}
}
$entry->replace("objectClass" => \@replace);
if ($entry->exists('gotoMode')) {
my $gotoMode = $entry->get_value('gotoMode');
if ($gotoMode eq 'locked') {
$entry->add('fdMode' => 'locked');
} else {
$entry->add('fdMode' => 'unlocked');
}
$entry->delete('gotoMode');
}
if ($entry->exists('argonautLdap2zoneAllowNotify')) {
$entry->delete('argonautLdap2zoneAllowNotify');
}
$mesg = $ldap->add($entry);
if ($mesg->code) {
print $entry->dn().": ".$mesg->error."\n";
next;
}
undef @replace;
$mesg = $ldap->delete($dn_old);
if ($mesg->code) {
print $entry->dn().": ".$mesg->error."\n";
next;
}
$mesg = $ldap->moddn($dn_new, newrdn => $newrdn);
if ($mesg->code) {
print $entry->dn().": ".$mesg->error."\n";
next;
}
}
}
} else {
print "Found no system using $oldOC\n";
}
}
# unbind to the LDAP server
my $unbind = $ldap->unbind;
$unbind->code && warn "! Unable to unbind from LDAP server: ", $unbind->error."\n";
}
# function that migrates winstations from FD<1.1 to FD>=1.1
sub migrate_winstations
{
# 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 $mesg = $ldap->search(
filter => "(&(!(objectClass=fdWorkstation))(!(objectClass=inetOrgPerson))(!(objectClass=posixGroup))(uid=*\$)(objectClass=sambaSamAccount))",
1471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540
base => $base
);
$mesg->code && die $mesg->error;
if ($mesg->count > 0) {
print ("The following winstations are not using the new fdWorkstation objectClass:\n");
my @entries = $mesg->entries;
foreach my $entry (@entries) {
print $entry->dn()."\n";
}
if (ask_yn_question("Migrate these entries to fdWorkstation objectClass?")) {
foreach my $entry (@entries) {
my $cn = $entry->get_value('cn');
$cn =~ s/\$$//;
$entry->replace('cn' => $cn);
my $newrdn = "cn=".$cn;
my $dn_old = $entry->dn();
my $entrybase;
if ($dn_old =~ m/^[^,]+,$winstationrdn,(.+)$/) {
$entrybase = $1;
} elsif ($dn_old =~ m/^[^,]+,.*$systemrdn,(.+)$/) {
$entrybase = $1;
} elsif ($dn_old =~ m/^[^,]+,.*$winstationrdn,(.+)$/) {
$entrybase = $1;
} else {
die "Could not parse dn ".$dn_old."\n";
}
if (!branch_exists($ldap, "$workstationrdn,$entrybase")) {
if ($workstationrdn =~ m/^([^,]+),([^,]+)$/) {
if (!branch_exists($ldap, "$2,$entrybase")) {
create_branch($ldap, $entrybase, $2);
}
create_branch($ldap, "$2,$entrybase", $1);
} else {
create_branch($ldap, $entrybase, $workstationrdn);
}
}
my $dn_new = "$newrdn,$workstationrdn,$entrybase";
$entry->dn($dn_new);
my @replace = ('fdWorkstation');
my @classes = $entry->get_value('objectClass');
foreach my $class (@classes) {
if ($class ne 'account') {
push(@replace, "$class");
}
}
$entry->replace("objectClass" => \@replace);
$entry->add('fdMode' => 'unlocked');
$mesg = $ldap->add($entry);
if ($mesg->code) {
print $entry->dn().": ".$mesg->error."\n";
next;
}
undef @replace;
$mesg = $ldap->delete($dn_old);
if ($mesg->code) {
print $entry->dn().": ".$mesg->error."\n";
next;
}
}
}
} else {
print "Found no winstation to migrate\n";
}
}
# function that migrates phones from FD<1.1 to FD>=1.1
1541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610
sub migrate_phones {
# 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 $mesg = $ldap->search(
filter => '(&(objectClass=fdPhone)(objectClass=device))',
base => $base
);
$mesg->code && die $mesg->error;
if ($mesg->count > 0) {
print ("The following phones are still using the device objectClass:\n");
my @entries = $mesg->entries;
foreach my $entry (@entries) {
print $entry->dn()."\n";
}
if (ask_yn_question("Migrate these entries to fdPhone objectClass?")) {
foreach my $entry (@entries) {
my $tmprdn = "cn=".$entry->get_value('cn')."+objectClass=fdPhone";
my $newrdn = "cn=".$entry->get_value('cn');
my $dn_old = $entry->dn();
my $dn_new = $entry->dn();
$dn_new =~ s/^[^,]+,/$tmprdn,/;
$entry->dn($dn_new);
my @replace = ();
my @classes = $entry->get_value('objectClass');
foreach my $class (@classes) {
if ($class ne 'device') {
push(@replace, "$class");
}
}
$entry->replace("objectClass" => \@replace);
$mesg = $ldap->add($entry);
if ($mesg->code) {
print $entry->dn().": ".$mesg->error."\n";
next;
}
undef @replace;
$mesg = $ldap->delete($dn_old);
if ($mesg->code) {
print $entry->dn().": ".$mesg->error."\n";
next;
}
$mesg = $ldap->moddn($dn_new, newrdn => $newrdn);
if ($mesg->code) {
print $entry->dn().": ".$mesg->error."\n";
next;
}
}
}
}
# unbind to the LDAP server
my $unbind = $ldap->unbind;
$unbind->code && warn "! Unable to unbind from LDAP server: ", $unbind->error."\n";
}
# List LDAP attributes which have been deprecated
sub list_deprecated {
my ($obsolete_attrs, $obsolete_classes) = get_deprecated();
print "Deprecated attributes:\n";
foreach my $attribute (@$obsolete_attrs) {
1611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680
printf(" %-30s\t%-60s\t- %s\n", $attribute->{'name'}, '('.$attribute->{'desc'}.')', $attribute->{'oid'});
}
print "Deprecated objectClasses:\n";
foreach my $oc (@$obsolete_classes) {
printf(" %-30s\t%-60s\t- %s\n", $oc->{'name'}, '('.$oc->{'desc'}.')', $oc->{'oid'});
}
}
# List LDAP entries using attributes which have been deprecated
sub check_deprecated {
my ($obsolete_attrs, $obsolete_classes) = get_deprecated();
my $filterAttrs = '(|'.join('', (map{ '('.$_->{'name'}.'=*)' } @$obsolete_attrs)).')';
# 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 $entries = $ldap->search(
base => "$base",
filter => "$filterAttrs",
);
$entries->code && die $entries->error;
if ($entries->count > 0) {
while (my $entry = $entries->shift_entry) {
print $entry->dn." contains an obsolete attribute\n";
}
} else {
print "There are no entries in the LDAP using obsolete attributes\n";
}
my $useobsoletes = 0;
foreach my $class (@$obsolete_classes) {
$entries = $ldap->search(
base => "$base",
filter => '(objectClass='.$class->{'name'}.')',
);
$entries->code && die $entries->error;
if ($entries->count > 0) {
$useobsoletes = 1;
while (my $entry = $entries->shift_entry) {
print $entry->dn." uses the obsolete object class ".$class->{'name'}."\n";
}
}
}
if (!$useobsoletes) {
print "There are no entries in the LDAP using obsolete classes\n";
}
}
# Print a LDIF file removing attributes which have been deprecated
sub ldif_deprecated {
my ($obsolete_attrs, $obsolete_classes) = get_deprecated();
my $filterAttrs = '(|'.join('', (map{ '('.$_->{'name'}.'=*)' } @$obsolete_attrs)).')';
my $filterClasses = '(|'.join('', (map{ '(objectClass='.$_->{'name'}.')' } @$obsolete_classes)).')';
# 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};
1681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750
my $entries = $ldap->search(
base => "$base",
filter => "$filterAttrs",
);
$entries->code && die $entries->error;
if ($entries->count > 0) {
while (my $entry = $entries->shift_entry) {
print 'dn:'.$entry->dn."\n";
print "changetype:modify\n";
foreach my $attr (@$obsolete_attrs) {
if ($entry->exists($attr->{'name'})) {
print "delete:".$attr->{'name'}."\n-\n";
}
}
print "\n";
}
} else {
print "# There are no entries in the LDAP using obsolete attributes\n";
}
$entries = $ldap->search(
base => "$base",
filter => "$filterClasses",
);
$entries->code && die $entries->error;
if ($entries->count > 0) {
print "# WARNING: There are entries in the LDAP using obsolete classes, you need to edit them manually\n";
} else {
print "# There are no entries in the LDAP using obsolete classes\n";
}
}
# Read FD config in the LDAP
sub 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 $mesg = $ldap->search (base => "$configrdn,$base", filter => '(objectClass=fusionDirectoryConf)', scope => 'base');
die_on_ldap_errors($mesg);
if ($mesg->count > 0) {
if (($mesg->entries)[0]->exists('fdUserRDN')) {
$userrdn = ($mesg->entries)[0]->get_value('fdUserRDN');
}
if (($mesg->entries)[0]->exists('fdOGroupRDN')) {
$grouprdn = ($mesg->entries)[0]->get_value('fdOGroupRDN');
}
if (($mesg->entries)[0]->exists('fdAclRoleRDN')) {
$aclrolerdn = ($mesg->entries)[0]->get_value('fdAclRoleRDN');
}
if (($mesg->entries)[0]->exists('fdSystemRDN')) {
$systemrdn = ($mesg->entries)[0]->get_value('fdSystemRDN');
}
if (($mesg->entries)[0]->exists('fdDnsRDN')) {
$dnsrdn = ($mesg->entries)[0]->get_value('fdDnsRDN');
}
if (($mesg->entries)[0]->exists('fdDhcpRDN')) {
$dhcprdn = ($mesg->entries)[0]->get_value('fdDhcpRDN');
}
if (($mesg->entries)[0]->exists('fdWorkstationRDN')) {
$workstationrdn = ($mesg->entries)[0]->get_value('fdWorkstationRDN');
}
if (($mesg->entries)[0]->exists('fdSambaMachineAccountRDN')) {
1751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820
$winstationrdn = ($mesg->entries)[0]->get_value('fdSambaMachineAccountRDN');
}
}
return ($mesg->entries)[0];
}
sub show_ldap_config {
my $config_node = read_ldap_config();
$config_node->dump();
}
sub set_config_var {
my ($var, $value) = @_;
if (!($var =~ m/^fd/)) {
$var = "fd$var";
}
print "Setting configuration var $var to $value\n";
# 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 $result = $ldap->modify (
"$configrdn,$base",
replace => {
$var => $value
}
);
$result->code && warn "! failed to set value for '".$var."' - ".$result->error_name.": ".$result->error_text;
}
sub show_version {
my $variables_common_path = "$vars{fd_home}/include/variables_common.inc";
if (-e $variables_common_path) {
open(my $vars, q{<}, $variables_common_path) || die ("Could not open $variables_common_path");
while(<$vars>) {
if ($_ =~ m/^define \(["']FD_VERSION["'], "([^"]+)"\);/) {
print "FusionDirectory version is $1\n";
last;
}
}
close($vars);
} else {
print "File $variables_common_path does not exists, can’t find out FusionDirectory version\n";
}
}
# function that set useful vars based on user specified folders and files
sub set_vars {
$fd_config = $vars{fd_config_dir}."/".$vars{config_file};
$fd_secrets = $vars{fd_config_dir}."/".$vars{secrets_file};
$locale_dir = $vars{fd_home}."/".$vars{locale_dir};
$class_cache = $vars{fd_cache}."/".$vars{class_cache};
$locale_cache_dir = $vars{fd_cache}."/".$vars{locale_cache_dir};
$tmp_dir = $vars{fd_cache}."/".$vars{tmp_dir};
$fai_log_dir = $vars{fd_cache}."/".$vars{fai_log_dir};
$template_dir = $vars{fd_cache}."/".$vars{template_dir};
my $supann_dir = $vars{fd_cache}."/supann";
@root_config_dirs = ( $vars{fd_home}, $vars{fd_config_dir} );
@apache_config_dirs = ( $vars{fd_spool_dir}, $vars{fd_cache}, $tmp_dir, $fai_log_dir,
$template_dir );
@config_dirs = ( @root_config_dirs, @apache_config_dirs );
}
1821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890
# function that list variables that can be modified by the user
sub list_vars {
while ( my ($key, $value) = each(%vars) ) {
print "$key\t[$value]"."\n";
}
}
#################### main function #####################
#die if the user is not root
die ("! You have to run this script as root\n") if ($<!=0);
my @vars_keys = keys %vars;
# $commands{<cli-option>} = [<description>, <function>, <needs-ldap-config>];
my %commands = ();
$commands{"--update-cache"} = ["Updating class.cache", \&rescan_classes];
$commands{"--update-locales"} = ["Updating translations", \&rescan_i18n];
$commands{"--check-directories"} = ["Checking FusionDirectory's directories", \&check_directories];
$commands{"--check-config"} = ["Checking FusionDirectory's config file", \&check_config];
$commands{"--check-ldap"} = ["Checking your LDAP tree", \&check_ldap, 1];
$commands{"--check-ids"} = ["Checking for duplicated uid or gid numbers", \&check_id_numbers, 1];
$commands{"--migrate-users"} = ["Migrating your users", \&migrate_users, 1];
$commands{"--migrate-phones"} = ["Migrating your phones from FD < 1.1", \&migrate_phones, 1];
$commands{"--migrate-systems"} = ["Migrating your systems from FD < 1.1", \&migrate_systems, 1];
$commands{"--migrate-winstations"} = ["Migrating your winstations from FD < 1.1", \&migrate_winstations, 1];
$commands{"--migrate-dhcp"} = ["Migrating DHCP configurations for FD >= 1.0.17",\&migrate_dhcp, 1];
$commands{"--delete-gosa-locks"} = ["Delete lock tokens using old gosaLockEntry class", \&delete_gosa_locks];
$commands{"--install-plugins"} = ["Installing FusionDirectory's plugins", \&install_plugins];
$commands{"--encrypt-passwords"} = ["Encrypt passwords in fusiondirectory.conf", \&encrypt_passwords];
$commands{"--show-version"} = ["Show FusionDirectory version from variables_common.inc", \&show_version];
$commands{"--list-vars"} = ["List possible vars to give --set", \&list_vars];
$commands{"--write-vars"} = ["Choose FusionDirectory Directories", \&write_vars];
$commands{"--set-VAR=value"} = ["Set the variable VAR to value see --list-vars", \&die]; # Won't be called because it contains uppercase
$commands{"--list-deprecated"} = ["List deprecated attributes and objectclasses", \&list_deprecated];
$commands{"--check-deprecated"} = ["List LDAP entries using deprecated attributes or objectclasses", \&check_deprecated];
$commands{"--ldif-deprecated"} = ["# Print an LDIF removing deprecated attributes",\&ldif_deprecated];
$commands{"--show-config"} = ["Show an LDAP dump of the FusionDirectory configuration", \&show_ldap_config];
$commands{"--set-config-VAR=value"} = ["Set the value in LDAP of a configuration field",\&set_config_var];
my $usage = 0;
set_vars();
foreach my $arg ( @ARGV ) {
if (( $arg =~ m/^--set-(.*)=(.*)$/ ) && (grep {$_ eq lc($1)} @vars_keys)) {
$vars{lc($1)} = $2;
print "Setting ".lc($1)." to $2\n";
set_vars();
} elsif ( $arg =~ m/^--set-config-(.*)=(.*)$/ ) {
set_config_var($1, $2);
} elsif ( defined $commands { lc ( $arg ) } ) {
my @command = @{ $commands{ $arg } };
if ((defined $command[2]) && $command[2]) {
read_ldap_config();
}
print( $command[0]."\n" );
$command[1]();
} elsif ( ( lc($arg) eq "--help" ) || ( lc($arg) eq "-h" ) ) {
print ( "\nCommands:\n" );
while ( my ( $key,$value ) = each %commands ) {
print ( "$key\t".$value->[0]."\n" );
}
print ("--yes\t\t\tAlways answer yes to yes/no questions\n");
print ("--help\t\t\tShows this help\n\n");
} elsif (( lc($arg) eq "--yes" ) || ( lc($arg) eq "-y" )) {
$yes_flag = 1;
} else {
print ("\nInvalid argument\n\n");
$usage = 1;
1891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960
}
}
if( $usage || ( @ARGV <= 0 ) ) {
print ( "Usage : $0 [--yes]" );
foreach my $command ( keys ( %commands )) {
print ( " [$command]" );
}
print "\n\n";
}
exit 0;
__END__
=head1 NAME
fusiondirectory-setup - FusionDirectory configuration management tool
=head1 DESCRIPTION
This script is designed to perform multiple checks on your FusionDirectory/LDAP architecture, and fix usual misconfiguration.
Some extra features allow you to install FusionDirectory's plugins, and change destinations directories.
=head2 Options
=over 4
=item --update-cache
This option update the /var/cache/fusiondirectory/class.cache file. Which contain PHP classes used in FusionDirectory, and their location.
=item --update-locales
This option update internalization, by generating a new .mo locales file for each language, with every .po files it found.
Needs I<msgcat> and I<msgfmt> to be installed.
=item --check-directories
This option perform a check on all FusionDirectory's files or directories.
=item --check-config
This option perform a check on FusionDirectory's config file.
=item --check-ldap
This option check your LDAP tree. Looking for admin account, and groups or people branch. If one of those don't exists, the script will ask you what to do.
=item --check-ids
This option check your LDAP tree for duplicated uidNumber or gidNumber among users and groups.
=item --migrate-users
This option add FusionDirectory attributes to the people branch.
=item --migrate-phones
This option removes device objectClass for phones as fdPhones is now structural since FD 1.1.
=item --migrate-systems
This option replace old systems objectClasses by new objectClasses from FD 1.1.
=item --migrate-winstations
This option replace old winstations objectClasses by new objectClasses from FD 1.1.
=item --migrate-dhcp
1961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030
This option moves DHCP configurations from systems branch to DHCP branch, which is necessary for FusionDirectory 1.0.17 and above.
=item --delete-gosa-locks
This option will delete old GOsa style lock tokens from 1.0.15 or older
=item --install-plugins
This option will install the plugin from a tar.gz of the plugin. This option is intended for people wanting to install from the sources.
=item --encrypt-passwords
This option will encrypt the password inside your fusiondirectory.conf file, it need the headers module to be activated in your apache to work.
=item --show-version
This option will parse the file variables_common.inc of FusionDirectory to find out which version of FusionDirectory is installed.
=item --list_vars
This option will list the variables you can change to install FusionDirectory on another set of directories. This option is intended for people wanting to install from the sources.
=item --write-vars
This option will write back the variables.inc file with the updated variables and is only useful with --set-VAR=variable and for people installing from sources.
=item --set-VAR=variable
This option will change the variable for the FusionDirectory installation. it is only useful with --install-directories and for people installing from sources.
=item --list-deprecated
This option will list the deprecated attributes and objectclasses still in your schemas and no longer used by FusionDirectory.
=item --check-deprecated
This option will list the dn of LDAP entries using deprecated attributes or objectclasses and no longer used by FusionDirectory.
=item --ldif-deprecated
This option will print an LDIF to allow you to remove deprecated attributes from you ldap server. Be careful and check before applying.
=item --show-config
This option will print a dump of the FusionDirectory configuration LDAP node.
=item --set-config-VAR=value
This option sets the value of a configuration field in the LDAP. The value needs to be in the correct LDAP format.
You cannot set multivalued field with this. The var name can be provided with or without the fd prefix.
=item --yes
This flag will answer "yes" to every yes/no question asked by the script
=back
=head1 EXAMPLE
benoit@catbert$ fusiondirectory-setup --update-cache --update-locales
Update FusionDirectory class cache and update localization
benoit@catbert$ fusiondirectory-setup --list-vars
List possible vars to give --set
locale_cache_dir [locale]
config_file [fusiondirectory.conf]
fd_cache [/var/cache/fusiondirectory]
fd_smarty_dir [/usr/share/php/smarty3]
fd_spool_dir [/var/spool/fusiondirectory]
203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072
fai_log_dir [fai]
tmp_dir [tmp]
secrets_file [fusiondirectory.secrets]
template_dir [template]
locale_dir [locale]
class_cache [class.cache]
fd_config_dir [/etc/fusiondirectory]
fd_home [/var/www/fusiondirectory]
benoit@catbert$ fusiondirectory-setup --set-class_cache=class.cache --write-vars
update the class.cache name and write back the variables.inc file
=head1 BUGS
Please report any bugs, or post any suggestions, to the fusiondirectory mailing list fusiondirectory-users or to
<https://gitlab.fusiondirectory.org/fusiondirectory/fd/issues/new>
=head1 AUTHORS
Benjamin Carpentier
Come Bernigaud
=head1 LICENCE AND COPYRIGHT
This code is part of FusionDirectory (http://www.fusiondirectory.org/)
=over 2
=item Copyright (C) 2011-2018 FusionDirectory
=back
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.
=cut