1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
/* caretx.c
*
* Copyright (C) 2013
* by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* TODO: Quote
*/
/* This file contains a single function, set_caret_X, to set the $^X
* variable. It's only used in perl.c, but has various OS dependencies,
* so its been moved to its own file to reduce header pollution.
* See RT 120314 for details.
*/
#if defined(PERL_IS_MINIPERL) && !defined(USE_SITECUSTOMIZE)
# define USE_SITECUSTOMIZE
#endif
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#ifdef NETWARE
#include "nwutil.h"
#endif
#ifdef USE_KERN_PROC_PATHNAME
# include <sys/sysctl.h>
#endif
#ifdef USE_NSGETEXECUTABLEPATH
# include <mach-o/dyld.h>
#endif
void
Perl_set_caret_X(pTHX) {
dVAR;
GV* tmpgv = gv_fetchpvs("\030", GV_ADD|GV_NOTQUAL, SVt_PV); /* $^X */
if (tmpgv) {
SV *const caret_x = GvSV(tmpgv);
#if defined(OS2)
sv_setpv(caret_x, os2_execname(aTHX));
#else
# ifdef USE_KERN_PROC_PATHNAME
size_t size = 0;
int mib[4];
mib[0] = CTL_KERN;
mib[1] = KERN_PROC;
mib[2] = KERN_PROC_PATHNAME;
mib[3] = -1;
if (sysctl(mib, 4, NULL, &size, NULL, 0) == 0
&& size > 0 && size < MAXPATHLEN * MAXPATHLEN) {
sv_grow(caret_x, size);
if (sysctl(mib, 4, SvPVX(caret_x), &size, NULL, 0) == 0
&& size > 2) {
SvPOK_only(caret_x);
SvCUR_set(caret_x, size - 1);
SvTAINT(caret_x);
return;
}
}
# elif defined(USE_NSGETEXECUTABLEPATH)
char buf[1];
uint32_t size = sizeof(buf);
_NSGetExecutablePath(buf, &size);
if (size < MAXPATHLEN * MAXPATHLEN) {
sv_grow(caret_x, size);
if (_NSGetExecutablePath(SvPVX(caret_x), &size) == 0) {
char *const tidied = realpath(SvPVX(caret_x), NULL);
if (tidied) {
sv_setpv(caret_x, tidied);
free(tidied);
} else {
SvPOK_only(caret_x);
SvCUR_set(caret_x, size);
}
return;
}
}
# elif defined(HAS_PROCSELFEXE)
char buf[MAXPATHLEN];
int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
/* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
includes a spurious NUL which will cause $^X to fail in system
or backticks (this will prevent extensions from being built and
many tests from working). readlink is not meant to add a NUL.
Normal readlink works fine.
*/
if (len > 0 && buf[len-1] == '\0') {
len--;
}
/* FreeBSD's implementation is acknowledged to be imperfect, sometimes
returning the text "unknown" from the readlink rather than the path
to the executable (or returning an error from the readlink). Any
valid path has a '/' in it somewhere, so use that to validate the
result. See http://www.freebsd.org/cgi/query-pr.cgi?pr=35703
*/
if (len > 0 && memchr(buf, '/', len)) {
sv_setpvn(caret_x, buf, len);
return;
}
# endif
/* Fallback to this: */
sv_setpv(caret_x, PL_origargv[0]);
#endif
}
}
/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
* indent-tabs-mode: nil
* End:
*
* ex: set ts=8 sts=4 sw=4 et:
*/
|
