X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/abec5bedacd77b2152e61ec3216ab47bd7272fc9..HEAD:/caretx.c diff --git a/caretx.c b/caretx.c index 9366bc4..6dc7d9c 100644 --- a/caretx.c +++ b/caretx.c @@ -32,10 +32,6 @@ #include "perl.h" #include "XSUB.h" -#ifdef NETWARE -#include "nwutil.h" -#endif - #ifdef USE_KERN_PROC_PATHNAME # include #endif @@ -44,94 +40,97 @@ # include #endif -/* Note: Functions in this file must not have bool parameters. When - PERL_BOOL_AS_CHAR is #defined, mach-o/dyld.h overrides it in this file - by #including stdbool.h, so the function parameters here would conflict - with those in proto.h. -*/ - void Perl_set_caret_X(pTHX) { GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */ - if (tmpgv) { - SV *const caret_x = GvSV(tmpgv); + SV *const caret_x = GvSV(tmpgv); #if defined(OS2) - sv_setpv(caret_x, os2_execname(aTHX)); + sv_setpv(caret_x, os2_execname(aTHX)); + return; +#elif defined(WIN32) + char *ansi; + WCHAR widename[MAX_PATH]; + GetModuleFileNameW(NULL, widename, sizeof(widename)/sizeof(WCHAR)); + ansi = win32_ansipath(widename); + sv_setpv(caret_x, ansi); + win32_free(ansi); + return; #else -# ifdef USE_KERN_PROC_PATHNAME - size_t size = 0; - int mib[4]; - mib[0] = CTL_KERN; - mib[1] = KERN_PROC; - mib[2] = KERN_PROC_PATHNAME; - mib[3] = -1; - - if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0 - && size > 0 && size < MAXPATHLEN * MAXPATHLEN) { - sv_grow(caret_x, size); - - if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0 - && size > 2) { - SvPOK_only(caret_x); - SvCUR_set(caret_x, size - 1); - SvTAINT(caret_x); - return; - } + /* We can try a platform-specific one if possible; if it fails, or we + * aren't running on a suitable platform, we'll fall back to argv[0]. */ +# ifdef USE_KERN_PROC_PATHNAME + size_t size = 0; + int mib[4]; + mib[0] = CTL_KERN; + mib[1] = KERN_PROC; + mib[2] = KERN_PROC_PATHNAME; + mib[3] = -1; + + if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0 + && inRANGE(size, 1, -1 + MAXPATHLEN * MAXPATHLEN)) { + sv_grow(caret_x, size); + + if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0 + && size > 2) { + SvPOK_only(caret_x); + SvCUR_set(caret_x, size - 1); + SvTAINT(caret_x); + return; } -# elif defined(USE_NSGETEXECUTABLEPATH) - char buf[1]; - uint32_t size = sizeof(buf); - - _NSGetExecutablePath(buf, &size); - if (size < MAXPATHLEN * MAXPATHLEN) { - sv_grow(caret_x, size); - if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) { - char *const tidied = realpath(SvPVX(caret_x), NULL); - if (tidied) { - sv_setpv(caret_x, tidied); - free(tidied); - } else { - SvPOK_only(caret_x); - SvCUR_set(caret_x, size); - } - return; + } +# elif defined(USE_NSGETEXECUTABLEPATH) + char buf[1]; + uint32_t size = sizeof(buf); + + _NSGetExecutablePath(buf, &size); + if (size < MAXPATHLEN * MAXPATHLEN) { + sv_grow(caret_x, size); + if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) { + char *const tidied = realpath(SvPVX(caret_x), NULL); + if (tidied) { + sv_setpv(caret_x, tidied); + free(tidied); + } else { + SvPOK_only(caret_x); + SvCUR_set(caret_x, size); } + return; } -# elif defined(HAS_PROCSELFEXE) - char buf[MAXPATHLEN]; - SSize_t len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1); - /* NOTE: if the length returned by readlink() is sizeof(buf) - 1, - * it is impossible to know whether the result was truncated. */ - - if (len != -1) { - buf[len] = '\0'; - } + } +# elif defined(HAS_PROCSELFEXE) + char buf[MAXPATHLEN]; + SSize_t len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1); + /* NOTE: if the length returned by readlink() is sizeof(buf) - 1, + * it is impossible to know whether the result was truncated. */ + + if (len != -1) { + buf[len] = '\0'; + } - /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe) - includes a spurious NUL which will cause $^X to fail in system - or backticks (this will prevent extensions from being built and - many tests from working). readlink is not meant to add a NUL. - Normal readlink works fine. - */ - if (len > 0 && buf[len-1] == '\0') { - len--; - } + /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe) + includes a spurious NUL which will cause $^X to fail in system + or backticks (this will prevent extensions from being built and + many tests from working). readlink is not meant to add a NUL. + Normal readlink works fine. + */ + if (len > 0 && buf[len-1] == '\0') { + len--; + } - /* FreeBSD's implementation is acknowledged to be imperfect, sometimes - returning the text "unknown" from the readlink rather than the path - to the executable (or returning an error from the readlink). Any - valid path has a '/' in it somewhere, so use that to validate the - result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703 - */ - if (len > 0 && memchr(buf, '/', len)) { - sv_setpvn(caret_x, buf, len); - return; - } -# endif - /* Fallback to this: */ - sv_setpv(caret_x, PL_origargv[0]); -#endif + /* FreeBSD's implementation is acknowledged to be imperfect, sometimes + returning the text "unknown" from the readlink rather than the path + to the executable (or returning an error from the readlink). Any + valid path has a '/' in it somewhere, so use that to validate the + result. See https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=35703 + */ + if (len > 0 && memchr(buf, '/', len)) { + sv_setpvn(caret_x, buf, len); + return; } +# endif + /* Fallback to this: */ + sv_setpv(caret_x, PL_origargv[0]); +#endif } /*