This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
caretx.c: Add bool warning comment
[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 /* 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  */