Dh_Lib.pm: Provide `mkdirs` to create (non-package) directories

This is an alternative to `install_dir` that never does chown (and is
not printed with `--verbose`).  It is intended for creating
directories that are not part of a binary package.

Note that at the moment `install_dir` does not do chown either,
which is a bug (causing #1024261).

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

10 files changed, 56 insertions, 24 deletions

diff --git a/dh_builddeb b/dh_builddeb
index 66308c65..aca17f6d 100755
--- a/dh_builddeb
+++ b/dh_builddeb
@@ -80,7 +80,7 @@ sub build_and_rename_deb {
 	my ($package, $destdir, $cmd, $rename_sub) = @_;
 	my $build_dir = "debian/.debhelper/scratch-space/build-${package}";
 	my ($dpkg_filename, $desired_filename);
-	install_dir($build_dir);
+	mkdirs($build_dir);
 	doit(@${cmd}, $build_dir);
 	opendir(my $fd, $build_dir) or error("opendir($build_dir) failed: $!");
 	for my $name (readdir($fd)) {
diff --git a/dh_strip b/dh_strip
index 5cd32c10..a7c21491 100755
--- a/dh_strip
+++ b/dh_strip
@@ -251,7 +251,7 @@ sub write_buildid_file {
 	my ($package, $build_ids) = @_;
 	my $dir = "debian/.debhelper/${package}";
 	my $path = "${dir}/dbgsym-build-ids";
-	install_dir($dir);
+	mkdirs($dir);
 	open(my $fd, '>>', $path) or error("open $path failed: $!");
 	print {$fd} join(q{ }, sort(@{$build_ids})) . ' ';
 	close($fd) or error("close $path failed: $!");
diff --git a/doc/PROGRAMMING.md b/doc/PROGRAMMING.md
index 59d5e0fc..9a176b23 100644
--- a/doc/PROGRAMMING.md
+++ b/doc/PROGRAMMING.md
@@ -378,13 +378,20 @@ The following keys are also set in the `%dh` hash when you call `init()`:
   be executed instead and its output will be used to generate the
   `$dest` file.
 
-- `install_dir(@dirs)`
+- `install_dir(@dirs)` / `mkdirs(@dirs)`
 
   Create the directories denoted by the paths in `@dirs` and all
   parent entries as well (as needed).  It uses mode 0755.
   If a directory listed in `@dirs` already exists, the function
   silently skips that directory (similar to `mkdir -p`).
 
+  The `install_dir` function should be used for directories
+  installed in a final package while `mkdirs` should be used
+  for other directories.  The difference is that `install_dir`
+  will attempt to chown the directory to `root:root` if required
+  whereas `mkdirs` will not.  The `mkdirs` function requires
+  `debhelper (>= 13.11~)`.
+
 - `install_file($src, $dest)`
 
   Installs `$src` into `$dest` with mode 0644.  The parent dir of
diff --git a/lib/Debian/Debhelper/Buildsystem.pm b/lib/Debian/Debhelper/Buildsystem.pm
index 47d9b7eb..795f3d3d 100644
--- a/lib/Debian/Debhelper/Buildsystem.pm
+++ b/lib/Debian/Debhelper/Buildsystem.pm
@@ -413,7 +413,7 @@ sub get_build_rel2sourcedir {
 sub mkdir_builddir {
 	my $this=shift;
 	if ($this->get_builddir()) {
-		install_dir($this->get_builddir());
+		mkdirs($this->get_builddir());
 	}
 }
 
diff --git a/lib/Debian/Debhelper/Dh_Lib.pm b/lib/Debian/Debhelper/Dh_Lib.pm
index da5d7962..10e67f90 100644
--- a/lib/Debian/Debhelper/Dh_Lib.pm
+++ b/lib/Debian/Debhelper/Dh_Lib.pm
@@ -134,6 +134,7 @@ qw(
 qw(
 	basename
 	dirname
+	mkdirs
 	install_file
 	install_prog
 	install_lib
@@ -668,28 +669,52 @@ sub error_exitcode {
 	}
 }
 
-sub install_dir {
-	my @to_create = grep { not -d $_ } @_;
-	return if not @to_create;
+
+sub _mkdirs {
+	my ($maybe_chown, @dirs) = @_;
+	return if not @dirs;
+	my $do_chown = !$maybe_chown && should_use_root();
+	if ($do_chown) {
+		# Use the real install for the case that requires root.  The error handling
+		# of File::Path for this case seems a bit too fragile for my liking.
+		# (E.g., chown failures are carp warnings rather than hard errors and
+		# intercepting them via the error parameter does not seem to work so well)
+		doit('install', '-m0755', '-o', '0', '-g', '0', '-d', @dirs);
+		return;
+	}
+	if (not $maybe_chown && $dh{VERBOSE}) {
+		verbose_print(sprintf('install -m0755 -d %s', escape_shell(@dirs)));
+	}
+	return 1 if $dh{NO_ACT};
 	state $_loaded;
 	if (not $_loaded) {
 		$_loaded++;
 		require File::Path;
 	}
-	verbose_print(sprintf('install -d %s', escape_shell(@to_create)))
-		if $dh{VERBOSE};
-	return 1 if $dh{NO_ACT};
+	my %opts = (
+		# install -d uses 0755 (no umask), make_path uses 0777 (& umask) by default.
+		# Since we claim to run install -d, then ensure the mode is correct.
+		'chmod' => 0755,
+	);
 	eval {
-		File::Path::make_path(@to_create, {
-			# install -d uses 0755 (no umask), make_path uses 0777 (& umask) by default.
-			# Since we claim to run install -d, then ensure the mode is correct.
-			'chmod' => 0755,
-		});
+		File::Path::make_path(@dirs, \%opts);
 	};
 	if (my $err = "$@") {
 		$err =~ s/\s+at\s+\S+\s+line\s+\d+\.?\n//;
 		error($err);
 	}
+	return;
+}
+
+sub mkdirs {
+	my @to_create = grep { not -d $_ } @_;
+	return _mkdirs(0, @to_create);
+}
+
+sub install_dir {
+	my @dirs = @_;
+	my $maybe_chown = (defined($main::VERSION) && $main::VERSION eq DH_BUILTIN_VERSION) ? 1 : 0;
+	return _mkdirs($maybe_chown, @dirs);
 }
 
 sub rename_path {
@@ -1362,7 +1387,7 @@ sub generated_file {
 	my $dir = "debian/.debhelper/generated/${package}";
 	my $path = "${dir}/${filename}";
 	$mkdirs //= 1;
-	install_dir($dir) if $mkdirs;
+	mkdirs($dir) if $mkdirs;
 	return $path;
 }
 
@@ -2576,7 +2601,7 @@ sub setup_home_and_xdg_dirs {
 		XDG_DATA_DIRS
 		XDG_RUNTIME_DIR
 	);
-	install_dir(@paths);
+	mkdirs(@paths);
 	for my $envname (@clear_env) {
 		delete($ENV{$envname});
 	}
@@ -2722,7 +2747,7 @@ sub restore_file_on_clean {
 	my $bucket_index = 'debian/.debhelper/bucket/index';
 	my $bucket_dir = 'debian/.debhelper/bucket/files';
 	my $checksum;
-	install_dir($bucket_dir);
+	mkdirs($bucket_dir);
 	if ($file =~ m{^/}) {
 		error("restore_file_on_clean requires a path relative to the package dir");
 	}
diff --git a/t/Test/DH.pm b/t/Test/DH.pm
index 7fa30bfd..9658d90a 100644
--- a/t/Test/DH.pm
+++ b/t/Test/DH.pm
@@ -109,7 +109,7 @@ sub _prepare_test_root {
             for my $file (@::TEST_DH_EXTRA_TEMPLATE_FILES) {
                 if (index($file, '/') > -1) {
                     my $install_dir = dirname($file);
-                    install_dir($install_dir);
+                    mkdirs($install_dir);
                 }
                 install_file("${actual_dir}/${file}", "${dir}/${file}");
             }
diff --git a/t/dh_installman/01-basics.t b/t/dh_installman/01-basics.t
index 8aaa0a04..05a15ecf 100755
--- a/t/dh_installman/01-basics.t
+++ b/t/dh_installman/01-basics.t
@@ -75,8 +75,8 @@ each_compat_subtest {
 			'generated-manpages/manpage-perl.3perl');
 		doit('gzip', '-9n', 'generated-manpages/manpage-compressed.1');
 	}
-	install_dir('debian/debhelper/usr/share/man/man1');
-	install_dir('debian/debhelper/usr/share/man/man3');
+	mkdirs('debian/debhelper/usr/share/man/man1');
+	mkdirs('debian/debhelper/usr/share/man/man3');
 	install_file('generated-manpages/manpage-uncompressed.1', 'debian/debhelper/usr/share/man/man1/manpage-uncompressed.1');
 	install_file('generated-manpages/manpage-compressed.1.gz', 'debian/debhelper/usr/share/man/man1/manpage-compressed.1.gz');
 	install_file('generated-manpages/manpage-perl.3perl', 'debian/debhelper/usr/share/man/man3/manpage-perl.3perl');
diff --git a/t/dh_installsystemd/dh_installsystemd.t b/t/dh_installsystemd/dh_installsystemd.t
index 99b6ea82..eb3a5305 100755
--- a/t/dh_installsystemd/dh_installsystemd.t
+++ b/t/dh_installsystemd/dh_installsystemd.t
@@ -14,7 +14,7 @@ sub write_file {
 	my ($path, $content) = @_;
 
 	my $dir = dirname($path);
-	install_dir($dir);
+	mkdirs($dir);
 
 	open(my $fd, '>>', $path) or error("open($path) failed: $!");
 	print {$fd} $content . '\n';
diff --git a/t/dh_link/03-894229.t b/t/dh_link/03-894229.t
index 10542f41..d42a3928 100755
--- a/t/dh_link/03-894229.t
+++ b/t/dh_link/03-894229.t
@@ -40,7 +40,7 @@ each_compat_subtest {
 
     remove_tree('debian/debhelper/a/b/c');
 
-    install_dir('debian/debhelper/a/b/c');
+    mkdirs('debian/debhelper/a/b/c');
 
     test_invalid('../../wow', 'a');
     # This is a can be made valid but at the moment we do not support
diff --git a/t/dh_usrlocal/01-basic.t b/t/dh_usrlocal/01-basic.t
index 2cd3f842..9b055161 100755
--- a/t/dh_usrlocal/01-basic.t
+++ b/t/dh_usrlocal/01-basic.t
@@ -43,7 +43,7 @@ sub perform_test {
 
 	rm_files(@scripts);
 	remove_tree('debian/debhelper');
-	install_dir(map { "debian/debhelper/$_" } @{$install_dirs});
+	mkdirs(map { "debian/debhelper/$_" } @{$install_dirs});
 
 	ok(run_dh_tool('dh_usrlocal'));