X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=5ff5c924a6e4237597982d3a778a5f768a8aa0f9;hb=8849edfd7e990957ceb72629c600ff2b74b838b1;hp=6ed8e0a35070e68ca93e8c3f6260235042865e9f;hpb=1e2c6ed7b1d7c43be9a4422286be5333f4f3b7f8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index 6ed8e0a..5ff5c92 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -173,6 +173,8 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; # define FD_CLOEXEC 1 /* NeXT needs this */ #endif +#include "reentr.h" + #undef PERL_EFF_ACCESS_R_OK /* EFFective uid/gid ACCESS R_OK */ #undef PERL_EFF_ACCESS_W_OK #undef PERL_EFF_ACCESS_X_OK @@ -321,10 +323,13 @@ PP(pp_backtick) ; } else if (gimme == G_SCALAR) { + SV *oldrs = PL_rs; + PL_rs = &PL_sv_undef; sv_setpv(TARG, ""); /* note that this preserves previous buffer */ while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch) /*SUPPRESS 530*/ ; + PL_rs = oldrs; XPUSHs(TARG); SvTAINTED_on(TARG); } @@ -605,6 +610,7 @@ PP(pp_pipe_op) IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"); IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"); + IoOFP(rstio) = IoIFP(rstio); IoIFP(wstio) = IoOFP(wstio); IoTYPE(rstio) = IoTYPE_RDONLY; IoTYPE(wstio) = IoTYPE_WRONLY; @@ -731,11 +737,16 @@ PP(pp_binmode) RETPUSHUNDEF; } + PUTBACK; if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp), - (discp) ? SvPV_nolen(discp) : Nullch)) + (discp) ? SvPV_nolen(discp) : Nullch)) { + SPAGAIN; RETPUSHYES; - else + } + else { + SPAGAIN; RETPUSHUNDEF; + } } PP(pp_tie) @@ -785,7 +796,7 @@ PP(pp_tie) ENTER; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); - EXTEND(SP,items); + EXTEND(SP,(I32)items); while (items--) PUSHs(*MARK++); PUTBACK; @@ -803,7 +814,7 @@ PP(pp_tie) ENTER; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); - EXTEND(SP,items); + EXTEND(SP,(I32)items); while (items--) PUSHs(*MARK++); PUTBACK; @@ -816,9 +827,7 @@ PP(pp_tie) if (sv_isobject(sv)) { sv_unmagic(varsv, how); /* Croak if a self-tie on an aggregate is attempted. */ - if (varsv == SvRV(sv) && - (SvTYPE(sv) == SVt_PVAV || - SvTYPE(sv) == SVt_PVHV)) + if (varsv == SvRV(sv) && how == PERL_MAGIC_tied) Perl_croak(aTHX_ "Self-ties of arrays and hashes are not supported"); sv_magic(varsv, sv, how, Nullch, 0); @@ -1593,7 +1602,7 @@ PP(pp_sysread) if (bufsize >= 256) bufsize = 255; #endif - buffer = SvGROW(bufsv, length+1); + buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, (struct sockaddr *)namebuf, &bufsize); @@ -1626,7 +1635,7 @@ PP(pp_sysread) blen = sv_len_utf8(bufsv); } if (offset < 0) { - if (-offset > blen) + if (-offset > (int)blen) DIE(aTHX_ "Offset outside string"); offset += blen; } @@ -1636,7 +1645,7 @@ PP(pp_sysread) } more_bytes: bufsize = SvCUR(bufsv); - buffer = SvGROW(bufsv, length+offset+1); + buffer = SvGROW(bufsv, (STRLEN)(length+offset+1)); if (offset > bufsize) { /* Zero any newly allocated space */ Zero(buffer+bufsize, offset-bufsize, char); } @@ -1826,10 +1835,10 @@ PP(pp_send) if (MARK < SP) { offset = SvIVx(*++MARK); if (offset < 0) { - if (-offset > blen) + if (-offset > (IV)blen) DIE(aTHX_ "Offset outside string"); offset += blen; - } else if (offset >= blen && blen > 0) + } else if (offset >= (IV)blen && blen > 0) DIE(aTHX_ "Offset outside string"); } else offset = 0; @@ -4034,14 +4043,13 @@ PP(pp_system) I32 value; STRLEN n_a; int result; - int pp[2]; I32 did_pipes = 0; if (PL_tainting) { TAINT_ENV(); while (++MARK <= SP) { (void)SvPV_nolen(*MARK); /* stringify for taint check */ - if (PL_tainted) + if (PL_tainted) break; } MARK = ORIGMARK; @@ -4057,82 +4065,84 @@ PP(pp_system) PERL_FLUSHALL_FOR_CHILD; #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO) { - Pid_t childpid; - int status; - Sigsave_t ihand,qhand; /* place to save signals during system() */ - - if (PerlProc_pipe(pp) >= 0) - did_pipes = 1; - while ((childpid = PerlProc_fork()) == -1) { - if (errno != EAGAIN) { - value = -1; - SP = ORIGMARK; - PUSHi(value); - if (did_pipes) { - PerlLIO_close(pp[0]); - PerlLIO_close(pp[1]); - } - RETURN; - } - sleep(5); - } - if (childpid > 0) { - if (did_pipes) - PerlLIO_close(pp[1]); + Pid_t childpid; + int pp[2]; + + if (PerlProc_pipe(pp) >= 0) + did_pipes = 1; + while ((childpid = PerlProc_fork()) == -1) { + if (errno != EAGAIN) { + value = -1; + SP = ORIGMARK; + PUSHi(value); + if (did_pipes) { + PerlLIO_close(pp[0]); + PerlLIO_close(pp[1]); + } + RETURN; + } + sleep(5); + } + if (childpid > 0) { + Sigsave_t ihand,qhand; /* place to save signals during system() */ + int status; + + if (did_pipes) + PerlLIO_close(pp[1]); #ifndef PERL_MICRO - rsignal_save(SIGINT, SIG_IGN, &ihand); - rsignal_save(SIGQUIT, SIG_IGN, &qhand); + rsignal_save(SIGINT, SIG_IGN, &ihand); + rsignal_save(SIGQUIT, SIG_IGN, &qhand); #endif - do { - result = wait4pid(childpid, &status, 0); - } while (result == -1 && errno == EINTR); + do { + result = wait4pid(childpid, &status, 0); + } while (result == -1 && errno == EINTR); #ifndef PERL_MICRO - (void)rsignal_restore(SIGINT, &ihand); - (void)rsignal_restore(SIGQUIT, &qhand); -#endif - STATUS_NATIVE_SET(result == -1 ? -1 : status); - do_execfree(); /* free any memory child malloced on fork */ - SP = ORIGMARK; - if (did_pipes) { - int errkid; - int n = 0, n1; - - while (n < sizeof(int)) { - n1 = PerlLIO_read(pp[0], - (void*)(((char*)&errkid)+n), - (sizeof(int)) - n); - if (n1 <= 0) - break; - n += n1; - } - PerlLIO_close(pp[0]); - if (n) { /* Error */ - if (n != sizeof(int)) - DIE(aTHX_ "panic: kid popen errno read"); - errno = errkid; /* Propagate errno from kid */ - STATUS_CURRENT = -1; - } - } - PUSHi(STATUS_CURRENT); - RETURN; - } - if (did_pipes) { - PerlLIO_close(pp[0]); + (void)rsignal_restore(SIGINT, &ihand); + (void)rsignal_restore(SIGQUIT, &qhand); +#endif + STATUS_NATIVE_SET(result == -1 ? -1 : status); + do_execfree(); /* free any memory child malloced on fork */ + SP = ORIGMARK; + if (did_pipes) { + int errkid; + int n = 0, n1; + + while (n < sizeof(int)) { + n1 = PerlLIO_read(pp[0], + (void*)(((char*)&errkid)+n), + (sizeof(int)) - n); + if (n1 <= 0) + break; + n += n1; + } + PerlLIO_close(pp[0]); + if (n) { /* Error */ + if (n != sizeof(int)) + DIE(aTHX_ "panic: kid popen errno read"); + errno = errkid; /* Propagate errno from kid */ + STATUS_CURRENT = -1; + } + } + PUSHi(STATUS_CURRENT); + RETURN; + } + if (did_pipes) { + PerlLIO_close(pp[0]); #if defined(HAS_FCNTL) && defined(F_SETFD) - fcntl(pp[1], F_SETFD, FD_CLOEXEC); + fcntl(pp[1], F_SETFD, FD_CLOEXEC); #endif - } - } - if (PL_op->op_flags & OPf_STACKED) { - SV *really = *++MARK; - value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes); - } - else if (SP - MARK != 1) - value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes); - else { - value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes); + } + if (PL_op->op_flags & OPf_STACKED) { + SV *really = *++MARK; + value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes); + } + else if (SP - MARK != 1) + value = (I32)do_aexec5(Nullsv, MARK, SP, pp[1], did_pipes); + else { + value = (I32)do_exec3(SvPVx(sv_mortalcopy(*SP), n_a), pp[1], did_pipes); + } + PerlProc__exit(-1); } - PerlProc__exit(-1); #else /* ! FORK or VMS or OS/2 */ PL_statusvalue = 0; result = 0; @@ -4165,7 +4175,7 @@ PP(pp_exec) TAINT_ENV(); while (++MARK <= SP) { (void)SvPV_nolen(*MARK); /* stringify for taint check */ - if (PL_tainted) + if (PL_tainted) break; } MARK = ORIGMARK; @@ -4952,7 +4962,7 @@ PP(pp_gservent) else if (which == OP_GSBYPORT) { #ifdef HAS_GETSERVBYPORT char *proto = POPpbytex; - unsigned short port = POPu; + unsigned short port = (unsigned short)POPu; #ifdef HAS_HTONS port = PerlSock_htons(port);