#!/usr/bin/perl

=encoding UTF-8

=head1 NAME

dh_usrlocal - migrate usr/local directories to maintainer scripts

=cut

use warnings;
use strict;
use Debian::Debhelper::Dh_Lib;
use File::Find;
use File::stat;

our $VERSION = DH_BUILTIN_VERSION;

=head1 SYNOPSIS

B<dh_usrlocal> [S<I<debhelper options>>] [B<-n>]

=head1 DESCRIPTION

B<dh_usrlocal> is a debhelper program that can be used for building packages
that will provide a subdirectory in F</usr/local> when installed.

It finds subdirectories of F<usr/local> in the package build directory, and
removes them, replacing them with maintainer script snippets (unless B<-n>
is used) to create the directories at install time, and remove them when
the package is removed, in a manner compliant with Debian policy. These
snippets are inserted into the maintainer scripts by B<dh_installdeb>. See
L<dh_installdeb(1)> for an explanation of debhelper maintainer script
snippets.

When the I<DEB_RULES_REQUIRES_ROOT> environment variable is not (effectively)
I<binary-targets>, the directories in F</usr/local> will be handled as if
they were owned by root:root (see below).

When the I<DEB_RULES_REQUIRES_ROOT> environment variable has an effective value of
I<binary-targets>, the owners, groups and permissions will be
preserved with the sole exception where the directory is owned by root:root.

If a directory is owned by root:root, then ownership will be determined
at install time.  The ownership and permission bits will either be root:root
mode 0755 or root:staff mode 02775.  The actual choice depends on whether
the system has F</etc/staff-group-for-usr-local> (as documented in the Debian
Policy Manual §9.1.2 since version 4.1.4)

=head1 OPTIONS

=over 4

=item B<-n>, B<--no-scripts>

Do not modify F<postinst>/F<prerm> scripts.

=back

=head1 NOTES

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

=head1 CONFORMS TO

Debian policy, version 2.2

=cut

init();

# PROMISE: DH NOOP WITHOUT tmp(usr/local) cli-options()

foreach my $package (@{$dh{DOPACKAGES}}) {
	my $tmp = tmpdir($package);

	if (-d "$tmp/usr/local") {
		my (@dirs, @justdirs);
		find({no_chdir => 1,
		      preprocess => sub {
				  # Ensure a reproducible traversal.
				  return sort @_;
		      },
		      postprocess => sub {
				  # Uninstall, unless a direct child of /usr/local.
				  $_ = $File::Find::dir;
				  s!^\Q$tmp\E!!;
				  push @justdirs, $_ if m!/usr/local/.*/!;
				  # Remove a directory after its childs.
				  doit('rmdir', $File::Find::dir);
		      },
			  wanted => sub {
				  # rmdir would fail later anyways.
				  error("${File::Find::name} is not a directory")
					  if not -d $File::Find::name;
				  # Install directory before its childs.
				  my $fn = $File::Find::name;
				  $fn =~ s!^\Q$tmp\E!!;
				  return if $fn eq '/usr/local';
				  # Detect some obvious cases of "this will not end
				  # well".  We rely on what "while read dir ... ; do"
				  # can handle for correctness.
				  if ($fn =~ m{[\s!'"\$()*#;<>?@\[\]\\`|]}) {
					  error("Cannot generate a correct shell script for $fn due to shell metacharacters");
				  }
				  if (should_use_root()) {
					  my $stat = stat $File::Find::dir;
					  if ($stat->uid == 0 && $stat->gid == 0) {
						  # Figure out the ownership and permission at runtime
						  # (required by Policy 9.1.2)
						  push(@dirs, "$fn default");
					  } else {
						  my $user = getpwuid $stat->uid;
						  my $group = getgrgid $stat->gid;
						  my $mode = sprintf "%04lo", ($stat->mode & 07777);
						  push @dirs, "$fn $mode $user $group";
					  }
				  } else {
					  # Figure out the ownership and permission at runtime
					  # (required by Policy 9.1.2)
					  push(@dirs, "$fn default");
				  }
		      }}, "$tmp/usr/local");

		if (! $dh{NOSCRIPTS}) { 
			autoscript($package,"postinst", "postinst-usrlocal",
					   { 'DIRS' => join ("\n", @dirs)}) if @dirs;
			autoscript($package,"prerm", "prerm-usrlocal",
					   { 'JUSTDIRS' => join ("\n", @justdirs)}) if @justdirs;
		}
	}
}

=head1 SEE ALSO

L<debhelper(7)>

This program is a part of debhelper.

=head1 AUTHOR

Andrew Stribblehill <ads@debian.org>

=cut