X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=200ed94831b32e50a74a4db8aeeab07383a1b799;hb=0f1f432106978ae5935b254430dd7045c4e76d3d;hp=2361b3c16ed5cda1673bdb753864399d6b4f3dce;hpb=3d7e8424cfac272bdb0b574fd551427fdfd63d10;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index 2361b3c..200ed94 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; @@ -817,11 +828,11 @@ PP(pp_tie) 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)) + (SvTYPE(varsv) == SVt_PVAV || + SvTYPE(varsv) == SVt_PVHV)) Perl_croak(aTHX_ "Self-ties of arrays and hashes are not supported"); - sv_magic(varsv, sv, how, Nullch, 0); + sv_magic(varsv, (SvRV(sv) == varsv ? Nullsv : sv), how, Nullch, 0); } LEAVE; SP = PL_stack_base + markoff; @@ -1593,7 +1604,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 +1637,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 +1647,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 +1837,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; @@ -2173,9 +2184,6 @@ PP(pp_ioctl) #else retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s); #endif -#else - DIE(aTHX_ "fcntl is not implemented"); -#endif if (SvPOK(argsv)) { if (s[SvCUR(argsv)] != 17) @@ -2194,6 +2202,10 @@ PP(pp_ioctl) PUSHp(zero_but_true, ZBTLEN); } RETURN; + +#else + DIE(aTHX_ "fcntl is not implemented"); +#endif } PP(pp_flock) @@ -4034,14 +4046,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 +4068,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 +4178,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 +4965,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); @@ -5430,7 +5443,7 @@ PP(pp_ggrent) PUSHs(sv = sv_mortalcopy(&PL_sv_no)); sv_setiv(sv, (IV)grent->gr_gid); -#if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API) +#if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API)) PUSHs(sv = sv_mortalcopy(&PL_sv_no)); /* In UNICOS/mk (_CRAYMPP) the multithreading * versions (getgrnam_r, getgrgid_r)