dh-linktree 0.4 / usr / bin / dh_linktree

#!/usr/bin/perl -w

# Copyright © 2011-2012 Raphaël Hertzog <hertzog@debian.org>
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This package is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.

=head1 NAME

dh_linktree - create symlink trees to embed files from other packages

=cut

use strict;
use File::Find;
use File::Spec;
use File::Compare;
use Debian::Debhelper::Dh_Lib;
use Dpkg::IPC;

=head1 SYNOPSIS

B<dh_linktree> [S<I<debhelper options>>] [B<-A>] [B<-X>I<item>] [S<I<action source destination> ...>]

=head1 DESCRIPTION

B<dh_linktree> is a debhelper program that creates symlink trees in package build
directories. The symlinks points to files provided by other packages and
which have to be present during build. As such you have to put the packages providing
the destination files in the build dependencies. For any symlink it
creates, it will add to B<${misc:Depends}> the dependency that is required to
ensure that the target of the symlink is available.

=head1 RATIONALE

This tool has been developed to handle the case of embedded libraries
written in interpreted languages (javascript, PHP, etc.). You usually want
to replace the embedded copy by the packaged one except if they are not
compatible. Since both versions evolve separately, you might have to
frequently switch between the embedded version and the packaged one.

If the embedded library had been replaced by a symlink to the top-level
directory, you would have to add code to the preinst/postinst every time
that you switch from one to the other (to replace the real directory
with a symlink and vice-versa). With a symlink tree, dpkg is doing
everything by itself.

Since symlink trees are created statically at build-time, they are not very
future-proof and have a risk to miss some files introduced by a newer
version of the package providing the file tree which is duplicated. That's
why the generated dependencies generally ensure that the same upstream
version be used at run-time than at build-time.

=head1 USAGE

B<dh_linktree> accepts arguments by set of 3. One action followed by
source and destination file/directories. Symlinking files works just like
B<dh_link> but symlinking directories will recreate the same directory
hierarchy and all individual files will be turned into symlinks.

The source files are the already existing files that will be symlinked from.
The destination files are the symlinks that will be created.

Be sure you B<do> specify the full filename to both the source and
destination files (unlike what you would do if you were using something
like L<ln(1)>).

B<dh_linktree> will generate symlinks that comply with Debian policy: absolute
when policy says they should be absolute, and relative links with as short
a path as possible. It will also create any subdirectories it needs to to put
the symlinks in.

Note that B<dh_linktree> will not be executed automatically by B<dh>, you
need to use B<dh $@ --with linktree> to get it hooked in the list
of dh_* commands automatically executed by B<dh>.

=head1 FILES

=over 4

=item debian/I<package>.linktrees

Lists source and destination trees to be symlinked. Each line consists
of 3 fields: the action, the source directory, the destination directory.
should be put on its own line, with the source and destination separated by
whitespace.

=back

=head1 OPTIONS

=over 4

=item B<-X>I<item>, B<--exclude=>I<item>

Do not create symlinks for files that contain I<item> anywhere in their
filename.

=item I<action source destination> ...

If the action is "embed" create a symlink tree named I<destination> with
all files within it pointing to the corresponding file in I<source>. It
generates a strong dependency ("exactly same upstream version").

The "deduplicate" action will not create new files but it will
replace existing files in the destination directory with symlinks to the
corresponding source file provided that both files have the same content.
It generates a strong dependency.

The "replace" action is like "deduplicate" except that it does replace
existing files even if their content is different from the content of the
source files. It generates a weak dependency ("at least the current
upstream version") on the basis that you already assume that
both version are compatible, otherwise you would have used "deduplicate"
or "embed".

=back

=head1 EXAMPLES

 dh_linktree embed usr/share/javascript/jquery usr/share/wordpress/plugin-jquery

Make F<plugin-jquery> be a symlink tree to F<jquery>.

=head1 ERRORS

 dpkg-query: no path found matching pattern /some/file.
 [...]
 dh_linktree: error: dpkg --search -- /some/file [...] gave error exit status 1

You get this error when the source tree contains files (here
F</some/file>) that are not managed by dpkg. B<dh_linktree> can't
generate a correct dependency for a file that is unknown to
dpkg and thus fails.

=cut

init();

foreach my $package (@{$dh{DOPACKAGES}}) {
	my $tmp=tmpdir($package);
	my $file=pkgfile($package,"linktrees");

        my @srclinks;
	if ($file) {
		@srclinks=filearray($file);
	}

	# Make sure it has a multiple of 3 args
	if ($#srclinks % 3 == 0) {
		error("$file lists a link without a destination.");
	}

	if (($package eq $dh{FIRSTPACKAGE} || $dh{PARAMS_ALL}) && @ARGV) {
		push @srclinks, @ARGV;
	}

	# Same test as above, including arguments this time.
	if ($#srclinks % 3 == 0) {
		error("parameters list a link without a destination.");
	}

	next unless scalar(@srclinks);

	my @links;
	while (@srclinks) {
	        my $action=shift @srclinks;
		my $src=File::Spec->canonpath(shift @srclinks);
		my $dest=File::Spec->canonpath(shift @srclinks);
		error("invalid action '$action'")
			if $action !~ /^(embed|replace|deduplicate)$/;
		if (! -l "/$src" and -d _) {
			find(sub {
				return if -d and ! -l;
				return if excludefile($_);
				my $rel=File::Spec->abs2rel($File::Find::name,"/$src");
				push @links, $action, "$src/$rel", "$dest/$rel";
			}, "/$src");
		} else {
			push @links, $action, $src, $dest;
		}
	}

	my %used;
	while (@links) {
	        my $action=shift @links;
		my $src=shift @links;
		my $dest=shift @links;

		$src=~s:^/::;
		$dest=~s:^/::;

		my $src_abs="/$src";

		if ($src eq $dest) {
			warning("skipping link from $src to self");
			next;
		}

		if ($action ne "embed" and not -e "$tmp/$dest") {
			verbose_print("not creating $tmp/$dest");
			next;
		}

		if ($action eq "deduplicate" and -e "$tmp/$dest" and
		    compare("$tmp/$dest", "/$src") != 0) {
			verbose_print("not replacing $tmp/$dest due to " .
				      "mismatch with /$src");
			next;
		}

		# Make sure the directory the link will be in exists.
		my $basedir=dirname("$tmp/$dest");
		if (! -e $basedir) {
			doit("install","-d",$basedir);
		}

		# Policy says that if the link is all within one toplevel
		# directory, it should be relative. If it's between
		# top level directories, leave it absolute.
		my @src_dirs=split(m:/+:,$src);
		my @dest_dirs=split(m:/+:,$dest);
		if (@src_dirs > 0 && $src_dirs[0] eq $dest_dirs[0]) {
			# Figure out how much of a path $src and $dest
			# share in common.
			my $x;
			for ($x=0; $x < @src_dirs && $src_dirs[$x] eq $dest_dirs[$x]; $x++) {}
			# Build up the new src.
			$src="";
			for (1..$#dest_dirs - $x) {
				$src.="../";
			}
			for ($x .. $#src_dirs) {
				$src.=$src_dirs[$_]."/";
			}
			if ($x > $#src_dirs && ! length $src) {
				$src.="."; # special case
			}
			$src=~s:/$::;
		}
		else {
			# Make sure it's properly absolute.
			$src="/$src";
		}

		if (-d "$tmp/$dest" && ! -l "$tmp/$dest") {
			error("link destination $tmp/$dest is a directory");
		}
		doit("rm", "-f", "$tmp/$dest");
		doit("ln","-sf", $src, "$tmp/$dest");
		$used{$src_abs} = $action;
	}
	my $output;
	my @files = sort keys %used;
	my $pid = spawn(exec => [ "dpkg", "--search", "--", @files ],
			to_pipe => \$output,
			env => { LC_ALL => 'C' });
	my %pkgused;
	while(defined($_ = <$output>)) {
	    chomp($_);
	    if (m/^local diversion |^diversion by/) {
		warning(_g("diversions involved - output may be incorrect"));
		print(STDERR " $_\n")
		    || syserr(_g("write diversion info to stderr"));
	    } elsif (m/^([-a-z0-9+.:, ]+): (\/.*)$/) {
		foreach my $pkg (split(/, /, $1)) {
		    if (exists $pkgused{$pkg}) {
			$pkgused{$pkg} = $used{$2} if $pkgused{$pkg} eq "replace";
		    } else {
			$pkgused{$pkg} = $used{$2};
		    }
		}
	    } else {
		warning("unknown output from dpkg --search: '$_'");
	    }
	}
	close($output) or error("failed to close pipe with dpkg --search");
	wait_child($pid, cmdline => "dpkg --search -- @files");
	$output = undef;
	$pid = spawn(exec => [ "dpkg-query", "-W", "--", sort keys %pkgused ],
		     to_pipe => \$output,
		     env => { LC_ALL => 'C' });
	my %deps;
	while(defined($_ = <$output>)) {
	    chomp($_);
	    my ($pkg, $ver) = split(/\s+/, $_);
	    $ver =~ s/-[^-]*$//; # Drop debian revision
	    if (not exists $pkgused{$pkg}) {
		error("Unexpected package $pkg returned by dpkg-query -W.");
	    }
	    $deps{"$pkg (>= $ver)"} = 1;
	    $deps{"$pkg (<< $ver.0~)"} = 1 if $pkgused{$pkg} ne "replace";
	}
	close($output) or error("failed to close pipe with dpkg-query -W");
	wait_child($pid, cmdline => "dpkg-query -W @{[sort keys %pkgused]}");

	my $gendeps = join(", ", sort keys %deps);
	verbose_print("Generated dependency: $gendeps");
	addsubstvar($package, "misc:Depends", $gendeps);
}

=head1 SEE ALSO

L<debhelper(7)>

This program is a part of debhelper.

=head1 AUTHOR

Raphael Hertzog <hertzog@debian.org>
Joey Hess <joeyh@debian.org>

=cut