1 /* caretx.c 2 * 3 * Copyright (C) 2013 4 * by Larry Wall and others 5 * 6 * You may distribute under the terms of either the GNU General Public 7 * License or the Artistic License, as specified in the README file. 8 * 9 */ 10 11 /* 12 * 'I do not know clearly,' said Frodo; 'but the path climbs, I think, 13 * up into the mountains on the northern side of that vale where the old 14 * city stands. It goes up to a high cleft and so down to -- that which 15 * is beyond.' 16 * 'Do you know the name of that high pass?' said Faramir. 17 * 18 * [p.691 of _The Lord of the Rings_, IV/xi: "The Forbidden Pool"] 19 */ 20 21 /* This file contains a single function, set_caret_X, to set the $^X 22 * variable. It's only used in perl.c, but has various OS dependencies, 23 * so its been moved to its own file to reduce header pollution. 24 * See RT 120314 for details. 25 */ 26 27 #if defined(PERL_IS_MINIPERL) && !defined(USE_SITECUSTOMIZE) 28 # define USE_SITECUSTOMIZE 29 #endif 30 31 #include "EXTERN.h" 32 #include "perl.h" 33 #include "XSUB.h" 34 35 #ifdef USE_KERN_PROC_PATHNAME 36 # include <sys/sysctl.h> 37 #endif 38 39 #ifdef USE_NSGETEXECUTABLEPATH 40 # include <mach-o/dyld.h> 41 #endif 42 43 void 44 Perl_set_caret_X(pTHX) { 45 GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */ 46 SV *const caret_x = GvSV(tmpgv); 47 #if defined(OS2) 48 sv_setpv(caret_x, os2_execname(aTHX)); 49 return; 50 #elif defined(WIN32) 51 char *ansi; 52 WCHAR widename[MAX_PATH]; 53 GetModuleFileNameW(NULL, widename, sizeof(widename)/sizeof(WCHAR)); 54 ansi = win32_ansipath(widename); 55 sv_setpv(caret_x, ansi); 56 win32_free(ansi); 57 return; 58 #else 59 /* We can try a platform-specific one if possible; if it fails, or we 60 * aren't running on a suitable platform, we'll fall back to argv[0]. */ 61 # ifdef USE_KERN_PROC_PATHNAME 62 size_t size = 0; 63 int mib[4]; 64 mib[0] = CTL_KERN; 65 mib[1] = KERN_PROC; 66 mib[2] = KERN_PROC_PATHNAME; 67 mib[3] = -1; 68 69 if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0 70 && inRANGE(size, 1, -1 + MAXPATHLEN * MAXPATHLEN)) { 71 sv_grow(caret_x, size); 72 73 if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0 74 && size > 2) { 75 SvPOK_only(caret_x); 76 SvCUR_set(caret_x, size - 1); 77 SvTAINT(caret_x); 78 return; 79 } 80 } 81 # elif defined(USE_NSGETEXECUTABLEPATH) 82 char buf[1]; 83 uint32_t size = sizeof(buf); 84 85 _NSGetExecutablePath(buf, &size); 86 if (size < MAXPATHLEN * MAXPATHLEN) { 87 sv_grow(caret_x, size); 88 if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) { 89 char *const tidied = realpath(SvPVX(caret_x), NULL); 90 if (tidied) { 91 sv_setpv(caret_x, tidied); 92 free(tidied); 93 } else { 94 SvPOK_only(caret_x); 95 SvCUR_set(caret_x, size); 96 } 97 return; 98 } 99 } 100 # elif defined(HAS_PROCSELFEXE) 101 char buf[MAXPATHLEN]; 102 SSize_t len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1); 103 /* NOTE: if the length returned by readlink() is sizeof(buf) - 1, 104 * it is impossible to know whether the result was truncated. */ 105 106 if (len != -1) { 107 buf[len] = '\0'; 108 } 109 110 /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe) 111 includes a spurious NUL which will cause $^X to fail in system 112 or backticks (this will prevent extensions from being built and 113 many tests from working). readlink is not meant to add a NUL. 114 Normal readlink works fine. 115 */ 116 if (len > 0 && buf[len-1] == '\0') { 117 len--; 118 } 119 120 /* FreeBSD's implementation is acknowledged to be imperfect, sometimes 121 returning the text "unknown" from the readlink rather than the path 122 to the executable (or returning an error from the readlink). Any 123 valid path has a '/' in it somewhere, so use that to validate the 124 result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703 125 */ 126 if (len > 0 && memchr(buf, '/', len)) { 127 sv_setpvn(caret_x, buf, len); 128 return; 129 } 130 # endif 131 /* Fallback to this: */ 132 sv_setpv(caret_x, PL_origargv[0]); 133 #endif 134 } 135 136 /* 137 * ex: set ts=8 sts=4 sw=4 et: 138 */ 139