ExtUtils::Install handle symbolic and hard links

[perl #72028]

When upgrading an already-installed file, ExtUtils::Install could mess up
the permissions of files if the old versions of files were hard or
symbolic links. For example, if the Foo module had been installed as
lib/Foo.pm and for some reason (perhaps due to OS packaging) that file was
hard-linked to other/Foo.pm or replaced with a symbolic link to
other/Foo.pm, then when trying to install a newer release of Foo, the
permissions of the other/Foo.pm file could end up messed up.

This was due to ExtUtils::Install changing the permissions of the old file
before unlinking it; if the file was a link, then the linked file would
get the chmod instead. Since on POSIXy platforms it is the directory
permissions, not the file permissions, that affect whether a file can be
unlinked, the chmod was redundant anyway. So on these platforms, skip the
chmod.

I've also added tests for symlinked and hard-linked files.

dist/ExtUtils-Install/lib/ExtUtils/Install.pm

@@ -255,7 +255,14 @@ On failure throws a fatal error.
 sub _unlink_or_rename { #XXX OS-SPECIFIC
     my ( $file, $tryhard, $installing )= @_;
 
-    _chmod( 0666, $file );
+    # this chmod was originally unconditional. However, its not needed on
+    # POSIXy systems since permission to unlink a file is specified by the
+    # directory rather than the file; and in fact it screwed up hard- and
+    # symlinked files. Keep it for other platforms in case its still
+    # needed there.
+    if ($^O =~ /^(dos|os2|MSWin32|VMS)$/) {
+        _chmod( 0666, $file );
+    }
     my $unlink_count = 0;
     while (unlink $file) { $unlink_count++; }
     return $file if $unlink_count > 0;

dist/ExtUtils-Install/t/Install.t

@@ -12,7 +12,7 @@ use File::Path;
 use File::Spec;
 use File::Temp qw[tempdir];
 
-use Test::More tests => 52;
+use Test::More tests => 60;
 
 use MakeMaker::Test::Setup::BFD;
 
@@ -31,7 +31,7 @@ chdir $tmpdir;
 
 ok( setup_recurs(), 'setup' );
 END {
-    ok( chdir File::Spec->updir );
+    ok( chdir File::Spec->updir, 'chdir ..');
     ok( teardown_recurs(), 'teardown' );
 }
 
@@ -48,6 +48,7 @@ ok( -r 'blib/lib/Big/Dummy.pm', '  copied .pm file' );
 ok( -r 'blib/lib/auto',         '  created autosplit dir' );
 is( $stdout->read, "cp lib/Big/Dummy.pm blib/lib/Big/Dummy.pm\n" );
 
+
 pm_to_blib( { 'lib/Big/Dummy.pm' => 'blib/lib/Big/Dummy.pm' },
             'blib/lib/auto'
           );
@@ -56,6 +57,7 @@ ok( -r 'blib/lib/Big/Dummy.pm', '  .pm file still there' );
 ok( -r 'blib/lib/auto',         '  autosplit still there' );
 is( $stdout->read, "Skip blib/lib/Big/Dummy.pm (unchanged)\n" );
 
+
 install( { 'blib/lib' => 'install-test/lib/perl',
            read   => 'install-test/packlist',
            write  => 'install-test/packlist'
@@ -189,3 +191,67 @@ close DUMMY;
                                              '  UNINST=1 removed different' );
 }
 
+
+# really this test should be run on any platform that supports
+# symbolic and hard links, but this representative sample should do for
+# now
+
+
+# check hard and symbolic links
+
+SKIP: {
+    my $has_links =
+        $^O =~ /^(aix|bsdos|darwin|freebsd|hpux|irix|linux|openbsd|solaris)$/;
+    skip "(sym)links not supported", 8 unless $has_links;
+
+    install([ from_to => { 'blib/lib/' => 'install-links',
+                           read   => 'install-links/packlist',
+                           write  => 'install-links/packlist'
+                         },
+    ]);
+
+    # make orig file a hard link and check that it doesn't get messed up
+
+    my $bigdir = 'install-links/Big';
+    ok link("$bigdir/Dummy.pm", "$bigdir/DummyHard.pm"),
+        'link DummyHard.pm';
+
+    open(my $fh, ">>", "blib/lib/Big/Dummy.pm") or die $!;
+    print $fh "Extra stuff 2\n";
+    close $fh;
+
+    install([ from_to => { 'blib/lib/' => 'install-links',
+                           read   => 'install-links/packlist',
+                           write  => 'install-links/packlist'
+                         },
+    ]);
+
+    ok( !-w "$bigdir/DummyHard.pm", 'DummyHard.pm not writeable' );
+
+    use File::Compare;
+    ok(compare("$bigdir/Dummy.pm", "$bigdir/DummyHard.pm"),
+        "hard-linked file should be different");
+
+    # make orig file a symlink and check that it doesn't get messed up
+
+    ok rename("$bigdir/Dummy.pm", "$bigdir/DummyOrig.pm"),
+        'rename DummyOrig.pm';
+    ok symlink('DummyOrig.pm', "$bigdir/Dummy.pm"),
+        'symlink Dummy.pm';
+
+
+    open($fh, ">>", "blib/lib/Big/Dummy.pm") or die $!;
+    print $fh "Extra stuff 3\n";
+    close $fh;
+
+    install([ from_to => { 'blib/lib/' => 'install-links',
+                           read   => 'install-links/packlist',
+                           write  => 'install-links/packlist'
+                         },
+    ]);
+
+    ok( !-w "$bigdir/DummyOrig.pm", 'DummyOrig.pm not writeable' );
+    ok( !-l "$bigdir/Dummy.pm", 'Dummy.pm not a link' );
+    ok(compare("$bigdir/Dummy.pm", "$bigdir/DummyOrig.pm"),
+        "orig file should be different");
+}