Avoid mangling /bin non-perl shebangs on merged-/usr systems
If the shebang is absolute and exists in PATH, but was not the first
one found, leave it alone if it's actually the same file as first one.
This avoids packages built on merged-/usr systems with /usr/bin before
/bin in the path breaking when installed on systems without merged
/usr. See e.g. https://bugs.debian.org/913637.
Origin: backport, 9766f9c5ff
Bug: https://github.com/Perl-Toolchain-Gang/ExtUtils-MakeMaker/pull/330
Bug-Debian: https://bugs.debian.org/913637
Gbp-Pq: Topic fixes
Gbp-Pq: Name eumm-usrmerge.diff
This commit is contained in:
parent
b884651d9b
commit
5bdbd9a6b4
|
@ -1243,8 +1243,8 @@ sub _fixin_replace_shebang {
|
|||
my ( $self, $file, $line ) = @_;
|
||||
|
||||
# Now figure out the interpreter name.
|
||||
my ( $cmd, $arg ) = split ' ', $line, 2;
|
||||
$cmd =~ s!^.*/!!;
|
||||
my ( $origcmd, $arg ) = split ' ', $line, 2;
|
||||
(my $cmd = $origcmd) =~ s!^.*/!!;
|
||||
|
||||
# Now look (in reverse) for interpreter in absolute PATH (unless perl).
|
||||
my $interpreter;
|
||||
|
@ -1270,6 +1270,24 @@ sub _fixin_replace_shebang {
|
|||
$interpreter = $maybefile;
|
||||
}
|
||||
}
|
||||
|
||||
# If the shebang is absolute and exists in PATH, but was not
|
||||
# the first one found, leave it alone if it's actually the
|
||||
# same file as first one. This avoids packages built on
|
||||
# merged-/usr systems with /usr/bin before /bin in the path
|
||||
# breaking when installed on systems without merged /usr
|
||||
if ($origcmd ne $interpreter and $self->file_name_is_absolute($origcmd)) {
|
||||
my $origdir = dirname($origcmd);
|
||||
if ($self->maybe_command($origcmd) && grep { $_ eq $origdir } @absdirs) {
|
||||
my ($odev, $oino) = stat $origcmd;
|
||||
my ($idev, $iino) = stat $interpreter;
|
||||
if ($odev == $idev && $oino == $iino) {
|
||||
warn "$origcmd is the same as $interpreter, leaving alone"
|
||||
if $Verbose;
|
||||
$interpreter = $origcmd;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# Figure out how to invoke interpreter on this machine.
|
||||
|
|
|
@ -9,7 +9,7 @@ BEGIN {
|
|||
|
||||
use File::Spec;
|
||||
|
||||
use Test::More tests => 22;
|
||||
use Test::More tests => 30;
|
||||
|
||||
use Config;
|
||||
use TieOut;
|
||||
|
@ -123,3 +123,34 @@ END
|
|||
}
|
||||
);
|
||||
}
|
||||
|
||||
SKIP: {
|
||||
eval { chmod(0755, "usrbin/interp") }
|
||||
or skip "no chmod", 8;
|
||||
|
||||
my $dir = getcwd();
|
||||
local $ENV{PATH} = join $Config{path_sep}, map "$dir/$_", qw(usrbin bin);
|
||||
|
||||
test_fixin(<<END,
|
||||
#!$dir/bin/interp
|
||||
|
||||
blah blah blah
|
||||
END
|
||||
sub {
|
||||
is $_[0], "#!$dir/usrbin/interp\n", 'interpreter updated to one found in PATH';
|
||||
}
|
||||
);
|
||||
|
||||
eval { symlink("../usrbin/interp", "bin/interp") }
|
||||
or skip "no symlinks", 4;
|
||||
|
||||
test_fixin(<<END,
|
||||
#!$dir/bin/interp
|
||||
|
||||
blah blah blah
|
||||
END
|
||||
sub {
|
||||
is $_[0], "#!$dir/bin/interp\n", 'symlinked interpreter later in PATH not mangled';
|
||||
}
|
||||
);
|
||||
}
|
||||
|
|
|
@ -53,6 +53,9 @@ program - this is a program
|
|||
=cut
|
||||
|
||||
1;
|
||||
END
|
||||
'Big-Dummy/usrbin/interp' => <<'END',
|
||||
This is a dummy interpreter
|
||||
END
|
||||
|
||||
'Big-Dummy/test.pl' => <<'END',
|
||||
|
|
Loading…
Reference in New Issue