Dh_Lib: Expand on substitution in maintscripts

Signed-off-by: Niels Thykier <niels@thykier.net>

3 files changed, 99 insertions, 23 deletions

diff --git a/debian/changelog b/debian/changelog
index 2565eeeb..ce709d68 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -37,6 +37,11 @@ debhelper (12.1.2) UNRELEASED; urgency=medium
     fakeroot and file(1) appear to support the option.
     Thanks to Christoph Biedl for requesting the feature.
     (Closes: #932006)
+  * Dh_Lib.pm: Support substittuting additional variables
+    into the generated maintainer scripts.  These include
+    DEB_(BUILD|HOST|TARGET)_* and ENV.* which point to the
+    variables from dpkg-architecture(1) and variables from
+    the environment (respectively).
 
   [ Helmut Grohne ]
   * Buildsystem/cmake: Fix CMAKE_SYSTEM_PROCESSOR for mips64el.
diff --git a/dh_installdeb b/dh_installdeb
index 111f3bb6..6b53cb0a 100755
--- a/dh_installdeb
+++ b/dh_installdeb
@@ -36,6 +36,13 @@ correct permissions.
 
 These maintainer scripts are installed into the F<DEBIAN> directory.
 
+B<dh_installdeb> will perform substitution of known tokens of
+the pattern B<#TOKEN#>.  In generally, scripts will want to
+include the B<#DEBHELPER#> to benefit from the shell scripts
+generated by debhelper commands (including those from
+B<dh_installdeb> when it processes I<package>.maintscript files)
+
+For more information on what tokens
 Inside the scripts, the token B<#DEBHELPER#> is replaced with
 shell script snippets generated by other debhelper commands.
 
@@ -88,6 +95,47 @@ error in compat 12.
 
 =back
 
+=head1 SUBSTITUTION IN MAINTAINER SCRIPTS
+
+The B<dh_installdeb> will automatically replace the following tokens
+inside a provided maintainer script:
+
+=over 4
+
+=item #DEBHELPER#
+
+This token is replaced with generated shell snippets debhelper
+commands.  This includes the snippets generated by
+B<dh_installdeb> from I<package>.maintscript file (if present).
+
+=item #DEB_HOST_I<NAME>#, #DEB_BUILD_I<NAME>#, #DEB_TARGET_I<NAME>#
+
+These tokens are replaced with the respective variable from
+L<dpkg-architecture(1)>.  In almost all cases, you will want
+use the B<< #DEB_HOST_I<NAME> >> variant in a script to ensure
+you get the right value when cross-building.
+
+On a best effort, tokens of this pattern that do not match
+a variable in L<dpkg-architecture(1)> will be left as-is.
+
+=item #ENV.I<NAME>#
+
+These tokens of this form will be replaced with value of the
+corresponding environment variable.  If the environment
+variable is unset, the token is replaced with the empty
+string.
+
+Note that there are limits on which names can be used (see
+L</Limitations in token names>).
+
+=back
+
+=head2 Limitations in token names
+
+All tokens intended to be substituted must match the regex: #[A-Za-z0-9_.]+#
+
+Tokens that do not match that regex will be silently ignored.
+
 =cut
 
 init();
diff --git a/lib/Debian/Debhelper/Dh_Lib.pm b/lib/Debian/Debhelper/Dh_Lib.pm
index bfd00bb1..fe14039a 100644
--- a/lib/Debian/Debhelper/Dh_Lib.pm
+++ b/lib/Debian/Debhelper/Dh_Lib.pm
@@ -1998,43 +1998,66 @@ sub _concat_slurp_script_files {
 	return $res;
 }
 
+sub _substitution_generator {
+	my ($input) = @_;
+	my $cache = {};
+	return sub {
+		my ($orig_key) = @_;
+		return $cache->{$orig_key} if exists($cache->{$orig_key});
+		my $value = exists($input->{$orig_key}) ? $input->{$orig_key} : undef;
+		if (not defined($value)) {
+			if ($orig_key =~ m/^DEB_(?:BUILD|HOST|TARGET)_/) {
+				$value = dpkg_architecture_value($orig_key);
+			} elsif ($orig_key =~ m{^ENV[.](\S+)$}) {
+				$value = $ENV{$1} // '';
+			}
+		} elsif (ref($value) eq 'CODE') {
+			$value = $value->($orig_key);
+		} elsif ($value =~ s/^@//) {
+			$value = _concat_slurp_script_files($value);
+		}
+		$cache->{$orig_key} = $value;
+		return $value;
+	};
+}
+
 # Handles #DEBHELPER# substitution in a script; also can generate a new
 # script from scratch if none exists but there is a .debhelper file for it.
 sub debhelper_script_subst {
-	my $package=shift;
-	my $script=shift;
-	
+	my ($package, $script, $extra_vars) = @_;
+
 	my $tmp=tmpdir($package);
 	my $ext=pkgext($package);
 	my $file=pkgfile($package,$script);
+	my %variables = defined($extra_vars) ? %{$extra_vars} : ();
 	my $service_script = generated_file($package, "${script}.service", 0);
 	my @generated_scripts = ("debian/$ext$script.debhelper", $service_script);
+	my $subst;
+	@generated_scripts = grep { -f } @generated_scripts;
 	if ($script eq 'prerm' or $script eq 'postrm') {
 		@generated_scripts = reverse(@generated_scripts);
 	}
-	@generated_scripts = grep { -f } @generated_scripts;
+	if (not exists($variables{'DEBHELPER'})) {
+		$variables{'DEBHELPER'} = sub {
+			return _concat_slurp_script_files(@generated_scripts);
+		};
+	}
+	$subst = _substitution_generator(\%variables);
 
 	if ($file ne '') {
-		if (@generated_scripts) {
-			if ($dh{VERBOSE}) {
-				verbose_print('cp -f ' . escape_shell($file) . " $tmp/DEBIAN/$script");
-				verbose_print("perl -p -i -e \"s~#DEBHELPER#~qx{cat @generated_scripts}~eg\" $tmp/DEBIAN/$script");
-			}
-			# Add this into the script, where it has #DEBHELPER#
-			my $text = _concat_slurp_script_files(@generated_scripts);
-			if (not $dh{NO_ACT}) {
-				open(my $out_fd, '>', "$tmp/DEBIAN/$script") or error("open($tmp/DEBIAN/$script) failed: $!");
-				open(my $in_fd, '<', $file) or error("open($file) failed: $!");
-				while (my $line = <$in_fd>) {
-					$line =~ s/#DEBHELPER#/$text/g;
-					print {$out_fd} $line;
-				}
-				close($in_fd);
-				close($out_fd) or error("close($tmp/DEBIAN/$script) failed: $!");
+		if ($dh{VERBOSE}) {
+			verbose_print('cp -f ' . escape_shell($file) . " $tmp/DEBIAN/$script");
+			verbose_print("[META] Replace #TOKEN#s in \"$tmp/DEBIAN/$script\"");
+		}
+		if (not $dh{NO_ACT}) {
+			open(my $out_fd, '>', "$tmp/DEBIAN/$script") or error("open($tmp/DEBIAN/$script) failed: $!");
+			open(my $in_fd, '<', $file) or error("open($file) failed: $!");
+			while (my $line = <$in_fd>) {
+				$line =~ s{#([A-Za-z0-9_.]+)#}{$subst->($1) // "#${1}#"}ge;
+				print {$out_fd} $line;
 			}
-		} else {
-			# Just get rid of any #DEBHELPER# in the script.
-			doit({ stdout => "$tmp/DEBIAN/$script" }, 'sed', 's/#DEBHELPER#//', $file);
+			close($in_fd);
+			close($out_fd) or error("close($tmp/DEBIAN/$script) failed: $!");
 		}
 		reset_perm_and_owner('0755', "$tmp/DEBIAN/$script");
 	}