为什么这个XS代码会返回PerlIO*漏洞?

hil*_*llu 7 perl xs perl-io

我正在尝试编写一些XS代码,它将一个库公开给Perl代码作为可以写入的流接口.get_stream下面的 函数应该是一个准备和返回PerlIO对象的构造函数.我想我只需要 WriteClose方法,所以我把所有其他功能插槽留空了.

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
Run Code Online (Sandbox Code Playgroud)

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

{
    my $fh = MyLib::get_stream($lib_ctx);
    print $fh "x" x 300;
}
Run Code Online (Sandbox Code Playgroud)

... mylib_write函数被调用,所以到目前为止我还没有完全搞砸.(我通过插入debug printf语句验证了这一点.)但是,我希望PerlIO对象在$fh超出范围时关闭 ,就像使用常规文件句柄一样工作的方式open.但目前,该mylib_close 函数仅在解释器关闭期间调用.

直接调用close工作正常,设定$fhundef不.

更新:根据ikegami的建议,我使用Devel::Peek::Dumpsv_dump 发现句柄返回的get_stream功能是一个指向a的"RV" SV = PVGV(...).glob(PVGV)的引用计数器设置为3,这似乎不正确.

我补充道

CLEANUP:
SvREFCNT_dec (SvRV (ST(0)));
SvREFCNT_dec (SvRV (ST(0)));
Run Code Online (Sandbox Code Playgroud)

治愈症状的方法: 在块结束close$fh超出范围时调用该函数.但我仍然不太了解潜在的问题.

这是为该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);
Run Code Online (Sandbox Code Playgroud)

GV的参考计数如何最终达到3?

ike*_*ami 7

如果close在全局销毁时调用,则表示您的句柄仍然存在于全局销毁中.你漏了!

在C/XS代码中,您可以使用sv_dump(sv)将标量转储到stderr.在Perl代码,你可以使用杰韦利::皮克Dump,以获得相同的功能.这将显示参考计数.


在回答你的新问题时,

你有三个分配,但只有一个释放(从sv_2mortal延迟的一个).

  • gv:指针总是被丢弃.内存泄漏!

    你可以减少gv错误的refcnt ,或者newRV_inc在打开成功后使用"转移所有权"到RV 后无条件地减少refcnt .

  • SV来自newRV:指针总是被丢弃.内存泄漏!

    为什么不返回它而不是复制它?只需将其标记为凡人即可使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);
}
Run Code Online (Sandbox Code Playgroud)