From 62a6e9fa037ae8a76a7e54905c163e5df9b39d58 Mon Sep 17 00:00:00 2001 From: Daniel Dragan Date: Fri, 1 Nov 2024 12:22:12 -0400 Subject: [PATCH] util.c: Perl_xs_handshake print API ver mismatch before interp mismatch -this fatal error is much more common by general users than I (orig author) anticipated when I added this check in 5.21.6/2014. I assumed Unix land never had ABI/SEGVing or upgrade problems previous. I wrote the code for my dev style, and my personal setup as test cases, and test cases with Win32-isms. If other OSes get bad-ABI caught, its a plus, but I thought they wouldn't. -the hexadecimal handshake keys were intended to be a debug tool for core devs hacking on something and for XS authors with very complicated Makefile.PL s. To catch -D CCFLAGS arg dropouts on the way to the final cmd line invocation of the CC. -I say the handshake keys are a terrible UI for general "power users" and non-coder sys admins -the Perl API version strings ARE available, even with mismatched interp struct sizes, and those are much more user friendly to print as a error. It should be obvious that from now on, non-power users can figure out on their own (no community help) that a way to "fix" XS boot handshake is to force "reinstall" the "left side perl" or "right side perl" through the OS Pkg Manager. -after this commit, much more often! but not always, users will see a "Perl API 5.X.Y against 5.X+1.Y is incompatible" fatal message instead of the those Core-dev only undocumented hex handshake keys. Sadly the technical P5P debug info is now gone/lost/hidden if "Perl API 5.X.Y against 5.X+1.Y is incompatible" fatal message executes. -core devs, obv will have v5.X.Y matching v5.X.Y in blead perl, so they will still get the handshake keys hex numbers. Since API strings are same. -Package name will get downgraded to "Foo.c" if interp size is wrong, or 2 libperls in 1 proc happens. But the major improvement is showing left and right side Perl API version info. -The POD text is very wordy and detailed, since it has been observed over time, some Perl users, do not know Perl's backend implementation is written in the ISO C language. Or other Perl users on various internet forums or social media, do not know what the term XS code is. While they can sucessful write and debug private personal Perl 5 code, they only read the POD of CPAN modules and only use public documented APIs of CPAN modules, and rarely or never look at "private source" of CPAN modules. Therefore this group of users truly do not know MANY MANY p5p core modules and CPAN modules, make call outs to another language (C), and are unable to troubleshoot a .so file on their filing system is responsible for the error. Since they do not know about XS code concept, their troubleshooting goes very wrong as they keeping looking and keep incorrect diagnosing the problem to ASCII text somewhere in the Perl ecosystem. Either Perl source code, they wrote, or CPAN Perl source code, or a CSV, YAML or JSON file related to Perl. Make it clear, that some "Perl 5 modules" written in ASCII text in Perl 5 lang, depend on "foreign" C code and "foreign" .so/.dll files at runtime. First time Perl coders, can mistakenly assume the Perl 5 interpreter has JIT and self bootstraps to OS binaries from only Perl 5 source like Google Chrome V8 and Raku. So they guess, as first time users, Perl 5 also does it and has no dependency on legacy technologies like C or C++. This commit was specifically written for https://github.com/Perl/perl5/issues/16654 but there are dozens or 100s of them https://github.com/Perl/perl5/issues/19112 --- ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 59 ++++++++++++++++++++++++++ ext/XS-APItest/t/call.t | 12 +++++- pod/perldiag.pod | 30 ++++++++++++- util.c | 89 ++++++++++++++++++++++++++++++--------- 5 files changed, 169 insertions(+), 23 deletions(-) diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index 085e6dc2117e..35d4c34e8b3b 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Carp; -our $VERSION = '1.41'; +our $VERSION = '1.42'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 69561db6a106..dd3e7dcfdc3b 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -1941,6 +1941,65 @@ xsreturn_empty() PPCODE: XSRETURN_EMPTY; +void +test_mismatch_xs_handshake_api_ver(...) + ALIAS: + test_mismatch_xs_handshake_bad_struct = 1 + test_mismatch_xs_handshake_bad_struct_and_ver = 2 + PPCODE: + if(ix == 0) { +#ifdef MULTIPLICITY + Perl_xs_handshake(HS_KEYp(sizeof(PerlInterpreter), + TRUE, NULL, FALSE, + sizeof("v1.1337.0")-1, + sizeof("")-1), + HS_CXT, __FILE__, items, ax, + "v1.1337.0"); +#else + Perl_xs_handshake(HS_KEYp(sizeof(struct PerlHandShakeInterpreter), + FALSE, NULL, FALSE, + sizeof("v1.1337.0")-1, + sizeof("")-1), + HS_CXT, __FILE__, items, ax, + "v1.1337.0"); +#endif + } + else if(ix == 1) { +#ifdef MULTIPLICITY + Perl_xs_handshake(HS_KEYp(sizeof(PerlInterpreter)+1, + TRUE, NULL, FALSE, + sizeof("v" PERL_API_VERSION_STRING)-1, + sizeof("")-1), + HS_CXT, __FILE__, items, ax, + "v" PERL_API_VERSION_STRING); +#else + Perl_xs_handshake(HS_KEYp(sizeof(struct PerlHandShakeInterpreter)+1, + FALSE, NULL, FALSE, + sizeof("v" PERL_API_VERSION_STRING)-1, + sizeof("")-1), + HS_CXT, __FILE__, items, ax, + "v" PERL_API_VERSION_STRING); +#endif + } + else { +#ifdef MULTIPLICITY + Perl_xs_handshake(HS_KEYp(sizeof(PerlInterpreter)+1, + TRUE, NULL, FALSE, + sizeof("v1.1337.0")-1, + sizeof("")-1), + HS_CXT, __FILE__, items, ax, + "v1.1337.0"); +#else + Perl_xs_handshake(HS_KEYp(sizeof(struct PerlHandShakeInterpreter)+1, + FALSE, NULL, FALSE, + sizeof("v1.1337.0")-1, + sizeof("")-1), + HS_CXT, __FILE__, items, ax, + "v1.1337.0"); +#endif + } + + MODULE = XS::APItest:Hash PACKAGE = XS::APItest::Hash void diff --git a/ext/XS-APItest/t/call.t b/ext/XS-APItest/t/call.t index d17d67c96209..e31c2db4d7cd 100644 --- a/ext/XS-APItest/t/call.t +++ b/ext/XS-APItest/t/call.t @@ -11,7 +11,7 @@ use strict; BEGIN { require '../../t/test.pl'; - plan(544); + plan(547); use_ok('XS::APItest') }; use Config; @@ -385,3 +385,13 @@ eval { my @a = sort f 2, 1; $x++}; print "x=$x\n"; EOF } + +fresh_perl_like('use XS::APItest;' + .'XS::APItest::XSUB::test_mismatch_xs_handshake_api_ver("Dog");' + , qr/\QPerl API version v1.1337.0 of Dog does not match\E/); +fresh_perl_like('use XS::APItest;' + .'XS::APItest::XSUB::test_mismatch_xs_handshake_bad_struct("Dog");' + , qr/\Q loadable library and perl binaries are mismatched (got first handshake\E/); +fresh_perl_like('use XS::APItest;' + .'XS::APItest::XSUB::test_mismatch_xs_handshake_bad_struct_and_ver("Dog");' + , qr/\QPerl API version v1.1337.0 of APItest.xs does not match\E/); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index e03f723ca165..897f51413021 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3689,7 +3689,9 @@ does when displayed. (P) A dynamic loading library C<.so> or C<.dll> was being loaded into the process that was built against a different build of perl than the said library was compiled against. Reinstalling the XS module will -likely fix this error. +likely fix this error. This error is a less commonly seen subset of +L<"Perl API version %s of %s does not match %s"|perldiag/"Perl API version %s of %s does not match %s"> +error. =item Locale '%s' contains (at least) the following characters which have unexpected meanings: %s The Perl program will use the expected @@ -5281,7 +5283,31 @@ redirected it with select().) =item Perl API version %s of %s does not match %s (F) The XS module in question was compiled against a different incompatible -version of Perl than the one that has loaded the XS module. +version of Perl than the one that has loaded the XS module. If the internal +differences between the 2 incompatible Perl versions are large enough to +prevent obtaining the full module name causing this error message, a +C<.c> file name will be shown in this error message instead of the full module +name. The C<.c> file name serves as a hint to help identify the module +causing this error. + +The term XS module does not mean a C<.pm> file. This error is not directly +caused by Perl code inside a particular C<.pm> file or C<.pl> file. +Instead this error is only caused by OS and CPU specific "shared library" +files created by a C or C++ compiler. This file format is called a +C<.so>, C<.dll>, C<.dylib>, C<.bundle> or C<.sl> on Perl's most popular +operating systems. These shared library files are a part of the XS API +documented in L. + +Each OS has a different file extension or no extension for shared libraries. +But shared library files on all OSes are non-text, unprintable, binary files +with raw machine code inside of them created by a C or C++ compiler. + +The C<.so> or C<.dll> or equivalent is usually loaded by a C<.pm> or C<.pl> +file making a call to L or L, which +then calls OS specific mechanisms to load the shared library file into the Perl +process. The OS specific mechanism then calls a function or subroutine inside +the particular C<.so> or C<.dll> file. That particular C<.so> or C<.dll> file +then throws this error. =item Perl folding rules are not up-to-date for 0x%X; please use the perlbug utility to report; in regex; marked by S<<-- HERE> in m/%s/ diff --git a/util.c b/util.c index 6e78718c2978..069ec59c1747 100644 --- a/util.c +++ b/util.c @@ -5513,7 +5513,7 @@ Perl_my_cxt_init(pTHX_ int *indexp, size_t size) The meaning of the varargs is determined the U32 key arg (which is not a format string). The fields of key are assembled by using HS_KEY(). - Under PERL_IMPLICIT_CONTEX, the v_my_perl arg is of type + Under PERL_IMPLICIT_CONTEXT, the v_my_perl arg is of type "PerlInterpreter *" and represents the callers context; otherwise it is of type "CV *", and is the boot xsub's CV. @@ -5535,7 +5535,17 @@ Perl_my_cxt_init(pTHX_ int *indexp, size_t size) (remember that it assumes that the 1st arg is the interp cxt). 'file' is the source filename of the caller. -*/ + + Expansion provisions: Argument char * api_version is private to + #include "perl.h". EU::MM and XS authors can't modify it. perl.h could + place an aligned const pointer to a const static C struct before or after + the C string, or just the later. Or add argument #8 and 1 new bit in U32 key. + Arg U32 key can't be changed to arg U64 key, on OSes/CPUs with 32bit void*s. + Some/all 32b CCs will invisibly splice in "U32 key64_upper" as arg 2, + shifting all other args down the C stack, and breaking ABI compat of this C + function between any and all old/new permutations of a .xs vs a libperl. + + See GH PR #22719 for other expansion provisions. */ Stack_off_t Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) @@ -5546,6 +5556,7 @@ Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) void * got; void * need; const char *stage = "first"; + bool in_abi_mismatch = FALSE; #ifdef MULTIPLICITY dTHX; tTHX xs_interp; @@ -5561,7 +5572,7 @@ Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) if (UNLIKELY(got != need)) goto bad_handshake; /* try to catch where a 2nd threaded perl interp DLL is loaded into a process - by a XS DLL compiled against the wrong interl DLL b/c of bad @INC, and the + by a XS DLL compiled against the wrong interp DLL b/c of bad @INC, and the 2nd threaded perl interp DLL never initialized its TLS/PERL_SYS_INIT3 so dTHX call from 2nd interp DLL can't return the my_perl that pp_entersub passed to the XS DLL */ @@ -5585,10 +5596,10 @@ Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) stage = "second"; if(UNLIKELY(got != need)) { bad_handshake:/* recycle branch and string from above */ - if(got != (void *)HSf_NOCHK) - noperl_die("%s: loadable library and perl binaries are mismatched" - " (got %s handshake key %p, needed %p)\n", - file, stage, got, need); + if(got != (void *)HSf_NOCHK) { + in_abi_mismatch = TRUE; + goto die_mismatched_rmv_c_args; + } } if(key & HSf_SETXSUBFN) { /* this might be called from a module bootstrap */ @@ -5600,19 +5611,34 @@ Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) (void)gv_fetchfile(file); */ } + die_mismatched_rmv_c_args: if(key & HSf_POPMARK) { - ax = POPMARK; - { SV **mark = PL_stack_base + ax++; - { dSP; - items = (Stack_off_t)(SP - MARK); - } + /* Don't touch the local unthreaded or threaded Perl stack if mismatched + ABI. The pointers inside the mark stack vars and @_ vars are + uninitialized data if we are executing in an unexpected second + libperl.{so,dll} with a different major version. The second libperl + possibly was auto-loaded by the OS, as a dependency of the out of + date XS shared library file. */ + if(in_abi_mismatch) { + ax = Stack_off_t_MAX; /* silence CC & poison */ + items = Stack_off_t_MAX; + } + else { + ax = POPMARK; + SV **mark = PL_stack_base + ax++; + dSP; + items = (Stack_off_t)(SP - MARK); } } else { items = va_arg(args, Stack_off_t); ax = va_arg(args, Stack_off_t); } - assert(ax >= 0); - assert(items >= 0); + + if(!in_abi_mismatch) { + assert(ax >= 0); + assert(items >= 0); + } + { U32 apiverlen; assert(HS_GETAPIVERLEN(key) <= UCHAR_MAX); @@ -5620,11 +5646,36 @@ Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) char * api_p = va_arg(args, char*); if(apiverlen != sizeof("v" PERL_API_VERSION_STRING)-1 || memNE(api_p, "v" PERL_API_VERSION_STRING, - sizeof("v" PERL_API_VERSION_STRING)-1)) - croak("Perl API version %s of %" SVf " does not match %s", - api_p, SVfARG(PL_stack_base[ax + 0]), - "v" PERL_API_VERSION_STRING); - } + sizeof("v" PERL_API_VERSION_STRING)-1)) { + if(in_abi_mismatch) + noperl_die("Perl API version %s of %s does not match %s", + api_p, file, "v" PERL_API_VERSION_STRING); + else {/* use %s for SV * for string literal reuse with above */ + SV * package_sv = PL_stack_base[ax + 0]; + Perl_croak_nocontext("Perl API version %s of %s does not match %s", + api_p, SvPV_nolen_const(package_sv), + "v" PERL_API_VERSION_STRING); + } + } /* memcmp() */ + } /* if user wants API Ver Check (xsubpp default is on ) */ + +/* The gentler error above couldn't be shown. Maybe the 2 API ver strings DID +str eq match. So its an interpreter build time/Configure problem, or 3rd party +patches by OS vendors. Or system perl vs /home "local perl" battles. +No choice but to show the full hex debugging info and die. + +On Unix, the 1st correct original libperl/perl.bin, on ELF, is irreversibly +corrupted now because new Perl API C func function have already been +linked/injected into the 1st perl.bin from the 2nd incompatible "surprise" +new libperl.so/.dll in the same process. + +A quick process exit using only libc APIs, no perl APIs, is the only fool proof, +cross platform way to prevent a SEGV. +*/ + if(in_abi_mismatch) + noperl_die("%s: loadable library and perl binaries are mismatched" + " (got %s handshake key %p, needed %p)\n", + file, stage, got, need); } { U32 xsverlen = HS_GETXSVERLEN(key);