#!/usr/bin/env perl
# Renice some processes, to make system more respositive

# TODO: Add perlcritic rules :)
use strict;
use warnings;
use utf8;
use open         qw (:std :utf8);
use Encode       qw (encode);
use English      qw (-no_match_vars);

use Getopt::Long qw (GetOptions);
use JSON::XS        ();
use POSIX        qw (setsid :sys_resource_h);
use Proc::Find   qw (find_proc);
use Time::HiRes  qw (usleep);

local $SIG{INT}  = \&__signal_handler;
local $SIG{TERM} = \&__signal_handler;

my $uid = $<;

# We need it empty on first iteration
my %ionice_pids     = ();
my %ionice_pids_new = ();

my ($pidfile, $configfile, $help, $loopdelay);

GetOptions (
	'pidfile=s'   => \$pidfile,    # Пусть будет глобальной переменной, чтобы обратиться к ней в хэндлерах сигналов
	'config=s'    => \$configfile,
	'help'        => \$help,
);

if (defined $help) {
	help ();
	exit 0;
}

my $config = LoadConf();

unless (defined $pidfile) {
	$pidfile = '/run/reniced.pid';

	if ($uid > 0) {
		$pidfile = sprintf '/tmp/reniced-%s.pid', $uid;
	}

	if ((defined $config->{pidfile})) {
		$pidfile = $config->{parameters}->{pidfile};
	}
}

if (! $config->{parameters}->{foreground}) {
	daemonize ();
	my $pidfilehandler;

	# Поскольку мы логи никуда не пишем, то обработать ошибку, если она возникнет, вербозно не можем.
	if (open ($pidfilehandler, '>', $pidfile)) {
		if (print {$pidfilehandler} $PID) {
			close $pidfilehandler;
		}
	}
}

if ((defined $config->{parameters}->{loopdelay})  &&  ($config->{parameters}->{loopdelay} > 2)) {
	$loopdelay = $config->{parameters}->{loopdelay};
} else {
	$loopdelay = 2;
}

while (sleep $loopdelay) {
	# Конечно, хотелось бы не искать по регулярке, ибо это относительно затратно, а просто собрать список... но что поделать
	my $cmd = find_proc (
		name   => qr /./,
		detail => 1,
	);

	if ((defined $cmd)  &&  ($#{$cmd} > 0)) {
		# bulk chanage niceness :)
		my $prio = $config->{prio};
		my $kill = $config->{kill};

		foreach my $kill_signal (keys %{$kill}) {
			my @pids;

			foreach my $command (@{$cmd}) {
				foreach my $command_pattern (@{$kill->{$kill_signal}}) {
					if ($command->{cmdline}->[0] =~ /$command_pattern/) {
						push @pids, $command->{pid};
					}
				}
			}

			if ($#pids >= 0) {
				# This op is a bit racy, so eval() it
				eval { kill $kill_signal, join (' ', @pids) };

				# Use our cmd_delay here, but convert it from milliseconds to microseconds: 1k ms = 1 sec, 1M us = 1 sec
				# Not sure if we can handle properly delays < 10 ms, but noone really cares about such little delays.
				if (defined $config->{parameters}->{cmddelay}) {
					my $sleeptime = 1000 * $config->{parameters}->{cmddelay};
					usleep ($sleeptime);
				}
			}
		}

		foreach my $priority (keys %{$prio}) {
			my @pids;

			foreach my $command (@{$cmd}) {
				foreach my $command_pattern (@{$prio->{$priority}}) {

					if ($command->{cmdline}->[0] =~ /$command_pattern/u) {
						push @pids, $command->{pid};
					}
				}
			}

			if ($#pids >= 0) {
				# If we're not superuser we cannot set prio to negative value, for sure, so skip it
				if (($uid > 0) && ($priority < 0)) {
					# skip it
				} else {
					foreach (@pids) {
						eval { setpriority PRIO_PROCESS, $_, $priority; };

						if (defined $config->{parameters}->{cmddelay}) {
							my $sleeptime = 1000 * $config->{parameters}->{cmddelay};
							usleep ($sleeptime);
						}
					}
				}

				# Менять политику io процессам можно только руту :)
				if ($uid == 0) {
					if ($priority > 2) {
						if ($OSNAME eq 'darwin') {
							my $setflag = 0;
							my $taskpol = 'taskpolicy -b -p';

							foreach my $pid (@pids) {
								if (defined ($ionice_pids{$pid})) {
									$ionice_pids_new{$pid} = 1;
								} else {
									# set ionice for pid
									$setflag = 1;
									$ionice_pids_new{$pid} = 1;
									$taskpol .= " $pid";
								}
							}

							if ($setflag) {
								`$taskpol`;
							}
						} elsif ($OSNAME eq 'linux') {
							foreach my $pid (@pids) {
								if (defined ($ionice_pids{$pid})) {
									# do nothing
									$ionice_pids_new{$pid} = 1;
								} else {
									# set ionice for pid
									`ionice -c 3 -p $pid`;
									$ionice_pids_new{$pid} = 1;
								}

								%ionice_pids = %ionice_pids_new;
							}
						}

						if (defined $config->{parameters}->{cmddelay}) {
							my $sleeptime = 1000 * $config->{parameters}->{cmddelay};
							usleep ($sleeptime);
						}
					}
				}
			}

			$#pids = -1; undef @pids;
			sleep 1;
		}

		undef $prio;
		undef $cmd;
	}
}

# This code unreachable, but for formal correctness it should be here :)
if (-f $pidfile) {
	unlink $pidfile;
}

exit 0;

sub help {
	my $msg = "Usage: reniced [--config /etc/reniced.json] [--pidfile /run/reniced.pid] [--help]\n";
	$msg   .= "\n";
	$msg   .= "       --config  overrides default value for config file, which is /etc/reniced.json for root and ~/.reniced.json for user\n";
	$msg   .= "       --pidfile overrides default value for pid-file file, which is /run/reniced.pid for root and /tmp/reniced-uid.pid for user\n";
	$msg   .= "       --help    displays this help\n\n";

	if (defined $msg) {
		print $msg;
		exit 0;
	} else {
		warn $msg;
		exit 1;
	}
}

sub LoadConf {
	my $file = '/etc/reniced.json';

	if ((defined $configfile)  &&  ($configfile ne '')) {
		$file = $configfile;
	} else {
		my $uid = $<;

		# On recent MacOS we have no direct ability to run reniced as system service, so we have to run it as user, probably
		# via sudo, so we have to check OS here and use $HOME/.reniced.json for MacOS.
		if (($OSNAME eq 'darwin') || ($uid != 0)) {
			# Assume that script is not running under completely sanitized environment
			die "No HOME variable found.\n" unless (defined $ENV{HOME});

			$file = sprintf '%s/.reniced.json', $ENV{HOME};
		}
	}

	open my $FILEHANDLE, '<', $file || die "No config file at $file: $OS_ERROR\n";

	# Use binmode in order to get amount of read bytes (not chars!) from read()
	binmode $FILEHANDLE;
	my $len = (stat $file) [7];
	my $json;
	my $readlen = read $FILEHANDLE, $json, $len;
	$json = encode 'UTF-8', $json;

	unless (defined $readlen) {
		close $FILEHANDLE;
		die "Unable to read $file: $OS_ERROR\n";
	}

	if ($readlen != $len) {
		close $FILEHANDLE;
		die "File $file is $len bytes on disk, but we read only $readlen bytes\n";
	}

	close $FILEHANDLE;

	my $j = JSON::XS->new->utf8->relaxed;
	my $config = eval { $j->decode ($json); };

	unless (defined $config) {
		die "File $file does not contain a valid json data: $EVAL_ERROR\n";
	}

	return $config;
}

sub daemonize {
	__fork ();
	setsid ();
	open STDIN,  '<', '/dev/null';
	open STDOUT, '>', '/dev/null';
	open STDERR, '>', '/dev/null';
	__fork ();
	umask 0;
	return;
}

sub __fork {
	my $pid = fork;

	unless (defined $pid) {
		die ("Can't fork: $!");
	}

	if ($pid != 0) {
		exit;
	}

	return;
}

sub __signal_handler {
	# remove pidfile if it exist
	if (-f $pidfile) {
		unlink $pidfile;
	}

	exit 0;
}
