Commit 94bbc72f authored by sikeda's avatar sikeda
Browse files

[svn] Retrieving modifications about naming of system variable from trunk.

Exception: Log::do_log() uses "%m" format string instead of $ERRNO parameter.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@11316 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent c809d762
......@@ -26,6 +26,7 @@
use lib '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Getopt::Long;
use Conf;
......@@ -58,7 +59,7 @@ my $msg_count = 0;
#$main::options{'debug'} = 1;
#$main::options{'debug2'} = 1 if ($main::options{'debug'});
$| = 1;
$OUTPUT_AUTOFLUSH = 1;
my %opt;
unless (GetOptions(\%opt, 'input-directory=s')) {
......@@ -72,7 +73,7 @@ my $listname = $ARGV[0];
my $robot = $ARGV[1];
## Check UID
unless ([getpwuid $<]->[0] eq Sympa::Constants::USER) {
unless ([getpwuid $UID]->[0] eq Sympa::Constants::USER) {
printf
"You should run this script as user \"%s\", ignore ? (y/CR)",
Sympa::Constants::USER;
......
......@@ -6,6 +6,7 @@
use lib '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Sympa::Archive;
use Conf;
......@@ -28,8 +29,8 @@ if ($Conf::Conf{'db_name'} and $Conf::Conf{'db_type'}) {
} # to check availabity of Sympa database
# Set the UserID & GroupID for the process
$( = $) = (getgrnam(Sympa::Constants::GROUP))[2];
$< = $> = (getpwnam(Sympa::Constants::USER))[2];
$GID = $EGID = (getgrnam(Sympa::Constants::GROUP))[2];
$UID = $EUID = (getpwnam(Sympa::Constants::USER))[2];
# Sets the UMASK
umask(oct($Conf::Conf{'umask'}));
......
......@@ -26,6 +26,7 @@
use lib '--modulesdir--';
use strict;
use warnings;
use English qw(-no_match_vars);
use Conf;
use Sympa::Constants;
......@@ -38,7 +39,7 @@ use tools;
my %options;
$| = 1;
$OUTPUT_AUTOFLUSH = 1;
## Check UID
#unless (getlogin() eq Sympa::Constants::USER) {
......@@ -144,7 +145,7 @@ foreach my $vr (keys %{$Conf::Conf{'robots'}}) {
foreach my $d (@directories) {
unless (opendir DIR, $d) {
printf STDERR "Error: Cannot read %s directory : %s\n", $d, $!;
printf STDERR "Error: Cannot read %s directory : %s\n", $d, $ERRNO;
next;
}
......@@ -213,7 +214,8 @@ foreach my $tpl (@templates) {
unless (-d $dest_path) {
printf "Creating $dest_path directory\n";
unless (my_mkdir($dest_path)) {
printf STDERR "Error : Cannot create $dest_path directory : $!\n";
printf STDERR "Error : Cannot create %s directory: %s\n",
$dest_path, $ERRNO;
next;
}
unless (
......@@ -237,8 +239,8 @@ foreach my $tpl (@templates) {
## Rename old files to .converted
unless (rename $tpl, "$tpl.converted") {
printf STDERR
"Error : failed to rename $tpl to $tpl.converted : $!\n";
printf STDERR "Error : failed to rename %s to %s.converted: %s\n",
$tpl, $tpl, $ERRNO;
next;
}
}
......@@ -251,12 +253,12 @@ sub convert {
## Convert tpl file
unless (open TPL, $in_file) {
print STDERR "Cannot open $in_file : $!\n";
print STDERR "Cannot open $in_file : $ERRNO\n";
return undef;
}
if ($out_file) {
unless (open TT2, ">$out_file") {
print STDERR "Cannot create $out_file : $!\n";
print STDERR "Cannot create $out_file : $ERRNO\n";
return undef;
}
}
......@@ -300,14 +302,15 @@ sub my_mkdir {
unless (-d $root_path) {
unless (mkdir($root_path, 0777)) {
printf STDERR
"Error : Cannot create $root_path directory : $!\n";
printf STDERR "Error : Cannot create directory %s: %s\n",
$root_path, $ERRNO;
return undef;
}
}
unless (mkdir($path, 0777)) {
printf STDERR "Error : Cannot create $path directory : $!\n";
printf STDERR "Error : Cannot create directory %s: %s\n", $path,
$ERRNO;
return undef;
}
} else {
......
......@@ -26,7 +26,7 @@
use lib split(/:/, $ENV{SYMPALIB} || ''), '--modulesdir--';
use strict;
use warnings;
use Getopt::Long;
use English qw(-no_match_vars);
use SOAP::Lite;
## Sympa API
......@@ -57,8 +57,8 @@ Log::do_log('info', 'SOAP server launched');
## We set the real UID with the effective UID value
## It is usefull to allow execution of scripts like alias_manager
## that otherwise might loose the benefit of SetUID
$< = $>; ## UID
$( = $); ## GID
$UID = $EUID; ## UID
$GID = $EGID; ## GID
unless (SDM::check_db_connect()) {
Log::do_log('err', 'SOAP server requires a RDBMS to run');
......
This diff is collapsed.
......@@ -28,11 +28,13 @@ package Conf;
use strict;
use warnings;
use English qw(-no_match_vars);
use Storable;
use Sympa::ConfDef;
use Sympa::Constants;
use Sympa::Language;
use Sympa::LockedFile;
use Log;
use Sympa::Robot;
use SDM;
......@@ -807,9 +809,8 @@ sub checkfiles {
unless (open(FF, ">$dir" . '/index.html')) {
Log::do_log(
'err',
'Unable to create %s/index.html as an empty file to protect directory: %s',
$dir,
$!
'Unable to create %s/index.html as an empty file to protect directory: %m',
$dir
);
}
close FF;
......@@ -864,8 +865,8 @@ sub checkfiles {
unless (-d $dir) {
unless (tools::mkdir_all($dir, 0755)) {
Sympa::Robot::send_notify_to_listmaster('cannot_mkdir',
$robot, ["Could not create directory $dir: $!"]);
Log::do_log('err', 'Failed to create directory %s', $dir);
$robot, ["Could not create directory $dir: $ERRNO"]);
Log::do_log('err', 'Failed to create directory %s: %m', $dir);
return undef;
}
}
......@@ -891,10 +892,10 @@ sub checkfiles {
unless (open(CSS, ">$dir/$css")) {
Sympa::Robot::send_notify_to_listmaster(
'cannot_open_file', $robot,
["Could not open file $dir/$css: $!"]);
["Could not open file $dir/$css: $ERRNO"]);
Log::do_log(
'err',
'Failed to open (write) file %s',
'Failed to open (write) file %s: %m',
$dir . '/' . $css
);
return undef;
......@@ -1090,7 +1091,7 @@ sub _load_auth {
## Open the configuration file or return and read the lines.
unless (open(IN, $config_file)) {
Log::do_log('notice', 'Unable to open %s: %s', $config_file, $!);
Log::do_log('notice', 'Unable to open %s: %m', $config_file);
return undef;
}
......@@ -1148,7 +1149,7 @@ sub _load_auth {
}
eval "require AuthCAS";
if ($@) {
if ($EVAL_ERROR) {
Log::do_log('err',
'Failed to load AuthCAS perl module');
return undef;
......@@ -1263,8 +1264,8 @@ sub load_charset {
return {} unless $config_file;
unless (open CONFIG, $config_file) {
Log::do_log('err', 'Unable to read configuration file %s: %s',
$config_file, $!);
Log::do_log('err', 'Unable to read configuration file %s: %m',
$config_file);
return {};
}
while (<CONFIG>) {
......@@ -1276,7 +1277,7 @@ sub load_charset {
unless ($cset) {
Log::do_log('err',
'Charset name is missing in configuration file %s line %d',
$config_file, $.);
$config_file, $NR);
next;
}
# canonicalize lang if possible.
......@@ -1301,7 +1302,7 @@ sub load_nrcpt_by_domain {
## Open the configuration file or return and read the lines.
unless (open IN, '<', $config_file) {
Log::do_log('err', 'Unable to open %s: %s', $config_file, $!);
Log::do_log('err', 'Unable to open %s: %m', $config_file);
return;
}
while (<IN>) {
......@@ -1505,7 +1506,7 @@ sub load_generic_conf_file {
my (@paragraphs);
## Just in case...
local $/ = "\n";
local $RS = "\n";
## Set defaults to 1
foreach my $pname (keys %structure) {
......@@ -2148,7 +2149,7 @@ sub _check_cpan_modules_required_by_config {
## Some parameters require CPAN modules
if ($param->{'config_hash'}{'dkim_feature'} eq 'on') {
eval "require Mail::DKIM";
if ($@) {
if ($EVAL_ERROR) {
Log::do_log('notice',
'Failed to load Mail::DKIM perl module ; setting "dkim_feature" to "off"'
);
......@@ -2371,11 +2372,11 @@ sub _save_binary_cache {
}
eval { Storable::store_fd($param->{'conf_to_save'}, $lock_fh); };
if ($@) {
if ($EVAL_ERROR) {
Log::do_log(
'err',
'Failed to save the binary config %s. error: %s',
$param->{'target_file'}, $@
$param->{'target_file'}, $EVAL_ERROR
);
unless ($lock_fh->close()) {
return undef;
......@@ -2389,11 +2390,11 @@ sub _save_binary_cache {
$param->{'target_file'}
);
};
if ($@) {
if ($EVAL_ERROR) {
Log::do_log(
'err',
'Failed to change owner of the binary file %s. error: %s',
$param->{'target_file'}, $@
$param->{'target_file'}, $EVAL_ERROR
);
unless ($lock_fh->close()) {
return undef;
......@@ -2419,11 +2420,11 @@ sub _load_binary_cache {
}
eval { $result = Storable::fd_retrieve($lock_fh); };
if ($@) {
if ($EVAL_ERROR) {
Log::do_log(
'err',
'Failed to load the binary config %s. error: %s',
$param->{'config_file'}, $@
$param->{'config_file'}, $EVAL_ERROR
);
unless ($lock_fh->close()) {
return undef;
......
......@@ -26,6 +26,7 @@ package Log;
use strict;
use warnings;
use English qw(-no_match_vars);
use POSIX qw();
use Scalar::Util;
use Sys::Syslog qw();
......@@ -60,17 +61,17 @@ our $last_date_aggregation;
sub fatal_err {
my $m = shift;
my $errno = $!;
my $errno = $ERRNO;
eval {
Sys::Syslog::syslog('err', $m, @_);
Sys::Syslog::syslog('err', "Exiting.");
};
if ($@ && ($warning_date < time - $warning_timeout)) {
if ($EVAL_ERROR && ($warning_date < time - $warning_timeout)) {
$warning_date = time + $warning_timeout;
unless (
Sympa::Robot::send_notify_to_listmaster(
'logs_failed', $Conf::Conf{'domain'}, [$@]
'logs_failed', $Conf::Conf{'domain'}, [$EVAL_ERROR]
)
) {
print STDERR "No logs available, can't send warning message";
......@@ -91,7 +92,7 @@ sub fatal_err {
sub do_log {
my $level = shift;
my $message = shift;
my $errno = $!;
my $errno = $ERRNO;
unless (exists $levels{$level}) {
do_log('err', 'Invalid $level: "%s"', $level);
......@@ -201,10 +202,10 @@ sub do_log {
Sys::Syslog::syslog($level, '%s', $message);
}
};
if ($@ and $warning_date < time - $warning_timeout) {
if ($EVAL_ERROR and $warning_date < time - $warning_timeout) {
$warning_date = time + $warning_timeout;
Sympa::Robot::send_notify_to_listmaster('logs_failed',
$Conf::Conf{'domain'}, [$@]);
$Conf::Conf{'domain'}, [$EVAL_ERROR]);
}
}
......@@ -230,14 +231,14 @@ sub do_connect {
# process inherit the openlog with parameters from parent process
Sys::Syslog::closelog;
eval {
Sys::Syslog::openlog("$log_service\[$$\]", 'ndelay,nofatal',
Sys::Syslog::openlog("$log_service\[$PID\]", 'ndelay,nofatal',
$log_facility);
};
if ($@ && ($warning_date < time - $warning_timeout)) {
if ($EVAL_ERROR && ($warning_date < time - $warning_timeout)) {
$warning_date = time + $warning_timeout;
unless (
Sympa::Robot::send_notify_to_listmaster(
'logs_failed', $Conf::Conf{'domain'}, [$@]
'logs_failed', $Conf::Conf{'domain'}, [$EVAL_ERROR]
)
) {
print STDERR "No logs available, can't send warning message";
......
......@@ -660,7 +660,7 @@ sub data_structure_uptodate {
if (-f $version_file) {
unless (open VFILE, $version_file) {
Log::do_log('err', 'Unable to open %s: %s', $version_file, $!);
Log::do_log('err', 'Unable to open %s: %m', $version_file);
return undef;
}
while (<VFILE>) {
......
......@@ -39,6 +39,7 @@ package Sympa::Admin;
use strict;
use warnings;
use Encode qw();
use English qw(-no_match_vars);
use File::Copy qw();
use IO::Scalar;
......@@ -274,7 +275,8 @@ sub create_list_old {
## Check the privileges on the list directory
unless (mkdir($list_dir, 0777)) {
Log::do_log('err', 'Unable to create %s: %s', $list_dir, $?);
Log::do_log('err', 'Unable to create %s: %s', $list_dir,
$CHILD_ERROR);
return undef;
}
......@@ -302,8 +304,7 @@ sub create_list_old {
## Lock config before openning the config file
my $lock_fh = Sympa::LockedFile->new($list_dir . '/config', 5, '>');
unless ($lock_fh) {
Log::do_log('err', 'Impossible to create %s/config: %s',
$list_dir, $!);
Log::do_log('err', 'Impossible to create %s/config: %m', $list_dir);
return undef;
}
## Use an intermediate handler to encode to filesystem_encoding
......@@ -324,7 +325,7 @@ sub create_list_old {
## info file creation.
unless (open INFO, '>', "$list_dir/info") {
Log::do_log('err', 'Impossible to create %s/info: %s', $list_dir, $!);
Log::do_log('err', 'Impossible to create %s/info: %m', $list_dir);
}
if (defined $param->{'description'}) {
Encode::from_to($param->{'description'},
......@@ -510,7 +511,8 @@ sub create_list {
}
unless (-r $list_dir || mkdir($list_dir, 0777)) {
Log::do_log('err', 'Unable to create %s: %s', $list_dir, $?);
Log::do_log('err', 'Unable to create %s: %s', $list_dir,
$CHILD_ERROR);
return undef;
}
......@@ -525,8 +527,7 @@ sub create_list {
## Lock config before openning the config file
my $lock_fh = Sympa::LockedFile->new($list_dir . '/config', 5, '>');
unless ($lock_fh) {
Log::do_log('err', 'Impossible to create %s/config: %s',
$list_dir, $!);
Log::do_log('err', 'Impossible to create %s/config: %m', $list_dir);
return undef;
}
#tt2::parse_tt2($param, 'config.tt2', $lock_fh, [$family->{'dir'}]);
......@@ -541,7 +542,7 @@ sub create_list {
$param->{'description'} =~ s/\r\n|\r/\n/g;
unless (open INFO, '>', "$list_dir/info") {
Log::do_log('err', 'Impossible to create %s/info: %s', $list_dir, $!);
Log::do_log('err', 'Impossible to create %s/info: %m', $list_dir);
}
if (defined $param->{'description'}) {
print INFO $param->{'description'};
......@@ -567,8 +568,8 @@ sub create_list {
$param->{'listname'}, $family->{'name'}, $robot, $file);
}
unless (open FILE, '>', "$list_dir/$file") {
Log::do_log('err', 'Impossible to create %s/%s: %s',
$list_dir, $file, $!);
Log::do_log('err', 'Impossible to create %s/%s: %m',
$list_dir, $file);
}
print FILE $file_content;
close FILE;
......@@ -1025,8 +1026,8 @@ sub rename_list {
'queuesubscribe', 'queueautomatic'
) {
unless (opendir(DIR, $Conf::Conf{$spool})) {
Log::do_log('err', 'Unable to open "%s" spool: %s',
$Conf::Conf{$spool}, $!);
Log::do_log('err', 'Unable to open "%s" spool: %m',
$Conf::Conf{$spool});
}
foreach my $file (sort readdir(DIR)) {
......@@ -1065,10 +1066,9 @@ sub rename_list {
) {
Log::do_log(
'err',
'Unable to rename %s to %s: %s',
"$Conf::Conf{$spool}/$newfile",
'Unable to rename %s to %s: %m',
"$Conf::Conf{$spool}/$newfile",
$!
"$Conf::Conf{$spool}/$newfile"
);
next;
}
......@@ -1090,10 +1090,9 @@ sub rename_list {
) {
Log::do_log(
'err',
'Unable to rename %s to %s: %s',
'Unable to rename %s to %s: %m',
"$Conf::Conf{'queuedigest'}/$old_listname",
"$Conf::Conf{'queuedigest'}/$param{'new_listname'}",
$!
"$Conf::Conf{'queuedigest'}/$param{'new_listname'}"
);
next;
}
......@@ -1110,10 +1109,9 @@ sub rename_list {
) {
Log::do_log(
'err',
'Unable to rename %s to %s: %s',
'Unable to rename %s to %s: %m',
"$Conf::Conf{'queuedigest'}/$old_listname\@$robot",
"$Conf::Conf{'queuedigest'}/$param{'new_listname'}\@$param{'new_robot'}",
$!
"$Conf::Conf{'queuedigest'}/$param{'new_listname'}\@$param{'new_robot'}"
);
next;
}
......@@ -1169,7 +1167,7 @@ sub clone_list_as_empty {
}
unless (mkdir $new_dir, 0775) {
Log::do_log('err', 'Failed to create directory %s: %s', $new_dir, $!);
Log::do_log('err', 'Failed to create directory %s: %m', $new_dir);
return undef;
}
chmod 0775, $new_dir;
......@@ -1183,8 +1181,8 @@ sub clone_list_as_empty {
) {
Log::do_log(
'err',
'Failed to copy_directory %s: %s',
$new_dir . '/' . $subdir, $!
'Failed to copy_directory %s: %m',
$new_dir . '/' . $subdir
);
return undef;
}
......@@ -1200,8 +1198,8 @@ sub clone_list_as_empty {
) {
Log::do_log(
'err',
'Failed to copy %s: %s',
$new_dir . '/' . $file, $!
'Failed to copy %s: %m',
$new_dir . '/' . $file
);
return undef;
}
......@@ -1218,8 +1216,8 @@ sub clone_list_as_empty {
) {
Log::do_log(
'err',
'Failed to copy %s: %s',
$new_dir . '/' . $file, $!
'Failed to copy %s: %m',
$new_dir . '/' . $file
);
return undef;
}
......@@ -1383,7 +1381,7 @@ sub list_check_smtp {
push @addresses, "$list\@" . $domain;
eval { require Net::SMTP; };
if ($@) {
if ($EVAL_ERROR) {
Log::do_log('err',
"Unable to use Net library, Net::SMTP required, install it (CPAN) first"
);
......@@ -1425,14 +1423,14 @@ sub install_aliases {
/^none$/i;
my $alias_manager = $Conf::Conf{'alias_manager'};
my $output_file = $Conf::Conf{'tmpdir'} . '/aliasmanager.stdout.' . $$;
my $output_file = $Conf::Conf{'tmpdir'} . '/aliasmanager.stdout.' . $PID;
my $error_output_file =
$Conf::Conf{'tmpdir'} . '/aliasmanager.stderr.' . $$;
$Conf::Conf{'tmpdir'} . '/aliasmanager.stderr.' . $PID;
Log::do_log('debug2', '%s add %s %s', $alias_manager, $list->{'name'},
$list->{'admin'}{'host'});
unless (-x $alias_manager) {
Log::do_log('err', 'Failed to install aliases: %s', $!);
Log::do_log('err', 'Failed to install aliases: %m');
return undef;
}
......@@ -1440,12 +1438,12 @@ sub install_aliases {
# parameter to determine robot.
my ($saveout, $saveerr);
unless (open $saveout, '>&STDOUT' and open STDOUT, '>', $output_file) {
Log::do_log('err', 'Cannot open file %s: %s', $output_file, $!);
Log::do_log('err', 'Cannot open file %s: %m', $output_file);
return undef;
}
unless (open $saveerr, '>&STDERR'
and open STDERR, '>', $error_output_file) {
Log::do_log('err', 'Cannot open file %s: %s', $error_output_file, $!);
Log::do_log('err', 'Cannot open file %s: %m', $error_output_file);
open STDOUT, '>&', $saveout;
return undef;
}
......
......@@ -307,8 +307,8 @@ sub clean_archive_directory {
} else {
Log::do_log(
'err',
'Unable to open directory %s: %s',
$answer->{'dir_to_rebuild'}, $!
'Unable to open directory %s: %m',
$answer->{'dir_to_rebuild'}
);
tools::del_dir($answer->{'cleaned_dir'});
return undef;
......
......@@ -313,7 +313,6 @@ sub store {
$message_already_on_spool = 1;
} else {
## search if this message is already in spool database : mailfile may
## perform multiple submission of exactly the same message
unless (
......
......@@ -27,6 +27,7 @@ package Sympa::DBManipulatorSQLite;
use strict;
use warnings;
use DBI qw();
use English qw(-no_match_vars);
use POSIX qw();
use Log;
......@@ -655,11 +656,11 @@ sub do_query {
$rc = $self->{'dbh'}->rollback;
}
};
if ($@ or !$rc) {
if ($EVAL_ERROR or !$rc) {
Log::do_log(
'err',
'Could not unlock database: %s',
$@ || sprintf('(%s) %s',
$EVAL_ERROR || sprintf('(%s) %s',
$self->{'dbh'}->err, $self->{'dbh'}->errstr)
);
return undef;
......@@ -697,11 +698,11 @@ sub do_prepared_query {
$rc = $self->{'dbh'}