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