为什么这个返回PerlIO*的XS代码有漏洞

Question

我正在尝试编写一些XS代码，将库的片段公开给Perl代码作为可以写入的流接口下面的get_stream函数应该是一个构造函数准备并返回一个PerlIO对象。我想我只需要Write和Close方法，所以我将所有其他函数槽留空。

typedef struct {
struct _PerlIO base;
mylib_context* ctx;
} PerlIOmylib;
/* [...] */
PERLIO_FUNCS_DECL(PerlIO_mylib_funcs) = {
.fsize = sizeof(PerlIO_funcs),
.name  = "mylib",
.size  = sizeof(PerlIOmylib,
.Write = mylib_write,
.Close = mylib_close,
};
/* XS below */
PerlIO*
get_stream (SV* context_obj)
CODE:
mylib_context* ctx = (mylib_context*) SvIV (SvRV (context_obj));
PerlIO* f = PerlIO_allocate (aTHX);
f = PerlIO_push (aTHX, f, PERLIO_FUNCS_CAST(&PerlIO_mylib_funcs), "a", NULL);
PerlIOSelf(f, PerlIOmylib)->ctx = ctx;
PerlIOBase(f)->flags |= PERLIO_F_OPEN;
RETVAL = f;
OUTPUT:
RETVAL

当我像这样使用提供的界面时。。。

{
my $fh = MyLib::get_stream($lib_ctx);
print $fh "x" x 300;
}

调用了mylib_write函数，所以我还没有完全到目前为止搞砸了。(我通过插入调试printf验证了这一点语句。)但是，我希望PerlIO对象在$fh超出了范围，只是常规open创建的文件句柄。但目前，mylib_close函数仅在解释器关闭期间调用。

直接调用close效果良好，将$fh设置为undef效果良好不

更新：根据ikegami的建议，我使用了Devel::Peek::Dump和sv_dump发现句柄返回的get_stream函数为"RV"其指向CCD_ 14。glob(PVGV)引用计数器设置为3，这似乎不正确。

我添加了

CLEANUP:
SvREFCNT_dec (SvRV (ST(0)));
SvREFCNT_dec (SvRV (ST(0)));

治愈症状的方法：$fh时调用close函数在块的末尾超出范围。但我还是不太明白了解根本问题。

这是为OUTPUT段生成的C代码：

ST(0) = sv_newmortal();
{
GV *gv = newGVgen("MyLib");
if (do_open(gv, "+<&", 3, FALSE, 0, 0, RETVAL) )
sv_setsv(ST(0), sv_bless(newRV((SV*)gv), gv_stashpv("MyLib",1)));
else
ST(0) = &PL_sv_undef;
}
XSRETURN(1);

GV的引用计数如何达到3？

Answer 1

如果在全局销毁时调用close，则表示您的句柄在全局销毁中仍然存在。你在漏水！

在C/XS代码中，可以使用sv_dump(sv)将标量转储到stderr。在Perl代码中，您可以使用Devel:：Peek的Dump来获得相同的功能。这将向您显示引用计数。

---

在回答您的新问题时，

您有三个分配，但只有一个解除分配(sv_2moral中延迟的一个)。

• gv：指针总是被丢弃。内存泄漏！

  您可以在出现错误时减少gv的refcnt，也可以在打开成功时使用newRV_inc将所有权"转移"到RV后无条件地减少refcnt。

• 来自newRV的SV：指针总是被丢弃。内存泄漏！

  为什么不直接返回而不是复制呢？只需将其标记为致命，即可使Perl在调用方获得它之后减少其refcnt

已修复：

{
GV *gv = newGVgen("MyLib");
if (!do_open(gv, "+<&", 3, FALSE, 0, 0, RETVAL) ) {
SvREFCNT_dec(gv);
XSRETURN_UNDEF;
}
ST(0) = sv_2mortal(sv_bless(newRV_noinc((SV*)gv), gv_stashpv("MyLib",1))));
XSRETURN(1);
}

Answer 2

我刚刚用一个微不足道的例子重现了这个问题：

$ h2xs -n foo
Defaulting to backwards compatibility with perl 5.14.2
If you intend this module to be compatible with earlier perl versions, please
specify a minimum perl version with the -b option.
Writing foo/ppport.h
Writing foo/lib/foo.pm
Writing foo/foo.xs
Writing foo/fallback/const-c.inc
Writing foo/fallback/const-xs.inc
Writing foo/Makefile.PL
Writing foo/README
Writing foo/t/foo.t
Writing foo/Changes
Writing foo/MANIFEST

在foo/foo.xs中，我添加了：

PerlIO*
get_stream(char* name);
CODE:
RETVAL = PerlIO_open (name, "w");
OUTPUT:
RETVAL

以及以下琐碎的测试程序：

#!/usr/bin/perl
use foo;
use Devel::Peek;
{
my $fh = foo::get_stream ("testfile");
Devel::Peek::Dump $fh;
print $fh "hellon";
}
print "byen";

所生成的glob的引用计数被设置为3，并且CCD_ 27揭示关闭文件描述符是最后一个Perl解释器所做的事情。

因此，默认情况下，PerlIO*处理似乎是泄漏的-(

下面的typemap片段似乎解决了这个问题(谢谢，ikegami！)：

TYPEMAP
PerlIO *    T_PIO
OUTPUT
T_PIO
{
GV *gv = newGVgen("$Package");
if (do_open(gv, "+<&", 3, FALSE, 0, 0, $var) ) {
$arg = sv_2mortal(sv_bless(newRV_noinc((SV*)gv), gv_stashpv("$Package",1)));
} else {
SvREFCNT_dec(gv);
$arg = &PL_sv_undef;
}
}