[perl #125778] SvPV details lost when dereferencing HASH/ARRAY after shared_clone

[Mark Zealey (via RT)]

# New Ticket Created by Mark Zealey
# Please include the string: [perl #125778]
# in the subject line of all future correspondence about this issue.
# <URL: https://rt.perl.org/Ticket/Display.html?id=125778 >


This is a bug report for perl from ***@markandruth.co.uk,
generated with the help of perlbug 1.39 running under perl 5.18.2.


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

A simple script like:

use threads;
use Devel::Peek;
use threads::shared;
my $var = { a => 0.1 + 0 };
Dump($var);
my $t = shared_clone $var;
Dump( $t->{a} );
my $v = $t->{a};
my %v = %$t;
Dump($v);
Dump($v{a});

Produces somewhat incorrect output on the first Dump statement compared
to the
second two (see below). This shows that dereferencing a shared_clone hash
value directly does not produce the same information as copying it to a
variable in the local thread. I found this issue using MongoDB as we
wanted to
store a double datatype, however when dereferencing straight from a shared
variable it was inserting a string.

A solution is to clone (using pure-perl) into the local thread using a
function like:

sub _fix_dequeue {
my ( $v ) = @_;

my $ref = ref $v or return $v;

my $ret;
if ( $ref eq 'ARRAY' ) {
$ret = [ map { _fix_dequeue( $_ ) } @$v ];
}
elsif ( $ref eq 'HASH' ) {
$ret = { map { $_ => _fix_dequeue( $v->{$_} ) } keys %$v };
}

return $ret;
}

Here is the output of the first program on my computer showing the
dereference
compared to copying to local thread produces different results for a
SvNV type.

SV = IV(0x1311bb0) at 0x1311bc0
REFCNT = 1
FLAGS = (PADMY,ROK)
RV = 0x12e9cb8
SV = PVHV(0x12f09b0) at 0x12e9cb8
REFCNT = 1
FLAGS = (SHAREKEYS)
ARRAY = 0x131a920 (0:7, 1:1)
hash quality = 100.0%
KEYS = 1
FILL = 1
MAX = 7
Elt "a" HASH = 0x1bb2e90c
SV = NV(0x13283e8) at 0x12e9e98
REFCNT = 1
FLAGS = (NOK,pNOK)
NV = 0.1
SV = PVLV(0xaf5010) at 0xa82e98
REFCNT = 1
FLAGS = (TEMP,GMG,SMG,RMG)
IV = 0
NV = 0
PV = 0
MAGIC = 0xaa3df0
MG_VIRTUAL = 0x7fb7749412e0
MG_TYPE = PERL_MAGIC_tiedelem(p)
MG_FLAGS = 0x12
REFCOUNTED
DUP
MG_OBJ = 0xaa08e0
SV = IV(0xaa08d0) at 0xaa08e0
REFCNT = 2
FLAGS = (ROK)
RV = 0xaa0958
SV = PVMG(0xb69ed0) at 0xaa0958
REFCNT = 1
FLAGS = (OBJECT,IOK,pIOK)
IV = 12141928
NV = 0
PV = 0
STASH = 0xb73130 "threads::shared::tie"
MG_LEN = -2
MG_PTR = 0xa82cb8 => HEf_SVKEY
SV = PV(0xa83ba0) at 0xa82cb8
REFCNT = 2
FLAGS = (POK,pPOK)
PV = 0xa882e0 "a"\0
CUR = 1
LEN = 16
TYPE = T
TARGOFF = 0
TARGLEN = 0
TARG = 0xafd5d0
FLAGS = 0
SV = PVNV(0xb3fe00) at 0xb8b9a0
REFCNT = 1
FLAGS = (PADMY,NOK,pNOK)
IV = 0
NV = 0.1
PV = 0
SV = PVMG(0xb69f30) at 0xba5f00
REFCNT = 1
FLAGS = (NOK,pNOK)
IV = 0
NV = 0.1
PV = 0



[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=medium
module=threads::shared
---
Site configuration information for perl 5.18.2:

Configured by Debian Project at Thu Mar 27 18:28:21 UTC 2014.

Summary of my perl5 (revision 5 version 18 subversion 2) configuration:

Platform:
osname=linux, osvers=3.2.0-58-generic,
archname=x86_64-linux-gnu-thread-multi
uname='linux brownie 3.2.0-58-generic #88-ubuntu smp tue dec 3
17:37:58 utc 2013 x86_64 x86_64 x86_64 gnulinux '
config_args='-Dusethreads -Duselargefiles -Dccflags=-DDEBIAN
-D_FORTIFY_SOURCE=2 -g -O2 -fstack-protector --param=ssp-buffer-size=4
-Wformat -Werror=format-security -Dldflags= -Wl,-Bsymbolic-functions
-Wl,-z,relro -Dlddlflags=-shared -Wl,-Bsymbolic-functions -Wl,-z,relro
-Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr
-Dprivlib=/usr/share/perl/5.18 -Darchlib=/usr/lib/perl/5.18
-Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5
-Dvendorarch=/usr/lib/perl5 -Dsiteprefix=/usr/local
-Dsitelib=/usr/local/share/perl/5.18.2
-Dsitearch=/usr/local/lib/perl/5.18.2 -Dman1dir=/usr/share/man/man1
-Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1
-Dsiteman3dir=/usr/local/man/man3 -Duse64bitint -Dman1ext=1
-Dman3ext=3perl -Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm
-Uusesfio -Uusenm -Ui_libutil -Uversiononly -DDEBUGGING=-g
-Doptimize=-O2 -Duseshrplib -Dlibperl=libperl.so.5.18.2 -des'
hint=recommended, useposix=true, d_sigaction=define
useithreads=define, usemultiplicity=define
useperlio=define, d_sfio=undef, uselargefiles=define, usesocks=undef
use64bitint=define, use64bitall=define, uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cc', ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN
-fstack-protector -fno-strict-aliasing -pipe -I/usr/local/include
-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64',
optimize='-O2 -g',
cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fstack-protector
-fno-strict-aliasing -pipe -I/usr/local/include'
ccversion='', gccversion='4.8.2', gccosandvers=''
intsize=4, longsize=8, ptrsize=8, doublesize=8, byteorder=12345678
d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
ivtype='long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=8
alignbytes=8, prototype=define
Linker and Libraries:
ld='cc', ldflags =' -fstack-protector -L/usr/local/lib'
libpth=/usr/local/lib /lib/x86_64-linux-gnu /lib/../lib
/usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib /usr/lib
libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
perllibs=-ldl -lm -lpthread -lc -lcrypt
libc=, so=so, useshrplib=true, libperl=libperl.so.5.18.2
gnulibc_version='2.19'
Dynamic Linking:
dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags='-Wl,-E'
cccdlflags='-fPIC', lddlflags='-shared -L/usr/local/lib
-fstack-protector'

Locally applied patches:
DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS
default for modules installed from CPAN.
DEBPKG:debian/db_file_ver - http://bugs.debian.org/340047 Remove
overly restrictive DB_File version check.
DEBPKG:debian/doc_info - Replace generic man(1) instructions with
Debian-specific information.
DEBPKG:debian/enc2xs_inc - http://bugs.debian.org/290336 Tweak
enc2xs to follow symlinks and ignore missing @INC directories.
DEBPKG:debian/errno_ver - http://bugs.debian.org/343351 Remove
Errno version check due to upgrade problems with long-running processes.
DEBPKG:debian/libperl_embed_doc - http://bugs.debian.org/186778
Note that libperl-dev package is required for embedded linking
DEBPKG:fixes/respect_umask - Respect umask during installation
DEBPKG:debian/writable_site_dirs - Set umask approproately for site
install directories
DEBPKG:debian/extutils_set_libperl_path - EU:MM: Set location of
libperl.a to /usr/lib
DEBPKG:debian/no_packlist_perllocal - Don't install .packlist or
perllocal.pod for perl or vendor
DEBPKG:debian/prefix_changes - Fiddle with *PREFIX and variables
written to the makefile
DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the
binary targets.
DEBPKG:debian/instmodsh_doc - Debian policy doesn't install
.packlist files for core or vendor.
DEBPKG:debian/ld_run_path - Remove standard libs from LD_RUN_PATH
as per Debian policy.
DEBPKG:debian/libnet_config_path - Set location of libnet.cfg to
/etc/perl/Net as /usr may not be writable.
DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian
DEBPKG:debian/module_build_man_extensions -
http://bugs.debian.org/479460 Adjust Module::Build manual page
extensions for the Debian Perl policy
DEBPKG:debian/prune_libs - http://bugs.debian.org/128355 Prune the
list of libraries wanted to what we actually need.
DEBPKG:fixes/net_smtp_docs - [rt.cpan.org #36038]
http://bugs.debian.org/100195 Document the Net::SMTP 'Port' option
DEBPKG:debian/perlivp - http://bugs.debian.org/510895 Make perlivp
skip include directories in /usr/local
DEBPKG:debian/cpanplus_definstalldirs -
http://bugs.debian.org/533707 Configure CPANPLUS to use the site
directories by default.
DEBPKG:debian/cpanplus_config_path - Save local versions of
CPANPLUS::Config::System into /etc/perl.
DEBPKG:debian/deprecate-with-apt - http://bugs.debian.org/702096
Point users to Debian packages of deprecated core modules
DEBPKG:debian/squelch-locale-warnings -
http://bugs.debian.org/508764 Squelch locale warnings in Debian package
maintainer scripts
DEBPKG:debian/skip-upstream-git-tests - Skip tests specific to the
upstream Git repository
DEBPKG:debian/patchlevel - http://bugs.debian.org/567489 List
packaged patches for 5.18.2-2ubuntu1 in patchlevel.h
DEBPKG:debian/skip-kfreebsd-crash - http://bugs.debian.org/628493
[perl #96272] Skip a crashing test case in t/op/threads.t on GNU/kFreeBSD
DEBPKG:fixes/document_makemaker_ccflags -
http://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS
should include $Config{ccflags}
DEBPKG:debian/find_html2text - http://bugs.debian.org/640479
Configure CPAN::Distribution with correct name of html2text
DEBPKG:debian/hurd_test_skip_stack - http://bugs.debian.org/650175
Disable failing GNU/Hurd tests dist/threads/t/stack.t
DEBPKG:fixes/manpage_name_Test-Harness -
http://bugs.debian.org/650451 [rt.cpan.org #73399] cpan/Test-Harness:
add NAME headings in modules with POD
DEBPKG:debian/makemaker-pasthru - http://bugs.debian.org/660195
[rt.cpan.org #28632] Make EU::MM pass LD through to recursive
Makefile.PL invocations
DEBPKG:debian/perl5db-x-terminal-emulator.patch -
http://bugs.debian.org/668490 Invoke x-terminal-emulator rather than
xterm in perl5db.pl
DEBPKG:debian/cpan-missing-site-dirs -
http://bugs.debian.org/688842 Fix CPAN::FirstTime defaults with
nonexisting site dirs if a parent is writable
DEBPKG:fixes/memoize_storable_nstore - [rt.cpan.org #77790]
http://bugs.debian.org/587650 Memoize::Storable: respect 'nstore' option
not respected
DEBPKG:fixes/net_ftp_failed_command - [rt.cpan.org #37700]
http://bugs.debian.org/491062 Net::FTP: cope gracefully with a failed
command
DEBPKG:fixes/perlbug-patchlist - [3541c11]
http://bugs.debian.org/710842 [perl #118433] Make perlbug look up the
list of local patches at run time
DEBPKG:fixes/module_metadata_security_doc - [68cdd4b] CVE-2013-1437
documentation fix
DEBPKG:fixes/module_metadata_taint_fix - [bff978f]
http://bugs.debian.org/722210 [rt.cpan.org #88576] untaint version, if
needed, in Module::Metadata
DEBPKG:fixes/IPC-SysV-spelling - http://bugs.debian.org/730558
[rt.cpan.org #86736] Fix spelling of IPC_CREAT in IPC-SysV documentation
DEBPKG:fixes/fix-undef-source -

---
@INC for perl 5.18.2:
/etc/perl
/usr/local/lib/perl/5.18.2
/usr/local/share/perl/5.18.2
/usr/lib/perl5
/usr/share/perl5
/usr/lib/perl/5.18
/usr/share/perl/5.18
/usr/local/lib/site_perl
.

---
Environment for perl 5.18.2:
HOME=/home/mark
LANG=en_GB.UTF-8
LANGUAGE=en_GB:en
LD_LIBRARY_PATH (unset)
LOGDIR (unset)
PATH=/home/mark/Downloads/android-sdk-linux/tools/:/home/mark/bin:/home/mark/Downloads/android-sdk-linux/tools/:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/usr/sbin:/sbin:/home/mark/bin:/home/mark/.rvm/bin:/usr/sbin:/sbin:/home/mark/bin:/home/mark/.rvm/bin
PERL_BADLANG (unset)
SHELL=/bin/bash

[Vincent Pit (VPIT)]

Post by Mark Zealey (via RT)
use threads;
use Devel::Peek;
use threads::shared;
my $var = { a => 0.1 + 0 };
Dump($var);
my $t = shared_clone $var;
Dump( $t->{a} );
my $v = $t->{a};
my %v = %$t;
Dump($v);
Dump($v{a});
Produces somewhat incorrect output on the first Dump statement compared
to the
second two (see below). This shows that dereferencing a shared_clone hash
value directly does not produce the same information as copying it to a
variable in the local thread. I found this issue using MongoDB as we
wanted to
store a double datatype, however when dereferencing straight from a shared
variable it was inserting a string.

This is not a bug but the normal behaviour of tied hashes, which are
used to implement shared hashes : fetching values from a tied hash
returns a temporary proxy SV that will live until the actual action
(assignment from or to the hash element) is known by perl. The MongoDB
XS module is probably missing a SvGETMAGIC() somewhere to force the
'get' magic call to be resolved, which will yield the correct value
(this is also what happens when the pure perl assignment takes place).
Devel::Peek::Dump shows the intermediate value because it does not call
'get' magic by design, so that it is possible to debug magical SVs.


Vincent

[Tony Cook via RT]

Post by Vincent Pit (VPIT)

Post by Mark Zealey (via RT)
use threads;
use Devel::Peek;
use threads::shared;
my $var = { a => 0.1 + 0 };
Dump($var);
my $t = shared_clone $var;
Dump( $t->{a} );
my $v = $t->{a};
my %v = %$t;
Dump($v);
Dump($v{a});
Produces somewhat incorrect output on the first Dump statement compared
to the
second two (see below). This shows that dereferencing a shared_clone hash
value directly does not produce the same information as copying it to a
variable in the local thread. I found this issue using MongoDB as we
wanted to
store a double datatype, however when dereferencing straight from a shared
variable it was inserting a string.

This is not a bug but the normal behaviour of tied hashes, which are
used to implement shared hashes : fetching values from a tied hash
returns a temporary proxy SV that will live until the actual action
(assignment from or to the hash element) is known by perl. The MongoDB
XS module is probably missing a SvGETMAGIC() somewhere to force the
'get' magic call to be resolved, which will yield the correct value
(this is also what happens when the pure perl assignment takes place).
Devel::Peek::Dump shows the intermediate value because it does not call
'get' magic by design, so that it is possible to debug magical SVs.

This code at https://github.com/mongodb/mongo-perl-driver/blob/master/perl_mongo.c#L642 looks incorrect to me:

if (!SvOK(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
}
}

Tony


---
via perlbug: queue: perl5 status: open
https://rt.perl.org/Ticket/Display.html?id=125778

[David Golden]

Post by Tony Cook via RT
This code at
https://github.com/mongodb/mongo-perl-driver/blob/master/perl_mongo.c#L642
if (!SvOK(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
}
}

I'd welcome any suggestions. The inner "if" is just (an inefficient)
SvGETMAGIC. I'm not sure why the original logic deferred resolving get
magic if SvOK is true.

I can replicate the OP's problem on Perl's before 5.18. Looking at changes
between 5.16 and 5.18, I suspect it was "fixed" with commit 4bac9ae4 which
stopped changing public flags to private flags in mg_get.

Doing the inverse on older Perls -- promoting private flags to public if
there are not any existing public flags -- appears to solve the problem.

David

[Tony Cook]

Post by David Golden

Post by Tony Cook via RT
This code at
https://github.com/mongodb/mongo-perl-driver/blob/master/perl_mongo.c#L642
if (!SvOK(sv)) {
if (SvGMAGICAL(sv)) {
mg_get(sv);
}
}

I'd welcome any suggestions. The inner "if" is just (an inefficient)
SvGETMAGIC. I'm not sure why the original logic deferred resolving get
magic if SvOK is true.

You don't need or want the if (!SvOK(sv)) test.

The:

if (SvGMAGICAL(sv)) {
mg_get(sv);
}

is essentially just SvGETMAGIC():

#define SvGETMAGIC(x) ((void)(UNLIKELY(SvGMAGICAL(x)) && mg_get(x)))

Post by David Golden
I can replicate the OP's problem on Perl's before 5.18. Looking at changes
between 5.16 and 5.18, I suspect it was "fixed" with commit 4bac9ae4 which
stopped changing public flags to private flags in mg_get.
Doing the inverse on older Perls -- promoting private flags to public if
there are not any existing public flags -- appears to solve the problem.

Code that wants to deal with older perls should probably check the
private flags, at least for magical values.

Tony