Taint-Util-XS

Taint-Util-XS.c

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

#  if defined(__GNUC__)
#    define TU_FORCE_NOINLINE __attribute__((__noinline__))
#  elif defined(_MSC_VER)
#    define TU_FORCE_NOINLINE __declspec(noinline)
#  else
#    error "Unknown C compiler family type"
#endif

static TU_FORCE_NOINLINE void
S_addtaint(pTHX_ SV* sv)
{   /* sv_taint() is a macro with a large expansion. NOT a function call! */
    sv_taint(sv); 
}
#define addtaint(_sv) S_addtaint(aTHX_  (_sv))

MODULE = Taint::Util PACKAGE = Taint::Util

void
tainted(SV *sv)
PREINIT:
    SV* retval;
CODE:
    /* EXTEND(SP, 1); */ /* pp_entersub guarenteed >= 1 free slot */
    retval = boolSV(cBOOL(SvTAINTED(sv)));
    SETs(retval); /* no PUTBACK, 1 in, 1 out */
    return;

void
taint(...)
PREINIT:
    Stack_off_t i;
    SV *sv, **svp;
CODE:
    XSprePUSH;
    svp = &ST(0);
    PUTBACK; /* return empty list, SP lost liveness */
    for (i = 0; i < items; ++i) {
        sv = svp[i];
        if (!SvREADONLY(sv))
            addtaint(sv); /* prev: SvTAINTED_on(sv); */
    }   /* addtaint() is a coldpath __noinline that factors out a big macro */
    return;

void
untaint(...)
PREINIT:
    Stack_off_t i;
    SV *sv, **svp;
CODE:
    XSprePUSH;
    svp = &ST(0);
    PUTBACK;
    for (i = 0; i < items; ++i) {
        sv = svp[i];
        SvTAINTED_off(sv);
    }
    return;
    //  Ref:
    //  PERLVAR(I, tainting,	bool)		/* ? doing taint checks */
    //  PERLVARI(I, tainted,	bool, FALSE)	/* using variables controlled by $< */
    //  !!!THESE 2 are ADJACENT and 1 byte long each use a U16 read/test if the
    //  desired 1 out of 4 permutations can be tested using exactly 1 cond jmp.
    //  #define TAINTING_get		0
    //  $define TAINTING_get		(cBOOL(UNLIKELY(PL_tainting)))
    //  #define SvTAINTED_off(sv) STMT_START{ if(UNLIKELY(TAINTING_get)){sv_untaint(sv);} }STMT_END
    //  void Perl_sv_untaint(pTHX_ SV *const sv) {
    //  if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
    //      MAGIC * const mg = mg_find(sv, PERL_MAGIC_taint);
    //      if (mg)
    //          mg->mg_len &= ~1;
    //  }