From mhooreman@keyware.com

Created by mhooreman@keyware.com

This is a bug report for perl from mhooreman@​keyware.com,
generated with the help of perlbug 1.34 running under perl v5.8.1.

Say we have a script /opt/test.pl who use FindBin​::Bin.
Say that the user foo has read and execute access to the /opt directory.
Say that the user foo has no access to the /home/bar directory.

When I run, as bar, and into the /home/bar directory​:
"sudo -u foo /opt/test.pl",
the $FindBin​::Bin is empty, instead to be equal to "/opt/".

Thanks to take a look at this.

Michael HOOREMAN

Flags:
    category=core
    severity=low

Site configuration information for perl v5.8.1:

Configured by jvbo at Tue Oct 28 09:21:10 CET 2003.

Summary of my perl5 (revision 5.0 version 8 subversion 1) configuration:
  Platform:
    osname=linux, osvers=2.4.7-10, archname=i686-linux
    uname='linux obelix 2.4.7-10 #1 thu sep 6 17:27:27 edt 2001 i686 unknown '
    config_args=''
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -I/usr/include/gdbm',
    optimize='-O2',
    cppflags='-fno-strict-aliasing -I/usr/local/include -I/usr/include/gdbm'
    ccversion='', gccversion='2.96 20000731 (Red Hat Linux 7.1 2.96-98)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags =' -L/usr/local/lib'
    libpth=/usr/local/lib /lib /usr/lib
    libs=-lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
    libc=/lib/libc-2.2.4.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.2.4'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-rdynamic'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.1:
    /usr/local/lib/perl5/5.8.1/i686-linux
    /usr/local/lib/perl5/5.8.1
    /usr/local/lib/perl5/site_perl/5.8.1/i686-linux
    /usr/local/lib/perl5/site_perl/5.8.1
    /usr/local/lib/perl5/site_perl
    .


Environment for perl v5.8.1:
    HOME=/home/mhoo
    LANG=en_GB
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/u01/app/oracle/product/9.2.0/lib:/lib:/usr/lib:/opt/informix/lib:/opt/informix/lib/esql:/opt/informix/lib/tools:/usr/lib::/usr/local/lib
    LOGDIR (unset)
    PATH=/usr/local/bin:/bin:/usr/bin:/usr/X11R6/bin:/opt/dmp/util:/opt/dmp/bin:/opt/informix/bin:/u01/app/oracle/product/9.2.0/bin:/home/mhoo/bin
    PERL_BADLANG (unset)
    SHELL=/bin/bash

From @rgs

mhooreman@​keyware.com (via RT) wrote​:

Say we have a script /opt/test.pl who use FindBin​::Bin.
Say that the user foo has read and execute access to the /opt directory.
Say that the user foo has no access to the /home/bar directory.

When I run, as bar, and into the /home/bar directory​:
"sudo -u foo /opt/test.pl",
the $FindBin​::Bin is empty, instead to be equal to "/opt/".

The problem actually comes from Cwd, because getcwd() doesn't find the
current directory if it has no access to it. cwd() does.

The patch below might fix this, modulo portability problems :

Change 24375 by rgs@​bloom on 2005/05/03 08​:53​:25

  Fix for [perl #34252] Access rights in FindBin​::Bin
  At least on my platform, Cwd​::getcwd doesn't find the current
  directory if it has no access to it. Try harder with Cwd​::cwd.

Affected files ...

... //depot/perl/lib/FindBin.pm#18 edit

Differences ...

==== //depot/perl/lib/FindBin.pm#18 (text) ====

@​@​ -93,7 +93,7 @​@​
use Carp;
require 5.000;
require Exporter;
-use Cwd qw(getcwd abs_path);
+use Cwd qw(getcwd cwd abs_path);
use Config;
use File​::Basename;
use File​::Spec;
@​@​ -102,7 +102,7 @​@​
%EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]);
@​ISA = qw(Exporter);

-$VERSION = "1.44";
+$VERSION = "1.45";

sub init
{
@​@​ -158,8 +158,10 @​@​

  croak("Cannot find current script '$0'") unless(-f $script);

- # Ensure $script contains the complete path incase we C<chdir>
+ # Ensure $script contains the complete path in case we C<chdir>

+ my $cwd = getcwd();
+ defined $cwd or $cwd = cwd(); # try harder
  $script = File​::Spec->catfile(getcwd(), $script)
  unless File​::Spec->file_name_is_absolute($script);

The RT System itself - Status changed from 'new' to 'open'

@rgs - Status changed from 'open' to 'resolved'

From @nwc10

On Tue, May 03, 2005 at 11​:21​:59AM +0200, Rafael Garcia-Suarez wrote​:

The problem actually comes from Cwd, because getcwd() doesn't find the
current directory if it has no access to it. cwd() does.

The patch below might fix this, modulo portability problems :

+ my $cwd = getcwd();
+ defined $cwd or $cwd = cwd(); # try harder
$script = File​::Spec->catfile(getcwd(), $script)

should that last line be

  $script = File​::Spec->catfile($cwd, $script)

?

Nicholas Clark

From @rgs

Nicholas Clark wrote​:

On Tue, May 03, 2005 at 11​:21​:59AM +0200, Rafael Garcia-Suarez wrote​:

The problem actually comes from Cwd, because getcwd() doesn't find the
current directory if it has no access to it. cwd() does.

The patch below might fix this, modulo portability problems :

+ my $cwd = getcwd();
+ defined $cwd or $cwd = cwd(); # try harder
$script = File​::Spec->catfile(getcwd(), $script)

should that last line be

$script = File​::Spec\->catfile\($cwd\, $script\)

Of course. Just fixed.