caretx.c

   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  */