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