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  *     TODO: Quote
  13  */
  14
  15 /* This file contains a single function, set_caret_X, to set the $^X
  16  * variable.  It's only used in perl.c, but has various OS dependencies,
  17  * so its been moved to its own file to reduce header pollution.
  18  * See RT 120314 for details.
  19  */
  20
  21 #if defined(PERL_IS_MINIPERL) && !defined(USE_SITECUSTOMIZE)
  22 #  define USE_SITECUSTOMIZE
  23 #endif
  24
  25 #include "EXTERN.h"
  26 #include "perl.h"
  27 #include "XSUB.h"
  28
  29 #ifdef NETWARE
  30 #include "nwutil.h"
  31 #endif
  32
  33 #ifdef USE_KERN_PROC_PATHNAME
  34 #  include <sys/sysctl.h>
  35 #endif
  36
  37 #ifdef USE_NSGETEXECUTABLEPATH
  38 # include <mach-o/dyld.h>
  39 #endif
  40
  41 void
  42 Perl_set_caret_X(pTHX) {
  43     dVAR;
  44     GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
  45     if (tmpgv) {
  46         SV *const caret_x = GvSV(tmpgv);
  47 #if defined(OS2)
  48         sv_setpv(caret_x, os2_execname(aTHX));
  49 #else
  50 #  ifdef USE_KERN_PROC_PATHNAME
  51         size_t size = 0;
  52         int mib[4];
  53         mib[0] = CTL_KERN;
  54         mib[1] = KERN_PROC;
  55         mib[2] = KERN_PROC_PATHNAME;
  56         mib[3] = -1;
  57
  58         if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0
  59             && size > 0 && size < MAXPATHLEN * MAXPATHLEN) {
  60             sv_grow(caret_x, size);
  61
  62             if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0
  63                 && size > 2) {
  64                 SvPOK_only(caret_x);
  65                 SvCUR_set(caret_x, size - 1);
  66                 SvTAINT(caret_x);
  67                 return;
  68             }
  69         }
  70 #  elif defined(USE_NSGETEXECUTABLEPATH)
  71         char buf[1];
  72         uint32_t size = sizeof(buf);
  73
  74         _NSGetExecutablePath(buf, &size);
  75         if (size < MAXPATHLEN * MAXPATHLEN) {
  76             sv_grow(caret_x, size);
  77             if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) {
  78                 char *const tidied = realpath(SvPVX(caret_x), NULL);
  79                 if (tidied) {
  80                     sv_setpv(caret_x, tidied);
  81                     free(tidied);
  82                 } else {
  83                     SvPOK_only(caret_x);
  84                     SvCUR_set(caret_x, size);
  85                 }
  86                 return;
  87             }
  88         }
  89 #  elif defined(HAS_PROCSELFEXE)
  90         char buf[MAXPATHLEN];
  91         int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
  92
  93         /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
  94            includes a spurious NUL which will cause $^X to fail in system
  95            or backticks (this will prevent extensions from being built and
  96            many tests from working). readlink is not meant to add a NUL.
  97            Normal readlink works fine.
  98         */
  99         if (len > 0 && buf[len-1] == '\0') {
 100             len--;
 101         }
 102
 103         /* FreeBSD's implementation is acknowledged to be imperfect, sometimes
 104            returning the text "unknown" from the readlink rather than the path
 105            to the executable (or returning an error from the readlink). Any
 106            valid path has a '/' in it somewhere, so use that to validate the
 107            result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703
 108         */
 109         if (len > 0 && memchr(buf, '/', len)) {
 110             sv_setpvn(caret_x, buf, len);
 111             return;
 112         }
 113 #  endif
 114         /* Fallback to this:  */
 115         sv_setpv(caret_x, PL_origargv[0]);
 116 #endif
 117     }
 118 }
 119
 120 /*
 121  * Local variables:
 122  * c-indentation-style: bsd
 123  * c-basic-offset: 4
 124  * indent-tabs-mode: nil
 125  * End:
 126  *
 127  * ex: set ts=8 sts=4 sw=4 et:
 128  */