Use perlcritic to lint the code, make it happy

This commit is contained in:
eleksir
2020-10-18 22:47:55 +03:00
parent 9abb221dac
commit 9c629a8dbc
8 changed files with 295 additions and 209 deletions

View File

@@ -2,19 +2,22 @@
use 5.018;
use strict;
use warnings "all";
use warnings;
use utf8;
use open qw(:std :utf8);
use English qw( -no_match_vars );
use version; our $VERSION = qw(1.0);
my $workdir;
# before we run, change working dir
BEGIN {
use Cwd qw(chdir abs_path);
my @CWD = split (/\//, abs_path ($0));
my @CWD = split /\//xms, abs_path ($PROGRAM_NAME);
if ($#CWD > 1) { $#CWD = $#CWD - 2; }
$workdir = join ('/', @CWD);
chdir ($workdir);
$workdir = join '/', @CWD;
chdir $workdir;
}
use lib ("$workdir/lib", "$workdir/vendor_perl", "$workdir/vendor_perl/lib/perl5");
@@ -27,20 +30,24 @@ use conf qw(loadConf);
use botlib qw(logger);
use telegrambot qw(run_telegrambot);
sub daemonize ();
sub __fork ();
sub daemonize;
sub __fork;
$| = 1;
my $runAsUid = $<;
local $OUTPUT_AUTOFLUSH = 1;
my $runAsUid = $UID;
my $piddir = "/var/run/" . basename (abs_path ($0));
my $piddir = '/var/run/' . basename (abs_path ($PROGRAM_NAME));
my $C = loadConf ();
# if we run under root, create pid dir and set correct owner for it, same for debug log if it is defined
if ($< == 0) {
if ($UID == 0) {
my $user = $C->{user};
die "Unable to run as root, please define unprivileged user in config.json\n" unless (defined ($user));
my ($uid, $gid) = (getpwnam ($user))[2,3];
unless (defined $user) {
die "Unable to run as root, please define unprivileged user in config.json\n";
}
my ($uid, $gid) = (getpwnam $user)[2,3];
unless (-d $piddir) {
make_path (
@@ -52,9 +59,9 @@ if ($< == 0) {
}
if ($C->{'debug_log'}) {
unless (-d dirname($C->{'debug_log'})) {
unless (-d dirname ($C->{'debug_log'})) {
make_path (
dirname($C->{'debug_log'}), {
dirname ($C->{'debug_log'}), {
uid => $uid,
group => $gid
}
@@ -63,8 +70,8 @@ if ($< == 0) {
}
# drop privs
setgid ($gid) or die "Unable to switch to group of $user($!)\n";
setuid ($uid) or die "Unable to switch to account $user($!)\n";
setgid ($gid) or die "Unable to switch to group of $user($OS_ERROR)\n";
setuid ($uid) or die "Unable to switch to account $user($OS_ERROR)\n";
} else {
$piddir = $workdir;
}
@@ -73,42 +80,48 @@ if ($< == 0) {
daemonize ();
# write pidfile
my $apath = abs_path ($0);
my $apath = abs_path $PROGRAM_NAME;
unless (defined($apath)) {
logger ("Unable to get abs_path: $!");
die "Unable to get abs_path: $!\n";
unless (defined $apath) {
logger "Unable to get abs_path: $OS_ERROR";
die "Unable to get abs_path: $OS_ERROR\n";
};
# write pidfile
my $pidfile = sprintf ("%s/%s.pid", $piddir, basename ($apath));
logger ("Creating pidfile at $pidfile");
open (PID, ">", $pidfile) or die "Error opening $pidfile: $!\n";
print PID $$ or die "Error writing to $pidfile: $!\n";
close PID;
my $pidfile = sprintf '%s/%s.pid', $piddir, basename $apath;
logger "Creating pidfile at $pidfile";
open my $MYPID, '>', $pidfile or die "Error opening $pidfile: $OS_ERROR\n";
print {$MYPID} $PID or die "Error writing to $pidfile: $OS_ERROR\n";
close $MYPID; ## no critic (InputOutput::RequireCheckedSyscalls
# set correct proctitle
$0 = abs_path ($0);
$PROGRAM_NAME = abs_path $PROGRAM_NAME; ## no critic (Variables::RequireLocalizedPunctuationVars)
# run bot, at last
run_telegrambot ();
unlink ($pidfile) if (-f $pidfile);
exit 0;
sub daemonize () {
__fork ();
POSIX::setsid ();
open (STDIN, "<", "/dev/null");
open (STDOUT, ">", "/dev/null");
open (STDERR, ">", "/dev/null");
__fork ();
umask 0;
if (-f $pidfile) {
unlink $pidfile;
}
sub __fork () {
exit 0;
sub daemonize {
__fork ();
POSIX::setsid ();
open STDIN, '<', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
open STDOUT, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
open STDERR, '>', '/dev/null'; ## no critic (InputOutput::RequireCheckedSyscalls, InputOutput::RequireCheckedOpen)
__fork ();
umask 0;
return;
}
sub __fork {
my $pid = fork;
die "Can't fork: $!\n" unless (defined ($pid));
unless (defined $pid) { die "Can't fork: $OS_ERROR\n"; }
exit if ($pid != 0);
return;
}
__END__