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 /* Note: Functions in this file must not have bool parameters.  When
  42    PERL_BOOL_AS_CHAR is #defined, mach-o/dyld.h overrides it in this file
  43    by #including stdbool.h, so the function parameters here would conflict
  44    with those in proto.h.
  45 */
  46
  47 void
  48 Perl_set_caret_X(pTHX) {
  49     dVAR;
  50     GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
  51     if (tmpgv) {
  52         SV *const caret_x = GvSV(tmpgv);
  53 #if defined(OS2)
  54         sv_setpv(caret_x, os2_execname(aTHX));
  55 #else
  56 #  ifdef USE_KERN_PROC_PATHNAME
  57         size_t size = 0;
  58         int mib[4];
  59         mib[0] = CTL_KERN;
  60         mib[1] = KERN_PROC;
  61         mib[2] = KERN_PROC_PATHNAME;
  62         mib[3] = -1;
  63
  64         if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0
  65             && size > 0 && size < MAXPATHLEN * MAXPATHLEN) {
  66             sv_grow(caret_x, size);
  67
  68             if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0
  69                 && size > 2) {
  70                 SvPOK_only(caret_x);
  71                 SvCUR_set(caret_x, size - 1);
  72                 SvTAINT(caret_x);
  73                 return;
  74             }
  75         }
  76 #  elif defined(USE_NSGETEXECUTABLEPATH)
  77         char buf[1];
  78         uint32_t size = sizeof(buf);
  79
  80         _NSGetExecutablePath(buf, &size);
  81         if (size < MAXPATHLEN * MAXPATHLEN) {
  82             sv_grow(caret_x, size);
  83             if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) {
  84                 char *const tidied = realpath(SvPVX(caret_x), NULL);
  85                 if (tidied) {
  86                     sv_setpv(caret_x, tidied);
  87                     free(tidied);
  88                 } else {
  89                     SvPOK_only(caret_x);
  90                     SvCUR_set(caret_x, size);
  91                 }
  92                 return;
  93             }
  94         }
  95 #  elif defined(HAS_PROCSELFEXE)
  96         char buf[MAXPATHLEN];
  97         int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
  98
  99         /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
 100            includes a spurious NUL which will cause $^X to fail in system
 101            or backticks (this will prevent extensions from being built and
 102            many tests from working). readlink is not meant to add a NUL.
 103            Normal readlink works fine.
 104         */
 105         if (len > 0 && buf[len-1] == '\0') {
 106             len--;
 107         }
 108
 109         /* FreeBSD's implementation is acknowledged to be imperfect, sometimes
 110            returning the text "unknown" from the readlink rather than the path
 111            to the executable (or returning an error from the readlink). Any
 112            valid path has a '/' in it somewhere, so use that to validate the
 113            result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703
 114         */
 115         if (len > 0 && memchr(buf, '/', len)) {
 116             sv_setpvn(caret_x, buf, len);
 117             return;
 118         }
 119 #  endif
 120         /* Fallback to this:  */
 121         sv_setpv(caret_x, PL_origargv[0]);
 122 #endif
 123     }
 124 }
 125
 126 /*
 127  * Local variables:
 128  * c-indentation-style: bsd
 129  * c-basic-offset: 4
 130  * indent-tabs-mode: nil
 131  * End:
 132  *
 133  * ex: set ts=8 sts=4 sw=4 et:
 134  */