X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doio.c;h=462c8841b84858a8d613cb9a7c4e19861517f187;hb=dd570ea6ed120327ae1b94a6071154a927352720;hp=e20245a6b272ffc0457dbbc40d5a34b55ba364d1;hpb=516a5887ee93ac51c15492c01bb2e52bafd5bfaf;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doio.c b/doio.c index e20245a..462c884 100644 --- a/doio.c +++ b/doio.c @@ -158,45 +158,7 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, rawmode |= O_LARGEFILE; /* Transparently largefiley. */ #endif -#ifndef O_ACCMODE -#define O_ACCMODE 3 /* Assume traditional implementation */ -#endif - - switch (result = rawmode & O_ACCMODE) { - case O_RDONLY: - IoTYPE(io) = IoTYPE_RDONLY; - break; - case O_WRONLY: - IoTYPE(io) = IoTYPE_WRONLY; - break; - case O_RDWR: - default: - IoTYPE(io) = IoTYPE_RDWR; - break; - } - writing = (result > 0); - - if (result == O_RDONLY) { - mode[ix++] = 'r'; - } -#ifdef O_APPEND - else if (rawmode & O_APPEND) { - mode[ix++] = 'a'; - if (result != O_WRONLY) - mode[ix++] = '+'; - } -#endif - else { - if (result == O_WRONLY) - mode[ix++] = 'w'; - else { - mode[ix++] = 'r'; - mode[ix++] = '+'; - } - } - if (rawmode & O_BINARY) - mode[ix++] = 'b'; - mode[ix] = '\0'; + IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing); namesv = sv_2mortal(newSVpvn(name,strlen(name))); num_svs = 1; @@ -233,7 +195,9 @@ Perl_do_openn(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } IoTYPE(io) = *type; if ((*type == IoTYPE_RDWR) && /* scary */ + (*(type+1) == IoTYPE_RDONLY || *(type+1) == IoTYPE_WRONLY) && ((!num_svs || (tend > type+1 && tend[-1] != IoTYPE_PIPE)))) { + TAINT_PROPER("open"); mode[1] = *type++; writing = 1; } @@ -1011,7 +975,7 @@ Perl_do_eof(pTHX_ GV *gv) Off_t Perl_do_tell(pTHX_ GV *gv) { - register IO *io; + register IO *io = 0; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { @@ -1030,7 +994,7 @@ Perl_do_tell(pTHX_ GV *gv) bool Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) { - register IO *io; + register IO *io = 0; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) { @@ -1049,7 +1013,7 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) Off_t Perl_do_sysseek(pTHX_ GV *gv, Off_t pos, int whence) { - register IO *io; + register IO *io = 0; register PerlIO *fp; if (gv && (io = GvIO(gv)) && (fp = IoIFP(io))) @@ -1220,7 +1184,9 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) sv_utf8_upgrade(sv = sv_mortalcopy(sv)); } else if (DO_UTF8(sv)) { - if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE)) { + if (!sv_utf8_downgrade((sv = sv_mortalcopy(sv)), TRUE) + && ckWARN(WARN_UTF8)) + { Perl_warner(aTHX_ WARN_UTF8, "Wide character in print"); } } @@ -1332,7 +1298,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system"); #else register char **a; - char *tmps; + char *tmps = Nullch; STRLEN n_a; if (sp > mark) { @@ -1395,7 +1361,6 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) { register char **a; register char *s; - char flags[10]; while (*cmd && isSPACE(*cmd)) cmd++; @@ -1403,28 +1368,32 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) /* save an extra exec if possible */ #ifdef CSH - if (strnEQ(cmd,PL_cshname,PL_cshlen) && strnEQ(cmd+PL_cshlen," -c",3)) { - strcpy(flags,"-c"); - s = cmd+PL_cshlen+3; - if (*s == 'f') { - s++; - strcat(flags,"f"); - } - if (*s == ' ') - s++; - if (*s++ == '\'') { - char *ncmd = s; - - while (*s) - s++; - if (s[-1] == '\n') - *--s = '\0'; - if (s[-1] == '\'') { - *--s = '\0'; - PerlProc_execl(PL_cshname,"csh", flags,ncmd,(char*)0); - *s = '\''; - return FALSE; - } + { + char flags[10]; + if (strnEQ(cmd,PL_cshname,PL_cshlen) && + strnEQ(cmd+PL_cshlen," -c",3)) { + strcpy(flags,"-c"); + s = cmd+PL_cshlen+3; + if (*s == 'f') { + s++; + strcat(flags,"f"); + } + if (*s == ' ') + s++; + if (*s++ == '\'') { + char *ncmd = s; + + while (*s) + s++; + if (s[-1] == '\n') + *--s = '\0'; + if (s[-1] == '\'') { + *--s = '\0'; + PerlProc_execl(PL_cshname,"csh", flags, ncmd, (char*)0); + *s = '\''; + return FALSE; + } + } } } #endif /* CSH */ @@ -1442,7 +1411,8 @@ Perl_do_exec3(pTHX_ char *cmd, int fd, int do_report) goto doshell; for (s = cmd; *s; s++) { - if (*s != ' ' && !isALPHA(*s) && strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) { + if (*s != ' ' && !isALPHA(*s) && + strchr("$&*(){}[]'\";\\|?<>~`\n",*s)) { if (*s == '\n' && !s[1]) { *s = '\0'; break; @@ -1685,7 +1655,7 @@ nothing in the core. if ( accessed == &PL_sv_undef && modified == &PL_sv_undef ) utbufp = NULL; - + Zero(&utbuf, sizeof utbuf, char); #ifdef BIG_TIME utbuf.actime = (Time_t)SvNVx(accessed); /* time accessed */ @@ -2024,13 +1994,42 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) id = SvIVx(*++mark); opstr = *++mark; opbuf = SvPV(opstr, opsize); - if (opsize < sizeof(struct sembuf) - || (opsize % sizeof(struct sembuf)) != 0) { + if (opsize < 3 * SHORTSIZE + || (opsize % (3 * SHORTSIZE))) { SETERRNO(EINVAL,LIB$_INVARG); return -1; } SETERRNO(0,0); - return semop(id, (struct sembuf *)opbuf, opsize/sizeof(struct sembuf)); + /* We can't assume that sizeof(struct sembuf) == 3 * sizeof(short). */ + { + int nsops = opsize / (3 * sizeof (short)); + int i = nsops; + short *ops = (short *) opbuf; + short *o = ops; + struct sembuf *temps, *t; + I32 result; + + New (0, temps, nsops, struct sembuf); + t = temps; + while (i--) { + t->sem_num = *o++; + t->sem_op = *o++; + t->sem_flg = *o++; + t++; + } + result = semop(id, temps, nsops); + t = temps; + o = ops; + i = nsops; + while (i--) { + *o++ = t->sem_num; + *o++ = t->sem_op; + *o++ = t->sem_flg; + t++; + } + Safefree(temps); + return result; + } #else Perl_croak(aTHX_ "semop not implemented"); #endif @@ -2158,6 +2157,8 @@ Perl_start_glob (pTHX_ SV *tmpglob, IO *io) ok = ((wilddsc.dsc$a_pointer = tovmspath(SvPVX(tmpglob),vmsspec)) != NULL); else ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL); if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer); + for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++) + if (*cp == '?') *cp = '%'; /* VMS style single-char wildcard */ while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt, &dfltdsc,NULL,NULL,NULL))&1)) { end = rstr + (unsigned long int) *rslt;