#!/usr/bin/perl -w

=head1 NAME

dh_installs6 - install s6-rc unit files

=cut

use strict;
use warnings;
use Debian::Debhelper::Dh_Lib;
use File::Find;
use Cwd qw(getcwd abs_path);

our $VERSION = DH_BUILTIN_VERSION;

=head1 SYNOPSIS

B<dh_installs6> [S<I<debhelper options>>]

=head1 DESCRIPTION

B<dh_installs6> is a debhelper program that is responsible for
installing package maintainer supplied s6-rc unit folders.

Generates F<postinst>, F<prerm> and F<postrm> code blocks for enabling,
disabling and restarting the corresponding s6-rc services, when the package
is installed, updated, or removed. These snippets are added to the
maintainer scripts by L<dh_installdeb(1)>.

A unit is enabled exactly once: the first time F<postinst> ever runs for it,
tracked by a marker file under F</var/lib/dh-s6/enabled/>I<unit> (removed on
remove/purge). The marker is only ever written by that unit's own postinst,
so it can't be affected by another package's maintainer scripts in the same
dpkg run. This mirrors B<deb-systemd-helper>'s own
F</var/lib/systemd/deb-systemd-helper-enabled/>I<unit>B<.dsh-also> state
file, and for the same reason: consulting the live s6-rc database instead
(the former C<svctl isenabled> check) breaks, because other maintainer
scripts in the same dpkg run (notably B<deb-systemd-helper>, which always
runs C<svctl compile && svctl update>) may have compiled the freshly
unpacked unit into it already, which made C<svctl isenabled> see "known,
disabled" and never enable it.

=begin comment

BEGIN TEMPORARY: delete through END TEMPORARY below, and the matching
block in F<autoscripts/postinst-s6-enable>, once the fleet is past
packages built before markers existed.

=end comment

A missing marker normally means "genuinely new, enable it" -- except on a
package's very first run under this scheme, where that's ambiguous with
"predates markers entirely", and wrongly enabling would override an
admin's earlier C<svctl disable>. A sibling unit of the same package
already having a marker rules that out; so does dpkg's old-version
argument (C<$2>) being empty, i.e. a genuine first install. Otherwise the
unit is assumed to predate markers and is left alone.

=begin comment

END TEMPORARY

=end comment

B<dh_installs6> automatically processes unit folders containing the file
F<producer-for> (services). For changing the generated blocks behaviour use
file hints (e.g. B<.noenable>) for specific unit folders.

To enable this addon in your source package use B<Build-Depends: dh-sequence-s6>
or set `--with s6` in your debian/rules file.

=head1 FILES

=over 4

=item F<debian/I<package>.s6-rc/*/>

If any of those folders exists, they are installed into
F<usr/lib/s6-rc/sources/> in the package build directory.

=item Choosing between F<.noenable> and F<.norestart>

The two hint files answer B<two different questions>, and confusing them has cost
us real breakage in both directions. Decide them separately:

=over 4

=item *

F<.noenable> answers B<"initial installation">: should this service come up when
the package is installed for the first time? Say yes to it for everything that
needs configuration a package cannot ship -- the AEP rule is "packages yes,
services off, Puppet switches on".

=item *

F<.norestart> answers B<"upgrade of a service that is already running">: when new
code arrives, may C<dpkg> decide the moment the service goes down? Say yes to it
only when the timing of that outage is an B<operational> decision -- a database, a
process manager holding connections, a filesystem provider other processes depend
on. For a stateless service that holds nothing, C<.norestart> only means the
process keeps running the old code.

=back

B<F<.noenable> alone already prevents a start on initial installation.> The restart
block only touches a unit when C<svctl isenabled || svctl isup> says yes, and on a
first installation with F<.noenable> neither is true. So adding F<.norestart> "to
be safe" buys nothing there -- it only costs you the restart on later upgrades.

Where F<.norestart> is the right answer, the state it creates -- new package,
old process -- is not visible without help. The C<restart_pending> field of
C<aep-zabbix-checks> (>= 0.4.5) reports it per unit; wire a trigger to it, or the
pending restart will simply be forgotten. Measured case: aep-zabbix-checks-vrrp
0.1.7 was installed on rt-1.tick1 while the vrrp-gap process was 40908 seconds
old, so the watchdog's heartbeat file, added in 0.1.6, never appeared at all.

=item F<debian/I<package>.s6-rc/*/.noenable>

Disable the service(s) on purge, but do not enable them on install.

B<Note> that this option also affects whether the services are
started/restarted. If a service is enabled or was running it will be
started/restarted. Use file B<.norestart> to mitigate that -- but read the
section above first: that is usually B<not> what you want.

=item F<debian/I<package>.s6-rc/*/.norestart>

Do not restart the service after upgrades or start after initial installation.

B<Note> that this option does not affect whether the services are
enabled. Please remember to also use file B<.noenable> if the services
should not be enabled.

=item F<debian/I<package>.s6-rc/*/.no-readiness>

B<Readiness rule.> Every longrun either reports readiness -- it has a
F<notification-fd>, usually together with F<data/check> and
B<s6-notifyoncheck>(8) in F<run> -- or carries this file, whose first
non-empty line says why it does not. An empty F<.no-readiness> counts as
missing.

By default a violation is a B<warning> that names the package and the unit.
It becomes a B<build error> when the package opts in to strict mode (see
L</COMPAT LEVELS>) or the build environment selects it. dh-s6
1.2.5 made it an unconditional error; 1.3.0 returns the policy decision to the
package, so a newer helper in a build image does not break the rebuild of an
existing package.

Without a F<notification-fd>, "up" is true from the first instant of the
process, and s6-rc, C<svctl start>/C<restart> and every acceptance check
treat a service as done that does not answer yet. A reason that fits in a
line is enough, e.g. "cron: nothing to answer, the running process is the
function". Like the other hint files it is removed at build time and never
reaches the package; the reason lives in the source.

=item F<debian/I<package>.s6-rc/*/.permafail>

Opt in to permanent failure on a crash loop. B<dh_installs6> generates a
F<finish> script for that unit:

  #!/usr/bin/execlineb -S3
  s6-permafailon <arguments>
  exit 0

After the configured number of deaths inside the configured window,
B<s6-permafailon>(1) makes F<finish> exit 125, which tells B<s6-supervise>
to stop restarting the service. The service then reads as
C<up=false wantedup=false> in B<s6-svstat>(1) instead of looking healthy
while dying in a loop (C<svctl isup> only reports the s6-rc I<wanted> state
and cannot see a restart loop). Recover with C<svctl restart> and clear the
death tally with B<s6-svdt-clear>(1).

The content of the file is the argument list for B<s6-permafailon>, i.e.
I<seconds> I<deaths> I<events>. An empty file means the default

  120 5 1-255,SIGSEGV,SIGABRT,SIGKILL

(five deaths within two minutes, counting any non-zero exit code and the
usual fatal signals). Choose a generous window for services that legitimately
wait for a late network: permanent failure is deliberately sticky.

Only valid for units of type C<longrun> and only if the unit does not ship a
F<finish> script of its own; either condition raises a build error. Requires
B<s6> 2.7.1.0 or newer on the target system (jammy ships 2.11.1.0, resolute
2.13.1.0).

=back

=head1 COMPAT LEVELS

dh-s6 compat levels follow the debhelper pattern: a package declares its
level as a versioned virtual build dependency,

  Build-Depends: dh-s6-compat (= 2)

dh-s6 provides every level it implements, so a build image with an older
dh-s6 fails at dependency resolution instead of silently ignoring the level.

=over 4

=item Z<>1, or no declaration

Readiness rule violations are warnings. This is the behaviour of dh-s6 before
1.2.5, plus the warning.

=item Z<>2

Strict: readiness rule violations are build errors.

=back

The build environment can select strict mode as well, independent of the
declared level, for build infrastructure that wants to enforce the rule for
all packages it builds:

=over 4

=item B<DEB_BUILD_OPTIONS> containing B<dh-s6-strict>

Survives B<debuild>(1), which removes every other variable except C<DEB_*>,
C<LC_*> and a short list; use this in CI templates that build through
B<gbp-buildpackage>(1) or B<debuild>.

=item B<DH_S6_STRICT=1>

For direct B<dpkg-buildpackage>(1) runs and F<debian/rules>. B<debuild>
removes it unless called with B<--preserve-envvar=DH_S6_STRICT>.

=back

=head1 NOTES

This command is not idempotent. L<dh_prep(1)> should be called between
invocations of this command (with the same arguments). Otherwise, it
may cause multiple instances of the same text to be added to maintainer
scripts.

=cut

init(options => {});

# How many deaths s6-supervise keeps per longrun. s6's own default is 100, which
# is too small to MEASURE flapping: a service dying 25 times a minute (postfix on
# dns-1, 22.09.2026: 2063 restarts in 82 minutes) fills a tally of 100 in four
# minutes -- after that the 600 s and 3600 s windows report the same number, and
# "getting worse" reads as "unchanged".
#
# 4096 entries are 48 KB per unit in tmpfs, and only when they occur: s6-supervise
# writes 12 bytes per death. With 25 longruns that is at most 1.2 MB when things
# fail and 0 in normal operation.
use constant MAX_DEATH_TALLY => 4096;

# s6-permafailon arguments used when .permafail is empty: five deaths within
# two minutes, counting every non-zero exit code and the usual fatal signals.
use constant PERMAFAIL_DEFAULT => '120 5 1-255,SIGSEGV,SIGABRT,SIGKILL';

# dh-s6 compat levels, declared like debhelper's own: as a versioned virtual
# build dependency, "Build-Depends: dh-s6-compat (= N)". dh-s6 provides every
# level it knows (see debian/control), so an older dh-s6 in a build image makes
# the build fail at dependency resolution instead of silently ignoring a level.
#
#   no declaration, or 1  -- the readiness rule is a WARNING (behaviour of
#                            dh-s6 before 1.2.5, plus the warning)
#   2                     -- strict: the readiness rule is a build ERROR
#
# DH_S6_STRICT=1, or the tag "dh-s6-strict" in DEB_BUILD_OPTIONS, selects
# strict as well, without touching debian/control (see dh_s6_strict_env).
use constant DH_S6_COMPAT_MAX => 2;

sub dh_s6_compat {
	my $level = 1;
	if (-f 'debian/control') {
		require Dpkg::Control::Info;
		require Dpkg::Deps;
		my $src = Dpkg::Control::Info->new('debian/control')->get_source();
		my $bd = join(', ', grep { defined && length }
			map { $src->{$_} } qw(Build-Depends Build-Depends-Indep Build-Depends-Arch));
		if (length $bd) {
			my $deps = Dpkg::Deps::deps_parse($bd, build_dep => 1, reduce_restrictions => 1);
			Dpkg::Deps::deps_iterate($deps, sub {
				my $d = shift;
				return 1 unless defined $d->{package} && $d->{package} eq 'dh-s6-compat';
				error("dh-s6-compat must be declared as (= N), found: " . $d->output())
					unless defined $d->{relation} && $d->{relation} eq '='
						&& defined $d->{version} && "$d->{version}" =~ /^\d+$/;
				$level = int("$d->{version}");
				return 1;
			});
		}
	}
	error("unknown dh-s6 compat level $level (this dh-s6 knows 1.." . DH_S6_COMPAT_MAX . ")")
		if $level < 1 || $level > DH_S6_COMPAT_MAX;
	return $level;
}

# DEB_BUILD_OPTIONS tag "dh-s6-strict": the same as DH_S6_STRICT=1, but it
# survives debuild, which removes every environment variable except DEB_*, LC_*
# and a short list -- so it is the one a CI template that builds through
# "gbp buildpackage" (debuild) must use. DH_S6_STRICT=1 works for direct
# dpkg-buildpackage runs and debian/rules.
sub dh_s6_strict_env {
	return 1 if ($ENV{DH_S6_STRICT} // '') eq '1';
	return scalar grep { $_ eq 'dh-s6-strict' } split(/[\s,]+/, $ENV{DEB_BUILD_OPTIONS} // '');
}

my $s6_strict = dh_s6_strict_env() || dh_s6_compat() >= 2;

sub slurp_first_line {
	# First non-empty line of a file, whitespace-trimmed; '' if unreadable.
	my ($file) = @_;
	open(my $fh, '<', $file) or return '';
	while (my $line = <$fh>) {
		$line =~ s/\s+$//;
		$line =~ s/^\s+//;
		next unless length $line;
		close($fh);
		return $line;
	}
	close($fh);
	return '';
}

sub quote {
	# Add single quotes around the argument.
	return '\'' . $_[0] . '\'';
}

sub uniq {
	my %seen;
	return grep { !$seen{$_}++ } @_;
}

sub list_installed_service_units {
	my ($tmpdir) = @_;

	my @installed;

	foreach my $unitdir (glob("$tmpdir/usr/lib/s6-rc/sources/*")) {
		next unless -d $unitdir;
		next if -f "$unitdir/consumer-for"; # only service units (not log units)
		push @installed, basename($unitdir);
	}

	return @installed;
}

# Install package maintainer supplied unit folders
foreach my $package (@{$dh{DOPACKAGES}}) {
	my $tmpdir = tmpdir($package);

	# Install all unit folders in the debian/ directory in the
	# form $package.s6-rc/$name.
	my $basedir = "debian/$package.s6-rc";
	my $targetdir = "$tmpdir/usr/lib/s6-rc/sources";

	next unless -d $basedir;

	install_dir($targetdir);
	foreach my $namepath (glob("$basedir/*")) {
		doit("cp", '--reflink=auto', "-r", "-a", $namepath, $targetdir);
	}
}

# Add postinst, prerm, and postrm code blocks to handle activation,
# deactivation, start and stopping of services when the package is
# installed, upgraded or removed.
foreach my $package (@{$dh{DOPACKAGES}}) {
	my $tmpdir = tmpdir($package);
	my (@args, @enable_units, @restart_units);

	my @service_units = list_installed_service_units($tmpdir);

	# find service units that should not be enabled or restarted
	for my $unit (@service_units) {
		my $path = "${tmpdir}/usr/lib/s6-rc/sources/${unit}";
		push @enable_units, $unit unless (-f "$path/.noenable");
		push @restart_units, $unit unless (-f "$path/.norestart");
	}

	# Set max-death-tally for every longrun that does not bring its own value.
	# A package that writes the file itself keeps its value.
	for my $unit (@service_units) {
		my $path = "${tmpdir}/usr/lib/s6-rc/sources/${unit}";
		my $type = slurp_first_line("$path/type");
		next unless $type eq 'longrun';
		next if -f "$path/max-death-tally";
		open(my $fh, '>', "$path/max-death-tally")
			or error("cannot write $path/max-death-tally: $!");
		print $fh MAX_DEATH_TALLY . "\n";
		close($fh) or error("cannot write $path/max-death-tally: $!");
	}

	# Readiness rule: every longrun reports readiness (notification-fd) or states
	# in .no-readiness why it does not. Without notification-fd, "up" is true from
	# the first instant of the process, and s6-rc, "svctl start/restart" and any
	# acceptance check treat a service as done that does not answer yet.
	#
	# Mechanism, not policy (1.3.0): by default a violation is a WARNING, so a
	# helper upgrade in a build image does not break the rebuild of any existing
	# package. A package (Build-Depends: dh-s6-compat (= 2)) or a build
	# environment (DEB_BUILD_OPTIONS=dh-s6-strict, DH_S6_STRICT=1) opts in to
	# strict, where it is an ERROR.
	#
	# notification-fd alone is enough: the daemon may notify itself; data/check
	# with s6-notifyoncheck is the common way, not the only one. Loggers
	# (consumer-for) never reach this loop. An EMPTY .no-readiness is treated
	# like a missing one -- the file exists to carry the reason.
	my $readiness_issue = $s6_strict ? \&error : \&warning;
	for my $unit (@service_units) {
		my $path = "${tmpdir}/usr/lib/s6-rc/sources/${unit}";
		my $type = slurp_first_line("$path/type");
		next unless $type eq 'longrun';
		next if -f "$path/notification-fd";
		if (-f "$path/.no-readiness") {
			next if length slurp_first_line("$path/.no-readiness");
			$readiness_issue->("$package: $unit: .no-readiness is empty -- it must carry the "
				. "reason why this longrun does not report readiness");
			next;
		}
		$readiness_issue->("$package: $unit: longrun without readiness notification. Add "
			. "notification-fd (usually with data/check and s6-notifyoncheck in run), or "
			. "debian/$package.s6-rc/$unit/.no-readiness with a one-line reason. "
			. ($s6_strict ? "This is an error because the build is strict (dh-s6-compat (= 2), DEB_BUILD_OPTIONS=dh-s6-strict or DH_S6_STRICT=1)."
			              : "Warning only; declare dh-s6-compat (= 2) to make it an error. See dh_installs6(1)."));
	}

	# generate ./finish scripts for units that opted in to permanent failure
	for my $unit (@service_units) {
		my $path = "${tmpdir}/usr/lib/s6-rc/sources/${unit}";
		next unless -f "$path/.permafail";
		error("$unit: .permafail and finish cannot be used together, remove one")
			if -f "$path/finish";
		my $type = slurp_first_line("$path/type");
		error("$unit: .permafail needs a longrun unit, type is '$type'")
			unless $type eq 'longrun';
		my $args = slurp_first_line("$path/.permafail");
		$args = PERMAFAIL_DEFAULT unless length $args;
		open(my $fh, '>', "$path/finish")
			or error("cannot write $path/finish: $!");
		print $fh "#!/usr/bin/execlineb -S3\n";
		print $fh "s6-permafailon $args\n";
		print $fh "exit 0\n";
		close($fh) or error("cannot write $path/finish: $!");
		doit("chmod", "0755", "$path/finish");
	}

	# remove .noenable, .norestart, .permafail and .no-readiness hint files
	foreach my $unitdir (glob("${tmpdir}/usr/lib/s6-rc/sources/*")) {
		next unless -d $unitdir;
		doit("rm", "-f", "$unitdir/.noenable");
		doit("rm", "-f", "$unitdir/.norestart");
		doit("rm", "-f", "$unitdir/.permafail");
		doit("rm", "-f", "$unitdir/.no-readiness");
	}

	# quote and sort to be used in autoscript template
	@service_units = map { quote($_) } uniq sort @service_units;
	@enable_units = map { quote($_) } uniq sort @enable_units;
	@restart_units = map { quote($_) } uniq sort @restart_units;

	if (@enable_units) {
		# postinst enables a unit the first time it sees no marker for it (see POD)
		autoscript($package, 'postinst', 'postinst-s6-enable', {'UNITFILES' => join(' ', @enable_units) });
	} else {
		autoscript($package, 'postinst', 'postinst-s6-compile');
	}

	if (@service_units) {
		autoscript($package, 'postrm', 'postrm-s6-compile', { 'UNITFILES' => join(' ', @enable_units) });
		autoscript($package, 'prerm', 'prerm-s6-stop', { 'UNITFILES' => join(' ', @service_units) })
	}

	if (@restart_units) {
		autoscript($package, 'postinst', 'postinst-s6-restart', { 'UNITFILES' => join(' ', @restart_units) });
	}
}

=head1 SEE ALSO

L<debhelper(7)>

=head1 AUTHORS

info@automatic-server.com

=cut
