static void perl_vp_to_svpvn_element(REQUEST *request, AV *av, VALUE_PAIR const *vp, int *i, const char *hash_name, const char *list_name) { size_t len; SV *sv; char buffer[1024]; switch (vp->da->type) { case PW_TYPE_STRING: RDEBUG("$%s{'%s'}[%i] = &%s:%s -> '%s'", hash_name, vp->da->name, *i, list_name, vp->da->name, vp->vp_strvalue); sv = newSVpvn(vp->vp_strvalue, vp->vp_length); break; default: len = vp_prints_value(buffer, sizeof(buffer), vp, 0); RDEBUG("$%s{'%s'}[%i] = &%s:%s -> '%s'", hash_name, vp->da->name, *i, list_name, vp->da->name, buffer); sv = newSVpvn(buffer, truncate_len(len, sizeof(buffer))); break; } if (!sv) return; SvTAINTED_on(sv); av_push(av, sv); (*i)++; }
SV *modperl_table_get_set(pTHX_ apr_table_t *table, char *key, SV *sv_val, int do_taint) { SV *retval = &PL_sv_undef; if (table == NULL) { /* do nothing */ } else if (key == NULL) { retval = modperl_hash_tie(aTHX_ "APR::Table", (SV *)NULL, (void*)table); } else if (!sv_val) { /* no val was passed */ char *val; if ((val = (char *)apr_table_get(table, key))) { retval = newSVpv(val, 0); } else { retval = newSV(0); } if (do_taint) { SvTAINTED_on(retval); } } else if (!SvOK(sv_val)) { /* val was passed in as undef */ apr_table_unset(table, key); } else { apr_table_set(table, key, SvPV_nolen(sv_val)); } return retval; }
/* XXX: same as Perl_do_sprintf(); * but Perl_do_sprintf() is not part of the "public" api */ void modperl_perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg) { STRLEN patlen; char *pat = SvPV(*sarg, patlen); bool do_taint = FALSE; sv_vsetpvfn(sv, pat, patlen, (va_list *)NULL, sarg + 1, len - 1, &do_taint); SvSETMAGIC(sv); if (do_taint) { SvTAINTED_on(sv); } }
static XS(epoc_getcwd) /* more or less stolen from win32.c */ { dXSARGS; /* Make the host for current directory */ char *buffer; int buflen = 256; char *ptr; buffer = (char *) malloc( buflen); if (buffer == NULL) { XSRETURN_UNDEF; } while ((NULL == ( ptr = getcwd( buffer, buflen))) && (errno == ERANGE)) { buflen *= 2; if (NULL == realloc( buffer, buflen)) { XSRETURN_UNDEF; } } /* * If ptr != Nullch * then it worked, set PV valid, * else return 'undef' */ if (ptr) { SV *sv = sv_newmortal(); char *tptr; for (tptr = ptr; *tptr != '\0'; tptr++) { if (*tptr == '\\') { *tptr = '/'; } } sv_setpv(sv, ptr); free( buffer); EXTEND(SP,1); SvPOK_on(sv); ST(0) = sv; #ifndef INCOMPLETE_TAINTS SvTAINTED_on(ST(0)); #endif XSRETURN(1); } free( buffer); XSRETURN_UNDEF; }
MP_INLINE SV *modperl_slurp_filename(pTHX_ request_rec *r, int tainted) { SV *sv; apr_status_t rc; apr_size_t size; apr_file_t *file; size = r->finfo.size; sv = newSV(size); /* XXX: could have checked whether r->finfo.filehand is valid and * save the apr_file_open call, but apache gives us no API to * check whether filehand is valid. we can't test whether it's * NULL or not, as it may contain garbagea */ rc = apr_file_open(&file, r->filename, APR_READ|APR_BINARY, APR_OS_DEFAULT, r->pool); SLURP_SUCCESS("opening"); rc = apr_file_read(file, SvPVX(sv), &size); SLURP_SUCCESS("reading"); MP_TRACE_o(MP_FUNC, "read %d bytes from '%s'", size, r->filename); if (r->finfo.size != size) { SvREFCNT_dec(sv); Perl_croak(aTHX_ "Error: read %d bytes, expected %d ('%s')", size, (apr_size_t)r->finfo.size, r->filename); } rc = apr_file_close(file); SLURP_SUCCESS("closing"); SvPVX(sv)[size] = '\0'; SvCUR_set(sv, size); SvPOK_on(sv); if (tainted) { SvTAINTED_on(sv); } else { SvTAINTED_off(sv); } return newRV_noinc(sv); }
void my_xsinit(pTHX) { dVAR; static const char file[] = __FILE__; #ifdef USE_CTRLX GV *ctrlXgv; SV *ctrlX; #endif #ifdef USE_SUBFILE if (PL_preprocess) croak("Can't use -P with pl2exe"); #endif #ifdef NEED_INIT_WIN32CORE init_Win32CORE(aTHX); #endif #ifdef USE_ZIP pl2exe_boot_zip(aTHX); #endif #ifdef NEED_PREAMBLE newXS("ExtUtils::PerlToExe::preamble", XS_ExtUtils_PerlToExe_preamble, file); if (!PL_preambleav) PL_preambleav = newAV(); av_push(PL_preambleav, newSVpvs("BEGIN { ExtUtils::PerlToExe::preamble() }")); #endif #ifdef NEED_TAINT TAINT; TAINT_PROPER("appended " TAINT_TYPE); TAINT_NOT; #endif #ifdef USE_CTRLX ctrlXgv = gv_fetchpvs("\030", GV_NOTQUAL, SVt_PV); ctrlX = GvSV(ctrlXgv); /* * We can't reopen PL_rsfp yet as it hasn't been set (the file is * open, it's just in an auto variable in S_parse_body). However, * it's easier to fixup the name here, before gv_fetch_file gets * called on it. */ PL_origfilename = savepv(SvPV_nolen(ctrlX)); CopFILE_free(PL_curcop); CopFILE_set(PL_curcop, PL_origfilename); sv_setpv(ctrlX, CTRL_X); SvTAINTED_on(ctrlX); #endif #ifdef USE_ZIP pl2exe_load_zip(aTHX_ PL_origfilename); #endif real_xsinit(aTHX); }