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