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:
Dagfinn Ilmari Mannsåker 2018-11-13 16:00:48 +00:00 committed by openKylinBot
parent b884651d9b
commit 5bdbd9a6b4
3 changed files with 55 additions and 3 deletions

View File

@ -1243,8 +1243,8 @@ sub _fixin_replace_shebang {
my ( $self, $file, $line ) = @_; my ( $self, $file, $line ) = @_;
# Now figure out the interpreter name. # Now figure out the interpreter name.
my ( $cmd, $arg ) = split ' ', $line, 2; my ( $origcmd, $arg ) = split ' ', $line, 2;
$cmd =~ s!^.*/!!; (my $cmd = $origcmd) =~ s!^.*/!!;
# Now look (in reverse) for interpreter in absolute PATH (unless perl). # Now look (in reverse) for interpreter in absolute PATH (unless perl).
my $interpreter; my $interpreter;
@ -1270,6 +1270,24 @@ sub _fixin_replace_shebang {
$interpreter = $maybefile; $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. # Figure out how to invoke interpreter on this machine.

View File

@ -9,7 +9,7 @@ BEGIN {
use File::Spec; use File::Spec;
use Test::More tests => 22; use Test::More tests => 30;
use Config; use Config;
use TieOut; 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';
}
);
}

View File

@ -53,6 +53,9 @@ program - this is a program
=cut =cut
1; 1;
END
'Big-Dummy/usrbin/interp' => <<'END',
This is a dummy interpreter
END END
'Big-Dummy/test.pl' => <<'END', 'Big-Dummy/test.pl' => <<'END',