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

SvPV details lost when dereferencing HASH/ARRAY after shared_clone #14842

Open
p5pRT opened this issue Aug 10, 2015 · 6 comments
Open

SvPV details lost when dereferencing HASH/ARRAY after shared_clone #14842

p5pRT opened this issue Aug 10, 2015 · 6 comments

Comments

@p5pRT
Copy link

@p5pRT p5pRT commented Aug 10, 2015

Migrated from rt.perl.org#125778 (status was 'open')

Searchable as RT125778$

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 10, 2015

From mark@markandruth.co.uk

Created by mark@markandruth.co.uk

This is a bug report for perl from mark@​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

Perl Info

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


@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 10, 2015

From perl@profvince.com

Le 10/08/2015 06​:47, Mark Zealey (via RT) a écrit :

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.

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

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 10, 2015

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

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 10, 2015

From @tonycoz

On Mon Aug 10 09​:43​:10 2015, perl@​profvince.com wrote​:

Le 10/08/2015 06​:47, Mark Zealey (via RT) a écrit :

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.

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

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 11, 2015

From @xdg

On Mon, Aug 10, 2015 at 7​:37 PM, Tony Cook via RT <perlbug-followup@​perl.org

wrote​:

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);
}
}

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 4bac9ae 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

--
David Golden <xdg@​xdg.me> Twitter/IRC​: @​xdg

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Aug 11, 2015

From @tonycoz

On Mon, Aug 10, 2015 at 09​:52​:47PM -0400, David Golden wrote​:

On Mon, Aug 10, 2015 at 7​:37 PM, Tony Cook via RT <perlbug-followup@​perl.org

wrote​:

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);
}
}

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)))

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 4bac9ae 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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant