Commit 4958323a authored by Côme Chilliet's avatar Côme Chilliet
Browse files

Fixes perl sonar warnings in cli tools

Use 3 parameters open
Use vars for file handles
Use oct(770) instead of 0770
parent 8f5dd3cc
......@@ -156,15 +156,15 @@ foreach my $schema (@schemas) {
if ($modify < 2) {
# Searching schema name in ldif file first line.
open FILE, '< '.$path.$schema.".ldif" or die "Count not open ldif file : $!\n";
open my $file, q{<}, $path.$schema.".ldif" or die "Count not open ldif file : $!\n";
my $dn = "";
while ($dn eq "") {
chomp($dn = <FILE>);
chomp($dn = <$file>);
}
if ($dn =~ /^dn: cn=([^,]+),/) {
$schema_name = $1;
}
close(FILE);
close($file);
}
# Fallback on file name
......@@ -206,18 +206,18 @@ sub insert_schema
my $dn_part = $1;
# if the schema already exists in the LDAP server, modify it
if ($modify == 1) {
open(SCHEMA, "<".$path.$schema.".ldif") or die_with_error('Could not open '."<".$path.$schema.".ldif: $!");
open(UPDATE, ">".$path.$schema."_update.ldif") or die_with_error('Could not open '.">".$path.$schema."_update.ldif: $!");
open(my $schema, q{<}, $path.$schema.".ldif") or die_with_error('Could not open '."<".$path.$schema.".ldif: $!");
open(my $update, q{>}, $path.$schema."_update.ldif") or die_with_error('Could not open '.">".$path.$schema."_update.ldif: $!");
push @gen_files, $path.$schema."_update";
my $attrs = 0;
my $classes = 0;
while (<SCHEMA>) {
while (<$schema>) {
next if m/^#/; # remove comments
chomp;
next if m/^$/; # remove empty lines
if (m/^dn: cn=([^,]+),cn=schema,cn=config$/) {
print UPDATE "dn: $dn_part,cn=schema,cn=config\n";
print UPDATE "changetype: modify\n";
print $update "dn: $dn_part,cn=schema,cn=config\n";
print $update "changetype: modify\n";
next;
}
if (!m/^olcAttributeTypes:/ && !m/^olcObjectClasses:/ && !m/^ /) {
......@@ -231,29 +231,29 @@ sub insert_schema
if (!$attrs && m/^olcAttributeTypes:/) {
$attrs = 1;
print UPDATE "replace: olcAttributeTypes\n";
print $update "replace: olcAttributeTypes\n";
}
if (!$classes && m/^olcObjectClasses:/) {
$classes = 1;
print UPDATE "-\n";
print UPDATE "replace: olcObjectClasses\n";
print $update "-\n";
print $update "replace: olcObjectClasses\n";
}
print UPDATE;
print UPDATE "\n";
print $update;
print $update "\n";
}
close SCHEMA;
close UPDATE;
close $schema;
close $update;
} else { # Emptying schema
open(UPDATE, ">".$path.$schema."_update.ldif") or die_with_error('Could not open '.">".$path.$schema."_update.ldif: $!");
open(my $update, q{>}, $path.$schema."_update.ldif") or die_with_error('Could not open '.">".$path.$schema."_update.ldif: $!");
push @gen_files, $path.$schema."_update";
print UPDATE "dn: $dn_part,cn=schema,cn=config\n";
print UPDATE "changetype: modify\n";
print UPDATE "delete: olcAttributeTypes\n";
print UPDATE "-\n";
print UPDATE "delete: olcObjectClasses\n";
print UPDATE "-\n";
close UPDATE;
print $update "dn: $dn_part,cn=schema,cn=config\n";
print $update "changetype: modify\n";
print $update "delete: olcAttributeTypes\n";
print $update "-\n";
print $update "delete: olcObjectClasses\n";
print $update "-\n";
close $update;
}
$full_cmd = $mod_cmd.$path.$schema."_update.ldif";
print "executing '$full_cmd'\n";
......
......@@ -516,11 +516,11 @@ sub check_directories {
# if $dir is one of the dirs that remains to root
if ( grep (/.*$dir.*/, @root_config_dirs) ) {
check_rights($dir,"root","root",0755,1);
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,0770,1);
check_rights($dir,"root",$apache_group,oct(770),1);
}
}
}
......@@ -530,7 +530,7 @@ sub check_config {
my $apache_group = get_apache_group();
# check config file
check_rights($fd_config,"root",$apache_group,0640,0) or die 'The config file does not exists!';
check_rights($fd_config,"root",$apache_group,oct(640),0) or die 'The config file does not exists!';
}
############################################################# Change install directories #################################################################################
......@@ -792,21 +792,21 @@ sub get_ldap_connexion {
# bind to the LDAP server
if (-e $fd_secrets) {
open(SECRETS, $fd_secrets) || die ("Could not open $fd_secrets");
open(my $secrets, q{<}, $fd_secrets) || die ("Could not open $fd_secrets");
my $key = "";
while(<SECRETS>) {
while(<$secrets>) {
if ($_ =~ m/RequestHeader set FDKEY ([^ \n]+)\n/) {
$key = $1;
last;
}
}
close(SECRETS);
close($secrets);
$bind_pwd = cred_decrypt($bind_pwd, $key);
}
if ($tls) {
# Read LDAP config file
open (LDAPCONF,$vars{ldap_conf}) or die ("! Failed to open ldap config file '$vars{ldap_conf}': $!\n");
open (my $ldapconf, q{<}, $vars{ldap_conf}) or die ("! Failed to open ldap config file '$vars{ldap_conf}': $!\n");
my %tls_options = (
'REQCERT' => 'require',
......@@ -816,14 +816,14 @@ sub get_ldap_connexion {
'CACERT' => '',
);
# Scan LDAP config
while (<LDAPCONF>) {
while (<$ldapconf>) {
/^\s*(#|$)/ && next;
chomp;
if (m/^TLS_(REQCERT|CERT|KEY|CACERTDIR|CACERT)\s+(.*)\s*$/i) {
$tls_options{uc $1} = $2;
}
}
close(LDAPCONF);
close($ldapconf);
$ldap->start_tls(
verify => $tls_options{'REQCERT'},
......@@ -1687,14 +1687,14 @@ sub set_config_var {
sub show_version {
my $variables_common_path = "$vars{fd_home}/include/variables_common.inc";
if (-e $variables_common_path) {
open(VARS, $variables_common_path) || die ("Could not open $variables_common_path");
while(<VARS>) {
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);
close($vars);
} else {
print "File $variables_common_path does not exists, can’t find out FusionDirectory version\n";
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment