X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=cdc9385967511e0207454bb81c518b5004065565;hb=b30ea4af1eb31dd77630f331817dfe421bf8b269;hp=a5028ba7b1a756760bb8fc87e75a513ebd0b9f1e;hpb=6fca0082ec4f3b34a0dabc78331bad8c22489dd2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index a5028ba..cdc9385 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -766,22 +766,23 @@ PP(pp_binmode) } PUTBACK; - if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp), - (discp) ? SvPV_nolen_const(discp) : NULL)) { - if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { - if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io), - mode_from_discipline(discp), - (discp) ? SvPV_nolen_const(discp) : NULL)) { - SPAGAIN; - RETPUSHUNDEF; - } + { + const int mode = mode_from_discipline(discp); + const char *const d = (discp ? SvPV_nolen_const(discp) : NULL); + if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) { + if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { + if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) { + SPAGAIN; + RETPUSHUNDEF; + } + } + SPAGAIN; + RETPUSHYES; + } + else { + SPAGAIN; + RETPUSHUNDEF; } - SPAGAIN; - RETPUSHYES; - } - else { - SPAGAIN; - RETPUSHUNDEF; } } @@ -1265,6 +1266,7 @@ PP(pp_enterwrite) register IO *io; GV *fgv; CV *cv; + SV * tmpsv = NULL; if (MAXARG == 0) gv = PL_defoutgv; @@ -1288,8 +1290,8 @@ PP(pp_enterwrite) cv = GvFORM(fgv); if (!cv) { - SV * const tmpsv = sv_newmortal(); const char *name; + tmpsv = sv_newmortal(); gv_efullname4(tmpsv, fgv, NULL, FALSE); name = SvPV_nolen_const(tmpsv); if (name && *name) @@ -1617,7 +1619,7 @@ PP(pp_sysread) buffer = SvGROW(bufsv, (STRLEN)(length+1)); /* 'offset' means 'flags' here */ count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset, - (struct sockaddr *)namebuf, &bufsize); + (struct sockaddr *)namebuf, &bufsize); if (count < 0) RETPUSHUNDEF; #ifdef EPOC @@ -2557,6 +2559,17 @@ PP(pp_accept) nstio = GvIOn(ngv); fd = PerlSock_accept(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len); +#if defined(OEMVS) + if (len == 0) { + /* Some platforms indicate zero length when an AF_UNIX client is + * not bound. Simulate a non-zero-length sockaddr structure in + * this case. */ + namebuf[0] = 0; /* sun_len */ + namebuf[1] = AF_UNIX; /* sun_family */ + len = 2; + } +#endif + if (fd < 0) goto badexit; if (IoIFP(nstio)) @@ -2769,7 +2782,8 @@ PP(pp_stat) { dVAR; dSP; - GV *gv; + GV *gv = NULL; + IO *io; I32 gimme; I32 max = 13; @@ -2780,7 +2794,7 @@ PP(pp_stat) do_fstat_warning_check: if (ckWARN(WARN_IO)) Perl_warner(aTHX_ packWARN(WARN_IO), - "lstat() on filehandle %s", GvENAME(gv)); + "lstat() on filehandle %s", gv ? GvENAME(gv) : ""); } else if (PL_laststype != OP_LSTAT) Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat"); } @@ -2791,7 +2805,8 @@ PP(pp_stat) PL_statgv = gv; sv_setpvn(PL_statname, "", 0); if(gv) { - IO* const io = GvIO(gv); + io = GvIO(gv); + do_fstat_have_io: if (io) { if (IoIFP(io)) { PL_laststatval = @@ -2821,13 +2836,18 @@ PP(pp_stat) if (SvTYPE(sv) == SVt_PVGV) { gv = (GV*)sv; goto do_fstat; - } - else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { - gv = (GV*)SvRV(sv); - if (PL_op->op_type == OP_LSTAT) - goto do_fstat_warning_check; - goto do_fstat; - } + } else if(SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) { + gv = (GV*)SvRV(sv); + if (PL_op->op_type == OP_LSTAT) + goto do_fstat_warning_check; + goto do_fstat; + } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { + io = (IO*)SvRV(sv); + if (PL_op->op_type == OP_LSTAT) + goto do_fstat_warning_check; + goto do_fstat_have_io; + } + sv_setpv(PL_statname, SvPV_nolen_const(sv)); PL_statgv = NULL; PL_laststype = PL_op->op_type; @@ -3589,7 +3609,8 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename) *s++ = '\\'; *s++ = *filename++; } - strcpy(s, " 2>&1"); + if (s - cmdline < size) + my_strlcpy(s, " 2>&1", size - (s - cmdline)); myfp = PerlProc_popen(cmdline, "r"); Safefree(cmdline); @@ -4626,7 +4647,7 @@ PP(pp_ghostent) STRLEN addrlen; Netdb_host_t addr = (Netdb_host_t) SvPVbyte(addrsv, addrlen); - hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype); + hent = PerlSock_gethostbyaddr((const char*)addr, (Netdb_hlen_t) addrlen, addrtype); #else DIE(aTHX_ PL_no_sock_func, "gethostbyaddr"); #endif