On Fri, Jan 6, 2012 at 14:05, Tom Lane <[email protected]> wrote:
> Alex Hunsaker <[email protected]> writes:
>> Oh my... I dunno exactly what I was smoking last night, but its a good
>> thing I didn't share :-). Uh so my test program was also completely
>> wrong, Ill have to redo it all. I've narrowed it down to:
>> if ((type == SVt_PVGV || SvREADONLY(sv)))
>> {
>> if (type != SVt_PV &&
>> type != SVt_NV)
>> {
>> sv = newSVsv(sv);
>> }
>> }
>
> Has anyone tried looking at the source code for SvPVutf8 to see exactly
> what cases it fails on? The fact that there's an explicit croak() call
> makes me think it might not be terribly hard to tell.
Well its easy to find the message, its not so easy to trace it back up
:-). It is perl source code after all. It *looks* like its just:
sv.c:
Perl_sv_pvn_force_flags(SV *sv, STRLEN, I32 flags)
{
[ Flags is SV_GMAGIC ]
if (SvREADONLY(sv) && !(flags & SV_MUTABLE_RETURN))
// more or less...
Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref)
if ((SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
|| isGV_with_GP(sv))
Perl_croak(aTHX_ "Can't coerce %s to string in %s",
sv_reftype(sv,0),
}
Given that I added this hunk:
+
+ if (SvREADONLY(sv) ||
+ isGV_with_GP(sv) ||
+ (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
+ sv = newSVsv(sv);
+ else
+ /* increase the reference count so we cant just
SvREFCNT_dec() it when
+ * we are done */
+ SvREFCNT_inc(sv);
And viola all of these work (both in 5.14 and 5.8.9, although 5.8.9
gives different notices...)
do language plperl $$ elog(NOTICE, *foo); $$;
NOTICE: *main::foo
CONTEXT: PL/Perl anonymous code block
do language plperl $$ elog(NOTICE, $^V); $$;
NOTICE: v5.14.2
CONTEXT: PL/Perl anonymous code block
do language plperl $$ elog(NOTICE, ${^TAINT}); $$;
NOTICE: 0
CONTEXT: PL/Perl anonymous code block
So I've done that in the attached patch. ${^TAINT} seemed to be the
only case that gave consistent notices in 5.8.9 and up so I added it
to the regression tests.
Util.c/o not depending on plperl_helpers.h was also throwing me for a
loop so I fixed it and SPI.c...
Thoughts?
*** a/src/pl/plperl/GNUmakefile
--- b/src/pl/plperl/GNUmakefile
***************
*** 72,82 **** perlchunks.h: $(PERLCHUNKS)
all: all-lib
! SPI.c: SPI.xs
@if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi
$(PERL) $(XSUBPPDIR)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
! Util.c: Util.xs
@if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi
$(PERL) $(XSUBPPDIR)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
--- 72,82 ----
all: all-lib
! SPI.c: SPI.xs plperl_helpers.h
@if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi
$(PERL) $(XSUBPPDIR)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
! Util.c: Util.xs plperl_helpers.h
@if [ x"$(perl_privlibexp)" = x"" ]; then echo "configure switch --with-perl was not specified."; exit 1; fi
$(PERL) $(XSUBPPDIR)/ExtUtils/xsubpp -typemap $(perl_privlibexp)/ExtUtils/typemap $< >$@
*** a/src/pl/plperl/expected/plperl_elog.out
--- b/src/pl/plperl/expected/plperl_elog.out
***************
*** 58,60 **** select uses_global();
--- 58,62 ----
uses_global worked
(1 row)
+ -- make sure we don't choke on readonly values
+ do language plperl $$ elog('NOTICE', ${^TAINT}); $$;
*** a/src/pl/plperl/plperl_helpers.h
--- b/src/pl/plperl/plperl_helpers.h
***************
*** 47,74 **** sv2cstr(SV *sv)
{
char *val, *res;
STRLEN len;
- SV *nsv;
/*
* get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
*
* SvPVutf8() croaks nastily on certain things, like typeglobs and
* readonly objects such as $^V. That's a perl bug - it's not supposed to
! * happen. To avoid crashing the backend, we make a copy of the
! * sv before passing it to SvPVutf8(). The copy is garbage collected
* when we're done with it.
*/
! nsv = newSVsv(sv);
! val = SvPVutf8(nsv, len);
/*
* we use perl's length in the event we had an embedded null byte to ensure
* we error out properly
*/
! res = utf_u2e(val, len);
/* safe now to garbage collect the new SV */
! SvREFCNT_dec(nsv);
return res;
}
--- 47,81 ----
{
char *val, *res;
STRLEN len;
/*
* get a utf8 encoded char * out of perl. *note* it may not be valid utf8!
*
* SvPVutf8() croaks nastily on certain things, like typeglobs and
* readonly objects such as $^V. That's a perl bug - it's not supposed to
! * happen. To avoid crashing the backend, we make a copy of the sv before
! * passing it to SvPVutf8(). The copy is garbage collected
* when we're done with it.
*/
! if (SvREADONLY(sv) ||
! isGV_with_GP(sv) ||
! (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM))
! sv = newSVsv(sv);
! else
! /* increase the reference count so we cant just SvREFCNT_dec() it when
! * we are done */
! SvREFCNT_inc(sv);
!
! val = SvPVutf8(sv, len);
/*
* we use perl's length in the event we had an embedded null byte to ensure
* we error out properly
*/
! res = utf_u2e(val, len);
/* safe now to garbage collect the new SV */
! SvREFCNT_dec(sv);
return res;
}
*** a/src/pl/plperl/sql/plperl_elog.sql
--- b/src/pl/plperl/sql/plperl_elog.sql
***************
*** 43,45 **** create or replace function uses_global() returns text language plperl as $$
--- 43,48 ----
$$;
select uses_global();
+
+ -- make sure we don't choke on readonly values
+ do language plperl $$ elog('NOTICE', ${^TAINT}); $$;
--
Sent via pgsql-hackers mailing list ([email protected])
To make changes to your subscription:
http://www.postgresql.org/mailpref/pgsql-hackers
