From: Nick Ing-Simmons 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