File Coverage

Binmode.xs

Criterion	Covered	Total	%
statement	119	122	97.5
branch	104	172	60.4
condition			n/a
subroutine			n/a
pod			n/a
total	223	294	75.8

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include

#include "ppport.h"

#define DEBUG 0

/* A duplicate of PL_ppaddr as we find it at BOOT time.
   We can thus overwrite PL_ppaddr with our own wrapper functions.
   This interacts better with wrap_op_checker(), which doesn’t provide
   a good way to call the op’s (now-overwritten) op_ppaddr callback.
*/
static Perl_ppaddr_t ORIG_PL_ppaddr[OP_max];

#define MYPKG "Sys::Binmode"
#define HINT_KEY MYPKG "/enabled"

/* An idempotent variant of dMARK that allows us to inspect the
   mark stack without changing it: */
#ifndef dMARK_TOPMARK
    #define dMARK_TOPMARK SV **mark = PL_stack_base + TOPMARK
#endif

#define DOWNGRADE_SVPV(sv) if (SvPOK(sv) && SvUTF8(sv)) sv_utf8_downgrade(sv, FALSE)

PERL_STATIC_INLINE void MY_DOWNGRADE(pTHX_ SV** svp) {
    if (UNLIKELY(SvGAMAGIC(*svp))) {

        /* If the parameter in question is magical/overloaded
           then we need to fetch the (string) value, downgrade it,
           then replace the overloaded object in the stack with
           our fetched value.
        */

        SV* replacement = sv_newmortal();

        /* fetches the overloadeed value */
        sv_copypv(replacement, *svp);

        DOWNGRADE_SVPV(replacement);

        *svp = replacement;
    }

    /* NB: READONLY strings can be downgraded. */
    else DOWNGRADE_SVPV(*svp);
}

#define BINMODE_IS_ON (cop_hints_fetch_pvs(PL_curcop, HINT_KEY, 0) != &PL_sv_placeholder)

/* For ops that take an indefinite number of args. */
#define MAKE_OPEN_LIST_WRAPPER(OPID) MAKE_CAPPED_LIST_WRAPPER(OPID, 0)

/* For ops whose number of string args is a fixed range.

   NB: In some perls, some list opts don’t set MARK. In those cases we
   fall back to MAXARG. As of now mkdir is the known “offender”, and
   only on Alpine Linux 3.11 & 3.12 (not 3.13).
*/
#define MAKE_CAPPED_LIST_WRAPPER(OPID, OP_MAXARG)       \
static OP* _wrapped_pp_##OPID(pTHX) {                   \
    if (BINMODE_IS_ON) {                                \
        dSP;                                            \
        dMARK_TOPMARK;                                  \
                                                        \
        /* The compiler should optimize this away       \
           for MAKE_OPEN_LIST_WRAPPER:                  \
        */                                              \
        if (OP_MAXARG)                                  \
            if (SP < MARK || (SP - MARK) > OP_MAXARG) { \
                unsigned numargs = MAXARG;              \
                MARK = SP;                              \
                while (numargs--) MARK--;               \
            }                                           \
                                                        \
        while (++MARK <= SP) MY_DOWNGRADE(aTHX_ MARK);  \
    }                                                   \
                                                        \
    return ORIG_PL_ppaddr[OPID](aTHX);                  \
}

/* For ops that take a fixed number of args. */
#define MAKE_FIXED_LIST_WRAPPER(OPID, NUMARGS)      \
static OP* _wrapped_pp_##OPID(pTHX) {               \
    if (BINMODE_IS_ON) {                            \
        unsigned numargs = NUMARGS;                 \
        dSP;                                        \
        while (numargs--) MY_DOWNGRADE(aTHX_ SP--); \
    }                                               \
                                                    \
    return ORIG_PL_ppaddr[OPID](aTHX);              \
}

/* For ops where only the last arg is a string. */
#define MAKE_SP_WRAPPER(OPID)           \
static OP* _wrapped_pp_##OPID(pTHX) {   \
    if (BINMODE_IS_ON) {                \
        dSP;                            \
        MY_DOWNGRADE(aTHX_ SP);         \
    }                                   \
                                        \
    return ORIG_PL_ppaddr[OPID](aTHX);  \
}


MAKE_OPEN_LIST_WRAPPER(OP_OPEN);
MAKE_CAPPED_LIST_WRAPPER(OP_SYSOPEN, 4);
MAKE_FIXED_LIST_WRAPPER(OP_TRUNCATE, 2);
MAKE_OPEN_LIST_WRAPPER(OP_EXEC);
MAKE_OPEN_LIST_WRAPPER(OP_SYSTEM);

MAKE_SP_WRAPPER(OP_BIND);
MAKE_SP_WRAPPER(OP_CONNECT);
MAKE_SP_WRAPPER(OP_SSOCKOPT);
MAKE_SP_WRAPPER(OP_SEND);

MAKE_SP_WRAPPER(OP_IOCTL);

MAKE_SP_WRAPPER(OP_LSTAT);
MAKE_SP_WRAPPER(OP_STAT);
MAKE_SP_WRAPPER(OP_FTRREAD);
MAKE_SP_WRAPPER(OP_FTRWRITE);
MAKE_SP_WRAPPER(OP_FTREXEC);
MAKE_SP_WRAPPER(OP_FTEREAD);
MAKE_SP_WRAPPER(OP_FTEWRITE);
MAKE_SP_WRAPPER(OP_FTEEXEC);
MAKE_SP_WRAPPER(OP_FTIS);
MAKE_SP_WRAPPER(OP_FTSIZE);
MAKE_SP_WRAPPER(OP_FTMTIME);
MAKE_SP_WRAPPER(OP_FTATIME);
MAKE_SP_WRAPPER(OP_FTCTIME);
MAKE_SP_WRAPPER(OP_FTROWNED);
MAKE_SP_WRAPPER(OP_FTEOWNED);
MAKE_SP_WRAPPER(OP_FTZERO);
MAKE_SP_WRAPPER(OP_FTSOCK);
MAKE_SP_WRAPPER(OP_FTCHR);
MAKE_SP_WRAPPER(OP_FTBLK);
MAKE_SP_WRAPPER(OP_FTFILE);
MAKE_SP_WRAPPER(OP_FTDIR);
MAKE_SP_WRAPPER(OP_FTPIPE);
MAKE_SP_WRAPPER(OP_FTSUID);
MAKE_SP_WRAPPER(OP_FTSGID);
MAKE_SP_WRAPPER(OP_FTSVTX);
MAKE_SP_WRAPPER(OP_FTLINK);
/* MAKE_SP_WRAPPER(OP_FTTTY); */
MAKE_SP_WRAPPER(OP_FTTEXT);
MAKE_SP_WRAPPER(OP_FTBINARY);
MAKE_SP_WRAPPER(OP_CHDIR);
MAKE_OPEN_LIST_WRAPPER(OP_CHOWN);
MAKE_SP_WRAPPER(OP_CHROOT);
MAKE_OPEN_LIST_WRAPPER(OP_UNLINK);
MAKE_OPEN_LIST_WRAPPER(OP_CHMOD);
MAKE_OPEN_LIST_WRAPPER(OP_UTIME);
MAKE_FIXED_LIST_WRAPPER(OP_RENAME, 2);
MAKE_FIXED_LIST_WRAPPER(OP_LINK, 2);
MAKE_FIXED_LIST_WRAPPER(OP_SYMLINK, 2);
MAKE_SP_WRAPPER(OP_READLINK);
MAKE_CAPPED_LIST_WRAPPER(OP_MKDIR, 2);
MAKE_SP_WRAPPER(OP_RMDIR);
MAKE_SP_WRAPPER(OP_OPEN_DIR);

MAKE_SP_WRAPPER(OP_REQUIRE);
MAKE_SP_WRAPPER(OP_DOFILE);
MAKE_SP_WRAPPER(OP_BACKTICK);

/* (These appear to be fine already.)
MAKE_SP_WRAPPER(OP_GHBYADDR);
MAKE_SP_WRAPPER(OP_GNBYADDR);
*/

MAKE_OPEN_LIST_WRAPPER(OP_SYSCALL);

/* ---------------------------------------------------------------------- */

#define MAKE_BOOT_WRAPPER(OPID)         \
ORIG_PL_ppaddr[OPID] = PL_ppaddr[OPID]; \
PL_ppaddr[OPID] = _wrapped_pp_##OPID;

//----------------------------------------------------------------------

bool initialized = false;

MODULE = Sys::Binmode     PACKAGE = Sys::Binmode

PROTOTYPES: DISABLE

BOOT:
    /* In theory this is for PL_check rather than PL_ppaddr, but per
       Paul Evans in practice this mutex gets used for other stuff, too.
       Paul says a race here should be exceptionally rare, so for pre-5.16
       perls (which lack this mutex) let’s just skip it.
    */
#ifdef OP_CHECK_MUTEX_LOCK
    OP_CHECK_MUTEX_LOCK;
#endif
    if (!initialized) {
        initialized = true;

        HV *stash = gv_stashpv(MYPKG, FALSE);
        newCONSTSUB(stash, "_HINT_KEY", newSVpvs(HINT_KEY));

        MAKE_BOOT_WRAPPER(OP_OPEN);
        MAKE_BOOT_WRAPPER(OP_SYSOPEN);
        MAKE_BOOT_WRAPPER(OP_TRUNCATE);
        MAKE_BOOT_WRAPPER(OP_EXEC);
        MAKE_BOOT_WRAPPER(OP_SYSTEM);

        MAKE_BOOT_WRAPPER(OP_BIND);
        MAKE_BOOT_WRAPPER(OP_CONNECT);
        MAKE_BOOT_WRAPPER(OP_SSOCKOPT);
        MAKE_BOOT_WRAPPER(OP_SEND);

        MAKE_BOOT_WRAPPER(OP_IOCTL);

        MAKE_BOOT_WRAPPER(OP_LSTAT);
        MAKE_BOOT_WRAPPER(OP_STAT);
        MAKE_BOOT_WRAPPER(OP_FTRREAD);
        MAKE_BOOT_WRAPPER(OP_FTRWRITE);
        MAKE_BOOT_WRAPPER(OP_FTREXEC);
        MAKE_BOOT_WRAPPER(OP_FTEREAD);
        MAKE_BOOT_WRAPPER(OP_FTEWRITE);
        MAKE_BOOT_WRAPPER(OP_FTEEXEC);
        MAKE_BOOT_WRAPPER(OP_FTIS);
        MAKE_BOOT_WRAPPER(OP_FTSIZE);
        MAKE_BOOT_WRAPPER(OP_FTMTIME);
        MAKE_BOOT_WRAPPER(OP_FTATIME);
        MAKE_BOOT_WRAPPER(OP_FTCTIME);
        MAKE_BOOT_WRAPPER(OP_FTROWNED);
        MAKE_BOOT_WRAPPER(OP_FTEOWNED);
        MAKE_BOOT_WRAPPER(OP_FTZERO);
        MAKE_BOOT_WRAPPER(OP_FTSOCK);
        MAKE_BOOT_WRAPPER(OP_FTCHR);
        MAKE_BOOT_WRAPPER(OP_FTBLK);
        MAKE_BOOT_WRAPPER(OP_FTFILE);
        MAKE_BOOT_WRAPPER(OP_FTDIR);
        MAKE_BOOT_WRAPPER(OP_FTPIPE);
        MAKE_BOOT_WRAPPER(OP_FTSUID);
        MAKE_BOOT_WRAPPER(OP_FTSGID);
        MAKE_BOOT_WRAPPER(OP_FTSVTX);
        MAKE_BOOT_WRAPPER(OP_FTLINK);
        /* MAKE_BOOT_WRAPPER(OP_FTTTY); */
        MAKE_BOOT_WRAPPER(OP_FTTEXT);
        MAKE_BOOT_WRAPPER(OP_FTBINARY);
        MAKE_BOOT_WRAPPER(OP_CHDIR);
        MAKE_BOOT_WRAPPER(OP_CHOWN);
        MAKE_BOOT_WRAPPER(OP_CHROOT);
        MAKE_BOOT_WRAPPER(OP_UNLINK);
        MAKE_BOOT_WRAPPER(OP_CHMOD);
        MAKE_BOOT_WRAPPER(OP_UTIME);
        MAKE_BOOT_WRAPPER(OP_RENAME);
        MAKE_BOOT_WRAPPER(OP_LINK);
        MAKE_BOOT_WRAPPER(OP_SYMLINK);
        MAKE_BOOT_WRAPPER(OP_READLINK);
        MAKE_BOOT_WRAPPER(OP_MKDIR);
        MAKE_BOOT_WRAPPER(OP_RMDIR);
        MAKE_BOOT_WRAPPER(OP_OPEN_DIR);

        MAKE_BOOT_WRAPPER(OP_REQUIRE);
        MAKE_BOOT_WRAPPER(OP_DOFILE);
        MAKE_BOOT_WRAPPER(OP_BACKTICK);

        /* (These appear to be fine already.)
        MAKE_BOOT_WRAPPER(OP_GHBYADDR);
        MAKE_BOOT_WRAPPER(OP_GNBYADDR);
        */

        MAKE_BOOT_WRAPPER(OP_SYSCALL);
    }
#ifdef OP_CHECK_MUTEX_UNLOCK
    OP_CHECK_MUTEX_UNLOCK;
#endif