perlmod/src/ffi.rs

   1 //! Unsafe ffi code.
   2 //!
   3 //! You should not use this code directly. This is used by the binding generator to implement xsubs
   4 //! for exported functions.
   5
   6 /// Raw perl subroutine pointer value. This should not be used directly.
   7 #[repr(C)]
   8 pub struct CV {
   9     _ffi: usize,
  10 }
  11
  12 /// Raw scalar-ish perl value. This should not be used directly.
  13 #[repr(C)]
  14 pub struct SV {
  15     _ffi: usize,
  16 }
  17
  18 /// Raw perl array value. This should not be used directly.
  19 #[repr(C)]
  20 pub struct AV {
  21     _ffi: usize,
  22 }
  23
  24 /// Raw perl hash value. This should not be used directly.
  25 #[repr(C)]
  26 pub struct HV {
  27     _ffi: usize,
  28 }
  29
  30 /// Raw perl hash entry iterator. This should not be used directly.
  31 #[repr(C)]
  32 pub struct HE {
  33     _ffi: usize,
  34 }
  35
  36 /// Raw perl MAGIC struct, we don't actually make its contents available.
  37 #[repr(C)]
  38 pub struct MAGIC {
  39     _ffi: usize,
  40 }
  41
  42 #[allow(clippy::len_without_is_empty)]
  43 impl MAGIC {
  44     pub fn vtbl(&self) -> Option<&MGVTBL> {
  45         unsafe { RSPL_MAGIC_virtual(self as *const MAGIC).as_ref() }
  46     }
  47
  48     pub fn ptr(&self) -> *const libc::c_char {
  49         unsafe { RSPL_MAGIC_ptr(self as *const MAGIC) }
  50     }
  51
  52     pub fn len(&self) -> isize {
  53         unsafe { RSPL_MAGIC_len(self as *const MAGIC) }
  54     }
  55 }
  56
  57 #[repr(C)]
  58 pub struct Unsupported {
  59     _ffi: usize,
  60 }
  61
  62 #[cfg(perlmod = "multiplicity")]
  63 #[repr(C)]
  64 pub struct Interpreter {
  65     _ffi: usize,
  66 }
  67
  68 /// Build perl-compatible functions and fn types (`pTHX` macro equivalent).
  69 ///
  70 /// Takes an `extern "C" fn` (with or without body) and potentially inserts the a
  71 /// `*const Interpreter` as first parameter depending on the perl configuration, so it can be used
  72 /// for xsub implementations.
  73 #[macro_export]
  74 macro_rules! perl_fn {
  75     // inherited visibility
  76     ($(
  77         $(#[$attr:meta])*
  78         extern "C" fn($($args:tt)*) $(-> $re:ty)?
  79     )*) => {
  80         $crate::perl_fn_impl! {
  81             $(
  82                 $(#[$attr])*
  83                 () extern "C" fn($($args)*) $(-> $re)?
  84             )*
  85         }
  86     };
  87     ($(
  88         $(#[$attr:meta])*
  89         extern "C" fn $name:ident $(<($($gen:tt)*)>)? ($($args:tt)*) $(-> $re:ty)?
  90         $(where ($($where_clause:tt)*))?
  91         {
  92             $($code:tt)*
  93         }
  94     )*) => {
  95         $crate::perl_fn_impl! {
  96             $(
  97                 $(#[$attr])*
  98                 () extern "C" fn $name $(<($($gen)*)>)? ($($args)*) $(-> $re)?
  99                 $(where ($($where_clause)*))?
 100                 {
 101                     $($code)*
 102                 }
 103             )*
 104         }
 105     };
 106
 107     // same with 'pub' visibility
 108     ($(
 109         $(#[$attr:meta])*
 110         pub $(($($vis:tt)+))? extern "C" fn($($args:tt)*) $(-> $re:ty)?
 111     )*) => {
 112         $crate::perl_fn_impl! {
 113             $(
 114                 $(#[$attr])*
 115                 (pub $(($($vis)+))?) extern "C" fn($($args)*) $(-> $re)?
 116             )*
 117         }
 118     };
 119     ($(
 120         $(#[$attr:meta])*
 121         pub $(($($vis:tt)+))?
 122         extern "C" fn $name:ident $(<($($gen:tt)*)>)? ($($args:tt)*) $(-> $re:ty)?
 123         $(where ($($where_clause:tt)*))?
 124         {
 125             $($code:tt)*
 126         }
 127     )*) => {
 128         $crate::perl_fn_impl! {
 129             $(
 130                 $(#[$attr])*
 131                 (pub $(($($vis)+))?) extern "C" fn $name $(<($($gen)*)>)? ($($args)*) $(-> $re)?
 132                 $(where ($($where_clause)*))?
 133                 {
 134                     $($code)*
 135                 }
 136             )*
 137         }
 138     };
 139 }
 140
 141 #[cfg(perlmod = "multiplicity")]
 142 mod vtbl_types_impl {
 143     use super::{Interpreter, MAGIC, SV};
 144     use libc::c_int;
 145
 146     pub type Get = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int;
 147     pub type Set = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int;
 148     pub type Len = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> u32;
 149     pub type Clear = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int;
 150     pub type Free = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int;
 151     pub type Copy = extern "C" fn(
 152         _perl: *const Interpreter,
 153         sv: *mut SV,
 154         mg: *mut MAGIC,
 155         nsv: *mut SV,
 156         name: *const libc::c_char,
 157         namelen: i32,
 158     ) -> c_int;
 159     pub type Dup = extern "C" fn(
 160         _perl: *const Interpreter,
 161         sv: *mut SV,
 162         mg: *mut MAGIC,
 163         clone_parms: *mut super::Unsupported,
 164     ) -> c_int;
 165     pub type Local = extern "C" fn(_perl: *const Interpreter, sv: *mut SV, mg: *mut MAGIC) -> c_int;
 166
 167     #[doc(hidden)]
 168     #[macro_export]
 169     macro_rules! perl_fn_impl {
 170         ($(
 171             $(#[$attr:meta])*
 172             ($($vis:tt)*) extern "C" fn($($args:tt)*) $(-> $re:ty)?
 173         )*) => {$(
 174             $(#[$attr])*
 175             $($vis)* extern "C" fn(*const $crate::ffi::Interpreter, $($args)*) $(-> $re)?
 176         )*};
 177         ($(
 178             $(#[$attr:meta])*
 179             ($($vis:tt)*)
 180             extern "C" fn $name:ident $(<($($gen:tt)*)>)? ($($args:tt)*) $(-> $re:ty)?
 181             $(where ($($where_clause:tt)*))?
 182             {
 183                 $($code:tt)*
 184             }
 185         )*) => {$(
 186             $(#[$attr])*
 187             $($vis)* extern "C" fn $name $(<$($gen)*>)? (
 188                 _perl: *const $crate::ffi::Interpreter,
 189                 $($args)*
 190             ) $(-> $re)?
 191             $(where $($where_clause)*)?
 192             {
 193                 $($code)*
 194             }
 195         )*};
 196     }
 197 }
 198
 199 #[cfg(not(perlmod = "multiplicity"))]
 200 mod vtbl_types_impl {
 201     use super::{Interpreter, MAGIC, SV};
 202     use libc::c_int;
 203
 204     pub type Get = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int;
 205     pub type Set = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int;
 206     pub type Len = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> u32;
 207     pub type Clear = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int;
 208     pub type Free = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int;
 209     pub type Copy = extern "C" fn(
 210         sv: *mut SV,
 211         mg: *mut MAGIC,
 212         nsv: *mut SV,
 213         name: *const libc::c_char,
 214         namelen: i32,
 215     ) -> c_int;
 216     pub type Dup =
 217         extern "C" fn(sv: *mut SV, mg: *mut MAGIC, clone_parms: *mut super::Unsupported) -> c_int;
 218     pub type Local = extern "C" fn(sv: *mut SV, mg: *mut MAGIC) -> c_int;
 219
 220     #[doc(hidden)]
 221     #[macro_export]
 222     macro_rules! perl_fn_impl {
 223         ($(
 224             $(#[$attr:meta])*
 225             ($($vis:tt)*) extern "C" fn($($args:tt)*) $(-> $re:ty)?
 226         )*) => {$(
 227             $(#[$attr])*
 228             $($vis)* extern "C" fn($($args)*) $(-> $re)?
 229         )*};
 230         ($(
 231             $(#[$attr:meta])*
 232             ($($vis:tt)*)
 233             extern "C" fn $name:ident $(<($($gen:tt)*)>)? ($($args:tt)*) $(-> $re:ty)?
 234             $(where ($($where_clause:tt)*))?
 235             {
 236                 $($code:tt)*
 237             }
 238         )*) => {$(
 239             $(#[$attr])*
 240             $($vis)* extern "C" fn $name $(<$($gen)*>)? ($($args)*) $(-> $re)?
 241             $(where $($where_clause)*)?
 242             {
 243                 $($code)*
 244             }
 245         )*};
 246     }
 247 }
 248
 249 /// The types in this module depend on the configuration of your perl installation.
 250 ///
 251 /// If the perl interpreter has been compiled with `USEMULTIPLICITY`, these methods have an
 252 /// additional parameter.
 253 pub mod vtbl_types {
 254     pub use super::vtbl_types_impl::*;
 255 }
 256
 257 #[derive(Clone, Copy)]
 258 #[repr(C)]
 259 pub struct MGVTBL {
 260     pub get: Option<vtbl_types::Get>,
 261     pub set: Option<vtbl_types::Set>,
 262     pub len: Option<vtbl_types::Len>,
 263     pub clear: Option<vtbl_types::Clear>,
 264     pub free: Option<vtbl_types::Free>,
 265     pub copy: Option<vtbl_types::Copy>,
 266     pub dup: Option<vtbl_types::Dup>,
 267     pub local: Option<vtbl_types::Local>,
 268 }
 269
 270 impl MGVTBL {
 271     /// Let's not expose this directly, we need there to be distinct instances of these, so they
 272     /// should be created via `MGVTBL::zero()`.
 273     const EMPTY: Self = Self {
 274         get: None,
 275         set: None,
 276         len: None,
 277         clear: None,
 278         free: None,
 279         copy: None,
 280         dup: None,
 281         local: None,
 282     };
 283
 284     /// Create a new all-zeroes vtbl as perl docs suggest this is the safest way to
 285     /// make sure what a `PERL_MAGIC_ext` magic actually means, as the ptr value
 286     /// may be arbitrary.
 287     ///
 288     /// # Safety
 289     ///
 290     /// This must not be deallocated as long as it is attached to a perl value, so best use this as
 291     /// `const` variables, rather than dynamically allocating it.
 292     pub const fn zero() -> Self {
 293         Self::EMPTY
 294     }
 295 }
 296
 297 // in our glue:
 298 #[link(name = "glue", kind = "static")]
 299 extern "C" {
 300     pub fn RSPL_StackMark_count(this: usize) -> usize;
 301
 302     pub fn RSPL_stack_get(offset: usize) -> *mut SV;
 303
 304     pub fn RSPL_croak_sv(sv: *mut SV) -> !;
 305
 306     pub fn RSPL_newXS_flags(
 307         name: *const i8,
 308         subaddr: *const i8,
 309         filename: *const i8,
 310         proto: *const i8,
 311         flags: u32,
 312     ) -> *mut CV;
 313
 314     pub fn RSPL_SvNV(sv: *mut SV) -> f64;
 315     pub fn RSPL_SvIV(sv: *mut SV) -> isize;
 316     pub fn RSPL_SvPVutf8(sv: *mut SV, len: *mut libc::size_t) -> *const libc::c_char;
 317     pub fn RSPL_SvPV(sv: *mut SV, len: *mut libc::size_t) -> *const libc::c_char;
 318     /// This calls `sv_utf8_downgrade` first to avoid croaking, instead returns `NULL` on error.
 319     pub fn RSPL_SvPVbyte(sv: *mut SV, len: *mut libc::size_t) -> *const libc::c_char;
 320     pub fn RSPL_sv_2mortal(sv: *mut SV) -> *mut SV;
 321     pub fn RSPL_get_undef() -> *mut SV;
 322     pub fn RSPL_get_yes() -> *mut SV;
 323     pub fn RSPL_get_no() -> *mut SV;
 324     pub fn RSPL_pop_markstack_ptr() -> usize;
 325     pub fn RSPL_stack_resize_by(count: isize);
 326     pub fn RSPL_stack_shrink_to(count: usize);
 327     pub fn RSPL_stack_sp() -> *mut *mut SV;
 328     pub fn RSPL_newRV_inc(sv: *mut SV) -> *mut SV;
 329     pub fn RSPL_newSViv(v: isize) -> *mut SV;
 330     pub fn RSPL_newSVuv(v: usize) -> *mut SV;
 331     pub fn RSPL_newSVnv(v: f64) -> *mut SV;
 332     pub fn RSPL_newSVpvn(v: *const libc::c_char, len: libc::size_t) -> *mut SV;
 333     pub fn RSPL_newSVpvn_utf8(v: *const libc::c_char, len: libc::size_t) -> *mut SV;
 334     pub fn RSPL_SvREFCNT_inc(sv: *mut SV) -> *mut SV;
 335     pub fn RSPL_SvREFCNT_dec(sv: *mut SV);
 336     pub fn RSPL_is_reference(sv: *mut SV) -> bool;
 337     pub fn RSPL_dereference(sv: *mut SV) -> *mut SV;
 338     pub fn RSPL_is_array(sv: *mut SV) -> bool;
 339     pub fn RSPL_is_hash(sv: *mut SV) -> bool;
 340     pub fn RSPL_type_flags(sv: *mut SV) -> u32;
 341     pub fn RSPL_svtype(sv: *mut SV) -> u32;
 342     pub fn RSPL_SvOK(sv: *mut SV) -> bool;
 343     pub fn RSPL_SvANY(sv: *mut SV) -> bool;
 344     pub fn RSPL_SvTRUE(sv: *mut SV) -> bool;
 345
 346     pub fn RSPL_is_defined(sv: *mut SV) -> bool;
 347
 348     pub fn RSPL_newAV() -> *mut AV;
 349     pub fn RSPL_av_extend(av: *mut AV, len: libc::ssize_t);
 350     pub fn RSPL_av_push(av: *mut AV, sv: *mut SV);
 351     pub fn RSPL_av_pop(av: *mut AV) -> *mut SV;
 352     pub fn RSPL_av_len(av: *mut AV) -> usize;
 353     pub fn RSPL_av_fetch(av: *mut AV, index: libc::ssize_t, lval: i32) -> *mut *mut SV;
 354
 355     pub fn RSPL_newHV() -> *mut HV;
 356     pub fn RSPL_HvTOTALKEYS(hv: *mut HV) -> usize;
 357     pub fn RSPL_hv_fetch(
 358         hv: *mut HV,
 359         key: *const libc::c_char,
 360         klen: i32,
 361         lval: i32,
 362     ) -> *mut *mut SV;
 363     /// Always consumes ownership of `value`.
 364     pub fn RSPL_hv_store(hv: *mut HV, key: *const libc::c_char, klen: i32, value: *mut SV) -> bool;
 365     pub fn RSPL_hv_store_ent(hv: *mut HV, key: *mut SV, value: *mut SV) -> bool;
 366     pub fn RSPL_hv_iterinit(hv: *mut HV);
 367     pub fn RSPL_hv_iternextsv(
 368         hv: *mut HV,
 369         key: *mut *mut libc::c_char,
 370         retlen: *mut i32,
 371     ) -> *mut SV;
 372     pub fn RSPL_hv_iternext(hv: *mut HV) -> *mut HE;
 373     pub fn RSPL_hv_iterkeysv(he: *mut HE) -> *mut SV;
 374     pub fn RSPL_hv_iterval(hv: *mut HV, he: *mut HE) -> *mut SV;
 375
 376     pub fn RSPL_gv_stashsv(name: *const SV, flags: i32) -> *mut HV;
 377     pub fn RSPL_sv_bless(sv: *mut SV, stash: *mut HV) -> *mut SV;
 378
 379     pub fn RSPL_ENTER();
 380     pub fn RSPL_SAVETMPS();
 381     pub fn RSPL_FREETMPS();
 382     pub fn RSPL_LEAVE();
 383
 384     pub fn RSPL_sv_reftype(sv: *const SV, ob: libc::c_int) -> *const libc::c_char;
 385
 386     pub fn RSPL_PVLV() -> u32;
 387     pub fn RSPL_LvTARG(sv: *mut SV) -> *mut SV;
 388     //pub fn RSPL_LvTYPE(sv: *mut SV) -> u8;
 389     pub fn RSPL_vivify_defelem(sv: *mut SV);
 390
 391     //pub fn RSPL_SvFLAGS(sv: *mut SV) -> u32;
 392     pub fn RSPL_SvGETMAGIC(sv: *mut SV) -> bool;
 393
 394     pub fn RSPL_sv_magicext(
 395         sv: *mut SV,
 396         obj: *mut SV,
 397         how: libc::c_int,
 398         vtbl: Option<&MGVTBL>,
 399         name: *const libc::c_char,
 400         namelen: i32,
 401     ) -> *mut MAGIC;
 402     pub fn RSPL_sv_unmagicext(sv: *mut SV, ty: libc::c_int, vtbl: Option<&MGVTBL>);
 403     pub fn RSPL_mg_findext(sv: *const SV, ty: libc::c_int, vtbl: Option<&MGVTBL>) -> *const MAGIC;
 404     pub fn RSPL_MAGIC_virtual(mg: *const MAGIC) -> *const MGVTBL;
 405     pub fn RSPL_MAGIC_ptr(mg: *const MAGIC) -> *const libc::c_char;
 406     pub fn RSPL_MAGIC_len(mg: *const MAGIC) -> isize;
 407     pub fn RSPL_PERL_MAGIC_ext() -> libc::c_int;
 408
 409     pub fn RSPL_PERL_MAGIC_substr() -> libc::c_int;
 410     pub fn RSPL_vtbl_substr() -> *const MGVTBL;
 411     pub fn RSPL_substr(orig: *mut SV, off: usize, len: usize) -> *mut SV;
 412 }
 413
 414 /// Argument marker for the stack.
 415 pub struct StackMark(usize);
 416
 417 impl StackMark {
 418     pub fn count(&self) -> usize {
 419         unsafe { RSPL_StackMark_count(self.0) }
 420     }
 421
 422     pub fn iter(&self) -> StackIter {
 423         StackIter {
 424             at: self.0 + 1,
 425             end: self.0 + 1 + self.count(),
 426         }
 427     }
 428
 429     /// Shrink the perl stack to this mark.
 430     ///
 431     /// # Safety
 432     ///
 433     /// This is only valid if the mark is still valid (smaller than `PL_stack_sp`) and all values
 434     /// still remaining on the stack are mortal (which should normally be the case anyway).
 435     pub unsafe fn set_stack(self) {
 436         unsafe {
 437             RSPL_stack_shrink_to(self.0);
 438         }
 439     }
 440 }
 441
 442 /// Iterator over the stack up to the [`StackMark`].
 443 pub struct StackIter {
 444     at: usize,
 445     end: usize,
 446 }
 447
 448 impl Iterator for StackIter {
 449     type Item = crate::Scalar;
 450
 451     fn next(&mut self) -> Option<Self::Item> {
 452         let at = self.at;
 453         if at == self.end {
 454             return None;
 455         }
 456         unsafe {
 457             let ptr = RSPL_stack_get(self.at);
 458             self.at += 1;
 459             if ptr.is_null() {
 460                 None
 461             } else {
 462                 Some(crate::Scalar::from_raw_ref(ptr))
 463             }
 464         }
 465     }
 466 }
 467
 468 /// Pop the current argument marker off of the argument marker stack.
 469 ///
 470 /// # Safety
 471 ///
 472 /// Read up on `PL_markstack_ptr` in perlguts. This is equivalent to `*PL_markstack_ptr--` in C.
 473 pub unsafe fn pop_arg_mark() -> StackMark {
 474     StackMark(unsafe { RSPL_pop_markstack_ptr() })
 475 }
 476
 477 /// Push a value to the stack.
 478 ///
 479 /// # Safety
 480 ///
 481 /// Read up on mortals and the stack and when it is legal to put a value onto it. Typically a
 482 /// mortal value with no more references to it to avoid leaking if they aren't used later on.
 483 pub unsafe fn stack_push_raw(value: *mut SV) {
 484     unsafe {
 485         RSPL_stack_resize_by(1);
 486         *RSPL_stack_sp() = value;
 487     }
 488 }
 489
 490 pub fn stack_push(value: crate::Mortal) {
 491     unsafe {
 492         stack_push_raw(value.into_raw());
 493     }
 494 }
 495
 496 /// This calls perl's `croak_sv`.
 497 ///
 498 /// # Safety
 499 ///
 500 /// This seems to perform a `longjmp` and is thus never truly safe in rust code. You really want to
 501 /// limit this to the top entry point of your rust call stack in a separate `extern "C" fn` where
 502 /// no rust values with `Drop` handlers or anything similar are active.
 503 ///
 504 /// The `perlmod_macro`'s `export` attribute typically creates 2 wrapper functions of the form:
 505 ///
 506 /// ```no_run
 507 /// # use serde::Serialize;
 508 ///
 509 /// # struct Output;
 510 /// # impl Serialize for Output {
 511 /// #     fn serialize<S: serde::Serializer>(&self, serializer: S) -> Result<S::Ok, S::Error> {
 512 /// #         serializer.serialize_unit()
 513 /// #     }
 514 /// # }
 515 ///
 516 /// # fn code_to_extract_parameters() {}
 517 /// # fn actual_rust_function(_arg: ()) -> Result<Output, String> { Ok(Output) }
 518 /// #[no_mangle]
 519 /// pub extern "C" fn exported_name(/* pTHX parameter, */ cv: &::perlmod::ffi::CV) {
 520 ///     unsafe {
 521 ///         match private_implementation_name(cv) {
 522 ///             Ok(sv) => ::perlmod::ffi::stack_push_raw(sv),
 523 ///             Err(sv) => ::perlmod::ffi::croak(sv),
 524 ///         }
 525 ///     }
 526 /// }
 527 ///
 528 /// #[inline(never)]
 529 /// fn private_implementation_name(
 530 ///     _cv: &::perlmod::ffi::CV,
 531 /// ) -> Result<*mut ::perlmod::ffi::SV, *mut ::perlmod::ffi::SV> {
 532 ///     let args = code_to_extract_parameters();
 533 ///     // ...
 534 ///     let result = match actual_rust_function(args) {
 535 ///         Ok(output) => output,
 536 ///         Err(err) => {
 537 ///             return Err(::perlmod::Value::new_string(&err.to_string())
 538 ///                 .into_mortal()
 539 ///                 .into_raw());
 540 ///         }
 541 ///     };
 542 ///
 543 ///     match ::perlmod::to_value(&result) {
 544 ///         Ok(value) => Ok(value.into_mortal().into_raw()),
 545 ///         Err(err) => Err(::perlmod::Value::new_string(&err.to_string())
 546 ///             .into_mortal()
 547 ///             .into_raw()),
 548 ///     }
 549 /// }
 550 /// ```
 551 pub unsafe fn croak(sv: *mut SV) -> ! {
 552     unsafe {
 553         RSPL_croak_sv(sv);
 554     }
 555 }
 556
 557 /// Create a pseudo-block for mortals & temps to be freed after it.
 558 /// This calls `ENTER; SAVETMPS;` before and `FREETMPS; LEAVE;` after the provided closure.
 559 pub fn pseudo_block<F, R>(func: F) -> R
 560 where
 561     F: FnOnce() -> R,
 562 {
 563     unsafe {
 564         RSPL_ENTER();
 565         RSPL_SAVETMPS();
 566     }
 567
 568     let res = func();
 569
 570     unsafe {
 571         RSPL_FREETMPS();
 572         RSPL_LEAVE();
 573     }
 574
 575     res
 576 }