view release on metacpan or  search on metacpan

Shared.xs  view on Meta::CPAN

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include "buf_i8.h"
#include "buf_u8.h"
#include "buf_i16.h"
#include "buf_u16.h"
#include "buf_i32.h"
#include "buf_u32.h"
#include "buf_i64.h"
#include "buf_u64.h"
#include "buf_f32.h"
#include "buf_f64.h"
#include "buf_str.h"

#include "XSParseKeyword.h"

/* ---- as_scalar magic: prevent use-after-free by preventing buffer DESTROY
 * while the returned scalar ref is alive. We attach magic to the inner SV that
 * holds a reference to the buffer's underlying handle -- the REFERENT (SvRV),
 * not the caller's RV container: `undef $buf` clears the container in place and
 * releases the handle, which would free the mapping while the inner SV still
 * aliases it. When the inner SV is freed, the magic destructor releases the
 * reference (deferring DESTROY until both the caller and the scalar are gone). ---- */

static int buf_scalar_magic_free(pTHX_ SV *sv, MAGIC *mg) {
    PERL_UNUSED_ARG(sv);
    if (mg->mg_obj) SvREFCNT_dec(mg->mg_obj);
    return 0;
}

static const MGVTBL buf_scalar_magic_vtbl = {
    NULL, NULL, NULL, NULL, buf_scalar_magic_free, NULL, NULL, NULL
};

/* ---- Helper macros ---- */

#define EXTRACT_BUF(classname, sv) \
    if (!sv_isobject(sv) || !sv_derived_from(sv, classname)) \
        croak("Expected a %s object", classname); \
    BufHandle* h = INT2PTR(BufHandle*, SvIV(SvRV(sv))); \
    if (!h) croak("Attempted to use a destroyed %s object", classname); \
    BufHandle *h0 = h; PERL_UNUSED_VAR(h0); \
    sv_2mortal(SvREFCNT_inc(SvRV(sv)))

/* Re-read the handle after a call that can run Perl code (tied/overloaded
 * argument magic, e.g. SvPV on an SV argument or SvIV/SvUV/SvNV on a ST()
 * slot).  That code may call $obj->DESTROY explicitly, which frees the handle
 * and zeroes the IV; EXTRACT_BUF's mortal pins the referent only against
 * refcount-driven destruction, not an explicit DESTROY, so the local `h`
 * would dangle.  Used only where magic can actually intervene between
 * EXTRACT_BUF and the next use of h. */
#define REEXTRACT_BUF(classname, sv) \
    if (!SvROK(sv)) \
        croak("%s object was replaced during the call", classname); \
    h = INT2PTR(BufHandle*, SvIV(SvRV(sv))); \
    if (h != h0) croak("%s object replaced or destroyed during the call", classname)

/* Re-read the class-name PV immediately before blessing the new object.
 * `class` is captured by the typemap in the INPUT section; a tied/overloaded
 * later constructor argument can run get-magic that reallocs or frees ST(0)'s
 * PV, dangling that pointer before it is used to bless.  Same fix as
 * Data::CuckooFilter::Shared already carries. */
#define REREAD_CLASS() \
    class = SvPV_nolen(ST(0))

/* ---- Generic keyword build functions ---- */

static int build_kw_1arg(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata) {
    (void)nargs;
    const char *func = (const char *)hookdata;
    OP *map_op = args[0]->op;
    OP *cvref = newCVREF(0, newGVOP(OP_GV, 0, gv_fetchpv(func, GV_ADD, SVt_PVCV)));
    OP *arglist = op_append_elem(OP_LIST, map_op, cvref);
    *out = op_convert_list(OP_ENTERSUB, OPf_STACKED, arglist);
    return KEYWORD_PLUGIN_EXPR;
}

static int build_kw_2arg(pTHX_ OP **out, XSParseKeywordPiece *args[], size_t nargs, void *hookdata) {