#!/usr/bin/perl

# Copyright 2014 Jan Pazdziora
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
#     http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

use strict;
use warnings FATAL => 'all';

use IO::File ();
use IO::Dir ();
use IO::Socket::UNIX ();
use Socket ();
use POSIX ();
use Time::HiRes qw(sleep time);

my $SYSTEMCTL_LOG = $ENV{"_SYSTEMCTL_LITE_LOGFILE"};
if (not defined $SYSTEMCTL_LOG) {
	$SYSTEMCTL_LOG = '/var/log/systemctl.log';
}
sub log_command {
	local * LOG;
	open(LOG, '>>', $SYSTEMCTL_LOG);
	print LOG @_;
	close LOG;
}
log_command("[@ARGV]\n");
shift if @ARGV and $ARGV[0] eq '-q';

for (my $i = 0; $i < @ARGV; $i++) {
	if ($ARGV[$i] eq '--ignore-dependencies') {
		splice @ARGV, $i, 1;
		last;
	}
}
if (@ARGV == 1 and $ARGV[0] eq 'daemon-reload') {
	exit 0;
}
if (@ARGV == 2 and $ARGV[0] eq '--system' and $ARGV[1] eq 'daemon-reload') {
	exit 0;
}

for (keys %ENV) {
	delete $ENV{$_} unless $_ =~ /^_SYSTEMCTL_LITE/;
}

my $RUNNING_DIR = '/run/systemctl-lite-running';
if (not -d $RUNNING_DIR) {
	mkdir $RUNNING_DIR;
}
my $ENABLED_DIR = '/etc/systemctl-lite-enabled';
if (defined $ENV{_SYSTEMCTL_LITE_ENABLED_DIR}) {
	$ENABLED_DIR = $ENV{_SYSTEMCTL_LITE_ENABLED_DIR};
}

if (@ARGV == 1) {
	if ($ARGV[0] eq 'start-enabled' and -d $ENABLED_DIR) {
		local * ENABLED;
		opendir ENABLED, $ENABLED_DIR;
		my %services;
		while (defined(my $f = readdir ENABLED)) {
			next if $f eq '.' or $f eq '..';
			my $modified = (stat "$ENABLED_DIR/$f")[9];
			if (defined $modified) {
				$services{$f} = $modified;
			}
		}
		close ENABLED;
		for my $s (sort { $services{$a} <=> $services{$b} or $a cmp $b } keys %services) {
			print "Starting [$s]\n";
			system $0, 'start', $s;
			exit ($? >> 8) if ($? >> 8);
		}
	}
	if ($ARGV[0] eq 'stop-running' and -d $RUNNING_DIR) {
		local * RUNNING;
		opendir RUNNING, $RUNNING_DIR;
		my %services;
		while (defined(my $f = readdir RUNNING)) {
			next if $f eq '.' or $f eq '..';
			my $modified = (stat "$RUNNING_DIR/$f")[9];
			if (defined $modified) {
				my $trimmed = $f;
				$trimmed =~ s/\..+$//;
				$services{$trimmed} = $modified;
			}
		}
		close RUNNING;
		for my $s (sort { $services{$b} <=> $services{$a} or $a cmp $b } keys %services) {
			system $0, 'stop', $s;
		}
	}
	exit;
}

if (@ARGV != 2) {
	die "Usage: $0 (start|stop|status|...) (service|target|socket thing)\n";
}

my ($COMMAND, $SERVICE) = @ARGV;
my $TYPE = 'service';
if ($SERVICE =~ /\.(target|socket)$/) {
	$TYPE = $1;
} elsif (not $SERVICE =~ /\.service$/) {
	$SERVICE .= '.service';
}

my @PATHS = (
	'/etc/systemd/system',
	'/run/systemd/system',
	'/usr/lib/systemd/system',
);

my $FULL_SERVICE = $SERVICE;
my $INSTANCE = undef;

my $file = undef;
if ($SERVICE =~ s/\@(.+)\.service$/\@.service/) {
	$INSTANCE = $1;
}
for my $p (@PATHS) {
	if (-e "$p/$SERVICE") {
		if (-l "$p/$SERVICE") {
			my $new_service = readlink("$p/$SERVICE");
			log_command("Service [$p/$SERVICE] is a symlink to [$new_service]\n");
			$new_service =~ s!^.*/!!;
			$SERVICE = $new_service;
		}
		$file = "$p/$SERVICE";
		last;
	}
}

if ($SERVICE =~ s/\@(.+)\.service$/\@.service/) {
	$INSTANCE = $1;
	for my $p (@PATHS) {
		if (-f "$p/$SERVICE") {
			$file = "$p/$SERVICE";
			last;
		}
	}
}

if (not defined $file) {
	if ($COMMAND eq 'is-enabled') {
		exit 1;
	}
	if ($COMMAND eq 'is-active') {
		exit 3;
	}
	warn "No service definition found for [$FULL_SERVICE].\n";
	exit 2;
}

sub parse_file {
	my ($file, $data) = @_;
	if (-d $file) {
		my $op;
		if ($file =~ /\.requires$/) {
			$op = 'Unit.Requires';
		} elsif ($file =~ /\.wants$/) {
			$op = 'Unit.Wants';
		} else {
			die "Unknown directory [$file].\n";
		}
		my $dh = new IO::Dir($file);
		while (defined(my $de = $dh->read)) {
			next if $de eq '.' or $de eq '..';
			push @{$data->{$op}}, $de unless $de =~ /\.target$/;
		}
		$dh->close;
		return;
	}
	my $fh = new IO::File($file);
	my $section = 'undefined';
	while (my $line = <$fh>) {
		chomp $line;
		if ($line =~ /^\[(.+)\]\s*$/) {
			$section = $1;
			next;
		}
		next if $line =~ /^\s*(#|$)/;
		if ($line =~ /^\.include\s(.+)/) {
			parse_file($1, $data);
			next;
		}
		my ($key, $value) = split /=/, $line, 2;
		if (defined $INSTANCE) {
			$value =~ s/\%i/$INSTANCE/g;
		}
		if ($key eq 'EnvironmentFile') {
			if ($value eq '') {
				delete $data->{"$section.$key"};
			} else {
				push @{ $data->{"$section.$key"} }, $value;
			}
		} elsif ($key =~ /^(Wants|Requires)$/) {
			push @{ $data->{"$section.$key"} }, $value unless $value =~ /\.target$/;
		} elsif ($key =~ /^(ExecStart(Pre|Post)|ExecReload|ExecStop(Pre|Post)?)$/) {
			push @{ $data->{"$section.$key"} }, $value;
		} else {
			$data->{"$section.$key"} = $value;
		}
	}
	$fh->close;
	if (defined $data->{'Service.ExecStart'} and not defined $data->{'Service.PIDFile'}) {
		my ($pidfile) = grep /^\/.+\.pid$/, split /\s+/, $data->{'Service.ExecStart'};
		if (defined $pidfile) {
			$data->{'Service.PIDFile'} = $pidfile;
			log_command("Guessing pid file [$data->{'Service.PIDFile'}] from ExecStart [$data->{'Service.ExecStart'}]\n");
		}
	}
}

my $data = {};
parse_file($file, $data);
for my $p (@PATHS) {
	if (-d "$p/$SERVICE.wants") {
		$file = "$p/$SERVICE.wants";
		parse_file("$p/$SERVICE.wants", $data);
		last;
	}
}

sub pidof {
	my $command = shift;
	my $pids = `/usr/sbin/pidof $command`;
	chomp $pids;
	if ($pids ne '') {
		return split /\s+/, $pids;
	}
	return;
}

sub get_exec_start {
	my $data = shift;
	my $d = $data->{'Service.ExecStart'};
	if (not defined $d) {
		warn "No ExecStart value found for [$SERVICE].\n";
		exit 3;
	}
	return split /\s+/, $d;
}

sub get_pid {
	my $file = shift;
	if (not $file =~ m!^/!) {
		$file = "$RUNNING_DIR/$file";
	}
	if (-f $file) {
		local * PIDFILE;
		open PIDFILE, '<', $file;
		my $pid = <PIDFILE>;
		close PIDFILE;
		if (defined $pid) {
			chomp $pid;
			return $pid;
		}
	}
}

sub is_running {
	my $data = shift;
	my $ret;
	if (-f "$RUNNING_DIR/$FULL_SERVICE.oneshot") {
		return 1;
	} elsif (defined $data->{'Service.PIDFile'}) {
		my $pid = get_pid($data->{'Service.PIDFile'});
		if (defined $pid) {
			$ret = kill 0, $pid;
		}
	} else {
		my $path = get_pid("$FULL_SERVICE.name");
		if (defined $path) {
			if (pidof($path)) {
				$ret = 1;
			}
		} else {
			my $pid = get_pid("$FULL_SERVICE.pid");
			if (defined $pid) {
				$ret = kill 0, $pid;
			}
		}
	}
	return $ret;
}
if ($COMMAND eq 'is-active' or $COMMAND eq 'status') {
	if (is_running($data)) {
		print "active\n";
		exit;
	}
	print "inactive\n";
	exit 3;
}

sub exec_stop_pre {
	my ($data) = @_;
	if (defined $data->{'Socket.ExecStopPre'}) {
		for my $x (@{ $data->{'Socket.ExecStopPre'} }) {
			log_command("Running stop pre [$x]\n");
			system $x;
		}
	}
}
sub exec_stop_post {
	my ($data) = @_;
	if (defined $data->{'Service.ExecStopPost'}) {
		for my $x (@{ $data->{'Service.ExecStopPost'} }) {
			log_command("Running stop post [$x]\n");
			system $x;
		}
	}
}

if ($TYPE eq 'target' and not defined $data->{'Unit.Wants'} and not defined $data->{'Unit.Requires'}) {
	warn "No Unit.Wants/.wants/Unit.Requires/.requires list for target [$SERVICE]\n";
	exit 8;
}

if ($COMMAND eq 'restart') {
	if ($TYPE ne 'service' or is_running($data)) {
		system $0, 'stop', $FULL_SERVICE;
	}
	my $ret = system $0, 'start', $FULL_SERVICE;
	exit $ret >> 8;
}

sub pids_went_away_timeout {
	my $timeout = shift;
	my $start = time;
	while (kill 0, @_) {
		if (time - $start > $timeout) {
			log_command(sprintf(" ** pid(s) [%s] not killed within %d s\n", join(', ', @_), $timeout));
			return 0;
		}
		sleep 0.1;
	}
	log_command(sprintf(" ** pid(s) [%s] got killed after %.2f s\n", join(', ', @_), time - $start));
	return 1;
}

sub stop_pids {
	my @pids = @_;
	kill 15, @pids;
	if (not pids_went_away_timeout(5, @pids)) {
		kill 9, @pids;
		if (not pids_went_away_timeout(5, @pids)) {
			log_command("Failed to kill [@pids] even with 9\n");
			warn "Failed to kill [@pids].\n";
			return 1;
		}
		log_command("Killed [@pids] with 9\n");
	} else {
		log_command("Killed [@pids] with 15\n");
	}
	return 0;
}

if ($COMMAND eq 'stop') {
	my $mainpid;
	if (defined $data->{'Service.PIDFile'}) {
		$mainpid = get_pid($data->{'Service.PIDFile'});
	} else {
		$mainpid = get_pid("$FULL_SERVICE.pid");
	}
	if (defined $data->{'Service.ExecStop'}) {
		for my $x (@{ $data->{'Service.ExecStop'} }) {
			my $runit = 1;
			if (defined $mainpid) {
				$x =~ s!\$MAINPID\b|\$\{MAINPID\}!$mainpid!g;
			} elsif ($x =~ /\$MAINPID\b|\$\{MAINPID\}/) {
				$runit = 0;
				log_command("Service [$FULL_SERVICE] would like to stop via ExecStop [$x] but we have no pid file, skipping.\n");
			}
			if ($runit) {
				log_command("Running stop [$x]\n");
				system $x;
				sleep 1;
			}
		}
	}
	my $ret = undef;
	if ($TYPE eq 'target') {
		# noop
	} elsif (defined $data->{'Service.Type'} and $data->{'Service.Type'} eq 'oneshot') {
		# noop
	} elsif ($TYPE eq 'socket') {
		my $pids = `/usr/sbin/fuser $data->{'Socket.ListenStream'} 2> /dev/null`;
		if (defined $pids) {
			chomp $pids;
			$pids =~ s/^\s+//;
			my @pids = split /\s+/, $pids;
			if (@pids) {
				exec_stop_pre($data);
				log_command("Will kill [@pids] as fuser [$data->{'Socket.ListenStream'}] of [$FULL_SERVICE]\n");
				$ret = stop_pids(@pids);
			}
		}
	} elsif (defined $data->{'Service.PIDFile'}) {
		my $pid = get_pid($data->{'Service.PIDFile'});
		if (defined $pid) {
			log_command("Will kill [$pid] found in Service.PIDFile of [$FULL_SERVICE]\n");
			$ret = stop_pids($pid);
		}
	} else {
		my $path = get_pid("$FULL_SERVICE.name");
		if (defined $path) {
			if (my @pids = pidof($path)) {
				log_command("Will kill [@pids] as pidof [$path] found in [$FULL_SERVICE.name]\n");
				$ret = stop_pids(@pids);
			} else {
				warn "No pidof for [$path] found in [$FULL_SERVICE.name].\n";
			}
		} else {
			my $pid = get_pid("$FULL_SERVICE.pid");
			if (defined $pid) {
				log_command("Will kill [$pid] found in [$FULL_SERVICE.pid]\n");
				$ret = stop_pids($pid);
			} else {
				warn "No pid and no name for [$FULL_SERVICE].\n";
			}
		}
	}
	exec_stop_post($data);
	unlink "$RUNNING_DIR/$FULL_SERVICE.pid", "$RUNNING_DIR/$FULL_SERVICE.name", "$RUNNING_DIR/$FULL_SERVICE.oneshot";
	if (defined $data->{'Unit.Wants'}) {
		for my $x (@{ $data->{'Unit.Wants'} }) {
			system $0, 'stop', $x;
		}
	}
	if (defined $data->{'Unit.Requires'}) {
		for my $x (@{ $data->{'Unit.Requires'} }) {
			system $0, 'stop', $x;
		}
	}
	exit ( defined $ret ? $ret : 0 );
}

sub add_runuser {
	my ($data, $cmd) = @_;
	if (defined $data->{'Service.User'}) {
		unshift @$cmd, '-u', $data->{'Service.User'}, '--';
		if (defined $data->{'Service.Group'}) {
			unshift @$cmd, '-g', $data->{'Service.Group'};
		}
		unshift @$cmd, '/usr/sbin/runuser';
	}
}

if ($COMMAND eq 'start') {
	my (@starting_stack, %starting_stack);
	if (defined $ENV{_SYSTEMCTL_LITE_STARTING}) {
		@starting_stack = split /:/, $ENV{_SYSTEMCTL_LITE_STARTING};
		@starting_stack{@starting_stack} = ();
		$ENV{_SYSTEMCTL_LITE_STARTING} .= ":$FULL_SERVICE";
	} else {
		$ENV{_SYSTEMCTL_LITE_STARTING} = $FULL_SERVICE;
	}

	if ($TYPE eq 'service' and is_running($data)) {
		log_command("Service [$FULL_SERVICE] already found running, not starting again.\n");
		exit;
	}
	if (defined $data->{'Service.PIDFile'}) {
		log_command("Service [$FULL_SERVICE] defines PIDFile [$data->{'Service.PIDFile'}], unlinking it before start\n");
		unlink $data->{'Service.PIDFile'};
	}
	if (defined $data->{'Unit.Wants'}) {
		for my $x (@{ $data->{'Unit.Wants'} }) {
			if (exists $starting_stack{$x}) {
				log_command("Skipping start of [$x], we are already in the process of starting it.\n");
				next;
			}
			my @cmd = ($0, 'start', $x);
			log_command("Running [@cmd] for Unit.Wants of [$FULL_SERVICE]\n");
			system @cmd;
		}
	}
	if (defined $data->{'Unit.Requires'}) {
		for my $x (@{ $data->{'Unit.Requires'} }) {
			if (exists $starting_stack{$x}) {
				log_command("Skipping start of [$x], we are already in the process of starting it.\n");
				next;
			}
			my @cmd = ($0, 'start', $x);
			log_command("Running [@cmd] for Unit.Requires of [$FULL_SERVICE]\n");
			if (system @cmd) {
				log_command("Failed to start [$x], aborting start\n");
				exit 1;
			}
		}
	}
	if (defined $data->{'Service.PIDFile'} and is_running($data)) {
		log_command("Service [$FULL_SERVICE] defines PIDFile [$data->{'Service.PIDFile'}] and it seems to have already started, not starting again.\n");
		exit;
	}

	if ($TYPE eq 'target') {
		exit;
	}
	if ($TYPE eq 'socket' and -S $data->{'Socket.ListenStream'}) {
		my $out = `/usr/sbin/fuser $data->{'Socket.ListenStream'} 2> /dev/null`;
		if (defined $out and $out ne '') {
			log_command("Service [$FULL_SERVICE] already found active on socket [$data->{'Socket.ListenStream'}], not starting again.\n");
			exit;
		}
	}
	if (defined $data->{'Service.Type'} and $data->{'Service.Type'} eq 'dbus') {
		my @cmd = ($0, 'start', 'dbus.socket');
		log_command("Running [@cmd] for Service.Type dbus\n");
		system @cmd;
	}
	if (defined $data->{'Service.ExecStartPre'}) {
		for my $x (@{ $data->{'Service.ExecStartPre'} }) {
			my $can_fail = 0;
			if ($x =~ s/^-//) {
				$can_fail = 1;
			}
			my @cmd = split /\s+/, $x;
			if (not $data->{'Service.PermissionsStartOnly'} or $data->{'Service.PermissionsStartOnly'} =~ /^(false|0)$/i) {
				add_runuser($data, \@cmd);
			}
			no warnings 'uninitialized';
			log_command("Running start pre [@cmd]\n");
			if (system @cmd and not $can_fail) {
				exit 1;
			}
		}
	}
	my @paths;
	if ($TYPE eq 'socket') {
		my $service = $SERVICE;
		if (defined $data->{'Socket.Accept'} and $data->{'Socket.Accept'} eq 'true') {
			$service =~ s/\.socket$/\@.service/;
			@paths = ( '/bin/systemctl-socket-daemon', $data->{'Socket.ListenStream'}, $data->{'Socket.SocketMode'} // '0666', $service );
		} else {
			$service =~ s/\.socket$/\.service/;
			my $ret = system "$0 is-active $service > /dev/null";
			if (($ret >> 8) == 0) {
				log_command("Service [$service] is already running for [$SERVICE]\n");
				exit;
			}
			@paths = ( $0, 'start', $service );
		}
	} else {
		@paths = get_exec_start($data);
	}
	my $first_path = $paths[0];

	my $ENV = '';
	if (exists $data->{'Service.EnvironmentFile'}) {
		for my $e (@{ $data->{'Service.EnvironmentFile'} }) {
			my $error_fail = 1;
			if ($e =~ s/^-//) {
				$error_fail = 0;
			}
			my $fh = new IO::File($e);
			if (not defined $fh) {
				if ($error_fail) {
					warn "Error reading EnvironmentFile [$e]: $!\n";
					exit 5;
				}
			} else {
				while (my $line = <$fh>) {
					chomp $line;
					next if $line =~ /^\s*(#|$)/;
					$ENV .= "export $line; ";
				}
				$fh->close();
			}
		}
	}
	if (defined $data->{'Service.Environment'}) {
		my $x = $data->{'Service.Environment'};
		$x =~ s/^"(.*)"$/$1/;
		$ENV .= "export $x; ";
	}
	add_runuser($data, \@paths);
	log_command("Running [$ENV@paths]\n");
	if (defined $data->{'Service.Type'} and $data->{'Service.Type'} eq 'oneshot') {
		system "$ENV@paths";
		if (defined $data->{'Service.RemainAfterExit'} and $data->{'Service.RemainAfterExit'} eq 'yes') {
			local * PIDFILE;
			open PIDFILE, '>', "$RUNNING_DIR/$FULL_SERVICE.oneshot";
			close PIDFILE;
		}
		exit;
	}
	my $pid = fork();
	die "Failed to fork for [@_]\n" if not defined $pid;
	if ($pid == 0) {
		open(STDOUT, '>>', $SYSTEMCTL_LOG);
		open(STDERR, '>>', $SYSTEMCTL_LOG);
		open(STDIN, '<', '/dev/null');
		POSIX::setsid();
		exec "$ENV@paths";
	}
	if (defined $data->{'Service.PIDFile'}) {
		log_command("Service [$FULL_SERVICE] defines PIDFile [$data->{'Service.PIDFile'}], not marking pid\n");
		unlink "$RUNNING_DIR/$FULL_SERVICE.pid";
		my $i = 0;
		while (not -f $data->{'Service.PIDFile'}) {
			sleep 0.2;
			$i++;
			if ($i > 250) {
				log_command("Starting [$FULL_SERVICE] did not create PIDFile [$data->{'Service.PIDFile'}]\n");
				exit 10;
			}
		}
		my $pid = get_pid($data->{'Service.PIDFile'});
		if (not defined $pid or not kill 0, $pid) {
			log_command("Starting [$FULL_SERVICE] created PIDFile [$data->{'Service.PIDFile'}] but the process is not running\n");
			exit 11;
		}
	} else {
		local * PIDFILE;
		open PIDFILE, '>', "$RUNNING_DIR/$FULL_SERVICE.pid";
		print PIDFILE "$pid\n";
		close PIDFILE;
		log_command("Marked pid [$pid] for [$FULL_SERVICE]\n");
		sleep 1;
		if (defined $data->{'Service.Type'} and $data->{'Service.Type'} ne 'simple' and $data->{'Service.Type'} ne 'notify' and pidof($first_path)) {
			local * PIDFILE;
			open PIDFILE, '>', "$RUNNING_DIR/$FULL_SERVICE.name";
			print PIDFILE "$first_path\n";
			close PIDFILE;
			log_command("Marked process name [$first_path] for [$FULL_SERVICE]\n");
		}
	}
	if (defined $data->{'Service.Type'}
		and $data->{'Service.Type'} eq 'dbus'
		and defined $data->{'Service.BusName'}) {
		my $busname = $data->{'Service.BusName'};
		my $objectpath = $busname;
		$objectpath =~ s!^|\.!/!g;
		for (0 .. 10) {
			system "/usr/bin/dbus-send --system --type=method_call --print-reply --dest=$busname $objectpath org.freedesktop.DBus.Introspectable.Introspect > /dev/null";
			exit if ($? >> 8) == 0;
			sleep 1;
		}
		exit 9;
	}
	exit;
}

if ($COMMAND eq 'is-enabled') {
	if (-e "$ENABLED_DIR/$FULL_SERVICE") {
		print "enabled\n";
		exit 0;
	}
	print "disabled\n";
	exit 1;
}

if ($COMMAND eq 'enable') {
	if (not -d $ENABLED_DIR) {
		mkdir $ENABLED_DIR;
	}
	local * FILE;
	open FILE, '>', "$ENABLED_DIR/$FULL_SERVICE" or die "Error creating $ENABLED_DIR/$FULL_SERVICE: $!\n";
	exit;
}

if ($COMMAND eq 'disable') {
	unlink "$ENABLED_DIR/$FULL_SERVICE" or die "Error removing $ENABLED_DIR/$FULL_SERVICE: $!\n";
	exit;
}

die "Unknown command [$COMMAND].\n";

1;