From 73172a67eaae5671dffc06b427f005810d151472 Mon Sep 17 00:00:00 2001 From: bulk88 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.xs | 59 +++++++++++++++++++++++++++++++ ext/XS-APItest/t/call.t | 12 ++++++- pod/perldiag.pod | 30 ++++++++++++++-- util.c | 73 ++++++++++++++++++++++++++++++--------- 4 files changed, 155 insertions(+), 19 deletions(-) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 4196bbb7004c..5c4d45ab6c47 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 7f981e8008ff..80834bed3961 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3637,7 +3637,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 +error. =item Locale '%s' contains (at least) the following characters which have unexpected meanings: %s The Perl program will use the expected @@ -5216,7 +5218,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 file +formats 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 sequence of 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 mechanisms +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 message. =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 fa946b4153c2..9816980b4366 100644 --- a/util.c +++ b/util.c @@ -5546,6 +5546,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; @@ -5585,10 +5586,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 +5601,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 + 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 +5636,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)) - Perl_croak_nocontext("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 abv */ + 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(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 a interp 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 irreverisbly +corrupted now. B/c new Perl API C func bodies have already been +linked/injected into the 1st perl.bin from the 2nd incompatible "surprise" +new libperl.so/.dll in the same proc. + +A quick process exit using only libc APIs, no perl APIs, is 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);