DB_File methods and substr don't mix #7361

p5pRT · 2004-06-12T17:58:33Z

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

Searchable as RT30237$

p5pRT · 2004-06-12T17:58:33Z

From perl-5.8.0@ton.iguana.be

Created by perl-5.8.0@ton.iguana.be

The following program works as expected on 5.8.0, but picks up
weird undef warnings under 5.8.4. And indeed what it does
is WRONG on 5.8.4

#!/usr/bin/perl -wl
use strict;
use DB_File;

# This program tries to associate a set of digits with a given alpha key.
# It fails and gives undef warning if run without args (or with arg 0)
# Also fails in various ways for arg 1 and 2
# Works for arg 3

my $mode = shift || 0;

my $db_file = "testdb";
unlink($db_file);
my $db = tie(my %db, "DB_File", $db_file, O_CREAT|O_RDWR, 0666, $DB_HASH)
|| die "Could not db_tie $db_file: $!";
my $set;
for ([a => 4], [b => 1], [a=> 4], [c => 2], [d => 2]) {
my ($m, $n) = @$_;
print STDERR "Want to associate $n with key $m";
my $combo = $m . $n;
if ($mode & 1) {
$set = "" if $db->get(scalar substr($combo, 0, 1), $set);
} else {
$set = "" if $db->get(substr($combo, 0, 1), $set);
}
print STDERR " Fetching key ", substr($combo, 0, 1), " gives '$set'";
if (index($set, $n) >= 0) {
print STDERR " Already have $n, no store";
} else {
$set .= $n;
print STDERR " Don't have $n yet, storing '$set' on key ", substr($combo, 0, 1);
if ($mode & 2) {
die "Storage problem" if $db->put(scalar substr($combo, 0, 1), $set);
} else {
die "Storage problem" if $db->put(substr($combo, 0, 1), $set);
}
}
}

Will output if run without args:

Want to associate 4 with key a
Fetching key a gives ''
Don't have 4 yet, storing '4' on key a
Want to associate 1 with key b
Fetching key b gives ''
Don't have 1 yet, storing '1' on key b
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 4 with key a
Fetching key a gives '1'
Don't have 4 yet, storing '14' on key a
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key c
Fetching key c gives '14'
Don't have 2 yet, storing '142' on key c
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key d
Fetching key d gives '142'
Already have 2, no store

Apart from the warnings, notice how it fetches wrong (old) values for the
several keys.

Running it with argument 3 (causing a "scalar" to be put before all
substr arguments) makes things work as expected.

Perl Info


Flags:
    category=library
    severity=low

Site configuration information for perl v5.8.4:

Configured by ton at Thu Jun  3 13:28:19 CEST 2004.

Summary of my perl5 (revision 5 version 8 subversion 4) configuration:
  Platform:
    osname=linux, osvers=2.6.5, archname=i686-linux-64int-ld
    uname='linux quasar 2.6.5 #8 mon apr 5 05:41:20 cest 2004 i686 gnulinux '
    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=define use64bitall=undef uselongdouble=define
    usemymalloc=y, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
    optimize='-O2 -fomit-frame-pointer',
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='3.4.0 20031231 (experimental)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long long', ivsize=8, nvtype='long double', nvsize=12, 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 -ldb -ldl -lm -lcrypt -lutil -lc
    perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
    libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a
    gnulibc_version='2.3.2'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
    cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.8.4:
    /usr/lib/perl5/5.8.4/i686-linux-64int-ld
    /usr/lib/perl5/5.8.4
    /usr/lib/perl5/site_perl/5.8.4/i686-linux-64int-ld
    /usr/lib/perl5/site_perl/5.8.4
    /usr/lib/perl5/site_perl
    .


Environment for perl v5.8.4:
    HOME=/home/ton
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/opt/schily/bin:/usr/local/bin:/usr/local/sbin:/home/oracle/product/9.0.1/bin:/usr/local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sbin:/bin:/sbin:.
    PERL_BADLANG (unset)
    SHELL=/bin/bash

p5pRT · 2004-06-15T18:10:37Z

From @mhx

On 2004-06-14, at 17:32:26 +0100, Paul Marquess wrote:

Thanks for the bug report.

I've can reproduce the problem with 5.8.4 and can't with 5.6.1, so it looks
like something has changed in between.

I'll have a dig into the code.

Paul

-----Original Message-----
From: via RT [mailto:perl-5.8.0@ton.iguana.beperlbug-followup@perl.org]
Sent: 12 June 2004 18:59
To: bugs-bitbucket@rt.perl.org
Subject: [perl #30237] DB_File methods and substr don't mix

# New Ticket Created by perl-5.8.0@ton.iguana.be
# Please include the string: [perl #30237]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=30237 >

This is a bug report for perl from perl-5.8.0@ton.iguana.be,
generated with the help of perlbug 1.35 running under perl v5.8.4.

-----------------------------------------------------------------
[Please enter your report here]

The following program works as expected on 5.8.0, but picks up
weird undef warnings under 5.8.4. And indeed what it does
is WRONG on 5.8.4

#!/usr/bin/perl -wl
use strict;
use DB_File;

# This program tries to associate a set of digits with a given alpha key.
# It fails and gives undef warning if run without args (or with arg 0)
# Also fails in various ways for arg 1 and 2
# Works for arg 3

my $mode = shift || 0;

my $db_file = "testdb";
unlink($db_file);
my $db = tie(my %db, "DB_File", $db_file, O_CREAT|O_RDWR, 0666, $DB_HASH)
|| die "Could not db_tie $db_file: $!";
my $set;
for ([a => 4], [b => 1], [a=> 4], [c => 2], [d => 2]) {
my ($m, $n) = @$_;
print STDERR "Want to associate $n with key $m";
my $combo = $m . $n;
if ($mode & 1) {
$set = "" if $db->get(scalar substr($combo, 0, 1), $set);
} else {
$set = "" if $db->get(substr($combo, 0, 1), $set);
}
print STDERR " Fetching key ", substr($combo, 0, 1), " gives '$set'";
if (index($set, $n) >= 0) {
print STDERR " Already have $n, no store";
} else {
$set .= $n;
print STDERR " Don't have $n yet, storing '$set' on key ",
substr($combo, 0, 1);
if ($mode & 2) {
die "Storage problem" if $db->put(scalar substr($combo, 0, 1),
$set);
} else {
die "Storage problem" if $db->put(substr($combo, 0, 1), $set);
}
}
}

Will output if run without args:

Want to associate 4 with key a
Fetching key a gives ''
Don't have 4 yet, storing '4' on key a
Want to associate 1 with key b
Fetching key b gives ''
Don't have 1 yet, storing '1' on key b
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 4 with key a
Fetching key a gives '1'
Don't have 4 yet, storing '14' on key a
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key c
Fetching key c gives '14'
Don't have 2 yet, storing '142' on key c
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key d
Fetching key d gives '142'
Already have 2, no store

This looks like missing SvGETMAGIC's to me. When you pass the result
of a substr() to an XS function, you need to call SvGETMAGIC in order
to get the PV right. I noticed this just recently when passing substr()
results to my XS module.

The following should help, but there may be SvGETMAGIC's missing in
other places.

Inline Patch

--- ext/DB_File/typemap.orig	2004-06-15 20:02:10.000000000 +0200
+++ ext/DB_File/typemap	2004-06-15 20:02:42.000000000 +0200
@@ -17,6 +17,7 @@
 T_dbtkeydatum
 	DBM_ckFilter($arg, filter_store_key, \"filter_store_key\");
 	DBT_clear($var) ;
+	SvGETMAGIC($arg);
 	if (SvOK($arg)){
 	    if (db->type != DB_RECNO) {
 	        $var.data = SvPVbyte($arg, PL_na);
@@ -31,6 +32,7 @@
 T_dbtdatum
 	DBM_ckFilter($arg, filter_store_value, \"filter_store_value\");
 	DBT_clear($var) ;
+	SvGETMAGIC($arg);
 	if (SvOK($arg)) {
 	    $var.data = SvPVbyte($arg, PL_na);
 	    $var.size = (int)PL_na;

Marcus

Apart from the warnings, notice how it fetches wrong (old) values for the
several keys.

Running it with argument 3 (causing a "scalar" to be put before all
substr arguments) makes things work as expected.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=low
---
Site configuration information for perl v5.8.4:

Configured by ton at Thu Jun 3 13:28:19 CEST 2004.

Summary of my perl5 (revision 5 version 8 subversion 4) configuration:
Platform:
osname=linux, osvers=2.6.5, archname=i686-linux-64int-ld
uname='linux quasar 2.6.5 #8 mon apr 5 05:41:20 cest 2004 i686
gnulinux '
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=define use64bitall=undef uselongdouble=define
usemymalloc=y, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -
D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -fomit-frame-pointer',
cppflags='-fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='3.4.0 20031231 (experimental)',
gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
ivtype='long long', ivsize=8, nvtype='long double', nvsize=12,
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 -ldb -ldl -lm -lcrypt -lutil -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
libc=/lib/libc-2.3.2.so, so=so, useshrplib=false, libperl=libperl.a
gnulibc_version='2.3.2'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:

---
@INC for perl v5.8.4:
/usr/lib/perl5/5.8.4/i686-linux-64int-ld
/usr/lib/perl5/5.8.4
/usr/lib/perl5/site_perl/5.8.4/i686-linux-64int-ld
/usr/lib/perl5/site_perl/5.8.4
/usr/lib/perl5/site_perl
.

---
Environment for perl v5.8.4:
HOME=/home/ton
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/opt/schi
ly/bin:/usr/local/bin:/usr/local/sbin:/home/oracle/product/9.0.1/bin:/usr/
local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sb
in:/bin:/sbin:.
PERL_BADLANG (unset)
SHELL=/bin/bash

p5pRT · 2004-06-15T18:10:38Z

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

p5pRT · 2004-06-15T21:18:30Z

From @pmqs

Hey thanks!

I had got as far as writing a regression test for the DB_File test suite to
reproduce the errant behaviour, and was about to start digging, when your
patch arrived. Looks like it fixes the problem when run against my
regression test.

The only thing I found out was that the new behaviour started with 5.8.1 -
my test passes on DB_File with older perl's.

I'll run DB_File through my torture test. If there aren't any problems with
older Perl's and or versions of Berkeley DB, I'll post a patch with your fix
and my regression test.

Anyone know if this new behaviour documented anywhere?

Paul

-----Original Message-----
From: Marcus Holland-Moritz [mailto:mhx-perl@gmx.net]
Sent: 15 June 2004 19:10
To: Paul.Marquess@btinternet.com
Cc: perl5-porters@perl.org; bugs-bitbucket@rt.perl.org
Subject: Re: [perl #30237] DB_File methods and substr don't mix

On 2004-06-14, at 17:32:26 +0100, Paul Marquess wrote:

Thanks for the bug report.

I've can reproduce the problem with 5.8.4 and can't with 5.6.1, so it
looks
like something has changed in between.

I'll have a dig into the code.

Paul

-----Original Message-----
From: via RT [mailto:perl-5.8.0@ton.iguana.beperlbug-
followup@perl.org]
Sent: 12 June 2004 18:59
To: bugs-bitbucket@rt.perl.org
Subject: [perl #30237] DB_File methods and substr don't mix

# New Ticket Created by perl-5.8.0@ton.iguana.be
# Please include the string: [perl #30237]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=30237 >

This is a bug report for perl from perl-5.8.0@ton.iguana.be,
generated with the help of perlbug 1.35 running under perl v5.8.4.

-----------------------------------------------------------------
[Please enter your report here]

The following program works as expected on 5.8.0, but picks up
weird undef warnings under 5.8.4. And indeed what it does
is WRONG on 5.8.4

#!/usr/bin/perl -wl
use strict;
use DB_File;

# This program tries to associate a set of digits with a given alpha
key.
# It fails and gives undef warning if run without args (or with arg 0)
# Also fails in various ways for arg 1 and 2
# Works for arg 3

my $mode = shift || 0;

my $db_file = "testdb";
unlink($db_file);
my $db = tie(my %db, "DB_File", $db_file, O_CREAT|O_RDWR, 0666,
$DB_HASH)
|| die "Could not db_tie $db_file: $!";
my $set;
for ([a => 4], [b => 1], [a=> 4], [c => 2], [d => 2]) {
my ($m, $n) = @$_;
print STDERR "Want to associate $n with key $m";
my $combo = $m . $n;
if ($mode & 1) {
$set = "" if $db->get(scalar substr($combo, 0, 1), $set);
} else {
$set = "" if $db->get(substr($combo, 0, 1), $set);
}
print STDERR " Fetching key ", substr($combo, 0, 1), " gives
'$set'";
if (index($set, $n) >= 0) {
print STDERR " Already have $n, no store";
} else {
$set .= $n;
print STDERR " Don't have $n yet, storing '$set' on key ",
substr($combo, 0, 1);
if ($mode & 2) {
die "Storage problem" if $db->put(scalar substr($combo, 0,
1),
$set);
} else {
die "Storage problem" if $db->put(substr($combo, 0, 1),
$set);
}
}
}

Will output if run without args:

Want to associate 4 with key a
Fetching key a gives ''
Don't have 4 yet, storing '4' on key a
Want to associate 1 with key b
Fetching key b gives ''
Don't have 1 yet, storing '1' on key b
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 4 with key a
Fetching key a gives '1'
Don't have 4 yet, storing '14' on key a
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key c
Fetching key c gives '14'
Don't have 2 yet, storing '142' on key c
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key d
Fetching key d gives '142'
Already have 2, no store

This looks like missing SvGETMAGIC's to me. When you pass the result
of a substr() to an XS function, you need to call SvGETMAGIC in order
to get the PV right. I noticed this just recently when passing substr()
results to my XS module.

The following should help, but there may be SvGETMAGIC's missing in
other places.

--- ext/DB_File/typemap.orig 2004-06-15 20:02:10.000000000 +0200
+++ ext/DB_File/typemap 2004-06-15 20:02:42.000000000 +0200
@@ -17,6 +17,7 @@
T_dbtkeydatum
DBM_ckFilter($arg, filter_store_key, \"filter_store_key\");
DBT_clear($var) ;
+ SvGETMAGIC($arg);
if (SvOK($arg)){
if (db->type != DB_RECNO) {
$var.data = SvPVbyte($arg, PL_na);
@@ -31,6 +32,7 @@
T_dbtdatum
DBM_ckFilter($arg, filter_store_value, \"filter_store_value\");
DBT_clear($var) ;
+ SvGETMAGIC($arg);
if (SvOK($arg)) {
$var.data = SvPVbyte($arg, PL_na);
$var.size = (int)PL_na;

Marcus

Apart from the warnings, notice how it fetches wrong (old) values for
the
several keys.

Running it with argument 3 (causing a "scalar" to be put before all
substr arguments) makes things work as expected.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=low
---
Site configuration information for perl v5.8.4:

Configured by ton at Thu Jun 3 13:28:19 CEST 2004.

Summary of my perl5 (revision 5 version 8 subversion 4) configuration:
Platform:
osname=linux, osvers=2.6.5, archname=i686-linux-64int-ld
uname='linux quasar 2.6.5 #8 mon apr 5 05:41:20 cest 2004 i686
gnulinux '
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=define use64bitall=undef uselongdouble=define
usemymalloc=y, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -
D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -fomit-frame-pointer',
cppflags='-fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='3.4.0 20031231 (experimental)',
gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define,
longdblsize=12
ivtype='long long', ivsize=8, nvtype='long double', nvsize=12,
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 -ldb -ldl -lm -lcrypt -lutil -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
libc=/lib/libc-2.3.2.so, so=so, useshrplib=false,
libperl=libperl.a
gnulibc_version='2.3.2'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:

---
@INC for perl v5.8.4:
/usr/lib/perl5/5.8.4/i686-linux-64int-ld
/usr/lib/perl5/5.8.4
/usr/lib/perl5/site_perl/5.8.4/i686-linux-64int-ld
/usr/lib/perl5/site_perl/5.8.4
/usr/lib/perl5/site_perl
.

---
Environment for perl v5.8.4:
HOME=/home/ton
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/opt/schi

ly/bin:/usr/local/bin:/usr/local/sbin:/home/oracle/product/9.0.1/bin:/usr/

local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sb

in:/bin:/sbin:.
PERL_BADLANG (unset)
SHELL=/bin/bash

p5pRT · 2004-06-16T20:17:18Z

From @pmqs

Looking at the modules in 5.8.4, I see that GDBM_File, NDBM_File, ODBM_File,
SDBM_File all have the same problem. I'll fix them when I'm at it.

MIME::Base64 seems to have the same issue as well. It uses this

/* set up EOL from the second argument if present, default to "\n"
*/
if (items > 1 && SvOK(ST(1))) {
eol = SvPV(ST(1), eol_len);
} else {
eol = "\n";
eol_len = 1;
}

Didn't get the chance to run my DB_File torture test yet, but I thought it
would be useful to summarise the issue.

In DB_File I need to differentiate between someone passing an empty string
("") and someone passing undef into a number of the XSUB methods. To do that
I had some code that looked a bit like this

xsub_method(sv * arg)
CODE:
{
char * ptr = NULL ;
int len = 0 ;

if (SvOK(arg)) {
ptr = (char*)SvPV(arg, len) ;
}
...
}

The important part of that code, as far as this bug is concerned, is the
SvOK test. I use that test to determine when someone has passed undef.

Starting with perl 5.8.1 (I think), this code can do the wrong thing under
specific circumstances - namely if you use substr.

Consider this snippet of code

foreach my $key ( 'alpha', 'beta', 'gamma') {
xsub_method(substr($key,0,1)) ;
}

Assume the "xsub_method" uses the code at the start to parse the parameter.
The first time around the loop SvOK will be true, but subsequent times it
will be false. This means it will assume that it has been passed undef when
it hasn't.

Changing the XSUB code, as Marcus suggests, to this

char * ptr = NULL ;
int len = 0 ;

SvGETMAGIC(arg);
if (SvOK(arg)) {
ptr = (char*)SvPV(arg, len) ;
}

fixes the problem.

Paul

-----Original Message-----
From: Paul Marquess [mailto:Paul.Marquess@btinternet.com]
Sent: 15 June 2004 22:18
To: 'Marcus Holland-Moritz'
Cc: perl5-porters@perl.org; bugs-bitbucket@rt.perl.org
Subject: RE: [perl #30237] DB_File methods and substr don't mix

Hey thanks!

I had got as far as writing a regression test for the DB_File test suite
to
reproduce the errant behaviour, and was about to start digging, when your
patch arrived. Looks like it fixes the problem when run against my
regression test.

The only thing I found out was that the new behaviour started with 5.8.1 -
my test passes on DB_File with older perl's.

I'll run DB_File through my torture test. If there aren't any problems
with
older Perl's and or versions of Berkeley DB, I'll post a patch with your
fix
and my regression test.

Anyone know if this new behaviour documented anywhere?

Paul

-----Original Message-----
From: Marcus Holland-Moritz [mailto:mhx-perl@gmx.net]
Sent: 15 June 2004 19:10
To: Paul.Marquess@btinternet.com
Cc: perl5-porters@perl.org; bugs-bitbucket@rt.perl.org
Subject: Re: [perl #30237] DB_File methods and substr don't mix

On 2004-06-14, at 17:32:26 +0100, Paul Marquess wrote:

Thanks for the bug report.

I've can reproduce the problem with 5.8.4 and can't with 5.6.1, so it
looks
like something has changed in between.

I'll have a dig into the code.

Paul

-----Original Message-----
From: via RT [mailto:perl-5.8.0@ton.iguana.beperlbug-
followup@perl.org]
Sent: 12 June 2004 18:59
To: bugs-bitbucket@rt.perl.org
Subject: [perl #30237] DB_File methods and substr don't mix

# New Ticket Created by perl-5.8.0@ton.iguana.be
# Please include the string: [perl #30237]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=30237 >

This is a bug report for perl from perl-5.8.0@ton.iguana.be,
generated with the help of perlbug 1.35 running under perl v5.8.4.

-----------------------------------------------------------------
[Please enter your report here]

The following program works as expected on 5.8.0, but picks up
weird undef warnings under 5.8.4. And indeed what it does
is WRONG on 5.8.4

#!/usr/bin/perl -wl
use strict;
use DB_File;

# This program tries to associate a set of digits with a given alpha
key.
# It fails and gives undef warning if run without args (or with arg
0)
# Also fails in various ways for arg 1 and 2
# Works for arg 3

my $mode = shift || 0;

my $db_file = "testdb";
unlink($db_file);
my $db = tie(my %db, "DB_File", $db_file, O_CREAT|O_RDWR, 0666,
$DB_HASH)
|| die "Could not db_tie $db_file: $!";
my $set;
for ([a => 4], [b => 1], [a=> 4], [c => 2], [d => 2]) {
my ($m, $n) = @$_;
print STDERR "Want to associate $n with key $m";
my $combo = $m . $n;
if ($mode & 1) {
$set = "" if $db->get(scalar substr($combo, 0, 1), $set);
} else {
$set = "" if $db->get(substr($combo, 0, 1), $set);
}
print STDERR " Fetching key ", substr($combo, 0, 1), " gives
'$set'";
if (index($set, $n) >= 0) {
print STDERR " Already have $n, no store";
} else {
$set .= $n;
print STDERR " Don't have $n yet, storing '$set' on key ",
substr($combo, 0, 1);
if ($mode & 2) {
die "Storage problem" if $db->put(scalar substr($combo,
0,
1),
$set);
} else {
die "Storage problem" if $db->put(substr($combo, 0, 1),
$set);
}
}
}

Will output if run without args:

Want to associate 4 with key a
Fetching key a gives ''
Don't have 4 yet, storing '4' on key a
Want to associate 1 with key b
Fetching key b gives ''
Don't have 1 yet, storing '1' on key b
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 4 with key a
Fetching key a gives '1'
Don't have 4 yet, storing '14' on key a
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key c
Fetching key c gives '14'
Don't have 2 yet, storing '142' on key c
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key d
Fetching key d gives '142'
Already have 2, no store

This looks like missing SvGETMAGIC's to me. When you pass the result
of a substr() to an XS function, you need to call SvGETMAGIC in order
to get the PV right. I noticed this just recently when passing substr()
results to my XS module.

The following should help, but there may be SvGETMAGIC's missing in
other places.

--- ext/DB_File/typemap.orig 2004-06-15 20:02:10.000000000 +0200
+++ ext/DB_File/typemap 2004-06-15 20:02:42.000000000 +0200
@@ -17,6 +17,7 @@
T_dbtkeydatum
DBM_ckFilter($arg, filter_store_key, \"filter_store_key\");
DBT_clear($var) ;
+ SvGETMAGIC($arg);
if (SvOK($arg)){
if (db->type != DB_RECNO) {
$var.data = SvPVbyte($arg, PL_na);
@@ -31,6 +32,7 @@
T_dbtdatum
DBM_ckFilter($arg, filter_store_value, \"filter_store_value\");
DBT_clear($var) ;
+ SvGETMAGIC($arg);
if (SvOK($arg)) {
$var.data = SvPVbyte($arg, PL_na);
$var.size = (int)PL_na;

Marcus

Apart from the warnings, notice how it fetches wrong (old) values
for
the
several keys.

Running it with argument 3 (causing a "scalar" to be put before all
substr arguments) makes things work as expected.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=low
---
Site configuration information for perl v5.8.4:

Configured by ton at Thu Jun 3 13:28:19 CEST 2004.

Summary of my perl5 (revision 5 version 8 subversion 4)
configuration:
Platform:
osname=linux, osvers=2.6.5, archname=i686-linux-64int-ld
uname='linux quasar 2.6.5 #8 mon apr 5 05:41:20 cest 2004 i686
gnulinux '
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=define use64bitall=undef uselongdouble=define
usemymalloc=y, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -
D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -fomit-frame-pointer',
cppflags='-fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='3.4.0 20031231 (experimental)',
gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8,
byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define,
longdblsize=12
ivtype='long long', ivsize=8, nvtype='long double', nvsize=12,
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 -ldb -ldl -lm -lcrypt -lutil -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
libc=/lib/libc-2.3.2.so, so=so, useshrplib=false,
libperl=libperl.a
gnulibc_version='2.3.2'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-
E'
cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:

---
@INC for perl v5.8.4:
/usr/lib/perl5/5.8.4/i686-linux-64int-ld
/usr/lib/perl5/5.8.4
/usr/lib/perl5/site_perl/5.8.4/i686-linux-64int-ld
/usr/lib/perl5/site_perl/5.8.4
/usr/lib/perl5/site_perl
.

---
Environment for perl v5.8.4:
HOME=/home/ton
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/opt/schi

ly/bin:/usr/local/bin:/usr/local/sbin:/home/oracle/product/9.0.1/bin:/usr/

local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sb

in:/bin:/sbin:.
PERL_BADLANG (unset)
SHELL=/bin/bash

p5pRT · 2004-06-17T10:54:24Z

From @timbunce

On Wed, Jun 16, 2004 at 01:20:44PM +0100, Paul Marquess wrote:

Looking at the modules in 5.8.4, I see that GDBM_File, NDBM_File, ODBM_File,
SDBM_File all have the same problem. I'll fix them when I'm at it.

I'm sure many modules do. I'd guess that parts of the code do as well.

I've suggested before that a very simple way to flush out these
bugs would be to provide some mechanism to taint everything
(or just about everything). Then just run the test suite.

Naturally this would only be for DEBUGGING builds (perhaps then
enabled via an env var) or a separate #ifdef plus env var.

Tim.

p5pRT · 2004-06-18T18:17:54Z

From @timbunce

On Thu, Jun 17, 2004 at 12:37:08PM +0100, Paul Marquess wrote:

From: Tim Bunce [mailto:Tim.Bunce@pobox.com]

On Wed, Jun 16, 2004 at 01:20:44PM +0100, Paul Marquess wrote:

Looking at the modules in 5.8.4, I see that GDBM_File, NDBM_File,
ODBM_File,
SDBM_File all have the same problem. I'll fix them when I'm at it.

I'm sure many modules do. I'd guess that parts of the code do as well.

It wouldn't surprise me at all, given that the problem seems to be
relatively recent (5.8.1+)

I've suggested before that a very simple way to flush out these
bugs would be to provide some mechanism to taint everything
(or just about everything). Then just run the test suite.

How would tainting have found this particular problem?

It would find places that are missing SvGETMAGIC(arg) calls.

I'm guess the overlap between SvGETMAGIC(arg) calls needed for
tainted data, and those needed for lvalue substrings (and those
needed for auto-vivified hash element arguments) is high.

A taint-everything mechanism would find most instances of the
missing-getmagic class of bugs.

Any volunteers? (Ought to be fairly trivial to add the mechanism.)

Tim.

Naturally this would only be for DEBUGGING builds (perhaps then
enabled via an env var) or a separate #ifdef plus env var.

Paul

p5pRT · 2004-06-22T20:29:41Z

From @pmqs

Fix for 30237 with regression tests enclosed.

Paul

-----Original Message-----
From: Paul Marquess [mailto:Paul.Marquess@btinternet.com]
Sent: 15 June 2004 22:18
To: 'Marcus Holland-Moritz'
Cc: perl5-porters@perl.org; bugs-bitbucket@rt.perl.org
Subject: RE: [perl #30237] DB_File methods and substr don't mix

Hey thanks!

I had got as far as writing a regression test for the DB_File test suite
to
reproduce the errant behaviour, and was about to start digging, when your
patch arrived. Looks like it fixes the problem when run against my
regression test.

The only thing I found out was that the new behaviour started with 5.8.1 -
my test passes on DB_File with older perl's.

I'll run DB_File through my torture test. If there aren't any problems
with
older Perl's and or versions of Berkeley DB, I'll post a patch with your
fix
and my regression test.

Anyone know if this new behaviour documented anywhere?

Paul

-----Original Message-----
From: Marcus Holland-Moritz [mailto:mhx-perl@gmx.net]
Sent: 15 June 2004 19:10
To: Paul.Marquess@btinternet.com
Cc: perl5-porters@perl.org; bugs-bitbucket@rt.perl.org
Subject: Re: [perl #30237] DB_File methods and substr don't mix

On 2004-06-14, at 17:32:26 +0100, Paul Marquess wrote:

Thanks for the bug report.

I've can reproduce the problem with 5.8.4 and can't with 5.6.1, so it
looks
like something has changed in between.

I'll have a dig into the code.

Paul

-----Original Message-----
From: via RT [mailto:perl-5.8.0@ton.iguana.beperlbug-
followup@perl.org]
Sent: 12 June 2004 18:59
To: bugs-bitbucket@rt.perl.org
Subject: [perl #30237] DB_File methods and substr don't mix

# New Ticket Created by perl-5.8.0@ton.iguana.be
# Please include the string: [perl #30237]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=30237 >

This is a bug report for perl from perl-5.8.0@ton.iguana.be,
generated with the help of perlbug 1.35 running under perl v5.8.4.

-----------------------------------------------------------------
[Please enter your report here]

The following program works as expected on 5.8.0, but picks up
weird undef warnings under 5.8.4. And indeed what it does
is WRONG on 5.8.4

#!/usr/bin/perl -wl
use strict;
use DB_File;

# This program tries to associate a set of digits with a given alpha
key.
# It fails and gives undef warning if run without args (or with arg
0)
# Also fails in various ways for arg 1 and 2
# Works for arg 3

my $mode = shift || 0;

my $db_file = "testdb";
unlink($db_file);
my $db = tie(my %db, "DB_File", $db_file, O_CREAT|O_RDWR, 0666,
$DB_HASH)
|| die "Could not db_tie $db_file: $!";
my $set;
for ([a => 4], [b => 1], [a=> 4], [c => 2], [d => 2]) {
my ($m, $n) = @$_;
print STDERR "Want to associate $n with key $m";
my $combo = $m . $n;
if ($mode & 1) {
$set = "" if $db->get(scalar substr($combo, 0, 1), $set);
} else {
$set = "" if $db->get(substr($combo, 0, 1), $set);
}
print STDERR " Fetching key ", substr($combo, 0, 1), " gives
'$set'";
if (index($set, $n) >= 0) {
print STDERR " Already have $n, no store";
} else {
$set .= $n;
print STDERR " Don't have $n yet, storing '$set' on key ",
substr($combo, 0, 1);
if ($mode & 2) {
die "Storage problem" if $db->put(scalar substr($combo,
0,
1),
$set);
} else {
die "Storage problem" if $db->put(substr($combo, 0, 1),
$set);
}
}
}

Will output if run without args:

Want to associate 4 with key a
Fetching key a gives ''
Don't have 4 yet, storing '4' on key a
Want to associate 1 with key b
Fetching key b gives ''
Don't have 1 yet, storing '1' on key b
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 4 with key a
Fetching key a gives '1'
Don't have 4 yet, storing '14' on key a
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key c
Fetching key c gives '14'
Don't have 2 yet, storing '142' on key c
Use of uninitialized value in subroutine entry at test.pl line 35.
Want to associate 2 with key d
Fetching key d gives '142'
Already have 2, no store

This looks like missing SvGETMAGIC's to me. When you pass the result
of a substr() to an XS function, you need to call SvGETMAGIC in order
to get the PV right. I noticed this just recently when passing substr()
results to my XS module.

The following should help, but there may be SvGETMAGIC's missing in
other places.

--- ext/DB_File/typemap.orig 2004-06-15 20:02:10.000000000 +0200
+++ ext/DB_File/typemap 2004-06-15 20:02:42.000000000 +0200
@@ -17,6 +17,7 @@
T_dbtkeydatum
DBM_ckFilter($arg, filter_store_key, \"filter_store_key\");
DBT_clear($var) ;
+ SvGETMAGIC($arg);
if (SvOK($arg)){
if (db->type != DB_RECNO) {
$var.data = SvPVbyte($arg, PL_na);
@@ -31,6 +32,7 @@
T_dbtdatum
DBM_ckFilter($arg, filter_store_value, \"filter_store_value\");
DBT_clear($var) ;
+ SvGETMAGIC($arg);
if (SvOK($arg)) {
$var.data = SvPVbyte($arg, PL_na);
$var.size = (int)PL_na;

Marcus

Apart from the warnings, notice how it fetches wrong (old) values
for
the
several keys.

Running it with argument 3 (causing a "scalar" to be put before all
substr arguments) makes things work as expected.

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=low
---
Site configuration information for perl v5.8.4:

Configured by ton at Thu Jun 3 13:28:19 CEST 2004.

Summary of my perl5 (revision 5 version 8 subversion 4)
configuration:
Platform:
osname=linux, osvers=2.6.5, archname=i686-linux-64int-ld
uname='linux quasar 2.6.5 #8 mon apr 5 05:41:20 cest 2004 i686
gnulinux '
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=define use64bitall=undef uselongdouble=define
usemymalloc=y, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-fno-strict-aliasing -I/usr/local/include -
D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -fomit-frame-pointer',
cppflags='-fno-strict-aliasing -I/usr/local/include'
ccversion='', gccversion='3.4.0 20031231 (experimental)',
gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8,
byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define,
longdblsize=12
ivtype='long long', ivsize=8, nvtype='long double', nvsize=12,
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 -ldb -ldl -lm -lcrypt -lutil -lc
perllibs=-lnsl -ldl -lm -lcrypt -lutil -lc
libc=/lib/libc-2.3.2.so, so=so, useshrplib=false,
libperl=libperl.a
gnulibc_version='2.3.2'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-
E'
cccdlflags='-fpic', lddlflags='-shared -L/usr/local/lib'

Locally applied patches:

---
@INC for perl v5.8.4:
/usr/lib/perl5/5.8.4/i686-linux-64int-ld
/usr/lib/perl5/5.8.4
/usr/lib/perl5/site_perl/5.8.4/i686-linux-64int-ld
/usr/lib/perl5/site_perl/5.8.4
/usr/lib/perl5/site_perl
.

---
Environment for perl v5.8.4:
HOME=/home/ton
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=/home/ton/bin.Linux:/home/ton/bin:/home/ton/bin.SampleSetup:/opt/schi

ly/bin:/usr/local/bin:/usr/local/sbin:/home/oracle/product/9.0.1/bin:/usr/

local/ar/bin:/usr/games/bin:/usr/X11R6/bin:/usr/share/bin:/usr/bin:/usr/sb

in:/bin:/sbin:.
PERL_BADLANG (unset)
SHELL=/bin/bash

p5pRT · 2004-06-22T20:29:41Z

From @pmqs

db_file-1.809.patch.gz

p5pRT · 2004-06-22T20:48:45Z

From @mhx

On 2004-06-22, at 21:29:12 +0100, Paul Marquess wrote:

Fix for 30237 with regression tests enclosed.

Thanks, applied as #22970.

Marcus

--
/earth: file system full.

p5pRT · 2004-06-22T20:50:37Z

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

p5pRT closed this as completed Jun 22, 2004

p5pRT added Severity Low distro-Linux type-library labels Oct 18, 2019

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

DB_File methods and substr don't mix #7361

DB_File methods and substr don't mix #7361

p5pRT commented Jun 12, 2004

p5pRT commented Jun 12, 2004

p5pRT commented Jun 15, 2004

p5pRT commented Jun 15, 2004

p5pRT commented Jun 15, 2004

p5pRT commented Jun 16, 2004

p5pRT commented Jun 17, 2004

p5pRT commented Jun 18, 2004

p5pRT commented Jun 22, 2004

p5pRT commented Jun 22, 2004

p5pRT commented Jun 22, 2004

p5pRT commented Jun 22, 2004

Navigation Menu

DB_File methods and substr don't mix #7361

DB_File methods and substr don't mix #7361

Comments

p5pRT commented Jun 12, 2004

p5pRT commented Jun 12, 2004

From perl-5.8.0@ton.iguana.be

Created by perl-5.8.0@ton.iguana.be

p5pRT commented Jun 15, 2004

From @mhx

p5pRT commented Jun 15, 2004

p5pRT commented Jun 15, 2004

From @pmqs

p5pRT commented Jun 16, 2004

From @pmqs

p5pRT commented Jun 17, 2004

From @timbunce

p5pRT commented Jun 18, 2004

From @timbunce

p5pRT commented Jun 22, 2004

From @pmqs

p5pRT commented Jun 22, 2004

From @pmqs

p5pRT commented Jun 22, 2004

From @mhx

p5pRT commented Jun 22, 2004