Check API compatibility when loading xs modules

This adds PL_apiversion, allowing the API version of a running interpreter to be
introspected. It is used in the new XS_APIVERSION_BOOTCHECK macro, which is
added to the _boot function of every XS module, to compare it against the API
version the module has been compiled against. If the versions do not match, an
exception is thrown.

This doesn't fully prevent binary incompatible extensions to be loaded. It
merely compares PERL_API_* between compile- and runtime, and does not attempt to
solve the problem of identifying binary incompatible perls with the same API
version (i.e. the same perl version configured with and without DEBUGGING).

diff --git a/XSUB.h b/XSUB.h
index f3ba802..939a7a6 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
@@ -243,6 +243,10 @@ Macro to verify that a PM module's $VERSION variable matches the XS
 module's C<XS_VERSION> variable.  This is usually handled automatically by
 C<xsubpp>.  See L<perlxs/"The VERSIONCHECK: Keyword">.
 
+=for apidoc Ams||XS_APIVERSION_BOOTCHECK
+Macro to verify that the perl api version an XS module has been compiled against
+matches the api version of the perl interpreter it's being loaded into.
+
 =head1 Simple Exception Handling Macros
 
 =for apidoc Ams||dXCPT
@@ -335,6 +339,26 @@ Rethrows a previously caught exception.  See L<perlguts/"Exception Handling">.
 #  define XS_VERSION_BOOTCHECK
 #endif
 
+#define XS_APIVERSION_BOOTCHECK                                                \
+    STMT_START {                                                       \
+       SV *_xpt = NULL;                                                \
+       SV *_compver = Perl_newSVpv(aTHX_ "v" PERL_API_VERSION_STRING, 0); \
+       SV *_runver = new_version(PL_apiversion);                       \
+       _compver = upg_version(_compver, 0);                            \
+       if (vcmp(_compver, _runver)) {                                  \
+           _xpt = Perl_newSVpvf(aTHX_ "Perl API version %"SVf          \
+                                " of %s does not match %"SVf,          \
+                                SVfARG(Perl_sv_2mortal(aTHX_ vstringify(_compver))), \
+                                SvPV_nolen_const(ST(0)),               \
+                                SVfARG(Perl_sv_2mortal(aTHX_ vstringify(_runver)))); \
+           Perl_sv_2mortal(aTHX_ _xpt);                                \
+       }                                                               \
+       SvREFCNT_dec(_compver);                                         \
+       SvREFCNT_dec(_runver);                                          \
+       if (_xpt)                                                       \
+           Perl_croak_sv(aTHX_ _xpt);                                  \
+    } STMT_END
+
 #ifdef NO_XSLOCKS
 #  define dXCPT             dJMPENV; int rEtV = 0
 #  define XCPT_TRY_START    JMPENV_PUSH(rEtV); if (rEtV == 0)
@@ -343,9 +367,9 @@ Rethrows a previously caught exception.  See L<perlguts/"Exception Handling">.
 #  define XCPT_RETHROW      JMPENV_JUMP(rEtV)
 #endif
 
-/* 
-   The DBM_setFilter & DBM_ckFilter macros are only used by 
-   the *DB*_File modules 
+/*
+   The DBM_setFilter & DBM_ckFilter macros are only used by
+   the *DB*_File modules
 */
 
 #define DBM_setFilter(db_type,code)                            \

diff --git a/cpan/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/cpan/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
index 385e2fb..cde1a40 100644 (file)
--- a/cpan/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
+++ b/cpan/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm
@@ -1004,8 +1004,11 @@ EOF
   print Q(<<"EOF");
 #    PERL_UNUSED_VAR(cv); /* -W */
 #    PERL_UNUSED_VAR(items); /* -W */
+##ifdef XS_APIVERSION_BOOTCHECK
+#    XS_APIVERSION_BOOTCHECK;
+##endif
 EOF
-    
+
   print Q(<<"EOF") if $WantVersionChk ;
 #    XS_VERSION_BOOTCHECK ;
 #

diff --git a/embedvar.h b/embedvar.h
index 25c033c..587bc94 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -65,6 +65,7 @@
 #define PL_Xpv                 (vTHX->IXpv)
 #define PL_amagic_generation   (vTHX->Iamagic_generation)
 #define PL_an                  (vTHX->Ian)
+#define PL_apiversion          (vTHX->Iapiversion)
 #define PL_argvgv              (vTHX->Iargvgv)
 #define PL_argvout_stack       (vTHX->Iargvout_stack)
 #define PL_argvoutgv           (vTHX->Iargvoutgv)
@@ -395,6 +396,7 @@
 #define PL_IXpv                        PL_Xpv
 #define PL_Iamagic_generation  PL_amagic_generation
 #define PL_Ian                 PL_an
+#define PL_Iapiversion         PL_apiversion
 #define PL_Iargvgv             PL_argvgv
 #define PL_Iargvout_stack      PL_argvout_stack
 #define PL_Iargvoutgv          PL_argvoutgv

diff --git a/intrpvar.h b/intrpvar.h
index 1e01e43..21fb933 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -228,6 +228,7 @@ PERLVAR(Iwarnhook,  SV *)
 
 /* switches */
 PERLVAR(Ipatchlevel,   SV *)
+PERLVAR(Iapiversion,   SV *)
 PERLVAR(Ilocalpatches, const char * const *)
 PERLVARI(Isplitstr,    const char *, " ")
 

diff --git a/perl.c b/perl.c
index d52d79f..404372c 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -348,6 +348,7 @@ perl_construct(pTHXx)
     PL_stashcache = newHV();
 
     PL_patchlevel = newSVpvs("v" PERL_VERSION_STRING);
+    PL_apiversion = newSVpvs("v" PERL_API_VERSION_STRING);
 
 #ifdef HAS_MMAP
     if (!PL_mmap_page_size) {
@@ -877,6 +878,7 @@ perl_destruct(pTHXx)
     Safefree(PL_inplace);
     PL_inplace = NULL;
     SvREFCNT_dec(PL_patchlevel);
+    SvREFCNT_dec(PL_apiversion);
 
     if (PL_e_script) {
        SvREFCNT_dec(PL_e_script);

diff --git a/perl.h b/perl.h
index 32cf787..59df0aa 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4900,6 +4900,10 @@ typedef struct exitlistentry {
                                STRINGIFY(PERL_VERSION) "." \
                                STRINGIFY(PERL_SUBVERSION)
 
+#define PERL_API_VERSION_STRING        STRINGIFY(PERL_API_REVISION) "." \
+                               STRINGIFY(PERL_API_VERSION) "." \
+                               STRINGIFY(PERL_API_SUBVERSION)
+
 #ifdef PERL_GLOBAL_STRUCT
 struct perl_vars {
 #  include "perlvars.h"

diff --git a/perlapi.h b/perlapi.h
index 742bb3a..869d512 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -166,6 +166,8 @@ END_EXTERN_C
 #define PL_amagic_generation   (*Perl_Iamagic_generation_ptr(aTHX))
 #undef  PL_an
 #define PL_an                  (*Perl_Ian_ptr(aTHX))
+#undef  PL_apiversion
+#define PL_apiversion          (*Perl_Iapiversion_ptr(aTHX))
 #undef  PL_argvgv
 #define PL_argvgv              (*Perl_Iargvgv_ptr(aTHX))
 #undef  PL_argvout_stack

diff --git a/sv.c b/sv.c
index 10e41a9..b2383fd 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12283,6 +12283,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     /* switches */
     PL_minus_c         = proto_perl->Iminus_c;
     PL_patchlevel      = sv_dup_inc(proto_perl->Ipatchlevel, param);
+    PL_apiversion      = sv_dup_inc(proto_perl->Iapiversion, param);
     PL_localpatches    = proto_perl->Ilocalpatches;
     PL_splitstr                = proto_perl->Isplitstr;
     PL_minus_n         = proto_perl->Iminus_n;