develooper Front page | perl.perl5.porters | Postings from September 2011

probes to convert $^X to an absolute path

Thread Next
From:
Nicholas Clark
Date:
September 22, 2011 12:32
Subject:
probes to convert $^X to an absolute path
Message ID:
20110922193200.GG2604@plum.flirble.org
I wasn't previously aware of this, but it turns out that it's possible to
find out the absolute path of the running executable on OS X using
_NSGetExecutablePath() and realpath(), and on FreeBSD via sysctl().

[The latter is useful, as it doesn't need /proc mounted. I believe that
/proc in FreeBSD has been deprecated, but I've not done the homework to
confirm this]

I have the code to do this in smoke-me/abs-caret-X

There, perl.c's S_set_caret_X() starts like this:

STATIC void
S_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);
	int result;

	_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);

...


This works nicely. (And intentionally USE_KERN_PROC_PATHNAME takes preference
over HAS_PROCSELFEXEC, as the former works on all FreeBSDs that I have access
to, whereas the latter does not).

However, I'm not *sure* if I was overly paranoid with the probing.
I'm suspicious that the above code

a) relies rather heavily on particular features of the given interfaces
   [that sysctl() with a NULL pointer returns the needed size without error]
   [that realpath() with a NULL pointer calls malloc()]
b) is worse than nothing if it turns out not to work
   [in that it's better to have $^X set to argv[0] than be set to something
    corrupted by a bad call above]

hence I thought it safest to go for very careful probing, by running
pretty much the code we intend to use in perl.c, and sanity checking
everything possible about it. eg:


$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


[And similarly for the _NSGetExecutablePath() and realpath() combination]

Does this make sense?

[I know that there's an open ticket for $^X not being absolute under OS X,
but I've not yet gone hunting for it.]

The HAS_PROCSELFEXE approach can be used on Linux, Solaris 10 and 11, and
NetBSD. _NSGetExecutablePath() with realpath() gets us OS X [and possibly
NeXT?], sysctl() FreeBSD. I think that's as good as it gets. But I'd love
to be proven wrong.


Nicholas Clark

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About