Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

use lib segmentation fault #4206

Closed
p5pRT opened this issue Jul 13, 2001 · 29 comments
Closed

use lib segmentation fault #4206

p5pRT opened this issue Jul 13, 2001 · 29 comments

Comments

@p5pRT
Copy link

p5pRT commented Jul 13, 2001

Migrated from rt.perl.org#7273 (status was 'resolved')

Searchable as RT7273$

@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2001

From aldrsh@meappdev.micro.lucent.com

Created by bplatz@us.ibm.com

This is a bug report for perl from bplatz@​us.ibm.com,
generated with the help of perlbug 1.33 running under perl v5.6.1.

-----------------------------------------------------------------

After installing Perl 5.6.1, the following Perl script generates a segmentation
fault when the effective uid differs from the real uid. This script is
being run under Solaris 2.6, Perl 5.6.1​:

# start of script​:
#
#!/usr/local/bin/perl -U

BEGIN
  {
  #
  # Set $PATH and $IFS to avoid any security risks. We expect cfg/profile
  # to overwrite them when invoked via MatrixOneProfile->new().
  #
  $ENV{PATH} = "/bin​:/usr/bin";
  $ENV{IFS} = " \t\n";

  #
  # Explicitly set our umask to 022, since CGI commands are run with
  # umask 0.
  #
  umask 022;

  use File​::Basename;

  #
  # Assume "../lib". dirname() returns "." if no
  # path is present.
  #
  $ENV{LMEPDM_LIB} = File​::Basename​::dirname($0) . "/../lib";
  }

use lib $ENV{LMEPDM_LIB};
use IO​::Handle;

system("id");
print "\@​INC = @​INC\n";
print "\$ENV{LMEPDM_LIB} = $ENV{LMEPDM_LIB}\n";
#
# end of script

The above runs fine under Perl 5.004.

I found that if I replace the variable reference in the
"use lib" statement with a string representing the full path to the
given library, it works fine.

Example​:

use lib "/home/mxweb/lib";

I also found that the above script will work fine under 5.6.1 if I leave
the "use lib" statement alone and comment out the "use IO​::Handle" line.

I would appreciate any assistance you might be able to provide if this is
not a bug and I'm doing something incorrectly.

Thanks in advance,
Dave Schulte
bplatz@​us.ibm.com

Perl Info

Flags:
    category=core
    severity=high

Site configuration information for perl v5.6.1:

Configured by steve at Wed Apr 25 02:36:48 EDT 2001.

Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
  Platform:
    osname=solaris, osvers=2.6, archname=sun4-solaris
    uname='sunos tensor.vnet.net 5.6 generic_105181-06 sun4u sparc sunw,ultra-1 '
    config_args='-Dcc=gcc -de'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
  Compiler:
    cc='gcc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O',
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='2.95.3 20010315 (release)', gccosandvers='solaris2.6'
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, usemymalloc=y, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -L/usr/local/lib '
    libpth=/usr/local/lib /usr/lib /usr/ccs/lib
    libs=-lsocket -lnsl -lgdbm -ldb -ldl -lm -lc
    perllibs=-lsocket -lnsl -ldl -lm -lc
    libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.6.1:
    /usr/local/lib/perl5/5.6.1/sun4-solaris
    /usr/local/lib/perl5/5.6.1
    /usr/local/lib/perl5/site_perl/5.6.1/sun4-solaris
    /usr/local/lib/perl5/site_perl/5.6.1
    /usr/local/lib/perl5/site_perl
    .


Environment for perl v5.6.1:
    HOME=/home/aldrsh
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/opt/SUNWspro3/SC3.0.1:/usr/lib:/sopt/app/oracle/product/7.3.4/lib:/usr/dt/lib
    LOGDIR (unset)
    PATH=/sopt/app/oracle/product/7.3.4/bin:/usr/openwin/bin:/opt/X11/X11R5/bin:/opt/X11/X11R5/localxbin:/sopt/app/oracle/product/7.3.4/bin:/opt/oracle/local/bin:/usr/ccs/bin:/opt/SUNWspro3/bin:/home/aldrsh/bin:/opt/addpath/bin:/usr/ccs/bin:/usr/bin:/usr/ucb:/usr/openv/netbackup/bin:/opt/VRTSvmsa/bin:/opt/dcs/bin:/opt/dcs/adm:/opt/local/bin:/usr/local/bin:::/opt/smradmin/scheduler/dcssrv15eP:/opt/smradmin/bin:/home/unidats/UNI_DEVTOOLS/bin:/opt/oracle/local/bin:/opt11/matrix/local/bin:/usr/local/bin:/bin:/usr/ccs/bin
    PERL_BADLANG (unset)
    SHELL=/bin/ksh



@p5pRT
Copy link
Author

p5pRT commented Jul 13, 2001

From [Unknown Contact. See original ticket]

Dear Perl Bug Administrators, please update the "sent from" information for
case 20010713.001 to reflect "bplatz@​us.ibm.com".
I apologize, but I should have sent this email from my normal email
address, but I thought that the "reply to" address would be recorded. The
aldrsh@​meappdev.micro.lucent.com address will not work shortly due to
separation of Agere Systems from Lucent Technologies.

Thanks in advance,
Dave Schulte
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

@p5pRT
Copy link
Author

p5pRT commented Jul 31, 2001

From [Unknown Contact. See original ticket]

Thanks again,
Dave Schulte
bplatz@​us.ibm.com
voice​: 610.712.5225

@p5pRT
Copy link
Author

p5pRT commented Nov 1, 2001

From [Unknown Contact. See original ticket]

Is anyone monitoring email sent to perlbug@​perl.org? Back in July I
submitted bug # 20010713.001 and have not heard any response regarding this
issue. I would like to know if this problem is something I've done wrong or
if the problem may have be resolved in newer Perl release.

I would greatly appreciate it if someone could please respond to this bug
report.

Thanks in advance,
Dave Schulte
bplatz@​us.ibm.com
voice​: 610.712.5225

@p5pRT
Copy link
Author

p5pRT commented Nov 9, 2001

From [Unknown Contact. See original ticket]

Created by bplatz@us.ibm.com

This fellow feels like he's being ignored.

He sent the message in July, it recieved a bugid, and both it and his
reminder emails appeared on p5p (see mpg archive). Never had a reply
apparently, could someone have a peek at this, please?

TIA

Ciao

-------- Original Message --------
Subject​: use lib segmentation fault
Date​: Thu, 8 Nov 2001 15​:56​:25 -0500
From​: "David Schulte" <bplatz@​us.ibm.com>
To​: richard@​rfi.net

Richard, below is a bug report that I submitted back on 7/13 regarding a
problem we encountered with Perl 5.6.1. I never received a reply
regarding
this issue and was wondering if you could provide some assistance or
route
this issue to the correct person currently supporting Perl under
Solaris.

I did not know what action to take. I noticed your name appear when
searching for bugs reported within the last few days at bugs.per.org.

I would really like to take advantage of some of the new features in
Perl
5.6.1, but I'm stuck at Perl 5.005 until I can determine whether the
problem encountered below is something I'm doing wrong or not.

Thanks in advance for any assistance you can provide.
Dave Schulte
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

----- Forwarded by David Schulte/Allentown/IBM on 11/08/2001 03​:51 PM
-----
 
 
David_Schulte
  <aldrsh@​meappdev.micro.l To​:
perlbug@​perl.org
  ucent.com> cc​: David
Schulte/Allentown/IBM@​IBMUS
  Subject​: use lib
segmentation fault
  07/13/2001 08​:41
AM
  Please respond to
David
 
Schulte
 
 

Your e-mail has been received by the Perl Bug Squashing Team.

  Original subject​: use lib segmentation fault

A Bug ID (20010713.001) has been assigned and is shown in the subject of
this email.
Please include this bug ID in the subject line of any followup messages.

This is an automatic confirmation message.

If you do not wish to receive this confirmation, in the future,
put 'ack=no' somewhere in the body of your mail.

--
Perl Bug Squashing Team
Message from the Perlbug squashing team at 'perlbug@​perl.org'

----------------------------------------------------------------------------------------------------

This is a bug report for perl from bplatz@​us.ibm.com,
generated with the help of perlbug 1.33 running under perl v5.6.1.

-----------------------------------------------------------------

After installing Perl 5.6.1, the following Perl script generates a
segmentation
fault when the effective uid differs from the real uid. This script is
being run under Solaris 2.6, Perl 5.6.1​:

# start of script​:
#
#!/usr/local/bin/perl -U

BEGIN
  {
  #
  # Set $PATH and $IFS to avoid any security risks. We expect
cfg/profile
  # to overwrite them when invoked via MatrixOneProfile->new().
  #
  $ENV{PATH} = "/bin​:/usr/bin";
  $ENV{IFS} = " \t\n";

  #
  # Explicitly set our umask to 022, since CGI commands are run with
  # umask 0.
  #
  umask 022;

  use File​::Basename;

  #
  # Assume "../lib". dirname() returns "." if no
  # path is present.
  #
  $ENV{LMEPDM_LIB} = File​::Basename​::dirname($0) . "/../lib";
  }

use lib $ENV{LMEPDM_LIB};
use IO​::Handle;

system("id");
print "\@​INC = @​INC\n";
print "\$ENV{LMEPDM_LIB} = $ENV{LMEPDM_LIB}\n";
#
# end of script

The above runs fine under Perl 5.004.

I found that if I replace the variable reference in the
"use lib" statement with a string representing the full path to the
given library, it works fine.

Example​:

use lib "/home/mxweb/lib";

I also found that the above script will work fine under 5.6.1 if I leave
the "use lib" statement alone and comment out the "use IO​::Handle" line.

I would appreciate any assistance you might be able to provide if this
is
not a bug and I'm doing something incorrectly.

Thanks in advance,
Dave Schulte
bplatz@​us.ibm.com

Perl Info

Flags:
    category=core
    severity=high

Site configuration information for perl v5.6.1:

Configured by steve at Wed Apr 25 02:36:48 EDT 2001.

Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
  Platform:
    osname=solaris, osvers=2.6, archname=sun4-solaris
    uname='sunos tensor.vnet.net 5.6 generic_105181-06 sun4u sparc
sunw,ultra-1 '
    config_args='-Dcc=gcc -de'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef
usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
  Compiler:
    cc='gcc', ccflags ='-fno-strict-aliasing -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O',
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='2.95.3 20010315 (release)', gccosandvers
='solaris2.6'
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
    alignbytes=8, usemymalloc=y, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -L/usr/local/lib '
    libpth=/usr/local/lib /usr/lib /usr/ccs/lib
    libs=-lsocket -lnsl -lgdbm -ldb -ldl -lm -lc
    perllibs=-lsocket -lnsl -ldl -lm -lc
    libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'

Locally applied patches:



@INC for perl v5.6.1:
    /usr/local/lib/perl5/5.6.1/sun4-solaris
    /usr/local/lib/perl5/5.6.1
    /usr/local/lib/perl5/site_perl/5.6.1/sun4-solaris
    /usr/local/lib/perl5/site_perl/5.6.1
    /usr/local/lib/perl5/site_perl
    .


Environment for perl v5.6.1:
    HOME=/home/aldrsh
    LANG (unset)
    LANGUAGE (unset)

LD_LIBRARY_PATH=/opt/SUNWspro3/SC3.0.1:/usr/lib:/sopt/app/oracle/product/7.3.4/lib:/usr/dt/lib

    LOGDIR (unset)

PATH=/sopt/app/oracle/product/7.3.4/bin:/usr/openwin/bin:/opt/X11/X11R5/bin:/opt/X11/X11R5/localxbin:/sopt/app/oracle/product/7.3.4/bin:/opt/oracle/local/bin:/usr/ccs/bin:/opt/SUNWspro3/bin:/home/aldrsh/bin:/opt/addpath/bin:/usr/ccs/bin:/usr/bin:/usr/ucb:/usr/openv/netbackup/bin:/opt/VRTSvmsa/bin:/opt/dcs/bin:/opt/dcs/adm:/opt/local/bin:/usr/local/bin:::/opt/smradmin/scheduler/dcssrv15eP:/opt/smradmin/bin:/home/unidats/UNI_DEVTOOLS/bin:/opt/oracle/local/bin:/opt11/matrix/local/bin:/usr/local/bin:/bin:/usr/ccs/bin

    PERL_BADLANG (unset)
    SHELL=/bin/ksh

@p5pRT
Copy link
Author

p5pRT commented Nov 10, 2001

From @rspier

  I am unable to replicate your segfault bug on a Solaris 8 machine,
  with a freshly compiled perl5.6.1.

  Could you compile a debugging version of perl (as per the
  instructions in the INSTALL file) and run your test again? If you
  can provide us with a stack trace, it would help.

  Also, you may wish to try your test in one of the recent
  development versions of perl that will become 5.8.0.

-R

[bug details snipped]

@p5pRT
Copy link
Author

p5pRT commented Nov 12, 2001

From @rspier

No, I didn't test in that case. I missed it in the bugreport. I
won't be able to easily test that (uid!=euid) on the Solaris box I have
access to.

It's possible that this bug might also be related to something you
might be doing in that C wrapper. It might be useful (if that wrapper
is short) to add it to the ticket.

Please let me know if you did the above. In the meantime, I'm recompiling a
local version of Perl 5.6.1 so I can run my test again.

See above.

Ok.

-R

@p5pRT
Copy link
Author

p5pRT commented Nov 12, 2001

From @rspier

The stack trace is more than a little scary, but I'll see if I can
track it done a little closer after work.

-R

Program received signal SIGSEGV, Segmentation fault.
0x080b13ff in Perl_mg_get (sv=0x81b925c) at mg.c​:113
113 MGVTBL *vtbl = mg->mg_virtual;

#0 0x080b13ff in Perl_mg_get (sv=0x81b925c) at mg.c​:113
#1 0x080cd1ec in Perl_sv_2pv_flags (sv=0x81b925c, lp=0xbfffe4e0,
#flags=2)
  at sv.c​:2902
#2 0x080c85d1 in S_method_common (meth=0x81b925c, hashp=0xbfffe51c)
  at pp_hot.c​:3017
#3 0x080c8566 in Perl_pp_method_named () at pp_hot.c​:3001
#4 0x080be289 in Perl_runops_debug () at run.c​:53
#5 0x08060cc4 in S_call_body (myop=0xbfffe680, is_eval=0) at
#perl.c​:1946
#6 0x08060967 in perl_call_sv (sv=0x81b9220, flags=6) at perl.c​:1864
#7 0x0806431a in S_call_list_body (cv=0x81b9220) at perl.c​:3937
#8 0x08063f2f in Perl_call_list (oldscope=11, paramList=0x81bc9d8)
  at perl.c​:3865
#9 0x08093102 in Perl_newATTRSUB (floor=549, o=0x819afb0, proto=0x0,
  attrs=0x0, block=0x81baa60) at op.c​:4963
#10 0x0808e9d7 in Perl_utilize (aver=1, floor=549, version=0x0,
#id=0x81aa848,
  arg=0x0) at op.c​:3327
#11 0x0808531c in Perl_yyparse () at perly.y​:414
#12 0x080f808d in S_doeval (gimme=0, startop=0x0) at pp_ctl.c​:2904
#13 0x080f9ced in Perl_pp_require () at pp_ctl.c​:3389
#14 0x080be289 in Perl_runops_debug () at run.c​:53
#15 0x08060cc4 in S_call_body (myop=0xbfffec50, is_eval=0) at
#perl.c​:1946
#16 0x08060967 in perl_call_sv (sv=0x81a98a8, flags=6) at perl.c​:1864
#17 0x0806431a in S_call_list_body (cv=0x81a98a8) at perl.c​:3937
#18 0x08063f2f in Perl_call_list (oldscope=6, paramList=0x8187e64)
  at perl.c​:3865
#19 0x08093102 in Perl_newATTRSUB (floor=329, o=0x81b9a00, proto=0x0,
  attrs=0x0, block=0x81b99d8) at op.c​:4963
#20 0x0808e9d7 in Perl_utilize (aver=1, floor=329, version=0x0,
#id=0x819bb80,
  arg=0x0) at op.c​:3327
#21 0x0808531c in Perl_yyparse () at perly.y​:414
#22 0x080f808d in S_doeval (gimme=0, startop=0x0) at pp_ctl.c​:2904
#23 0x080f9ced in Perl_pp_require () at pp_ctl.c​:3389
#24 0x080be289 in Perl_runops_debug () at run.c​:53
#25 0x08060cc4 in S_call_body (myop=0xbffff220, is_eval=0) at
#perl.c​:1946
#26 0x08060967 in perl_call_sv (sv=0x8163758, flags=6) at perl.c​:1864
#27 0x0806431a in S_call_list_body (cv=0x8163758) at perl.c​:3937
#28 0x08063f2f in Perl_call_list (oldscope=1, paramList=0x81637b8)
  at perl.c​:3865
#29 0x08093102 in Perl_newATTRSUB (floor=109, o=0x816bc80, proto=0x0,
  attrs=0x0, block=0x8167420) at op.c​:4963
#30 0x0808e9d7 in Perl_utilize (aver=1, floor=109, version=0x0,
#id=0x8167588,
  arg=0x0) at op.c​:3327
#31 0x0808531c in Perl_yyparse () at perly.y​:414
#32 0x0805f96e in S_parse_body (env=0x0, xsinit=0x805c8b0 <xs_init>)
  at perl.c​:1433
#33 0x0805ed76 in perl_parse (my_perl=0x8157e48, xsinit=0x805c8b0
#<xs_init>,
#34 0x0805c85d in main (argc=3, argv=0xbffff6e4, env=0xbffff6f4)
  at perlmain.c​:74
#35 0x40085306 in __libc_start_main (main=0x805c7e0 <main>, argc=3,
  ubp_av=0xbffff6e4, init=0x805b8d8 <_init>, fini=0x8135cf0 <_fini>,
 
  rtld_fini=0x4000d2cc <_dl_fini>, stack_end=0xbffff6dc)
  at ../sysdeps/generic/libc-start.c​:129

David Schulte writes​:

Robert, attached is a simple main and a copy of the test Perl script.

Compile main using​:

make main

Then chown main to some other user. Then, as the other user, change its
mode to 4755. Then, as the original user invoke main and you should see a
segmentation fault.

Example​:

aldrsh(meappdev/megpsrv)​: id
uid=17912(aldrsh) gid=103(dba)
aldrsh(meappdev/megpsrv)​: ls -l
total 48
-rwsr-xr-x 1 mxweb dba 6536 Nov 12 11​:04 main
-rw-r--r-- 1 aldrsh dba 71 Nov 12 11​:03 main.c
-rwxr-xr-x 1 aldrsh dba 734 Nov 12 11​:03 test.pl
aldrsh(meappdev/megpsrv)​: main
Segmentation Fault

If you invoke main as the "other" user (the one who now owns main), you
won't see the segmentation fault.

Example​:

aldrsh(meappdev/megpsrv)​: su mxweb
Password​:
aldrsh(meappdev/megpsrv)​: id
uid=30005(mxweb) gid=30005(mxweb)
aldrsh(meappdev/megpsrv)​: main
uid=30005(mxweb) gid=30005(mxweb)
@​INC = ./../lib /home/aldrsh/tmp/perlInstall/lib/5.6.1/sun4-solaris
/home/aldrsh
/tmp/perlInstall/lib/5.6.1
/home/aldrsh/tmp/perlInstall/lib/site_perl/5.6.1/sun4
-solaris /home/aldrsh/tmp/perlInstall/lib/site_perl/5.6.1
/home/aldrsh/tmp/perlI
nstall/lib/site_perl .
$ENV{LMEPDM_LIB} = ./../lib

Due to the way that Solaris treats setuid'ed programs, I can't get a core
file created. I believe that when the kernel sees that the effective and
real uid's don't match, it doesn't generate a core file.

Please note that you will have to edit test.pl to change the first line to
reference your Perl 5.6.1 installation.

(See attached file​: main.c)(See attached file​: test.pl)

Thanks again,
Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

--

@p5pRT
Copy link
Author

p5pRT commented Nov 12, 2001

From [Unknown Contact. See original ticket]

Please let me know if you did the above. In the meantime, I'm recompiling a
local version of Perl 5.6.1 so I can run my test again.

Thanks,
Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

@p5pRT
Copy link
Author

p5pRT commented Nov 12, 2001

From [Unknown Contact. See original ticket]

main.c

@p5pRT
Copy link
Author

p5pRT commented Nov 12, 2001

From [Unknown Contact. See original ticket]

test.pl

@p5pRT
Copy link
Author

p5pRT commented Nov 12, 2001

From [Unknown Contact. See original ticket]

I REALLY appreciate your efforts in digging into this problem!!
Thanks again!!
Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

@p5pRT
Copy link
Author

p5pRT commented Nov 13, 2001

From @rspier

--- snip ---
#!/pkg/perl-snap/bin/perl -U
unshift(@​INC, $0);
require Exporter;
--- snip ---
( run under setuid wrapper, of course. )
( Any tainted data in place of $0 will do, i.e. a command line
argument, or environment variable, as in the original.)
( Exporter is the simplest module I could make this segfault on.)

At the moment, it looks like the problem is in some interaction
between Magic, Taint Mode, -U (deactivate some taint), and @​INC or
method lookups. A real rats nest. I think it has to do with how some
values used in the require/use/import stuff end up being tainted
(i.e. PVMG's) under taint mode, but one of them gets corrupted.
(Maybe they're tainted because they come from potential outside
sources.. i.e. another modules on the system which cannot be trusted?)

This is a segfault that should probably be eliminated, but David, you
might want to rethink how your code works as well. -U is potentially
a very bad and dangerous thing, because it disables some of the taint
mode security checks. You're essentially getting what you ask for
when you use that flag.

-R

David Schulte writes​:

Fantastic! ... well the fact that you were able to replicate it and get a
good stack trace, not the fact that the bug really exists...

I REALLY appreciate your efforts in digging into this problem!!
Thanks again!!
Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

--

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2001

From [Unknown Contact. See original ticket]

While reading the configuration files, we need the effective uid changed
from nobody to the administrative login to have permission to read these
files. This is the reason for running in a setuid'ed environment. We only
remain in the administrative uid for as long as required to read these
configuration files.

For our code to be portable, we determine where our local Perl library
support (not the standard Perl libraries, but our own custom software)
comes from based on a relative path to where the given CGI script was
invoked. Thus the need for the "use lib" statement in my original example.

Given that we set $PATH and $IFS explicitly, I figured we "should" be safe
from deviant people trying to hack into our system. One exception to is
allowing $LMEPDM_LIB in my original example to be set explicitly in the
environment, but there might be others.

Even the simple example I provided with my original bug report complains
about the system("id") invocation without the -U option, even though we've
explicitly set $PATH as part of the BEGIN block.

Please let me know if you have any suggestions or documentation that I
might refer to.

Thanks,
Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2001

From [Unknown Contact. See original ticket]

As a workaround for the core dump, if the following patches won't be
applied to perl, you have to make sure that all @​INC entries and
"required" file paths are not tainted.

If the source code is loaded from a tainted path everything from that
file becomes tainted and the current perl implementation is likely to
explode as found by you and Robert.

The first patch, against bleadperl, cures the segfault. It is mostly a
workaround​: if perl is running in unsafe mode, then perl will clear
the tainted flag before running the source required. After the file
required is run perl restores the tainted flag. With this patch
everything inside the sources loaded from tainted paths will not
become tainted too and cause perl to crash.

The workaround may look too dangerous, but perl is already running in
unsafe mode. I think that the second hunk of the patch should be
applied anyway because it prevents perl crashing after loading a
source from an @​INC entry not tainted, but appearing in the @​INC array
after a tainted element, like in this example​:
perl -UTe 'unshift(@​INC, "/garbage" . substr($^X, 0, 0)); require Exporter;'

The second patch is for perl 5.6.x if you decide that the idea is
good.

Thank you,
Radu Greab

Inline Patch
--- pp_ctl.c~	Sun Nov  4 04:35:19 2001
+++ pp_ctl.c	Wed Nov 14 19:04:34 2001
@@ -3038,6 +3038,7 @@
     SV *hook_sv = 0;
     SV *encoding;
     OP *op;
+    bool tainted;
 
     sv = POPs;
     if (SvNIOKp(sv)) {
@@ -3147,6 +3148,8 @@
 	    for (i = 0; i <= AvFILL(ar); i++) {
 		SV *dirsv = *av_fetch(ar, i, TRUE);
 
+		TAINT_NOT;	/* must clear taintedness after previous
+				   possibly tainted entry */
 		if (SvROK(dirsv)) {
 		    int count;
 		    SV *loader = dirsv;
@@ -3386,11 +3389,17 @@
     encoding = PL_encoding;
     PL_encoding = Nullsv;
 
+    tainted = PL_tainted;
+    if (PL_unsafe)
+	TAINT_NOT;
+
     op = DOCATCH(doeval(gimme, NULL));
     
     /* Restore encoding. */
     PL_encoding = encoding;
 
+    TAINT_IF(tainted);
+
     return op;
 }
 
End of patch.
Inline Patch
--- pp_ctl.c~	Wed Sep 26 06:23:51 2001
+++ pp_ctl.c	Wed Nov 14 19:48:31 2001
@@ -2957,6 +2957,8 @@
     GV *filter_child_proc = 0;
     SV *filter_state = 0;
     SV *filter_sub = 0;
+    OP *op;
+    bool tainted;
 
     sv = POPs;
     if (SvNIOKp(sv)) {
@@ -3063,6 +3065,8 @@
 	    for (i = 0; i <= AvFILL(ar); i++) {
 		SV *dirsv = *av_fetch(ar, i, TRUE);
 
+		TAINT_NOT;	/* must clear taintedness after previous
+				   possibly tainted entry */
 		if (SvROK(dirsv)) {
 		    int count;
 		    SV *loader = dirsv;
@@ -3286,7 +3290,16 @@
     PL_eval_owner = thr;
     MUTEX_UNLOCK(&PL_eval_mutex);
 #endif /* USE_THREADS */
-    return DOCATCH(doeval(G_SCALAR, NULL));
+
+    tainted = PL_tainted;
+    if (PL_unsafe)
+	TAINT_NOT;
+
+    op = DOCATCH(doeval(G_SCALAR, NULL));
+     
+    TAINT_IF(tainted);
+
+    return op;
 }
 
 PP(pp_dofile)
End of patch.

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2001

From [Unknown Contact. See original ticket]

Something like this​:

my $path;
BEGIN {
  use FindBin;
  if ($FindBin​::Bin =~ /(.*)/) {
  $path = "$1/../lib";
  }
}

use lib $path;
.... the rest of your code

Read perlsec about how to untaint variables.

Thanks,
Radu Greab

@p5pRT
Copy link
Author

p5pRT commented Nov 14, 2001

From @rspier

While I agree that this is a workaround, I don't think it is a good
solution. Yes, the user is running in unsafe mode, and deserve what
they get somewhat, but by not propogating the taint into the sub-files
makes the taint inconsistent and actually untaints data that should be
tainted and therefore won't warn (as -U -w does) if you try and do
something dangerous.

Better would be to have perl not choke on the tainted data, of course.
(Some research shows that it might be malformed magic.)

I have a new test case. four lines. Three files. No more big ugly
modules. :)

:​::​::​::​::​::​::​:
test.pl
:​::​::​::​::​::​::​:
#!/pkg/perl-snap/bin/perl -T -U
@​INC = ("." . substr($0,0,0));
require Foo;
:​::​::​::​::​::​::​:
Foo.pm
:​::​::​::​::​::​::​:
use Bar; 1;
:​::​::​::​::​::​::​:
Bar.pm
:​::​::​::​::​::​::​:
$Bar​::blah = "any SV";

-R

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2001

From [Unknown Contact. See original ticket]

Given that we want to determine dynamically where our local library support
exists, based on where a given command resides, do you have any ideas how
to append such a path to @​INC without referencing $0, which appears to be
what's introducing the tainted path to @​INC?

Currently we are using​:

#!/usr/local/bin/perl
$ENV{LMEPDM_LIB} = File​::Basename​::dirname($0) . "/../lib";
use lib $ENV{LMEPDM_LIB};

If a given command is found as a result of searching $PATH, $0 will equal a
full path. If a given command is found based on a relateive path (e.g.,
../cmd, ../../bin/cmd, bin/cmd, etc.), $0 will equal the given relative
path. If $0 does not include a path, dirname() will return "."

I tried using the FindBin module, but this produced the same results as the
above (i.e., the segmentation fault under a setuid environment).

Example​:

#!/usr/local/bin/perl
use FindBin;
use lib "$FindBin​::Bin/../lib";

Note that the "#!/usr/local/bin/perl" forces $0 to be set to a full path.
If a line like "#!/bin/sh" were not included in a Borne shell script, and
the script were found based on a search of $PATH, $0 would be the basename
of the given script, not the full path. In this case, the "type" command
(or "whence" command for ksh) should probably be used to determine where
the given command was invoked from. For Perl, I guess it would be better to
use the FindBin module instead of a reference to $0, although FindBIn.pm
also appears to reference $0, which is why I see the same results as my
original example.

We still need to use the -U option due the use of basenames with system()
as noted in my earlier mail. Therefore, we either need to implement some
form of workaround as suggested by Radu, or need some form of patch
applied.

Thanks in advance for any suggestions you might offer.
Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2001

From [Unknown Contact. See original ticket]

With your simple test case I found the cause of the core dump in this
code from Perl_utilize(), lines 3306-3309​:

  /* Fake up a method call to import/unimport */
  meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);;
  sv_upgrade(meth, SVt_PVIV);

The method name is createad as of type SVt_PVMG because it is tainted, but
later is is "upgraded" to SVt_PVIV. Perl_sv_upgrade() frees the magic,
but keeps the SVs_GMG and SVs_SMG flags and Perl_mg_get() chokes when
it tries to access the already freed magic.

Changing Perl_sv_upgrade() to not downgrade the SV if it is already in
a more complex form than requested cures the core dump. All tests pass
but I have a feeling that this change may be too simplistic and the
right fix would be to clear the relevant flags when downgrading a
structure.

Below is the new patch for review.

Thanks,
Radu Greab

Inline Patch
--- sv.c~	Mon Nov 12 17:34:13 2001
+++ sv.c	Thu Nov 15 12:45:21 2001
@@ -1231,7 +1231,7 @@
 	sv_force_normal(sv);
     }
 
-    if (SvTYPE(sv) == mt)
+    if (SvTYPE(sv) >= mt)
 	return TRUE;
 
     if (mt < SVt_PVIV)
--- pp_ctl.c~	Sun Nov  4 04:35:19 2001
+++ pp_ctl.c	Thu Nov 15 12:51:59 2001
@@ -3147,6 +3147,8 @@
 	    for (i = 0; i <= AvFILL(ar); i++) {
 		SV *dirsv = *av_fetch(ar, i, TRUE);
 
+		TAINT_NOT;	/* must clear taintedness after previous
+				   possibly tainted entry */
 		if (SvROK(dirsv)) {
 		    int count;
 		    SV *loader = dirsv;
End of patch.

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2001

From @gsar

This will break some kinds of code (be extra careful when changing
logic that hasn't been changed in a long time). s/sv_upgrade/SvUPGRADE/
in the snippet above would be the right fix.

--- sv.c~ Mon Nov 12 17​:34​:13 2001
+++ sv.c Thu Nov 15 12​:45​:21 2001
@​@​ -1231,7 +1231,7 @​@​
sv_force_normal(sv);
}

- if (SvTYPE(sv) == mt)
+ if (SvTYPE(sv) >= mt)
return TRUE;

if \(mt \< SVt\_PVIV\)

Sarathy
gsar@​ActiveState.com

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2001

From [Unknown Contact. See original ticket]

Radu, Robert, and Richard, thanks again for all your help!!
Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2001

From @rspier

Changing Perl_sv_upgrade() to not downgrade the SV if it is already in
a more complex form than requested cures the core dump. All tests pass
Below is the new patch for review.

This will break some kinds of code (be extra careful when changing
logic that hasn't been changed in a long time). s/sv_upgrade/SvUPGRADE/
in the snippet above would be the right fix.

Here's the patch as suggested by Sarathy.

Against latest perl-snap, all tests (still) pass under Linux. (And
this also cures David's segfault.)

-R

Inline Patch
--- op.c.orig	Thu Nov 15 11:03:47 2001
+++ op.c	Thu Nov 15 11:04:49 2001
@@ -3305,7 +3305,7 @@
 
 	/* Fake up a method call to import/unimport */
 	meth = aver ? newSVpvn("import",6) : newSVpvn("unimport", 8);;
-	sv_upgrade(meth, SVt_PVIV);
+	(void)SvUPGRADE(meth, SVt_PVIV);
 	(void)SvIOK_on(meth);
 	PERL_HASH(SvUVX(meth), SvPVX(meth), SvCUR(meth));
 	imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,

@p5pRT
Copy link
Author

p5pRT commented Nov 15, 2001

From [Unknown Contact. See original ticket]

Thanks, applied. (#13024)

- ams

@p5pRT
Copy link
Author

p5pRT commented Nov 16, 2001

From [Unknown Contact. See original ticket]

Why does the following untaint a variable​:

if ($z =~ /(.*)/)
  {
  $z = $1;
  }

and the following does not​:

$z =~ s/(.*)/$1/;

Don't these do effectively the same thing?

Consider the following example. When invoked where the euid != uid, it
produces an insecure dependency error at the second eval statement (line
16).

#!/usr/local/bin/perl

my $evalstmt;
my $var;

$evalstmt = "\$var = '$0'";
if ($evalstmt =~ /(.*)/)
  {
  $evalstmt = $1;
  }
eval $evalstmt;
print "\$var = $var\n";

$evalstmt = "\$var = '$0'";
$evalstmt =~ s/(.*)/$1/;
eval $evalstmt;
print "\$var = $var\n";

I'm going to use the if() statement recommended by Radu, but I'm just
curious why the second case does not work as well.
The above holds true for both Perl 5.004 and Perl 5.6.1. Maybe I should
open a new perl.org ticket to cover this question.

Thanks,
Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

@p5pRT
Copy link
Author

p5pRT commented Nov 16, 2001

From @tamias

Substitution does not untaint. Substitution is not documented to untaint.
Substitution modifies the target string in place, so although $1 may be
untainted, any characters which were not matched by the pattern remain in
the string and are not untainted. This is the correct behavior.

For example, consider $z = 'hello\nrm -rf /';

Ronald

@p5pRT
Copy link
Author

p5pRT commented Nov 16, 2001

From @Abigail

No, consider $z = "foo\nbar".

Of course, you might say, "shouldn't $z =~ s/(.*)/$1/s" untaint a variable?

I don't think so. If you are doing "$z = $1", you are setting $z to something
that is untainted. All of $z, because it's an assignment.

With $z =~ s///, you are replacing *part* of $z - just that in some cases
said part of $z happens to be all of $z shouldn't create an exception.
People would be very surprised if

  $z =~ s/(\w+) (\w+)/$1 $2/

untainted $z just because $z happened to consist of two words separated
by a space.

Abigail

@p5pRT
Copy link
Author

p5pRT commented Nov 16, 2001

From [Unknown Contact. See original ticket]

Thank you for setting me straight. Also please forgive my ignorance with
respect to this stuff. Although I've been programming in Perl for about a
year now, there are things I find myself still being somewhat of a
neophyte.

Thanks again for your help and I hope everyone has a nice weekend.

Dave
bplatz@​us.ibm.com
voice​: 610.712.5225
pager​: 800.946.4646, pin 1464630

@p5pRT
Copy link
Author

p5pRT commented Nov 16, 2001

From @vanstyn

No; the latter is effectively the same as​:
  if ($z =~ /(.*)/) {
  substr($z, 0) = $1;
  }
which is intended to be quite different.

Hugo

@p5pRT
Copy link
Author

p5pRT commented May 9, 2003

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

@p5pRT p5pRT closed this as completed May 9, 2003
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Development

No branches or pull requests

1 participant