diff --git a/perlmod/src/ffi.rs b/perlmod/src/ffi.rs index 894199d..e1966df 100644 --- a/perlmod/src/ffi.rs +++ b/perlmod/src/ffi.rs @@ -33,6 +33,46 @@ pub struct HE { _ffi: usize, } +/// Raw perl MAGIC struct, we don't actually make its contents available. +#[repr(C)] +pub struct MAGIC { + _ffi: usize, +} + +impl MAGIC { + pub fn vtbl(&self) -> Option<&MGVTBL> { + unsafe { RSPL_MAGIC_virtual(self as *const MAGIC).as_ref() } + } + + pub fn ptr(&self) -> *const libc::c_char { + unsafe { RSPL_MAGIC_ptr(self as *const MAGIC) } + } + + pub fn len(&self) -> isize { + unsafe { RSPL_MAGIC_len(self as *const MAGIC) } + } +} + +/// Struct big enough to fit perl's MGVTBL struct. We don't make the contents available for now. +#[repr(C)] +pub struct MGVTBL { + _funptrs: [usize; 8], +} + +impl MGVTBL { + /// Create a new all-zeroes vtbl as perl docs suggest this is the safest way to + /// make sure what a `PERL_MAGIC_ext` magic actually means, as the ptr value + /// may be arbitrary. + /// + /// # Safety + /// + /// This must not be deallocated as long as it is attached to a perl value, so best use this as + /// `const` variables, rather than dynamically allocating it. + pub const fn zero() -> Self { + Self { _funptrs: [0; 8] } + } +} + // in our glue: #[link(name = "glue", kind = "static")] extern "C" { @@ -129,6 +169,21 @@ extern "C" { //pub fn RSPL_SvFLAGS(sv: *mut SV) -> u32; pub fn RSPL_SvGETMAGIC(sv: *mut SV) -> bool; + + pub fn RSPL_sv_magicext( + sv: *mut SV, + obj: *mut SV, + how: libc::c_int, + vtbl: Option<&MGVTBL>, + name: *const libc::c_char, + namelen: i32, + ) -> *mut MAGIC; + pub fn RSPL_sv_unmagicext(sv: *mut SV, ty: libc::c_int, vtbl: Option<&MGVTBL>); + pub fn RSPL_mg_findext(sv: *const SV, ty: libc::c_int, vtbl: Option<&MGVTBL>) -> *const MAGIC; + pub fn RSPL_MAGIC_virtual(mg: *const MAGIC) -> *const MGVTBL; + pub fn RSPL_MAGIC_ptr(mg: *const MAGIC) -> *const libc::c_char; + pub fn RSPL_MAGIC_len(mg: *const MAGIC) -> isize; + pub fn RSPL_PERL_MAGIC_ext() -> libc::c_int; } /// Argument marker for the stack. diff --git a/perlmod/src/glue.c b/perlmod/src/glue.c index 5ddfe7c..7e81c21 100644 --- a/perlmod/src/glue.c +++ b/perlmod/src/glue.c @@ -377,6 +377,55 @@ extern void RSPL_SvGETMAGIC(SV *sv) { return SvGETMAGIC(sv); } +/// Create a new all-zeroes vtbl as perl docs suggest this is the safest way to +/// make sure what a `PERL_MAGIC_ext` magic actually means, as the ptr value +/// may be arbitrary. So this function is actually used to allocate "tags". +extern MGVTBL* RSPL_mgvtbl_new() { + return calloc(1, sizeof(MGVTBL)); +} + +extern MAGIC* RSPL_sv_magicext( + SV *sv, + SV *obj, + int how, + const MGVTBL *vtbl, + const char *name, + int32_t namelen) +{ + return sv_magicext(sv, obj, how, vtbl, name, namelen); +} + +extern MAGIC* RSPL_mg_findext(const SV *sv, int ty, const MGVTBL *vtbl) { + return mg_findext(sv, ty, vtbl); +} + +/* it's not completely clear to me whether we want to use mg_freeext or sv_unmagicext +extern void RSPL_mg_freeext(SV *sv, int ty, const MGVTBL *vtbl) { + return mg_freeext(sv, ty, vtbl); +} +*/ +extern void RSPL_sv_unmagicext(SV *sv, int ty, MGVTBL *vtbl) { + // always returns 0 currently + sv_unmagicext(sv, ty, vtbl); +} + +// Seems safer than depending on a `struct magic` declaration within rust code: +extern const MGVTBL* RSPL_MAGIC_virtual(const MAGIC* mg) { + return mg->mg_virtual; +} + +extern const char* RSPL_MAGIC_ptr(const MAGIC* mg) { + return mg->mg_ptr; +} + +extern isize RSPL_MAGIC_len(const MAGIC* mg) { + return mg->mg_len; +} + +extern int RSPL_PERL_MAGIC_ext() { + return PERL_MAGIC_ext; +} + /* These make are convoluted brainfarts: SVt_NULL undef