$^X is not full path when perl is searched in PATH on NetBSD and OpenBSD

[leleliu008]

-Duserelocatableinc=true

Configure option is passed.

relavant code : https://github.com/Perl/perl5/blob/blead/caretx.c#L61C9-L61C31

That code works on FreeBSD and DragonFlyBSD, but does not work on NetBSD and OpenBSD

NetBSD use this:

const int mib[] = { CTL_KERN, KERN_PROC_ARGS, -1, KERN_PROC_PATHNAME };

It is silightly different from FreeBSD

OpenBSD has no such API to get executable filepath. Developers should parse argv[0].

[jkeenan]

-Duserelocatableinc=true

Configure option is passed.

relavant code : https://github.com/Perl/perl5/blob/blead/caretx.c#L61C9-L61C31

That code works on FreeBSD and DragonFlyBSD, but does not work on NetBSD and OpenBSD

NetBSD use this:

const int mib[] = { CTL_KERN, KERN_PROC_ARGS, -1, KERN_PROC_PATHNAME };

It is silightly different from FreeBSD

OpenBSD has no such API to get executable filepath. Developers should parse argv[0].

Can you provide links to the relevant source code fragments in the 4 *BSDs you mention? Thanks.

[jkeenan]

Note: perldoc perlvar already contains this cautionary language:

Depending on the host operating system, the value of $^X may be
a relative or absolute pathname of the perl program file, or may
be the string used to invoke perl but not the pathname of the
perl program file.

[leleliu008]

Can you provide links to the relevant source code fragments in the 4 *BSDs you mention? Thanks.

I'm not sure if I accurately understood what you said.

The following code is a example to determine a exe filepath:

#include <errno.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

#include <unistd.h>
#include <sys/stat.h>

// https://developer.apple.com/library/archive/documentation/System/Conceptual/ManPages_iPhoneOS/man3/dyld.3.html
#if defined (__APPLE__)
#include <mach-o/dyld.h>
#include <sys/syslimits.h>
#elif defined (__linux__) && defined (HAVE_LINUX_LIMITS_H)
#include <linux/limits.h>
#else
#include <limits.h>
#endif

#if defined (__NetBSD__) || defined (__OpenBSD__) || defined (__FreeBSD__) || defined (__DragonFly__)
#include <sys/types.h>
#include <sys/sysctl.h>
#endif

int selfpath(char buf[PATH_MAX]) {
#if defined (__APPLE__)
    // https://developer.apple.com/library/archive/documentation/System/Conceptual/ManPages_iPhoneOS/man3/dyld.3.html
    uint32_t bufSize = 0U;
    _NSGetExecutablePath(NULL, &bufSize);
    _NSGetExecutablePath(buf,  &bufSize);

    return (bufSize - 1);
#elif defined (__FreeBSD__) || defined (__DragonFly__)
    const int mib[] = { CTL_KERN, KERN_PROC, KERN_PROC_PATHNAME, -1 };

    size_t len = 0U;

    if (sysctl(mib, 4, NULL, &len, NULL, 0) < 0) {
        return -1;
    }

    if (sysctl(mib, 4, buf,  &len, NULL, 0) < 0) {
        return -1;
    }

    return len;
#elif defined (__NetBSD__)
    const int mib[] = { CTL_KERN, KERN_PROC_ARGS, -1, KERN_PROC_PATHNAME };

    size_t len = 0U;

    if (sysctl(mib, 4, NULL, &len, NULL, 0) < 0) {
        return -1;
    }

    if (sysctl(mib, 4, buf,  &len, NULL, 0) < 0) {
        return -1;
    }

    return len;
#elif defined (__OpenBSD__)
    const int mib[4] = { CTL_KERN, KERN_PROC_ARGS, getpid(), KERN_PROC_ARGV };

    size_t size;

    if (sysctl(mib, 4, NULL, &size, NULL, 0) != 0) {
        return -1;
    }

    char** argv = (char**)malloc(size);

    if (argv == NULL) {
        errno = ENOMEM;
        return -1;
    }

    memset(argv, 0, size);

    if (sysctl(mib, 4, argv, &size, NULL, 0) != 0) {
        return -1;
    }

    //////////////////////////////////

    size_t m = 0U;

    int ispath = 0;

    for ( ; argv[0][m] != '\0'; m++) {
        if (argv[0][m] == '/') {
            ispath = 1;
        }
    }

    char argv0[m];

    for (size_t j = 0U; j <= m; j++) {
        argv0[j] = argv[0][j];
    }

    free(argv);

    //////////////////////////////////

    if (ispath == 1) {
        if (realpath(argv0, buf) == NULL) {
            return -1;
        } else {
            return strlen(buf);
        }
    }

    //////////////////////////////////

    const char * p = getenv("PATH");

    if (p == NULL) {
        return -2;
    }

    if (p[0] == '\0') {
        return -3;
    }

    //////////////////////////////////

    struct stat st;

    char pathBuf[PATH_MAX];

    char * q;

    size_t i;
    size_t n;

loop:
    if (p[0] == '\0') {
        return 0;
    }

    if (p[0] == ' ' || p[0] == ':') {
        p++;
        goto loop;
    }

    //////////////////////////////////

    for (i = 0U; ; i++) {
        pathBuf[i] = p[i];

        if (p[i] == '\0') {
            break;
        }

        if (p[i] == ':') {
            pathBuf[i] = '\0';
            break;
        }
    }

    //////////////////////////////////

    if ((stat(pathBuf, &st) == 0) && S_ISDIR(st.st_mode)) {
        q = &pathBuf[i];

        q[0] = '/';

        q++;

        for (size_t j = 0U; ; j++) {
            q[j] = argv0[j];

            if (q[j] == '\0') {
                n = i + j + 1U;
                break;
            }
        }

        if (access(pathBuf, X_OK) == 0) {
            for (size_t j = 0U; j < n; j++) {
                buf[j] = pathBuf[j];
            }

            buf[n] = '\0';

            return n;
        }
    }

    //////////////////////////////////

    p += i;

    if (p[0] == ':') {
        p++;
        goto loop;
    }

    return 0;
#else
    ssize_t n = readlink("/proc/self/exe", buf, PATH_MAX - 1);

    // readlink() does not append a terminating null byte to buf.
    if (n > 0) {
        buf[n] = '\0';
    }

    return n;
#endif
}

[bulk88]

Note: perldoc perlvar already contains this cautionary language:

Depending on the host operating system, the value of $^X may be
a relative or absolute pathname of the perl program file, or may
be the string used to invoke perl but not the pathname of the
perl program file.

That is a legal disclaimer. $^X is hopelessly insecure and unfixable on most OSes if the criteria for being a "stable Perl feature" is for that feature to be penetration testing/CTF resistant.

https://forum.lazarus.freepascal.org/index.php/topic,51692.msg379990.html?PHPSESSID=hjk66gu5occj9jfc8tfnushai2#msg379990

Basically no OS guarantees that once a process starts, that the .elf or .exe or .app disk file used to start that process is un-deleteable, un-moveable, and un-modifiable for the rest of the lifetime of that process.

If that process wants to take extraordinary and extreme measures to ask the kernel to make sure its image file's backing storage is tamper-resistant, sure, it can do that if that OS/kernel/user account perms will allow it. Op-locks, shared access open bits, crypto file signatures, copying the mmap pages into an unreachable anonymous temp tile, etc.

#23351

https://blogs.perl.org/users/todd_rinaldo/2016/11/what-happened-to-dot-in-inc.html

The list goes on and on, for Perl and all other desktop/server SW, being vulnerable to "rename/delete/modify critical files that app needs after that app started" attacks.

https://perldoc.perl.org/perlsec#Cleaning-Up-Your-Path and the rest of that page, explains all the well known race conditions and file system attacks that Perl is vulnerable to and those attacks methods are wontfixes.

The Perl parser is not designed to evaluate untrusted code. If your application requires the evaluation of untrusted code, it should rely on an operating system level sandbox for its security.

https://perldoc.perl.org/perlsecpolicy#Feeding-untrusted-code-to-the-interpreter

Back to this ticket, not being able to launch a 2nd perl process from the 1st perl process, is highly annoying and very broken behavior if someone runs into it by accident so this needs to be fixed if $^X + https://perldoc.perl.org/5.42.0/Cwd can't relaunch perl.

Using fork() and https://metacpan.org/dist/perl/source/lib/Symbol.pm#L144 to relaunch a clean new perl process because /usr/bin/perl the file is now gone from the FS while /usr/bin/perl is still executing is absurd.

From my decades old memories working on Unix shell servers, the getcwd()/CWD/PWD concept has a fatal flaw, because my SSH session starts in the /home/bulk88 dir, if I run cd /, I can never cd back into my /home/bulk88 dir, because I don't have Unix user permission to iterate or do an ls on the /home dir.

The sysadmin blocked all users from reading the /home dir so they can't learn about each others login names. It was security through obscurity since ps and top still show the other active logins on the Unix sever.

Unix/POSIX nowadays is seen as a failure at creating a Multi-User Time Sharing system. Cgroups, VMware, and Docker are not part of Unix. Docker is indistinguishable from root, and perhaps that is making modern Unix SW a little bit "too comfortable" in picking which APIs/solutions to use to solve a task.

Perl's $^X implementation is extremely proprietary.

# endif
    /* Fallback to this:  */
    sv_setpv(caret_x, PL_origargv[0]);
#endif
}

If Configure picked this 1975 era code path as a fallback in caretx.c on any OS, I'm calling that a bug inside the Interp.

Perl's $^X is supposed to ask the kernel "Where on the filing system is the backing storage for the mmap-ed pages that are making me (the PID) run?"

Every single OS has a different way of doing it. Each Unix OS has a different way of doing it.

If Perl doesn't know the magic line of C to use on to get $^X from the NetBSD kernel and OpenBSD kernel, that needs to fixed ASAP.

[bulk88]

Looking at caretx.c, I don't like that it universally ignores and silences the retvals of all the OS specific kernel calls.

# 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; <<<<<<<<<<<<<<<<<<<<<<
        }
///// this should be
///// else { no_perl_die("OSX/iOS _NSGEP() broken"); }
    }
# elif defined(HAS_PROCSELFEXE)
    char buf[MAXPATHLEN];
    SSize_t len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
    if (len != -1) {
        buf[len] = '\0';
    }
    if (len > 0 && buf[len-1] == '\0') {
        len--;
    }
    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
}

https://chromium.googlesource.com/chromium/src/base/+/47ed640960dbb73b0d7123f714860b74e2656bc6/base_paths_apple.cc#30

Chrome devs decided a debug build assert is good enough for _NSGEP().

https://developer.apple.com/library/archive/documentation/System/Conceptual/ManPages_iPhoneOS/man3/dyld.3.html

https://github.com/opensource-apple/dyld/blob/master/include/mach-o/dyld.h#L92

Apple API docs implies _NSGEP() is incapable of failing but Apple didn't spell it out.

My opinion is that 2 -1 retvals in a row on the C level from any OS's special $^X backend call, then its time to panic: the perl process on startup. Something is really wrong to get 2 -1s in a row.

If a perl PID, truly has no backing storage for its perl.exe or perl.bin, that is extremely dangerous even if the OS is required to allow that. There is no backing storage, there is no anonymous inode number, there is no secret copy of perl.exe or perl.bin inside the swap file. The next read or write to an address inside a 4KB page that isn't sitting on a DDR RAM stick, will SIGBUS the perl process. When, and if, is unpredictable, since no developer cares what parts of a mmap-ed file are located on a DDR RAM stick or were swapped out.

If such crazyness is detectable by perl on a user mode level, and its trivial to detect the condition, killing the perl proc ASAP is required. Not waiting for a random SEGV in the future that most Perl users can't diagnose.

The 1975 fallback shouldn't be compiled into a perl binary on any modern OS. The 1975 fallback only needs to be the repo incase someone is porting Perl to a brand new OS in the future, and the 1975 fallback is only needed for experimental alpha quality blead perl builds by that person.

https://github.com/Perl/perl5/blob/blead/caretx.c#L53

I'm not personally worried about WinPerl not checking the retval of GetModuleFileNameW(NULL, ...). GetModuleFileNameW is not capable of failing or erroring out. Its has only 2 failure paths internally. 122 - ERROR_INSUFFICIENT_BUFFER, 0xC0000135 - STATUS_DLL_NOT_FOUND. It also doesn't call any other functions [non-trivial]. GetModuleFileNameW is a very very dumb for() loop that searches a linked list hanging off the PEB while holding a mutex lock.

I can't give an opinion on the real world likelyhood of the other OSes's special syscalls returning -1 for $^X.

[bulk88]

This thread https://marc.info/?l=openbsd-misc&m=144987773230417&w=2 says OpenBSD Project Devs say it is a security exploit to find out the disk file name of the current running process. They only allow argv[0] to work because of back compat reasons.

Another message in that thread points out for the OS kernel, or the OS Kernel's user mode middleware, to keep the absolute $^X absolute file path hidden away somewhere in ring 0 or ring 3 until the PID number is reaped/waitpid()-ed, is a shellcode storage location risk, or a side-channel attack risk.

I want to agree with that logic, if OpenBSD's design criteria is to leave no unnecessary metadata or statistics in live Phy Ram or SSD, because OpenBSD was designed to be resistant to a (China/Iran/Venezuela) SWAT team search warrant at 4:30AM, and the OpenBSD server being hot moved https://cdsg.com/products/hotplug-field-kit?image=0 by police to their forensics lab. So keep "recently used files" or the file names of PIDs to backing storage disk files after being launched, is unnecessary metadata, that no whitehat OpenBSD user or blackhat OpenBSD user needs to know.

I saw a post that there is an alternative way to get the current executing disk file name on OpenBSD, just what perl wants for $^X feature, but it requires 15-20 function calls to the OpenBSD kernel, and copy pasting 30 undocumented C struct types, and you writing 12-15 pages of code for OpenBSD platform.

fish-shell/fish-shell#9086 (comment)

This describes how to get $^X on OpenBSD, but @bulk88 's opinion is to license that OpenBSD library you just wrote as closed source commercial software, if you actually write it and it works on OpenBSD, and users have no other choice but to pay you to get the feature. Its too complex and too much work was put into the $^X OpenBSD library, only for you to just GIVE AWAY FOR FREE to everyone else, after you spent weeks working on it.

[bulk88]

#ifdef __OpenBSD__
    // kd variable is necessary for kvm_getfiles() first argument; RTFM.
    kvm_t *kd = kvm_openfiles(nullptr, nullptr, nullptr, KVM_NO_FILES, nullptr);
    if (!kd) { result = "fish"; return result; }
    int cntp = 0;
    bool ok = false;
    kinfo_file *kif = nullptr;
    if ((kif = kvm_getfiles(kd, KERN_FILE_BYPID, getpid(), sizeof(struct kinfo_file), &cntp))) {
        if (!stat(buffstr.c_str(), &st)) {
            for (int i = 0; i < cntp; i++) {
                if (kif[i].fd_fd == KERN_FILE_TEXT) {
                    if (st.st_dev == (dev_t)kif[i].va_fsid && st.st_ino == (ino_t)kif[i].va_fileid) {
                        ok = true;
                        break;
                    }
                }
            }
        }
    }
    kvm_close(kd);
    if (!ok) { result = "fish"; return result; }
#endif
    result = ((!buffstr.empty()) ? buffstr : "fish");
    return result;
}

https://github.com/fish-shell/fish-shell/blob/c961885e772123f9d6d02d72d3910479b086c1dd/src/common.cpp#L1950

OpenBSD problem solved in 30 mins. Why is there such low effort by P5P to learn from other FOSS projects?