From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 21 Sep 2011 12:32:58 +0000 (+0200)
Subject: Where available, use sysctl() with KERN_PROC_PATHNAME to make $^X absolute.
X-Git-Tag: v5.15.4~240^2~4
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/2982a345b7a1edb63720282eef0fba5c61d0e6b5

Where available, use sysctl() with KERN_PROC_PATHNAME to make $^X absolute.

In Configure, check whether sysctl() and KERN_PROC_PATHNAME can be used
to find the absolute pathname of the executable. If so, set
usekernprocpathname in config.sh and USE_KERN_PROC_PATHNAME in config.h.
If this is set, then use this approach in S_set_caret_X() to canonicalise
$^X as an absolute path. This approach works on (at least) FreeBSD, and
doesn't rely on the /proc filesystem existing, or /proc/curproc/file being
present.
---

diff --git a/Configure b/Configure
index 42a0a19..691bd81 100755
--- a/Configure
+++ b/Configure
@@ -1234,6 +1234,7 @@ usesocks=''
 d_oldpthreads=''
 use5005threads=''
 useithreads=''
+usekernprocpathname=''
 usereentrant=''
 usethreads=''
 incpath=''
@@ -19346,6 +19347,121 @@ $rm_try
 set ebcdic
 eval $setvar
 
+: Determine if we can use sysctl with KERN_PROC_PATHNAME to find executing program
+echo " "
+echo "Determining whether we can use sysctl with KERN_PROC_PATHNAME to find executing program..." >&4
+$cat >try.c <<'EOM'
+/* Intentionally a long probe as I'd like to sanity check that the exact
+   approach is going to work, as thinking it will work, but only having it
+   part working at runtime is worse than not having it.  */
+
+#include <sys/types.h>
+#include <sys/sysctl.h>
+#include <sys/param.h>
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+#include <unistd.h>
+
+int
+main(int argc, char **argv) {
+    char *buffer;
+    char *argv_leaf = strrchr(argv[0], '/');
+    char *buffer_leaf;
+    size_t size = 0;
+    int mib[4];
+
+    mib[0] = CTL_KERN;
+    mib[1] = KERN_PROC;
+    mib[2] = KERN_PROC_PATHNAME;
+    mib[3] = -1;
+
+    if (!argv_leaf) {
+	fprintf(stderr, "Can't locate / in '%s'\n", argv[0]);
+	return 1;
+    }
+
+    if (sysctl(mib, 4, NULL, &size, NULL, 0)) {
+	perror("sysctl");
+	return 2;
+    }
+
+    if (size < strlen(argv_leaf) + 1) {
+	fprintf(stderr, "size %lu is too short for a path\n",
+		(unsigned long) size);
+	return 3;
+    }
+
+    if (size > MAXPATHLEN * MAXPATHLEN) {
+	fprintf(stderr, "size %lu is too long for a path\n",
+		(unsigned long) size);
+	return 4;
+    }
+
+    buffer = malloc(size);
+    if (!buffer) {
+	perror("malloc");
+	return 5;
+    }
+
+    if (sysctl(mib, 4, buffer, &size, NULL, 0)) {
+	perror("sysctl");
+	return 6;
+    }
+
+    if (strlen(buffer) + 1 != size) {
+	fprintf(stderr, "size != strlen(buffer) + 1 (%lu != %lu)\n",
+		(unsigned long)size, (unsigned long)strlen(buffer) + 1);
+        return 7;
+    }
+
+
+    if (*buffer != '/') {
+	fprintf(stderr, "Not an absolute path: '%s'\n", buffer);
+	return 8;
+    }
+
+    if (strstr(buffer, "/./")) {
+	fprintf(stderr, "Contains /./: '%s'\n", buffer);
+	return 9;
+    }
+
+    if (strstr(buffer, "/../")) {
+	fprintf(stderr, "Contains /../: '%s'\n", buffer);
+	return 10;
+    }
+
+    buffer_leaf = strrchr(buffer, '/');
+    if (strcmp(buffer_leaf, argv_leaf) != 0) {
+	fprintf(stderr, "Leafnames differ: '%s' vs '%s'\n", argv[0], buffer);
+	return 11;
+    }
+
+    free(buffer);
+
+    return 0;
+}
+EOM
+
+val=$undef
+set try
+if eval $compile_ok; then
+	if $run ./try; then
+		echo "You can use sysctl with KERN_PROC_PATHNAME to find the executing program." >&4
+		val="$define"
+	else
+		echo "Nope, sysctl with KERN_PROC_PATHNAME doesn't work here." >&4
+		val="$undef"
+	fi
+else
+	echo "I'm unable to compile the test program." >&4
+	echo "I'll assume no sysctl with KERN_PROC_PATHNAME here." >&4
+	val="$undef"
+fi
+$rm_try
+set usekernprocpathname
+eval $setvar
+
 : Check how to flush
 echo " "
 $cat >&4 <<EOM
@@ -23434,6 +23550,7 @@ usedl='$usedl'
 usedtrace='$usedtrace'
 usefaststdio='$usefaststdio'
 useithreads='$useithreads'
+usekernprocpathname='$usekernprocpathname'
 uselargefiles='$uselargefiles'
 uselongdouble='$uselongdouble'
 usemallocwrap='$usemallocwrap'
diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
index 928efa7..78e8829 100644
--- a/Cross/config.sh-arm-linux
+++ b/Cross/config.sh-arm-linux
@@ -1024,6 +1024,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='define'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='define'
 uselongdouble='undef'
 usemallocwrap='define'
diff --git a/NetWare/config.wc b/NetWare/config.wc
index 419aa83..72118f4 100644
--- a/NetWare/config.wc
+++ b/NetWare/config.wc
@@ -987,6 +987,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='define'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='undef'
diff --git a/Porting/Glossary b/Porting/Glossary
index ceed6a5..1ed4ef8 100644
--- a/Porting/Glossary
+++ b/Porting/Glossary
@@ -5015,6 +5015,11 @@ useithreads (usethreads.U):
 	and indicates that Perl should be built to use the interpreter-based
 	threading implementation.
 
+usekernprocpathname (usekernprocpathname.U)
+	This variable, indicates that we can use sysctl with
+	KERN_PROC_PATHNAME to get a full path for the executable, and hence
+	convert $^X to an absolute path.
+
 uselargefiles (uselfs.U):
 	This variable conditionally defines the USE_LARGE_FILES symbol,
 	and indicates that large file interfaces should be used when
diff --git a/Porting/config.sh b/Porting/config.sh
index 2c7c2aa..9244924 100644
--- a/Porting/config.sh
+++ b/Porting/config.sh
@@ -1046,6 +1046,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='define'
 uselongdouble='undef'
 usemallocwrap='define'
diff --git a/config_h.SH b/config_h.SH
index 43743b6..9281cdd 100755
--- a/config_h.SH
+++ b/config_h.SH
@@ -2689,6 +2689,13 @@ sed <<!GROK!THIS! >$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
  */
 #$ebcdic	EBCDIC 		/**/
 
+/* USE_KERN_PROC_PATHNAME:
+ *	This symbol, if defined, indicates that we can use sysctl with
+ *	KERN_PROC_PATHNAME to get a full path for the executable, and hence
+ * 	convert $^X to an absolute path.
+ */
+#$usekernprocpathname USE_KERN_PROC_PATHNAME		/**/
+
 /* Fpos_t:
  *	This symbol holds the type used to declare file positions in libc.
  *	It can be fpos_t, long, uint, etc... It may be necessary to include
diff --git a/configure.com b/configure.com
index 14a73f1..a58f77e 100644
--- a/configure.com
+++ b/configure.com
@@ -6717,6 +6717,7 @@ $ WC "usefaststdio='" + usefaststdio + "'"
 $ WC "useieee='" + useieee + "'"                    ! VMS-specific
 $ WC "useithreads='" + useithreads + "'"
 $ WC "usekernelthreads='" + usekernelthreads + "'"	! VMS-specific
+$ WC "usekernprocpathname='undef'"
 $ WC "uselargefiles='" + uselargefiles + "'"
 $ WC "uselongdouble='" + uselongdouble + "'"
 $ WC "usemorebits='" + usemorebits + "'"
diff --git a/epoc/config.sh b/epoc/config.sh
index 87dce8a..b71d62e 100644
--- a/epoc/config.sh
+++ b/epoc/config.sh
@@ -983,6 +983,7 @@ usedl='undef'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='undef'
diff --git a/perl.c b/perl.c
index 0b3d9c6..5d2159d 100644
--- a/perl.c
+++ b/perl.c
@@ -38,6 +38,10 @@
 #include "nwutil.h"	
 #endif
 
+#ifdef USE_KERN_PROC_PATHNAME
+#  include <sys/sysctl.h>
+#endif
+
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
 #  ifdef I_SYSUIO
 #    include <sys/uio.h>
@@ -1390,7 +1394,27 @@ S_set_caret_X(pTHX) {
 #if defined(OS2)
 	sv_setpv(caret_x, os2_execname(aTHX));
 #else
-#  ifdef HAS_PROCSELFEXE
+#  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(HAS_PROCSELFEXE)
 	char buf[MAXPATHLEN];
 	int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
 
diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
index 2f7e938..b87320d 100644
--- a/plan9/config_sh.sample
+++ b/plan9/config_sh.sample
@@ -995,6 +995,7 @@ usedl='undef'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='define'
 uselongdouble='undef'
 usemallocwrap='undef'
diff --git a/symbian/config.sh b/symbian/config.sh
index 6a27ff5..c72d8c3 100644
--- a/symbian/config.sh
+++ b/symbian/config.sh
@@ -810,6 +810,7 @@ usedl='undef'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='define'
diff --git a/t/op/magic.t b/t/op/magic.t
index dd6d28e..5569154 100644
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -230,10 +230,11 @@ $$ = $pid; # Tests below use $$
 
 # $^X and $0
 {
+    my $is_abs = $Config{d_procselfexe} || $Config{usekernprocpathname};
     if ($^O eq 'qnx') {
 	chomp($wd = `/usr/bin/fullpath -t`);
     }
-    elsif($Is_Cygwin || $Config{'d_procselfexe'}) {
+    elsif($Is_Cygwin || $is_abs) {
        # Cygwin turns the symlink into the real file
        chomp($wd = `pwd`);
        $wd =~ s#/t$##;
@@ -248,7 +249,7 @@ $$ = $pid; # Tests below use $$
     else {
 	$wd = '.';
     }
-    my $perl = $Is_VMS || $Config{d_procselfexe} ? $^X : "$wd/perl";
+    my $perl = $Is_VMS || $is_abs ? $^X : "$wd/perl";
     my $headmaybe = '';
     my $middlemaybe = '';
     my $tailmaybe = '';
diff --git a/uconfig.h b/uconfig.h
index 1013423..c5f19f7 100644
--- a/uconfig.h
+++ b/uconfig.h
@@ -2656,6 +2656,13 @@
  */
 /*#define	EBCDIC 		/ **/
 
+/* USE_KERN_PROC_PATHNAME:
+ *	This symbol, if defined, indicates that we can use sysctl with
+ *	KERN_PROC_PATHNAME to get a full path for the executable, and hence
+ * 	convert $^X to an absolute path.
+ */
+/*#define USE_KERN_PROC_PATHNAME		/ **/
+
 /* Fpos_t:
  *	This symbol holds the type used to declare file positions in libc.
  *	It can be fpos_t, long, uint, etc... It may be necessary to include
@@ -4704,6 +4711,6 @@
 #endif
 
 /* Generated from:
- * 5c3a0864433ad4da7f3248b108cf8e17c19bd4d71799cd56b6c2a73bb647561a config_h.SH
- * e5d6d7ffdf6717946996c0807aa7a247b46adf41f2d98c62cdd7c1bb8ffe19f2 uconfig.sh
+ * e6513dfa5f1449ab9266aee521d6d5908873d1dc68bf4f049316ebc4921732e1 config_h.SH
+ * e940950d07a2be0354d6ae7e4316ec8465ed581607bbb958d8bfda024b9941fe uconfig.sh
  * ex: set ro: */
diff --git a/uconfig.sh b/uconfig.sh
index 74a1b91..ee84d35 100644
--- a/uconfig.sh
+++ b/uconfig.sh
@@ -777,6 +777,7 @@ usedl='undef'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='undef'
diff --git a/uconfig64.sh b/uconfig64.sh
index 784d0f0..e3346e7 100644
--- a/uconfig64.sh
+++ b/uconfig64.sh
@@ -778,6 +778,7 @@ usedl='undef'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='undef'
diff --git a/win32/config.ce b/win32/config.ce
index 1f58933..8028928 100644
--- a/win32/config.ce
+++ b/win32/config.ce
@@ -977,6 +977,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='~USE_ITHREADS~'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='define'
diff --git a/win32/config.gc b/win32/config.gc
index 5741584..ff6eb6f 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -1020,6 +1020,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='define'
diff --git a/win32/config.gc64 b/win32/config.gc64
index bc6210e..e46b55a 100644
--- a/win32/config.gc64
+++ b/win32/config.gc64
@@ -1021,6 +1021,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='define'
diff --git a/win32/config.gc64nox b/win32/config.gc64nox
index fc407ad..82226e9 100644
--- a/win32/config.gc64nox
+++ b/win32/config.gc64nox
@@ -1021,6 +1021,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='define'
diff --git a/win32/config.vc b/win32/config.vc
index 3095791..f578057 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -1020,6 +1020,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='define'
diff --git a/win32/config.vc64 b/win32/config.vc64
index 1396a0a..86b4040 100644
--- a/win32/config.vc64
+++ b/win32/config.vc64
@@ -1020,6 +1020,7 @@ usedl='define'
 usedtrace='undef'
 usefaststdio='undef'
 useithreads='undef'
+usekernprocpathname='undef'
 uselargefiles='undef'
 uselongdouble='undef'
 usemallocwrap='define'