nutestd: minetest server management/monitoring daemon

nutestd.pl

#!/usr/bin/perl -w
use strict;
use warnings;

use Sys::Syslog qw( :standard :macros );
use File::Spec::Functions qw(:ALL);
use File::Path qw(remove_tree mkpath);
use Getopt::Long;
use Cwd qw(cwd);
use IPC::Open3;
use IO::Select;
use IO::Handle;
use POSIX;
use Fcntl;

my($world, $bin, $cwd);
GetOptions('world=s' => \$world,
        'bin=s' => \$bin,
        'dir=s' => \$cwd);
$world or $world = 'world';
$bin or $bin = 'minetestserver';

if(!$cwd)
	{
	my $dotdir = catdir($ENV{'HOME'}, '.minetest', 'bin');
	$cwd or -d $dotdir and $cwd = $dotdir;
	$cwd or $cwd = cwd();
	}

$ENV{'PATH'} = '.:' . $ENV{'PATH'};

$0 =~ m#([^/]+)$#;
my $app = $1 || 'nutestd';
$0 = $app;

my $tmproot = catdir(tmpdir(), $app . '-' . getpwuid($>));
my $oldmask = umask(077);
-d $tmproot or mkpath($tmproot);
-d $tmproot or die('failed to mkdir ' . $tmproot);
umask($oldmask);

my $lockf = catfile($tmproot, 'lock');
open(LOCKFILE, '>>', $lockf) or die($!);
flock(LOCKFILE, 6) or die($!);

open(NEWINP, '<', devnull());
open(NEWOUT, '>', devnull());
open(NEWERR, '>', devnull());
STDIN->fdopen(\*NEWINP, 'r');
STDOUT->fdopen(\*NEWOUT, 'w');
STDERR->fdopen(\*NEWERR, 'w');
fork() and exit(0);
setsid();

openlog($app, 'ndelay,pid,nowait,perror', LOG_DAEMON) or die($!);
sub mylog
	{
	my $sev = shift();
	my $msg = join(' ', @_);
	syslog($sev, $msg);
	}

sub nonblock
	{
	my $sock = shift();
	my $flags = fcntl($sock, F_GETFL, 0);
	fcntl($sock, F_SETFL, $flags | O_NONBLOCK)
		or die ('set file handle nonblocking failed');
	}

my $pid = '';
my @signals = (2, 15, 9);
my $shutdown = '';
my $pausef = catdir($tmproot, 'pause');
my $restartf = catdir($tmproot, 'restart');

sub killserver
	{
	if($pid)
		{
		my $sig = shift(@signals);
		mylog(LOG_WARNING, 'killing server pid', $pid,
			'with signal', $sig);
		kill($sig, $pid);
		@signals or push(@signals, $sig);
		}
	}
	
for my $s ( 'TERM', 'INT', 'ALRM', 'PIPE' )
	{
	$SIG{$s} = sub
		{
		mylog(LOG_WARNING, 'signal:', @_);
		killserver();
		$shutdown = 1;
		};
	}
$SIG{'__DIE__'} = sub
	{
	mylog(LOG_ERR, 'exception:', @_);
	killserver();
	$shutdown = 1;
	};
$SIG{'HUP'} = sub
	{
	mylog(LOG_WARNING, 'signal:', @_);
	killserver();
	};
$SIG{'CHLD'} = sub
	{
	while(1)
		{
		my $kid = waitpid(-1, WNOHANG);
		$kid <= 0 and last;
		mylog(LOG_WARNING, 'child process', $kid, 'exit status', $?);
		}
	};

mylog(LOG_INFO, 'startup');

my $pausemsg = '';
while(!$shutdown)
	{
	utime(undef, undef, $lockf);

	if(-e $pausef and !$shutdown)
		{
		$pausemsg or mylog(LOG_INFO, 'server is paused');
		$pausemsg = 1;
		sleep(1);
		next;
		}
	$pausemsg and mylog(LOG_INFO, 'server is unpaused');
	$pausemsg = '';

	unlink($restartf);

	chdir($cwd) or die($!);
	my($sin, $sout, $serr);
	$pid = open3($sin, $sout, $serr, $bin, '--worldname', $world);
	mylog(LOG_INFO, 'server pid', $pid);
	my $stag = '[' . $pid . ']';

	@signals = (2, 15, 9);

	my $pidf = catfile($tmproot, 'pid');
	my $pidt = catfile($tmproot, '.pid.new');
	my $pfh;
	open($pfh, '>', $pidt) or die($!);
	print $pfh $pid . $/;
	close($pfh);
	rename($pidt, $pidf);

	$sout and nonblock($sout);
	$serr and nonblock($serr);
	my $lastkill = 0;
	my $buff = '';
	while(1)
		{
		utime(undef, undef, $lockf);

		if(-e $pausef or -e $restartf)
			{
			my $now = time();
			if($now > ($lastkill + 30))
				{
				killserver();
				$lastkill = $now;
				}
			}

		my $done = '';
		my $sel = new IO::Select($serr, $sout);
		foreach my $f ( $sel->can_read(1) )
			{
			my $data = '';
			my $r = $f->read($data, POSIX::BUFSIZ - length($buff));
			$r or $done = 1;
			$data and $buff .= $data;
			}
		while($buff =~ m#(.*)\n#)
			{
			my $x = $1;
			$buff = substr($buff, length($x) + 1);
			$x =~ s#^\s*\d\d:\d\d:\d\d:\s+##;
			mylog(LOG_INFO, $stag , $x);
			}
		$done and last;
		}
	$buff =~ s#^\s*\d\d:\d\d:\d\d:\s+##;
	$buff and mylog(LOG_INFO, $stag, $buff);

	syslog(LOG_INFO, 'server exited');
	$pid = 0;
	unlink($pidf);

	sleep(1);
	}

mylog(LOG_INFO, 'shutdown');