This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move the function to set $^X to its own file
[perl5.git] / 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  */