view release on metacpan or  search on metacpan

bin/realtimed  view on Meta::CPAN

use Time::HiRes;
use warnings;
use strict;
use Socket;
#use Fcntl;
use JSON;
use v5.10;
use EV;

BEGIN {
	sub lg ($;$$) {
		my ($message, $activity, $priority) = @_;
		$priority //= 'info';
		state $status = {};
		my $curtime = [Time::HiRes::gettimeofday()];
		my $elapsed = '';
		if($activity) {
			$elapsed = Time::HiRes::tv_interval($status->{$activity}->{timestamp}) if $status->{$activity}->{timestamp};
			$status->{$activity}->{timestamp} = $curtime;
			$elapsed = qq|- elapsed time: ${\sprintf("%.6f", $elapsed)} seconds| if $elapsed;
		}

		my @caller = caller(1);
		syslog $priority , '%s %s %s', $message, $elapsed, "at line $caller[2]";
	}

	my @priorities = ('emerg', 'alert', 'crit', 'err', 'warning', 'notice', 'info', 'debug');

	{
		no strict 'refs'; ## no critic
		for (@priorities) {
			my $priority = $_;
			*{__PACKAGE__ . "::$priority"} = sub ($;$) {
				my ($message, $activity) = @_;
				lg $message, $activity, $priority;
			};
		}
	}
}

# resolved to name this daemon "realtimed" cause
# suitable names already taken by other entities:
# inotifyd by Alpine Linux
# notifyd by Cyrus IMAP
# eventd by eventd.org
my $myrelpath = __FILE__;
open my $fh, '<', $myrelpath;
my $fd = fileno $fh;
my $myfullpath = readlink("/proc/$$/fd/$fd");
close $fh;
my $programname = 'realtimed';
$programname = $1 if $myfullpath =~ m{([^/]+)$};

openlog $programname, 'ndelay,pid', 'daemon';
info "detected current realtimed relative path as: $myrelpath";
info "detected current realtimed absolute path as: $myfullpath";
info "detected program name as: $programname";

my $euid = geteuid;
my $uid = getuid;
my $user = getpwuid($uid);
my $euser = getpwuid($euid);
my $rootuser = getpwuid(0);

unless ($euid == $uid){
	my $msg = "you ($user) are executing this program with setuid to $euser credentials, exiting";
	emerg $msg;
	say $msg;
	exit;
}

unless ($uid == 0){
	my $msg = "you are executing this program with $user credentials, this program requires $rootuser (uid 0) credentials to work";
	emerg $msg;
	say $msg;
	exit;
}

my $pidfile = "/var/run/${programname}.pid";
if ( -e $pidfile ) {
	my $msg = "unable to open PID file $pidfile";
	open my $fh, '<', $pidfile or emerg $msg && die $msg;
	my $pid = <$fh>;
	close $fh;
	if($pid) {
		alert "PID file $pidfile already existent for process $pid";
		if (kill 0, $pid) {
			emerg "preexistent process $pid still running, exiting";
			stopDaemon(1);
		}
	}
	alert "removing PID file $pidfile for defunct process $pid, that probably didn't shut down properly";
	unlink $pidfile;
}

my $confdir = "/etc/$programname";
unless ( -e $confdir && -d $confdir ){
	# no need for 'mkdir -p' or make_path from File::Path cause /etc must exists
	warning "main configuration directory $confdir does not exist, creating it";
	mkdir $confdir, 0755 or crit "cannot create conf directory $confdir" && exit 0;
}

my $rsyslogconffile = "/etc/rsyslog.d/${programname}.conf";
unless(-e $rsyslogconffile && -T $rsyslogconffile) {
	my $message = "$programname rsyslog conf file $rsyslogconffile does not exist, creating it";
	warning $message;
	say $message;

	my $rsyslogconf = qq{\$template	$programname,"%TIMESTAMP:::date-rfc3339% %syslogtag% %syslogseverity-text%%msg:::sp-if-no-1st-sp%%msg:::drop-last-lf%\\n"
:programname, isequal, "$programname" -/var/log/${programname}.log;$programname & stop
};

	# we assume rsyslog is installed, as it is for all main Linux distributions
	open my $fh, '>', $rsyslogconffile or die "cannot set rsyslog template: $@ $!";
	print $fh $rsyslogconf;
	close $fh;

	info 'restarting rsyslog:';
	info qx{systemctl restart rsyslog};

	info 'closing and reopening syslog';
	closelog;
	openlog $programname, 'ndelay,pid', 'daemon';