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