From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Thu, 22 Mar 2001 10:54:35 +0000 (+0000)
Subject: Die on n-arg open(...,"",xxx,yyy,...)
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4a7d1889681c73a99b9a39d8a3d3760367674002;p=p5sagit%2Fp5-mst-13.2.git
Die on n-arg open(...,"",xxx,yyy,...)
- redirect pipe cases to PerlProc_popen_list() (which just croaks for now)
- die on read/write cases so we can decide what it means later.
p4raw-id: //depot/perlio@9294
---
diff --git a/doio.c b/doio.c
index 3ed517b..67fa665 100644
--- a/doio.c
+++ b/doio.c
@@ -132,6 +132,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
if (as_raw) {
/* sysopen style args, i.e. integer mode and permissions */
+ if (num_svs != 0) {
+ Perl_croak(aTHX_ "panic:sysopen with multiple args");
+ }
#if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE)
rawmode |= O_LARGEFILE;
@@ -234,7 +237,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
name = type;
len = tend-type;
}
- if (*name == '\0') { /* command is missing 19990114 */
+ if (*name == '\0') {
+ /* command is missing 19990114 */
if (ckWARN(WARN_PIPE))
Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
errno = EPIPE;
@@ -254,7 +258,12 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
strcat(mode, "b");
else if (out_crlf)
strcat(mode, "t");
- fp = PerlProc_popen(name,mode);
+ if (num_svs > 1) {
+ fp = PerlProc_popen_list(mode, num_svs, svp);
+ }
+ else {
+ fp = PerlProc_popen(name,mode);
+ }
}
else if (*type == IoTYPE_WRONLY) {
TAINT_PROPER("open");
@@ -276,15 +285,17 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
if (*type == '&') {
name = type;
duplicity:
- if (num_svs)
- goto unknown_desr;
dodup = 1;
name++;
if (*name == '=') {
dodup = 0;
name++;
}
+ if (num_svs) {
+ goto unknown_desr;
+ }
if (!*name && supplied_fp)
+ /* "<+&" etc. is used by typemaps */
fp = supplied_fp;
else {
/*SUPPRESS 530*/
@@ -347,6 +358,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
}
}
else {
+ if (num_svs > 1) {
+ Perl_croak(aTHX_ "More than one argument to '>' open");
+ }
/*SUPPRESS 530*/
for (; isSPACE(*type); type++) ;
if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) {
@@ -361,6 +375,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
}
}
else if (*type == IoTYPE_RDONLY) {
+ if (num_svs > 1) {
+ Perl_croak(aTHX_ "More than one argument to '<' open");
+ }
/*SUPPRESS 530*/
for (type++; isSPACE(*type); type++) ;
mode[0] = 'r';
@@ -396,7 +413,8 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
name = type;
len = tend-type;
}
- if (*name == '\0') { /* command is missing 19990114 */
+ if (*name == '\0') {
+ /* command is missing 19990114 */
if (ckWARN(WARN_PIPE))
Perl_warner(aTHX_ WARN_PIPE, "Missing command in piped open");
errno = EPIPE;
@@ -410,7 +428,13 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw,
strcat(mode, "b");
else if (in_crlf)
strcat(mode, "t");
- fp = PerlProc_popen(name,mode);
+ if (num_svs > 1) {
+ fp = PerlProc_popen_list(mode,num_svs,svp);
+ }
+ else
+ {
+ fp = PerlProc_popen(name,mode);
+ }
IoTYPE(io) = IoTYPE_PIPE;
}
else {
diff --git a/embed.pl b/embed.pl
index cb2b4a7..7867892 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1772,6 +1772,7 @@ Anp |void* |my_memset |char* loc|I32 ch|I32 len
#if !defined(PERL_OBJECT)
Ap |I32 |my_pclose |PerlIO* ptr
Ap |PerlIO*|my_popen |char* cmd|char* mode
+Ap |PerlIO*|my_popen_list |char* mode|int n|SV ** args
#endif
Ap |void |my_setenv |char* nam|char* val
Ap |I32 |my_stat
diff --git a/iperlsys.h b/iperlsys.h
index fdbd12a..8a628cd 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -253,7 +253,7 @@ struct IPerlStdIOInfo
#define PerlSIO_printf Perl_fprintf_nocontext
#define PerlSIO_stdoutf Perl_printf_nocontext
#define PerlSIO_vprintf(f,fmt,a) \
- (*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a)
+ (*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a)
#define PerlSIO_ftell(f) \
(*PL_StdIO->pTell)(PL_StdIO, (f))
#define PerlSIO_fseek(f,o,w) \
@@ -982,6 +982,8 @@ struct IPerlProcInfo
(*PL_Proc->pPauseProc)(PL_Proc)
#define PerlProc_popen(c, m) \
(*PL_Proc->pPopen)(PL_Proc, (c), (m))
+#define PerlProc_popen_list(m, n, a) \
+ (*PL_Proc->pPopenList)(PL_Proc, (m), (n), (a))
#define PerlProc_pclose(f) \
(*PL_Proc->pPclose)(PL_Proc, (f))
#define PerlProc_pipe(fd) \
@@ -1043,6 +1045,7 @@ struct IPerlProcInfo
#define PerlProc_killpg(i, a) killpg((i), (a))
#define PerlProc_pause() Pause()
#define PerlProc_popen(c, m) my_popen((c), (m))
+#define PerlProc_popen_list(m,n,a) my_popen_list((m),(n),(a))
#define PerlProc_pclose(f) my_pclose((f))
#define PerlProc_pipe(fd) pipe((fd))
#define PerlProc_setuid(u) setuid((u))
diff --git a/util.c b/util.c
index e24a81d..25286ac 100644
--- a/util.c
+++ b/util.c
@@ -2309,6 +2309,13 @@ VTOH(vtohs,short)
VTOH(vtohl,long)
#endif
+PerlIO *
+Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
+{
+ Perl_croak(aTHX_ "List form of piped open not implemented");
+ return (PerlIO *) NULL;
+}
+
/* VMS' my_popen() is in VMS.c, same with OS/2. */
#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL)
PerlIO *
@@ -3969,14 +3976,14 @@ Perl_ebcdic_control(pTHX_ int ch)
{
if (ch > 'a') {
char *ctlp;
-
+
if (islower(ch))
ch = toupper(ch);
-
+
if ((ctlp = strchr(controllablechars, ch)) == 0) {
Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
}
-
+
if (ctlp == controllablechars)
return('\177'); /* DEL */
else