dh_usrlocal

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 dh_usrlocal - migrate usr/local directories to maintainer scripts
   6
   7 =cut
   8
   9 use warnings;
  10 use strict;
  11 use Debian::Debhelper::Dh_Lib;
  12 use File::Find;
  13 use File::stat;
  14
  15 =head1 SYNOPSIS
  16
  17 B<dh_usrlocal> [S<I<debhelper options>>] [B<-n>]
  18
  19 =head1 DESCRIPTION
  20
  21 B<dh_usrlocal> is a debhelper program that can be used for building packages
  22 that will provide a subdirectory in F</usr/local> when installed.
  23
  24 It finds subdirectories of F<usr/local> in the package build directory, and
  25 removes them, replacing them with maintainer script snippets (unless B<-n>
  26 is used) to create the directories at install time, and remove them when
  27 the package is removed, in a manner compliant with Debian policy. These
  28 snippets are inserted into the maintainer scripts by B<dh_installdeb>. See
  29 L<dh_installdeb(1)> for an explanation of debhelper maintainer script
  30 snippets.
  31
  32 If the directories found in the build tree have unusual owners, groups, or
  33 permissions, then those values will be preserved in the directories made by
  34 the F<postinst> script. However, as a special exception, if a directory is owned
  35 by root.root, it will be treated as if it is owned by root.staff and is mode
  36 2775. This is useful, since that is the group and mode policy recommends for
  37 directories in F</usr/local>.
  38
  39 =head1 OPTIONS
  40
  41 =over 4
  42
  43 =item B<-n>, B<--noscripts>
  44
  45 Do not modify F<postinst>/F<prerm> scripts.
  46
  47 =back
  48
  49 =head1 NOTES
  50
  51 Note that this command is not idempotent. L<dh_prep(1)> should be called
  52 between invocations of this command. Otherwise, it may cause multiple
  53 instances of the same text to be added to maintainer scripts.
  54
  55 =head1 CONFORMS TO
  56
  57 Debian policy, version 2.2
  58
  59 =cut
  60
  61 init();
  62
  63 foreach my $package (@{$dh{DOPACKAGES}}) {
  64         my $tmp = tmpdir($package);
  65
  66         if (-d "$tmp/usr/local") {
  67                 my (@dirs, @justdirs);
  68                 find({bydepth => 1,
  69                       no_chdir => 1,
  70                       wanted => sub {
  71                         my $fn = $File::Find::name;
  72                         if (-d $fn) {
  73                                 my $stat = stat $fn;
  74                                 my $user = getpwuid $stat->uid;
  75                                 my $group = getgrgid $stat->gid;
  76                                 my $mode = sprintf "%04lo", ($stat->mode & 07777);
  77
  78                                 if ($stat->uid == 0 && $stat->gid == 0) {
  79                                         $group = 'staff';
  80                                         $mode = '2775';
  81                                 }
  82
  83                                 $fn =~ s!^\Q$tmp\E!!;
  84                                 return if $fn eq '/usr/local';
  85
  86                                 # @dirs is in parents-first order for dir creation...
  87                                 unshift @dirs, "$fn $mode $user $group";
  88                                 # ...whereas @justdirs is depth-first for removal.
  89                                 push @justdirs, $fn;
  90                                 doit("rmdir $_");
  91                         }
  92                         else {
  93                                 warning("$fn is not a directory");
  94                         }
  95                       }}, "$tmp/usr/local");
  96                 doit("rmdir $tmp/usr/local");
  97
  98                 my $bs = "\\";     # A single plain backslash
  99                 my $ebs = $bs x 2; # Escape the backslash from the shell
 100                 # This constructs the body of a 'sed' c\ expression which
 101                 # is parsed by the shell in double-quotes
 102                 my $dirs = join("$ebs\n", @dirs);
 103                 pop @justdirs; # don't remove directories directly in /usr/local
 104                 my $justdirs = join("$ebs\n", @justdirs);
 105                 if (! $dh{NOSCRIPTS}) {
 106                         autoscript($package,"postinst", "postinst-usrlocal",
 107                                    "/#DIRS#/ c${ebs}\n${dirs}");
 108                         autoscript($package,"prerm", "prerm-usrlocal",
 109                                    "/#JUSTDIRS#/ c${ebs}\n${justdirs}") if length $justdirs;
 110                 }
 111         }
 112 }
 113
 114 =head1 SEE ALSO
 115
 116 L<debhelper(7)>
 117
 118 This program is a part of debhelper.
 119
 120 =head1 AUTHOR
 121
 122 Andrew Stribblehill <ads@debian.org>
 123
 124 =cut