devices. This fixes RT #24404.
p4raw-id: //depot/perl@26373
sR |I32 |dopoptosub_at |NN const PERL_CONTEXT* cxstk|I32 startingblock
s |void |save_lines |NULLOK AV *array|NN SV *sv
sR |OP* |doeval |int gimme|NULLOK OP** startop|NULLOK CV* outside|U32 seq
+sR |PerlIO *|check_type_and_open|NN const char *name|NN const char *mode
sR |PerlIO *|doopen_pm |NN const char *name|NN const char *mode
sR |bool |path_is_absolute|NN const char *name
sR |I32 |run_user_filter|int idx|NN SV *buf_sv|int maxlen
#define dopoptosub_at S_dopoptosub_at
#define save_lines S_save_lines
#define doeval S_doeval
+#define check_type_and_open S_check_type_and_open
#define doopen_pm S_doopen_pm
#define path_is_absolute S_path_is_absolute
#define run_user_filter S_run_user_filter
#define dopoptosub_at(a,b) S_dopoptosub_at(aTHX_ a,b)
#define save_lines(a,b) S_save_lines(aTHX_ a,b)
#define doeval(a,b,c,d) S_doeval(aTHX_ a,b,c,d)
+#define check_type_and_open(a,b) S_check_type_and_open(aTHX_ a,b)
#define doopen_pm(a,b) S_doopen_pm(aTHX_ a,b)
#define path_is_absolute(a) S_path_is_absolute(aTHX_ a)
#define run_user_filter(a,b,c) S_run_user_filter(aTHX_ a,b,c)
}
STATIC PerlIO *
+S_check_type_and_open(pTHX_ const char *name, const char *mode)
+{
+ Stat_t st;
+ int st_rc;
+ st_rc = PerlLIO_stat(name, &st);
+ if (st_rc < 0) {
+ return Nullfp;
+ }
+
+ if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
+ Perl_die(aTHX_ "%s %s not allowed in require",
+ S_ISDIR(st.st_mode) ? "Directory" : "Block device", name);
+ }
+ return PerlIO_open(name, mode);
+}
+
+STATIC PerlIO *
S_doopen_pm(pTHX_ const char *name, const char *mode)
{
#ifndef PERL_DISABLE_PMC
const char * const pmc = SvPV_nolen_const(pmcsv);
Stat_t pmcstat;
if (PerlLIO_stat(pmc, &pmcstat) < 0) {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(aTHX_ name, mode);
}
else {
Stat_t pmstat;
if (PerlLIO_stat(name, &pmstat) < 0 ||
pmstat.st_mtime < pmcstat.st_mtime)
{
- fp = PerlIO_open(pmc, mode);
+ fp = check_type_and_open(aTHX_ pmc, mode);
}
else {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(aTHX_ name, mode);
}
}
SvREFCNT_dec(pmcsv);
}
else {
- fp = PerlIO_open(name, mode);
+ fp = check_type_and_open(aTHX_ name, mode);
}
return fp;
#else
- return PerlIO_open(name, mode);
+ return check_type_and_open(aTHX_ name, mode);
#endif /* !PERL_DISABLE_PMC */
}
STATIC OP* S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
__attribute__warn_unused_result__;
+STATIC PerlIO * S_check_type_and_open(pTHX_ const char *name, const char *mode)
+ __attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
+ __attribute__nonnull__(pTHX_2);
+
STATIC PerlIO * S_doopen_pm(pTHX_ const char *name, const char *mode)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_1)