More verbose rmdir_builddir() and more its tests

[debhelper.git] / dh_link

diff --git a/dh_link b/dh_link
index 6cb889cdd79ea3b92132f2f9ee0ca79cdbc51cbb..dc396dd597fbae1516a9c7657e56c0a7f41dc9e1 100755 (executable)
--- a/dh_link
+++ b/dh_link
@@ -12,7 +12,7 @@ use Debian::Debhelper::Dh_Lib;
 
 =head1 SYNOPSIS
 
 
 =head1 SYNOPSIS
 

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

 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
 


@@ -43,7 +43,7 @@ a path as possible. It will also create any subdirectories it needs to to put
 the symlinks in.
 
 dh_link also scans the package build tree for existing symlinks which do not
 the symlinks in.
 
 dh_link also scans the package build tree for existing symlinks which do not

-conform to debian policy, and corrects them (v4 only).
+conform to debian policy, and corrects them (v4 or later).

 
 =head1 OPTIONS
 
 
 =head1 OPTIONS
 


@@ -54,6 +54,11 @@ conform to debian policy, and corrects them (v4 only).
 Create any links specified by command line parameters in ALL packages
 acted on, not just the first.
 
 Create any links specified by command line parameters in ALL packages
 acted on, not just the first.
 

+=item B<-Xitem>, B<--exclude=item>
+
+Do not correct symlinks that contain "item" anywhere in their filename from
+being corrected to comply with debian policy.
+

 =item I<source destination ...>
 
 Create a file named "destination" as a link to a file named "source". Do
 =item I<source destination ...>
 
 Create a file named "destination" as a link to a file named "source". Do


@@ -69,13 +74,49 @@ this in the package build directory of the first package acted on.
 Make bar.1 be a symlink to foo.1
 
  dh_link var/lib/foo usr/lib/foo \
 Make bar.1 be a symlink to foo.1
 
  dh_link var/lib/foo usr/lib/foo \

-   usr/X11R6/man/man1/foo.1x usr/share/man/man1/bar.1
+   usr/share/man/man1/foo.1 usr/share/man/man1/bar.1

 
 Make /usr/lib/foo/ be a link to /var/lib/foo/, and bar.1 be a symlink to
 
 Make /usr/lib/foo/ be a link to /var/lib/foo/, and bar.1 be a symlink to

-the X man page foo.1x
+the foo.1

 
 =cut
 
 
 =cut
 

+# This expand_path expands all path "." and ".." components, but doesn't
+# resolve symbolic links.
+sub expand_path {
+       my $start = @_ ? shift : '.';
+       my @pathname = split(m:/+:,$start);
+
+       my $entry;
+       my @respath;
+       foreach $entry (@pathname) {
+               if ($entry eq '.' || $entry eq '') {
+                       # Do nothing
+               }
+               elsif ($entry eq '..') {
+                       if ($#respath == -1) {
+                               # Do nothing
+                       }
+                       else {
+                               pop @respath;
+                       }
+               }
+               else {
+                       push @respath, $entry;
+               }
+       }
+
+       my $result;
+       foreach $entry (@respath) {
+               $result .= '/' . $entry;
+       }
+       if (! defined $result) {
+               $result="/"; # special case
+       }
+       return $result;
+}
+
+

 init();
 
 foreach my $package (@{$dh{DOPACKAGES}}) {
 init();
 
 foreach my $package (@{$dh{DOPACKAGES}}) {


@@ -102,13 +143,14 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
                error("parameters list a link without a destination.");
        }
 
                error("parameters list a link without a destination.");
        }
 

-       # v4 only and only if there is a temp dir already
+       # v4 or later and only if there is a temp dir already

        if (! compat(3) && -e $tmp) {
                # Scan for existing links and add them to @links, so they
                # are recreated policy conformant.
                find(
                        sub {
                                return unless -l;
        if (! compat(3) && -e $tmp) {
                # Scan for existing links and add them to @links, so they
                # are recreated policy conformant.
                find(
                        sub {
                                return unless -l;

+                               return if excludefile($_);

                                my $dir=$File::Find::dir;
                                $dir=~s/^\Q$tmp\E//;
                                my $target = readlink($_);
                                my $dir=$File::Find::dir;
                                $dir=~s/^\Q$tmp\E//;
                                my $target = readlink($_);


@@ -119,7 +161,6 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
                                        push @links, "$dir/$target";
                                }
                                push @links, "$dir/$_";
                                        push @links, "$dir/$target";
                                }
                                push @links, "$dir/$_";

-                               doit("rm","-f",$_);

                                
                        },
                        $tmp);
                                
                        },
                        $tmp);


@@ -127,11 +168,15 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
        
        while (@links) {
                my $dest=pop @links;
        
        while (@links) {
                my $dest=pop @links;

-               my $src=pop @links;
+               my $src=expand_path(pop @links);

 
 

-               # Relavatize src and dest.

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

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

 
                # Make sure the directory the link will be in exists.
                my $basedir=dirname("$tmp/$dest");
 
                # Make sure the directory the link will be in exists.
                my $basedir=dirname("$tmp/$dest");


@@ -144,11 +189,11 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
                # top level directories, leave it absolute.
                my @src_dirs=split(m:/+:,$src);
                my @dest_dirs=split(m:/+:,$dest);
                # top level directories, leave it absolute.
                my @src_dirs=split(m:/+:,$src);
                my @dest_dirs=split(m:/+:,$dest);

-               if ($src_dirs[0] eq $dest_dirs[0]) {
+               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;
                        # 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++) {}
+                       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) {
                        # Build up the new src.
                        $src="";
                        for (1..$#dest_dirs - $x) {


@@ -157,14 +202,21 @@ foreach my $package (@{$dh{DOPACKAGES}}) {
                        for ($x .. $#src_dirs) {
                                $src.=$src_dirs[$_]."/";
                        }
                        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";
                }
                        $src=~s:/$::;
                }
                else {
                        # Make sure it's properly absolute.
                        $src="/$src";
                }

-               
-               doit("ln","-sf",$src,"$tmp/$dest");
+
+               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");

        }
 }
 
        }
 }