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