[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]

Re: [PATCH 5.5.63] warn on flock() on closed handle



Oops.. forgot about the typo that Ronald reported.

diff -ur perl5.005_63.dist+4709/pod/perldiag.pod perl5.005_63/pod/perldiag.pod
--- perl5.005_63.dist+4709/pod/perldiag.pod	Fri Jan 14 17:35:45 2000
+++ perl5.005_63/pod/perldiag.pod	Fri Jan 14 21:37:57 2000
@@ -280,7 +280,7 @@
 (F) You wrote C<require E<lt>fileE<gt>> when you should have written
 C<require 'file'>.
 
-=item accept() on closed socket
+=item accept() on closed socket %s
 
 (W) You tried to do an accept on a closed socket.  Did you forget to check
 the return value of your socket() call?  See L<perlfunc/accept>.
@@ -518,7 +518,7 @@
 (4294967295) and therefore non-portable between systems.  See
 L<perlport> for more on portability concerns.
 
-=item bind() on closed socket
+=item bind() on closed socket %s
 
 (W) You tried to do a bind on a closed socket.  Did you forget to check
 the return value of your socket() call?  See L<perlfunc/bind>.
@@ -1187,7 +1187,7 @@
 expression so that it is simpler or backtracks less.  (See L<perlbook>
 for information on I<Mastering Regular Expressions>.)
 
-=item connect() on closed socket
+=item connect() on closed socket %s
 
 (W) You tried to do a connect on a closed socket.  Did you forget to check
 the return value of your socket() call?  See L<perlfunc/connect>.
@@ -1489,7 +1489,7 @@
 because if it did, it'd feel morally obligated to return every hostname
 on the Internet.
 
-=item get%sname() on closed socket
+=item get%sname() on closed socket %s
 
 (W) You tried to get a socket or peer socket name on a closed socket.
 Did you forget to check the return value of your socket() call?
@@ -1766,7 +1766,7 @@
 (F) While under the C<use filetest> pragma, switching the real and
 effective uids or gids failed.
 
-=item listen() on closed socket
+=item listen() on closed socket %s
 
 (W) You tried to do a listen on a closed socket.  Did you forget to check
 the return value of your socket() call?  See L<perlfunc/listen>.
@@ -2649,7 +2649,7 @@
 (W) A nearby syntax error was probably caused by a missing semicolon,
 or possibly some other missing operator, such as a comma.
 
-=item send() on closed socket
+=item send() on closed socket %s
 
 (W) The socket you're sending to got itself closed sometime before now.
 Check your logic flow.
@@ -2738,7 +2738,7 @@
 
 (F) You don't have System V shared memory IPC on your system.
 
-=item shutdown() on closed socket
+=item shutdown() on closed socket %s
 
 (W) You tried to do a shutdown on a closed socket.  Seems a bit superfluous.
 
@@ -2876,7 +2876,7 @@
 machine.  In some machines the functionality can exist but be
 unconfigured.  Consult your system support.
 
-=item syswrite() on closed filehandle
+=item syswrite() on closed filehandle %s
 
 (W) The filehandle you're writing to got itself closed sometime before now.
 Check your logic flow.
@@ -3487,7 +3487,7 @@
 will try to call the subroutine when the assignment is executed, which is
 probably not what you want.  (If it IS what you want, put an & in front.)
 
-=item %cetsockopt() on closed fd
+=item %cetsockopt() on closed socket %s
 
 (W) You tried to get or set a socket option on a closed socket.
 Did you forget to check the return value of your socket() call?
@@ -3557,3 +3557,10 @@
 
 =back
 
+=item flock() on closed filehandle %s
+
+(W) The filehandle you're attempting to flock() got itself closed some
+time before now.  Check your logic flow.  flock() operates on filehandles.
+Are you attempting to call flock() on a dirhandle by the same name?
+
+=back
diff -ur perl5.005_63.dist+4709/pp_hot.c perl5.005_63/pp_hot.c
--- perl5.005_63.dist+4709/pp_hot.c	Fri Jan 14 17:35:45 2000
+++ perl5.005_63/pp_hot.c	Fri Jan 14 18:40:01 2000
@@ -367,8 +367,7 @@
 			    "Filehandle %s opened only for input",
 			    SvPV(sv,n_a));
 	    else if (ckWARN(WARN_CLOSED))
-		Perl_warner(aTHX_ WARN_CLOSED,
-			    "print() on closed filehandle %s", SvPV(sv,n_a));
+		Perl_ck_open_dir(aTHX_ gv, io, "print", "filehandle");
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
@@ -1251,13 +1250,9 @@
 		Perl_warner(aTHX_ WARN_CLOSED,
 			    "glob failed (can't start child: %s)",
 			    Strerror(errno));
-	    else {
-		SV* sv = sv_newmortal();
-		gv_efullname3(sv, PL_last_in_gv, Nullch);
-		Perl_warner(aTHX_ WARN_CLOSED,
-			    "readline() on closed filehandle %s",
-			    SvPV_nolen(sv));
-	    }
+	    else
+		Perl_ck_open_dir(aTHX_ PL_last_in_gv, io,
+				 "readline", "filehandle");
 	}
 	if (gimme == G_SCALAR) {
 	    (void)SvOK_off(TARG);
diff -ur perl5.005_63.dist+4709/pp_sys.c perl5.005_63/pp_sys.c
--- perl5.005_63.dist+4709/pp_sys.c	Fri Jan 14 17:35:45 2000
+++ perl5.005_63/pp_sys.c	Fri Jan 14 18:44:04 2000
@@ -1280,8 +1280,7 @@
 			    "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));
+		Perl_ck_open_dir(aTHX_ gv, io, "write", "filehandle");
 	}
 	PUSHs(&PL_sv_no);
     }
@@ -1360,8 +1359,7 @@
 			    "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));
+		Perl_ck_open_dir(aTHX_ gv, io, "printf", "filehandle");
 	}
 	SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
 	goto just_say_no;
@@ -1631,9 +1629,9 @@
 	length = -1;
 	if (ckWARN(WARN_CLOSED)) {
 	    if (PL_op->op_type == OP_SYSWRITE)
-		Perl_warner(aTHX_ WARN_CLOSED, "syswrite() on closed filehandle");
+		Perl_ck_open_dir(aTHX_ gv, io, "syswrite", "filehandle");
 	    else
-		Perl_warner(aTHX_ WARN_CLOSED, "send() on closed socket");
+		Perl_ck_open_dir(aTHX_ gv, io, "send",     "socket");
 	}
     }
     else if (PL_op->op_type == OP_SYSWRITE) {
@@ -1986,8 +1984,11 @@
 	(void)PerlIO_flush(fp);
 	value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
     }
-    else
+    else {
 	value = 0;
+	if (ckWARN(WARN_CLOSED))
+	    Perl_ck_open_dir(aTHX_ gv, GvIO(gv), "flock", "filehandle");
+    }
     PUSHi(value);
     RETURN;
 #else
@@ -2140,7 +2141,7 @@
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed socket");
+	Perl_ck_open_dir(aTHX_ gv, io, "bind", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2170,7 +2171,7 @@
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed socket");
+	Perl_ck_open_dir(aTHX_ gv, io, "connect", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2196,7 +2197,7 @@
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed socket");
+	Perl_ck_open_dir(aTHX_ gv, io, "listen", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2250,7 +2251,7 @@
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed socket");
+	Perl_ck_open_dir(aTHX_ ggv, ggv ? GvIO(ggv) : 0, "accept", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
 
 badexit:
@@ -2277,7 +2278,7 @@
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed socket");
+	Perl_ck_open_dir(aTHX_ gv, io, "shutdown", "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2356,8 +2357,9 @@
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "%cetsockopt() on closed socket",
-		    optype == OP_GSOCKOPT ? 'g' : 's');
+	Perl_ck_open_dir(aTHX_ gv, io,
+			 optype == OP_GSOCKOPT ? "getsockopt" : "setsockopt",
+			 "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2430,8 +2432,10 @@
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-	Perl_warner(aTHX_ WARN_CLOSED, "get%sname() on closed socket",
-		    optype == OP_GETSOCKNAME ? "sock" : "peer");
+	Perl_ck_open_dir(aTHX_ gv, io,
+			 optype == OP_GETSOCKNAME ? "getsockname"
+						  : "getpeername",
+			 "socket");
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
diff -ur perl5.005_63.dist+4709/t/pragma/warn/pp_hot perl5.005_63/t/pragma/warn/pp_hot
--- perl5.005_63.dist+4709/t/pragma/warn/pp_hot	Fri Jan 14 17:35:45 2000
+++ perl5.005_63/t/pragma/warn/pp_hot	Fri Jan 14 19:09:44 2000
@@ -83,10 +83,17 @@
 use warnings 'closed' ;
 close STDIN ;
 print STDIN "anc";
+opendir STDIN, ".";
+print STDIN "anc";
+closedir STDIN;
 no warnings 'closed' ;
 print STDIN "anc";
+opendir STDIN, ".";
+print STDIN "anc";
 EXPECT
 print() on closed filehandle main::STDIN at - line 4.
+print() on closed filehandle main::STDIN at - line 6.
+(Are you trying to call print() on dirhandle main::STDIN?)
 ########
 # pp_hot.c [pp_rv2av]
 use warnings 'uninitialized' ;
@@ -124,11 +131,16 @@
 ########
 # pp_hot.c [Perl_do_readline]
 use warnings 'closed' ;
-close STDIN ; $a = <STDIN> ;
+close STDIN        ; $a = <STDIN> ;
+opendir STDIN, "." ; $a = <STDIN> ;
+closedir STDIN;
 no warnings 'closed' ;
+opendir STDIN, "." ; $a = <STDIN> ;
 $a = <STDIN> ;
 EXPECT
 readline() on closed filehandle main::STDIN at - line 3.
+readline() on closed filehandle main::STDIN at - line 4.
+(Are you trying to call readline() on dirhandle main::STDIN?)
 ########
 # pp_hot.c [Perl_do_readline]
 use warnings 'io' ;
diff -ur perl5.005_63.dist+4709/t/pragma/warn/pp_sys perl5.005_63/t/pragma/warn/pp_sys
--- perl5.005_63.dist+4709/t/pragma/warn/pp_sys	Fri Jan 14 17:35:45 2000
+++ perl5.005_63/t/pragma/warn/pp_sys	Fri Jan 14 19:37:16 2000
@@ -27,47 +27,51 @@
     close STDIN ;
     printf STDIN "fred"
 
-  syswrite() on closed filehandle		[pp_send]
+  syswrite() on closed filehandle %s		[pp_send]
     close STDIN; 
     syswrite STDIN, "fred", 1;
 
-  send() on closed socket			[pp_send]
+  send() on closed socket %s			[pp_send]
     close STDIN; 
     send STDIN, "fred", 1
 
-  bind() on closed socket			[pp_bind]
+  bind() on closed socket %s			[pp_bind]
     close STDIN; 
     bind STDIN, "fred" ;
 
 
-  connect() on closed socket			[pp_connect]
+  connect() on closed socket %s			[pp_connect]
     close STDIN; 
     connect STDIN, "fred" ;
 
-  listen() on closed socket			[pp_listen]
+  listen() on closed socket %s			[pp_listen]
     close STDIN; 
     listen STDIN, 2;
 
-  accept() on closed socket			[pp_accept]
+  accept() on closed socket %s			[pp_accept]
     close STDIN; 
-    accept STDIN, "fred" ;
+    accept "fred", STDIN ;
 
-  shutdown() on closed socket			[pp_shutdown]
+  shutdown() on closed socket %s		[pp_shutdown]
     close STDIN; 
     shutdown STDIN, 0;
 
-  setsockopt() on closed socket			[pp_ssockopt]
-  getsockopt() on closed socket			[pp_ssockopt]
+  setsockopt() on closed socket %s		[pp_ssockopt]
+  getsockopt() on closed socket	%s		[pp_ssockopt]
     close STDIN; 
     setsockopt STDIN, 1,2,3;
     getsockopt STDIN, 1,2;
 
-  getsockname() on closed socket		[pp_getpeername]
-  getpeername() on closed socket		[pp_getpeername]
+  getsockname() on closed socket %s		[pp_getpeername]
+  getpeername() on closed socket %s		[pp_getpeername]
     close STDIN; 
     getsockname STDIN;
     getpeername STDIN;
 
+  flock() on closed socket %s			[pp_flock]
+    close STDIN;
+    flock STDIN, 8;
+
   warn(warn_nl, "stat");			[pp_stat]
 
   Test on unopened file <%s>
@@ -111,10 +115,17 @@
 .
 close STDIN;
 write STDIN;
+opendir STDIN, ".";
+write STDIN;
+closedir STDIN;
 no warnings 'closed' ;
 write STDIN;
+opendir STDIN, ".";
+write STDIN;
 EXPECT
 write() on closed filehandle main::STDIN at - line 6.
+write() on closed filehandle main::STDIN at - line 8.
+(Are you trying to call write() on dirhandle main::STDIN?)
 ########
 # pp_sys.c [pp_leavewrite]
 use warnings 'io' ;
@@ -147,10 +158,17 @@
 use warnings 'closed' ;
 close STDIN ;
 printf STDIN "fred";
+opendir STDIN, ".";
+printf STDIN "fred";
+closedir STDIN;
 no warnings 'closed' ;
 printf STDIN "fred";
+opendir STDIN, ".";
+printf STDIN "fred";
 EXPECT
 printf() on closed filehandle main::STDIN at - line 4.
+printf() on closed filehandle main::STDIN at - line 6.
+(Are you trying to call printf() on dirhandle main::STDIN?)
 ########
 # pp_sys.c [pp_prtf]
 use warnings 'io' ;
@@ -164,10 +182,32 @@
 use warnings 'closed' ;
 close STDIN; 
 syswrite STDIN, "fred", 1;
+opendir STDIN, ".";
+syswrite STDIN, "fred", 1;
+closedir STDIN;
 no warnings 'closed' ;
 syswrite STDIN, "fred", 1;
+opendir STDIN, ".";
+syswrite STDIN, "fred", 1;
+EXPECT
+syswrite() on closed filehandle main::STDIN at - line 4.
+syswrite() on closed filehandle main::STDIN at - line 6.
+(Are you trying to call syswrite() on dirhandle main::STDIN?)
+########
+# pp_sys.c [pp_flock]
+use warnings 'closed' ;
+close STDIN;
+flock STDIN, 8;
+opendir STDIN, ".";
+flock STDIN, 8;
+no warnings 'closed' ;
+flock STDIN, 8;
+opendir STDIN, ".";
+flock STDIN, 8;
 EXPECT
-syswrite() on closed filehandle at - line 4.
+flock() on closed filehandle main::STDIN at - line 4.
+flock() on closed filehandle main::STDIN at - line 6.
+(Are you trying to call flock() on dirhandle main::STDIN?)
 ########
 # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername]
 use warnings 'io' ;
@@ -194,12 +234,24 @@
 bind STDIN, "fred" ;
 connect STDIN, "fred" ;
 listen STDIN, 2;
-accept STDIN, "fred" ;
+accept "fred", STDIN;
 shutdown STDIN, 0;
 setsockopt STDIN, 1,2,3;
 getsockopt STDIN, 1,2;
 getsockname STDIN;
 getpeername STDIN;
+opendir STDIN, ".";
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
+closedir STDIN;
 no warnings 'io' ;
 send STDIN, "fred", 1;
 bind STDIN, "fred" ;
@@ -211,17 +263,48 @@
 getsockopt STDIN, 1,2;
 getsockname STDIN;
 getpeername STDIN;
+opendir STDIN, ".";
+send STDIN, "fred", 1;
+bind STDIN, "fred" ;
+connect STDIN, "fred" ;
+listen STDIN, 2;
+accept "fred", STDIN;
+shutdown STDIN, 0;
+setsockopt STDIN, 1,2,3;
+getsockopt STDIN, 1,2;
+getsockname STDIN;
+getpeername STDIN;
 EXPECT
-send() on closed socket at - line 22.
-bind() on closed socket at - line 23.
-connect() on closed socket at - line 24.
-listen() on closed socket at - line 25.
-accept() on closed socket at - line 26.
-shutdown() on closed socket at - line 27.
-setsockopt() on closed socket at - line 28.
-getsockopt() on closed socket at - line 29.
-getsockname() on closed socket at - line 30.
-getpeername() on closed socket at - line 31.
+send() on closed socket main::STDIN at - line 22.
+bind() on closed socket main::STDIN at - line 23.
+connect() on closed socket main::STDIN at - line 24.
+listen() on closed socket main::STDIN at - line 25.
+accept() on closed socket main::STDIN at - line 26.
+shutdown() on closed socket main::STDIN at - line 27.
+setsockopt() on closed socket main::STDIN at - line 28.
+getsockopt() on closed socket main::STDIN at - line 29.
+getsockname() on closed socket main::STDIN at - line 30.
+getpeername() on closed socket main::STDIN at - line 31.
+send() on closed socket main::STDIN at - line 33.
+(Are you trying to call send() on dirhandle main::STDIN?)
+bind() on closed socket main::STDIN at - line 34.
+(Are you trying to call bind() on dirhandle main::STDIN?)
+connect() on closed socket main::STDIN at - line 35.
+(Are you trying to call connect() on dirhandle main::STDIN?)
+listen() on closed socket main::STDIN at - line 36.
+(Are you trying to call listen() on dirhandle main::STDIN?)
+accept() on closed socket main::STDIN at - line 37.
+(Are you trying to call accept() on dirhandle main::STDIN?)
+shutdown() on closed socket main::STDIN at - line 38.
+(Are you trying to call shutdown() on dirhandle main::STDIN?)
+setsockopt() on closed socket main::STDIN at - line 39.
+(Are you trying to call setsockopt() on dirhandle main::STDIN?)
+getsockopt() on closed socket main::STDIN at - line 40.
+(Are you trying to call getsockopt() on dirhandle main::STDIN?)
+getsockname() on closed socket main::STDIN at - line 41.
+(Are you trying to call getsockname() on dirhandle main::STDIN?)
+getpeername() on closed socket main::STDIN at - line 42.
+(Are you trying to call getpeername() on dirhandle main::STDIN?)
 ########
 # pp_sys.c [pp_stat]
 use warnings 'newline' ;
diff -ur perl5.005_63.dist+4709/util.c perl5.005_63/util.c
--- perl5.005_63.dist+4709/util.c	Tue Nov 30 21:47:11 1999
+++ perl5.005_63/util.c	Fri Jan 14 18:25:06 2000
@@ -3717,3 +3717,24 @@
     return Perl_atof(s);
 #endif
 }
+
+void
+Perl_ck_open_dir(pTHX_  GV *gv, IO *io, char *func, char *obj)
+{
+    SV*   sv;
+    char* name;
+
+    assert(gv);
+
+    sv = sv_newmortal();
+    gv_efullname3(sv, gv, Nullch);
+    name = SvPVX(sv);
+
+    Perl_warner(aTHX_ WARN_CLOSED,
+                "%s() on closed %s %s", func, obj, name);
+
+    if (io && IoDIRP(io))
+	Perl_warner(aTHX_ WARN_CLOSED,
+		    "(Are you trying to call %s() on dirhandle %s?)\n",
+		    func, name);
+}
End of Patch.


[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index][Thread Index][Top&Search][Original]