X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=f9db38e7acc2128afab630b603df70a93532b715;hb=68435ea717a7cd7f41241ff44917b542abd94222;hp=d853f6c26b1358ab48866ede2ff1afb4b3b5a664;hpb=5014db98d2c6d95f1afa45bfa9fe6b1ddb1a9dc2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_sys.c b/pp_sys.c index d853f6c..f9db38e 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -1,6 +1,6 @@ /* pp_sys.c * - * Copyright (c) 1991-1999, Larry Wall + * Copyright (c) 1991-2000, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -77,7 +77,7 @@ extern "C" int syscall(unsigned long,...); compiling multithreaded and singlethreaded ($ccflags et al). HOST_NOT_FOUND is typically defined in . */ -#if defined(HOST_NOT_FOUND) && !defined(h_errno) +#if defined(HOST_NOT_FOUND) && !defined(h_errno) && !defined(__CYGWIN__) extern int h_errno; #endif @@ -112,12 +112,6 @@ extern int h_errno; # include # endif #endif -#ifdef I_FCNTL -#include -#endif -#ifdef I_SYS_FILE -#include -#endif /* Put this after #includes because fork and vfork prototypes may conflict. */ #ifndef HAS_VFORK @@ -247,7 +241,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) Gid_t egid = getegid(); int res; - MUTEX_LOCK(&PL_cred_mutex); + LOCK_CRED_MUTEX; #if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID) Perl_croak(aTHX_ "switching effective uid is not implemented"); #else @@ -293,7 +287,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) #endif #endif Perl_croak(aTHX_ "leaving effective gid failed"); - MUTEX_UNLOCK(&PL_cred_mutex); + UNLOCK_CRED_MUTEX; return res; } @@ -442,7 +436,7 @@ PP(pp_warn) if (!tmps || !len) tmpsv = sv_2mortal(newSVpvn("Warning: something's wrong", 26)); - Perl_warn(aTHX_ "%_", tmpsv); + Perl_warn(aTHX_ "%"SVf, tmpsv); RETSETYES; } @@ -500,7 +494,7 @@ PP(pp_die) if (!tmps || !len) tmpsv = sv_2mortal(newSVpvn("Died", 4)); - DIE(aTHX_ "%_", tmpsv); + DIE(aTHX_ "%"SVf, tmpsv); } /* I/O. */ @@ -1095,8 +1089,6 @@ PP(pp_getc) gv = PL_stdingv; else gv = (GV*)POPs; - if (!gv) - gv = PL_argvgv; if (mg = SvTIED_mg((SV*)gv, 'q')) { I32 gimme = GIMME_V; @@ -1273,15 +1265,15 @@ PP(pp_leavewrite) fp = IoOFP(io); if (!fp) { if (ckWARN2(WARN_CLOSED,WARN_IO)) { - SV* sv = sv_newmortal(); - gv_efullname3(sv, gv, Nullch); - if (IoIFP(io)) + if (IoIFP(io)) { + SV* sv = sv_newmortal(); + gv_efullname3(sv, gv, Nullch); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input", SvPV_nolen(sv)); + } else if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, - "Write on closed filehandle %s", SvPV_nolen(sv)); + report_closed_fh(gv, io, "write", "filehandle"); } PUSHs(&PL_sv_no); } @@ -1354,14 +1346,14 @@ PP(pp_prtf) } else if (!(fp = IoOFP(io))) { if (ckWARN2(WARN_CLOSED,WARN_IO)) { - gv_efullname3(sv, gv, Nullch); - if (IoIFP(io)) + if (IoIFP(io)) { + gv_efullname3(sv, gv, Nullch); Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for input", SvPV(sv,n_a)); + } else if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, - "printf on closed filehandle %s", SvPV(sv,n_a)); + report_closed_fh(gv, io, "printf", "filehandle"); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -1631,9 +1623,9 @@ PP(pp_send) length = -1; if (ckWARN(WARN_CLOSED)) { if (PL_op->op_type == OP_SYSWRITE) - Perl_warner(aTHX_ WARN_CLOSED, "Syswrite on closed filehandle"); + report_closed_fh(gv, io, "syswrite", "filehandle"); else - Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket"); + report_closed_fh(gv, io, "send", "socket"); } } else if (PL_op->op_type == OP_SYSWRITE) { @@ -1793,7 +1785,11 @@ PP(pp_sysseek) if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); +#if LSEEKSIZE > IVSIZE + XPUSHs(sv_2mortal(newSVnv((NV) offset))); +#else XPUSHs(sv_2mortal(newSViv((IV) offset))); +#endif XPUSHs(sv_2mortal(newSViv((IV) whence))); PUTBACK; ENTER; @@ -1837,13 +1833,17 @@ PP(pp_truncate) tmpgv = gv_fetchpv(POPpx, FALSE, SVt_PVIO); do_ftruncate: TAINT_PROPER("truncate"); - if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) || + if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv))) + result = 0; + else { + PerlIO_flush(IoIFP(GvIOp(tmpgv))); #ifdef HAS_TRUNCATE - ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0) + if (ftruncate(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0) #else - my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0) + if (my_chsize(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), len) < 0) #endif - result = 0; + result = 0; + } } else { SV *sv = POPs; @@ -1986,8 +1986,12 @@ PP(pp_flock) (void)PerlIO_flush(fp); value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0); } - else + else { value = 0; + SETERRNO(EBADF,RMS$_IFI); + if (ckWARN(WARN_CLOSED)) + report_closed_fh(gv, GvIO(gv), "flock", "filehandle"); + } PUSHi(value); RETURN; #else @@ -2032,6 +2036,9 @@ PP(pp_socket) if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd); RETPUSHUNDEF; } +#if defined(HAS_FCNTL) && defined(F_SETFD) + fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ +#endif RETPUSHYES; #else @@ -2082,6 +2089,10 @@ PP(pp_sockpair) if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]); RETPUSHUNDEF; } +#if defined(HAS_FCNTL) && defined(F_SETFD) + fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd); /* ensure close-on-exec */ + fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd); /* ensure close-on-exec */ +#endif RETPUSHYES; #else @@ -2140,7 +2151,7 @@ PP(pp_bind) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd"); + report_closed_fh(gv, io, "bind", "socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2170,7 +2181,7 @@ PP(pp_connect) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd"); + report_closed_fh(gv, io, "connect", "socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2196,7 +2207,7 @@ PP(pp_listen) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd"); + report_closed_fh(gv, io, "listen", "socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2244,13 +2255,16 @@ PP(pp_accept) if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd); goto badexit; } +#if defined(HAS_FCNTL) && defined(F_SETFD) + fcntl(fd, F_SETFD, fd > PL_maxsysfd); /* ensure close-on-exec */ +#endif PUSHp((char *)&saddr, len); RETURN; nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd"); + report_closed_fh(ggv, ggv ? GvIO(ggv) : 0, "accept", "socket"); SETERRNO(EBADF,SS$_IVCHAN); badexit: @@ -2277,7 +2291,7 @@ PP(pp_shutdown) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd"); + report_closed_fh(gv, io, "shutdown", "socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2356,7 +2370,9 @@ PP(pp_ssockopt) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd"); + report_closed_fh(gv, io, + optype == OP_GSOCKOPT ? "getsockopt" : "setsockopt", + "socket"); SETERRNO(EBADF,SS$_IVCHAN); nuts2: RETPUSHUNDEF; @@ -2429,7 +2445,10 @@ PP(pp_getpeername) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd"); + report_closed_fh(gv, io, + optype == OP_GETSOCKNAME ? "getsockname" + : "getpeername", + "socket"); SETERRNO(EBADF,SS$_IVCHAN); nuts2: RETPUSHUNDEF; @@ -3357,12 +3376,19 @@ S_dooneliner(pTHX_ char *cmd, char *filename) PP(pp_mkdir) { djSP; dTARGET; - int mode = POPi; + int mode; #ifndef HAS_MKDIR int oldumask; #endif STRLEN n_a; - char *tmps = SvPV(TOPs, n_a); + char *tmps; + + if (MAXARG > 1) + mode = POPi; + else + mode = 0777; + + tmps = SvPV(TOPs, n_a); TAINT_PROPER("mkdir"); #ifdef HAS_MKDIR