dh_link

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 dh_link - create symlinks in package build directories
   6
   7 =cut
   8
   9 use strict;
  10 use File::Find;
  11 use Debian::Debhelper::Dh_Lib;
  12
  13 =head1 SYNOPSIS
  14
  15 B<dh_link> [S<I<debhelper options>>] [B<-A>] [B<-X>I<item>] [S<I<source destination> ...>]
  16
  17 =head1 DESCRIPTION
  18
  19 B<dh_link> is a debhelper program that creates symlinks in package build
  20 directories.
  21
  22 B<dh_link> accepts a list of pairs of source and destination files. The source
  23 files are the already existing files that will be symlinked from. The
  24 destination files are the symlinks that will be created. There B<must> be
  25 an equal number of source and destination files specified.
  26
  27 Be sure you B<do> specify the full filename to both the source and
  28 destination files (unlike you would do if you were using something like
  29 L<ln(1)>).
  30
  31 B<dh_link> will generate symlinks that comply with Debian policy - absolute
  32 when policy says they should be absolute, and relative links with as short
  33 a path as possible. It will also create any subdirectories it needs to to put
  34 the symlinks in.
  35
  36 B<dh_link> also scans the package build tree for existing symlinks which do not
  37 conform to Debian policy, and corrects them (v4 or later).
  38
  39 =head1 FILES
  40
  41 =over 4
  42
  43 =item debian/I<package>.links
  44
  45 Lists pairs of source and destination files to be symlinked. Each pair
  46 should be put on its own line, with the source and destination separated by
  47 whitespace.
  48
  49 =back
  50
  51 =head1 OPTIONS
  52
  53 =over 4
  54
  55 =item B<-A>, B<--all>
  56
  57 Create any links specified by command line parameters in ALL packages
  58 acted on, not just the first.
  59
  60 =item B<-X>I<item>, B<--exclude=>I<item>
  61
  62 Exclude symlinks that contain I<item> anywhere in their filename from
  63 being corrected to comply with Debian policy.
  64
  65 =item I<source destination> ...
  66
  67 Create a file named I<destination> as a link to a file named I<source>. Do
  68 this in the package build directory of the first package acted on.
  69 (Or in all packages if B<-A> is specified.)
  70
  71 =back
  72
  73 =head1 EXAMPLES
  74
  75  dh_link usr/share/man/man1/foo.1 usr/share/man/man1/bar.1
  76
  77 Make F<bar.1> be a symlink to F<foo.1>
  78
  79  dh_link var/lib/foo usr/lib/foo \
  80    usr/share/man/man1/foo.1 usr/share/man/man1/bar.1
  81
  82 Make F</usr/lib/foo/> be a link to F</var/lib/foo/>, and F<bar.1> be a symlink to
  83 the F<foo.1>
  84
  85 =cut
  86
  87 # This expand_path expands all path "." and ".." components, but doesn't
  88 # resolve symbolic links.
  89 sub expand_path {
  90         my $start = @_ ? shift : '.';
  91         my @pathname = split(m:/+:,$start);
  92
  93         my $entry;
  94         my @respath;
  95         foreach $entry (@pathname) {
  96                 if ($entry eq '.' || $entry eq '') {
  97                         # Do nothing
  98                 }
  99                 elsif ($entry eq '..') {
 100                         if ($#respath == -1) {
 101                                 # Do nothing
 102                         }
 103                         else {
 104                                 pop @respath;
 105                         }
 106                 }
 107                 else {
 108                         push @respath, $entry;
 109                 }
 110         }
 111
 112         my $result;
 113         foreach $entry (@respath) {
 114                 $result .= '/' . $entry;
 115         }
 116         if (! defined $result) {
 117                 $result="/"; # special case
 118         }
 119         return $result;
 120 }
 121
 122
 123 init();
 124
 125 foreach my $package (@{$dh{DOPACKAGES}}) {
 126         my $tmp=tmpdir($package);
 127         my $file=pkgfile($package,"links");
 128
 129         my @links;
 130         if ($file) {
 131                 @links=filearray($file);
 132         }
 133
 134         # Make sure it has pairs of symlinks and destinations. If it
 135         # doesn't, $#links will be _odd_ (not even, -- it's zero-based).
 136         if (int($#links/2) eq $#links/2) {
 137                 error("$file lists a link without a destination.");
 138         }
 139
 140         if (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
 141                 push @links, @ARGV;
 142         }
 143
 144         # Same test as above, including arguments this time.
 145         if (int($#links/2) eq $#links/2) {
 146                 error("parameters list a link without a destination.");
 147         }
 148
 149         # v4 or later and only if there is a temp dir already
 150         if (! compat(3) && -e $tmp) {
 151                 # Scan for existing links and add them to @links, so they
 152                 # are recreated policy conformant.
 153                 find(
 154                         sub {
 155                                 return unless -l;
 156                                 return if excludefile($_);
 157                                 my $dir=$File::Find::dir;
 158                                 $dir=~s/^\Q$tmp\E//;
 159                                 my $target = readlink($_);
 160                                 if ($target=~/^\//) {
 161                                         push @links, $target;
 162                                 }
 163                                 else {
 164                                         push @links, "$dir/$target";
 165                                 }
 166                                 push @links, "$dir/$_";
 167
 168                         },
 169                         $tmp);
 170         }
 171
 172         while (@links) {
 173                 my $dest=pop @links;
 174                 my $src=expand_path(pop @links);
 175
 176                 $src=~s:^/::;
 177                 $dest=~s:^/::;
 178
 179                 if ($src eq $dest) {
 180                         warning("skipping link from $src to self");
 181                         next;
 182                 }
 183
 184                 # Make sure the directory the link will be in exists.
 185                 my $basedir=dirname("$tmp/$dest");
 186                 if (! -e $basedir) {
 187                         doit("install","-d",$basedir);
 188                 }
 189
 190                 # Policy says that if the link is all within one toplevel
 191                 # directory, it should be relative. If it's between
 192                 # top level directories, leave it absolute.
 193                 my @src_dirs=split(m:/+:,$src);
 194                 my @dest_dirs=split(m:/+:,$dest);
 195                 if (@src_dirs > 0 && $src_dirs[0] eq $dest_dirs[0]) {
 196                         # Figure out how much of a path $src and $dest
 197                         # share in common.
 198                         my $x;
 199                         for ($x=0; $x < @src_dirs && $src_dirs[$x] eq $dest_dirs[$x]; $x++) {}
 200                         # Build up the new src.
 201                         $src="";
 202                         for (1..$#dest_dirs - $x) {
 203                                 $src.="../";
 204                         }
 205                         for ($x .. $#src_dirs) {
 206                                 $src.=$src_dirs[$_]."/";
 207                         }
 208                         if ($x > $#src_dirs && ! length $src) {
 209                                 $src.="."; # special case
 210                         }
 211                         $src=~s:/$::;
 212                 }
 213                 else {
 214                         # Make sure it's properly absolute.
 215                         $src="/$src";
 216                 }
 217
 218                 if (-d "$tmp/$dest" && ! -l "$tmp/$dest") {
 219                         error("link destination $tmp/$dest is a directory");
 220                 }
 221                 doit("rm", "-f", "$tmp/$dest");
 222                 doit("ln","-sf", $src, "$tmp/$dest");
 223         }
 224 }
 225
 226 =head1 SEE ALSO
 227
 228 L<debhelper(7)>
 229
 230 This program is a part of debhelper.
 231
 232 =head1 AUTHOR
 233
 234 Joey Hess <joeyh@debian.org>
 235
 236 =cut