perlmod: add magic ffi and glue

Signed-off-by: Wolfgang Bumiller <w.bumiller@proxmox.com>

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.

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