diff --git a/perlmod-test/src/magic.rs b/perlmod-test/src/magic.rs index 812279f..7677b28 100644 --- a/perlmod-test/src/magic.rs +++ b/perlmod-test/src/magic.rs @@ -24,9 +24,4 @@ mod export { println!("Calling magic with content {:?}", this.content); Ok(()) } - - #[export(name = "DESTROY")] - fn destroy(#[raw] this: Value) { - perlmod::magic_destructor!(this: &MAGIC); - } } diff --git a/perlmod/src/error.rs b/perlmod/src/error.rs index c0cab4e..daa389e 100644 --- a/perlmod/src/error.rs +++ b/perlmod/src/error.rs @@ -70,6 +70,9 @@ impl fmt::Display for MagicError { MagicError::NotAReference(class) => { write!(f, "value blessed into {} was not a reference", class) } + MagicError::NotFound("") => { + write!(f, "value did not contain the requested magic pointer") + } MagicError::NotFound(class) => write!( f, "value blessed into {} did not contain its declared magic pointer", diff --git a/perlmod/src/ffi.rs b/perlmod/src/ffi.rs index 2c17a64..bb3bf2c 100644 --- a/perlmod/src/ffi.rs +++ b/perlmod/src/ffi.rs @@ -53,13 +53,131 @@ impl MAGIC { } } -/// Struct big enough to fit perl's MGVTBL struct. We don't make the contents available for now. +#[repr(C)] +pub struct Unsupported { + _ffi: usize, +} + +#[cfg(perlmod = "multiplicity")] +#[repr(C)] +pub struct Interpreter { + _ffi: usize, +} + +#[cfg(perlmod = "multiplicity")] +mod vtbl_types_impl { + use super::{Interpreter, MAGIC, SV}; + use libc::c_int; + + pub type Get = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int; + pub type Set = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int; + pub type Len = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> u32; + pub type Clear = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int; + pub type Free = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int; + pub type Copy = extern "C" fn( + _perl: *const Interpreter, + sv: *mut SV, + mg: *mut MAGIC, + nsv: *mut SV, + name: *const libc::c_char, + namelen: i32, + ) -> c_int; + pub type Dup = extern "C" fn( + _perl: *const Interpreter, + sv: *mut SV, + mg: *mut MAGIC, + clone_parms: *mut super::Unsupported, + ) -> c_int; + pub type Local = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int; + + #[macro_export] + macro_rules! perl_fn { + ($( + $(#[$attr:meta])* + extern "C" fn $name:ident ($($args:tt)*) $(-> $re:ty)? { + $($code:tt)* + } + )*) => {$( + $(#[$attr])* + extern "C" fn $name (_perl: *const $crate::ffi::Interpreter, $($args)*) $(-> $re)? { + $($code)* + } + )*}; + } +} + +#[cfg(not(perlmod = "multiplicity"))] +mod vtbl_types_impl { + use super::{Interpreter, MAGIC, SV}; + use libc::c_int; + + pub type Get = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int; + pub type Set = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int; + pub type Len = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> u32; + pub type Clear = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int; + pub type Free = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int; + pub type Copy = extern "C" fn( + sv: *mut SV, + mg: *mut MAGIC, + nsv: *mut SV, + name: *const libc::c_char, + namelen: i32, + ) -> c_int; + pub type Dup = + extern "C" fn(sv: *mut SV, mg: *mut MAGIC, clone_parms: *mut super::Unsupported) -> c_int; + pub type Local = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int; + + #[macro_export] + macro_rules! perl_fn { + ($( + $(#[$attr:meta])* + extern "C" fn $name:ident ($($args:tt)*) $(-> $re:ty)? { + $($code:tt)* + } + )*) => {$( + $(#[$attr])* + extern "C" fn $name ($($args)*) $(-> $re)? { + $($code)* + } + )*}; + } +} + +/// The types in this module depend on the configuration of your perl installation. +/// +/// If the perl interpreter has been compiled with `USEMULTIPLICITY`, these methods have an +/// additional parameter. +pub mod vtbl_types { + pub use super::vtbl_types_impl::*; +} + +#[derive(Clone, Copy)] #[repr(C)] pub struct MGVTBL { - _funptrs: [usize; 8], + pub get: Option, + pub set: Option, + pub len: Option, + pub clear: Option, + pub free: Option, + pub copy: Option, + pub dup: Option, + pub local: Option, } impl MGVTBL { + /// Let's not expose this directly, we need there to be distinct instances of these, so they + /// should be created via `MGVTBL::zero()`. + const EMPTY: Self = Self { + get: None, + set: None, + len: None, + clear: None, + free: None, + copy: None, + dup: None, + local: None, + }; + /// 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. @@ -69,7 +187,7 @@ impl MGVTBL { /// 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] } + *&Self::EMPTY } } diff --git a/perlmod/src/lib.rs b/perlmod/src/lib.rs index 19a648e..55f0d96 100644 --- a/perlmod/src/lib.rs +++ b/perlmod/src/lib.rs @@ -27,8 +27,10 @@ pub use error::Error; #[macro_use] mod macros; -pub mod de; +#[macro_use] pub mod ffi; + +pub mod de; pub mod ser; #[doc(inline)] diff --git a/perlmod/src/macros.rs b/perlmod/src/macros.rs index bc9221e..9e13a7f 100644 --- a/perlmod/src/macros.rs +++ b/perlmod/src/macros.rs @@ -106,11 +106,15 @@ macro_rules! destructor { } /// Create a standard destructor for a value where a rust value has been attached via a -/// [`MagicSpec`](crate::magic::MagicSpec). +/// [`MagicSpec`] /// /// This assumes the type is a reference and calls [`dereference`](crate::Value::dereference()) on /// it. /// +/// Note that this only makes sense if the used [`MagicSpec`] does not include a `free` method. +/// This method *is* includded when using its `DEFAULT` or the [`declare_magic!`] macro, so this +/// macro is only required when using custom magic with a custom `DESTROY` sub. +/// /// Due to compiler restrictions, the function itself needs to be written manually, only the /// contents can be generated using this macro. This also means that the `this` parameter needs to /// be passed to the macro. @@ -137,7 +141,7 @@ macro_rules! destructor { /// ```ignore /// #[export(name = "DESTROY")] /// fn destroy(#[raw] this: Value) { -/// match this.remove_magic_spec(&MyMagic) { +/// match this.remove_magic(&MyMagic) { /// Ok(_drpo) => (), /// Err(err) => { /// eprintln!("DESTROY called with an invalid pointer: {}", err); @@ -145,6 +149,7 @@ macro_rules! destructor { /// } /// } /// ``` +/// [`MagicSpec`]: crate::magic::MagicSpec #[macro_export] macro_rules! magic_destructor { ($this:ident: $spec:expr) => { @@ -158,8 +163,9 @@ macro_rules! magic_destructor { match Value::dereference(&$this) { None => $on_ref_err, Some(value) => match $crate::ScalarRef::remove_magic(&value, $spec) { - Some(_drop) => (), - None => $on_type_err, + Ok(Some(_drop)) => (), + Ok(None) => (), + Err(_) => $on_type_err, } } }; @@ -173,13 +179,8 @@ macro_rules! magic_destructor { /// [`add_magic`](crate::ScalarRef::add_magic()). /// * `impl TryFrom<&Value> for &Inner`: assuming the value is a reference (calling /// [`dereference`](crate::Value::dereference()) on it) and then looking for the `MAGIC` pointer. -/// -/// # Warning -/// -/// This does *not* provide a destructor! -/// -/// This is due to compiler limitations (the `#[export]` attribute cannot be applied from within -/// this macro). +/// * Binds the `Drop` handler for to the magic value, so that a custom destructor for perl is not +/// necessary. /// /// ``` /// struct MyThing {} // anything @@ -192,10 +193,8 @@ macro_rules! magic_destructor { macro_rules! declare_magic { ($ty:ty : &$inner:ty as $class:literal) => { const CLASSNAME: &str = $class; - const MAGIC: $crate::MagicSpec<$ty> = unsafe { - const TAG: $crate::MagicTag = $crate::MagicTag::new(); - perlmod::MagicSpec::new_static(&TAG) - }; + const MAGIC: $crate::MagicSpec<$ty> = + unsafe { perlmod::MagicSpec::new_static(&$crate::MagicTag::<$ty>::DEFAULT) }; impl<'a> ::std::convert::TryFrom<&'a $crate::Value> for &'a $inner { type Error = $crate::error::MagicError; diff --git a/perlmod/src/magic.rs b/perlmod/src/magic.rs index b5074ee..29f93e9 100644 --- a/perlmod/src/magic.rs +++ b/perlmod/src/magic.rs @@ -68,7 +68,10 @@ //! ``` //! +use std::marker::PhantomData; + use crate::ffi; +use crate::perl_fn; use crate::ScalarRef; /// Pointer-like types which can be leaked and reclaimed. @@ -123,21 +126,52 @@ unsafe impl Leakable for std::rc::Rc { } /// A tag for perl magic, see [`MagicSpec`] for its usage. -pub struct MagicTag(ffi::MGVTBL); +pub struct MagicTag(ffi::MGVTBL, PhantomData); -impl MagicTag { +impl MagicTag { /// Create a new tag. See [`MagicSpec`] for its usage. pub const fn new() -> Self { - Self(ffi::MGVTBL::zero()) + Self(ffi::MGVTBL::zero(), PhantomData) } } -impl AsRef for MagicTag { +impl AsRef for MagicTag { fn as_ref(&self) -> &ffi::MGVTBL { &self.0 } } +impl MagicTag { + perl_fn! { + extern "C" fn drop_handler(_sv: *mut ffi::SV, mg: *mut ffi::MAGIC) -> libc::c_int { + let mg = unsafe { &*mg }; + match T::get_ref(mg.ptr()) { + Some(ptr) => { + let _drop = unsafe { T::reclaim(ptr) }; + } + None => eprintln!("Default magic drop handler called but pointer was NULL"), + } + 0 + } + } + + /// The default tag, note that using this tag when creating perl values for *different* types + /// than `T` this *will* cause memory corruption! + pub const DEFAULT: Self = Self( + ffi::MGVTBL { + free: Some(Self::drop_handler), + get: None, + set: None, + len: None, + clear: None, + copy: None, + dup: None, + local: None, + }, + PhantomData, + ); +} + /// A tag for perl magic. Use this for blessed objects. /// /// When creating a blessed object is safer to attach the rust pointer via magic than by embedding @@ -194,7 +228,7 @@ impl MagicSpec<'static, 'static, T> { /// # Safety /// /// This should be safe as long as the [`MagicTag`] is only used for a single [`MagicSpec`]. - pub const unsafe fn new_static(vtbl: &'static MagicTag) -> Self { + pub const unsafe fn new_static(vtbl: &'static MagicTag) -> Self { Self { obj: None, how: None, diff --git a/perlmod/src/scalar.rs b/perlmod/src/scalar.rs index d641c5e..f931b7c 100644 --- a/perlmod/src/scalar.rs +++ b/perlmod/src/scalar.rs @@ -6,6 +6,7 @@ use std::mem; use bitflags::bitflags; +use crate::error::MagicError; use crate::ffi::{self, SV}; use crate::magic::{Leakable, MagicSpec}; use crate::raw_value; @@ -475,14 +476,38 @@ impl ScalarRef { } /// Remove a magic tag from this value previously added via - /// [`add_magic`](ScalarRef::add_magic()) and reclaim the contained value of type `T`. + /// [`add_magic`](ScalarRef::add_magic()) and potentially reclaim the contained value of type + /// `T`. + /// + /// When using a "default" magic tag via [`MagicTag::DEFAULT`](crate::magic::MagicTag::DEFAULT) + /// such as when using the [`declare_magic!`](crate::declare_magic!) macro, removing the magic + /// implicitly causes perl call the `free` method, therefore in this case this method returns + /// `None`. + /// + /// In case the magic was not found, [`MagicError::NotFound("")`] is returned. /// /// This does not need to include the object and type information. - /// - /// Use the [`spec`](MagicSpec::spec())` method in case you have additional information in your - /// magic tag. - pub fn remove_magic(&self, spec: &MagicSpec<'static, 'static, T>) -> Option { - let this = self.find_magic(spec).map(|m| unsafe { T::reclaim(m) }); + pub fn remove_magic( + &self, + spec: &MagicSpec<'static, 'static, T>, + ) -> Result, MagicError> { + let this = match self.find_raw_magic(spec.how, Some(spec.vtbl)) { + None => Err(MagicError::NotFound("")), + Some(mg) => { + assert_eq!( + mg.vtbl().map(|v| v as *const _), + Some(spec.vtbl as *const _), + "Perl_mg_findext misbehaved horribly", + ); + + Ok(match mg.vtbl() { + // We assume that a 'free' callback takes care of reclaiming the value! + Some(v) if v.free.is_some() => None, + _ => T::get_ref(mg.ptr()).map(|m| unsafe { T::reclaim(m) }), + }) + } + }; + unsafe { self.remove_raw_magic(spec.how, Some(spec.vtbl)); } diff --git a/test.pl b/test.pl index 8327995..2fa5271 100644 --- a/test.pl +++ b/test.pl @@ -2,10 +2,12 @@ use v5.28.0; -# The nasty one: -use Storable; use POSIX (); +# The nasty ones: +use Storable; +use Clone; + use lib '.'; use RSPM::Bless; use RSPM::Foo142; @@ -86,13 +88,20 @@ print($ref1->{x}, "\n"); my $magic = RSPM::Magic->new('magic test'); $magic->call(); -print("Testing unsafe dclone\n"); -my $bad = Storable::dclone($magic); -eval { $bad->call() }; -if (!$@) { - die "dclone'd object not properly detected!\n"; -} elsif ($@ ne "value blessed into RSPM::Magic did not contain its declared magic pointer\n") { - die "dclone'd object error message changed to: [$@]\n"; +sub test_unsafe_clone($) { + my ($bad) = @_; + eval { $bad->call() }; + if (!$@) { + die "cloned object not properly detected!\n"; + } elsif ($@ ne "value blessed into RSPM::Magic did not contain its declared magic pointer\n") { + die "cloned object error message changed to: [$@]\n"; + } + undef $bad; + print("unsafe dclone dropped\n"); } -undef $bad; -print("unsafe dclone dropped (error should have been printed)\n"); + +print("Testing unsafe dclone\n"); +test_unsafe_clone(Storable::dclone($magic)); + +print("Testing unsafe clone\n"); +test_unsafe_clone(Clone::clone($magic)); diff --git a/test.pl.expected b/test.pl.expected index 3fcd3dd..831b715 100644 --- a/test.pl.expected +++ b/test.pl.expected @@ -34,6 +34,7 @@ x was stored x was changed Calling magic with content "magic test" Testing unsafe dclone -DESTROY called on a value with no magic -unsafe dclone dropped (error should have been printed) +unsafe dclone dropped +Testing unsafe clone +unsafe dclone dropped Dropping blessed magic with content "magic test"