Tcl Source Code

Artifact [c065b07f96]
Login

Artifact c065b07f96a37d070684c0fbe03c030699664e6e:

Attachment "tip287-revised.patch" to ticket [1586860fff] added by cleverly 2006-11-06 07:03:34.
--- doc/chan.n.orig	2006-10-28 22:37:48.000000000 -0600
+++ doc/chan.n	2006-11-05 14:59:38.000000000 -0700
@@ -493,6 +493,21 @@
 only those channel names that match it (according to the rules of
 \fBstring match\fR) will be returned.
 .TP
+\fBchan pendinginput \fIchannelId\fR
+.
+This returns the number of bytes of input currently buffered 
+internally for \fIchannelId\fr (especially useful in a readable event 
+callback to impose application-specific limits on line lengths to avoid
+a potential denial-of-service attack where a hostile user crafts
+an extremely long line that exceeds the available memory to buffer it).
+Returns -1 if the channel was not opened for reading.
+.TP
+\fBchan pendingoutput \fIchannelId\fR
+.
+This returns the number of bytes of output currently buffered 
+internally for \fIchannelId\fr. Returns -1 if the channel was not 
+opened for writing.
+.TP
 \fBchan postevent \fIchannelId eventSpec\fR
 .
 This subcommand is used by command handlers specified with \fBchan
--- generic/tclBasic.c.orig	2006-10-28 21:55:59.000000000 -0600
+++ generic/tclBasic.c	2006-11-05 14:50:30.000000000 -0700
@@ -485,6 +485,13 @@
     Tcl_CreateObjCommand(interp, "::tcl::chan::rPostevent",
 	    TclChanPostEventObjCmd, (ClientData) NULL, NULL);
 
+    /* TIP #287 */
+    Tcl_CreateObjCommand(interp, "::tcl::chan::PendingInput",
+	    TclChanPendingInputObjCmd, (ClientData) NULL, NULL);
+
+    Tcl_CreateObjCommand(interp, "::tcl::chan::PendingOutput",
+	    TclChanPendingOutputObjCmd, (ClientData) NULL, NULL);
+
     /*
      * Register the built-in functions. This is empty now that they are
      * implemented as commands in the ::tcl::mathfunc namespace.
--- generic/tclInt.h.orig	2006-10-28 22:08:38.000000000 -0600
+++ generic/tclInt.h	2006-11-05 14:50:53.000000000 -0700
@@ -2286,6 +2286,12 @@
 MODULE_SCOPE int	Tcl_CdObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int	TclChanPendingInputObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]); /* TIP 287 */
+MODULE_SCOPE int	TclChanPendingOutputObjCmd(
+			    ClientData clientData, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *CONST objv[]); /* TIP 287 */
 MODULE_SCOPE int	TclChanTruncateObjCmd(
 			    ClientData clientData, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *CONST objv[]);
--- generic/tclIOCmd.c.orig	2006-10-28 21:58:27.000000000 -0600
+++ generic/tclIOCmd.c	2006-11-05 16:39:07.000000000 -0700
@@ -1619,6 +1619,108 @@
 }
 
 /*
+ *---------------------------------------------------------------------------
+ *
+ * TclChanPendingInputObjCmd --
+ *
+ *	This function is invoked to process the Tcl "chan pendinginput $chan" 
+ *	command (TIP #287). See the user documentation for details on 
+ *	what it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interp's result to the number of bytes of input in the
+ *	channels input buffer, or -1 if the channel wasn't opened for 
+ *	reading.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+TclChanPendingInputObjCmd(
+    ClientData unused,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+    Tcl_Channel chan;
+    int mode;
+    char *arg;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+	return TCL_ERROR;
+    }
+
+    arg = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, arg, &mode);
+    if (chan == NULL) {
+	return TCL_ERROR;
+    }
+
+    if ((mode & TCL_READABLE) == 0) {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+    } else {
+	Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
+    }
+    return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclChanPendingOutputObjCmd --
+ *
+ *	This function is invoked to process the Tcl "chan pendingoutput $chan"
+ *	command (TIP #287). See the user documentation for details on what 
+ *	it does.
+ *
+ * Results:
+ *	A standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interp's result to the number of bytes of output in the
+ *	channels output buffer, or -1 if the channel wasn't opened for 
+ *	writing.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+int
+TclChanPendingOutputObjCmd(
+    ClientData unused,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *CONST objv[])	/* Argument objects. */
+{
+    Tcl_Channel chan;
+    int mode;
+    char *arg;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "channelId");
+	return TCL_ERROR;
+    }
+
+    arg = Tcl_GetString(objv[1]);
+    chan = Tcl_GetChannel(interp, arg, &mode);
+    if (chan == NULL) {
+	return TCL_ERROR;
+    }
+
+    if ((mode & TCL_WRITEABLE) == 0) {
+        Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+    } else {
+        Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
+    }
+    return TCL_OK;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * Tcl_ChanTruncateObjCmd --
--- library/init.tcl.orig	2006-09-22 12:13:29.000000000 -0600
+++ library/init.tcl	2006-11-05 14:56:58.000000000 -0700
@@ -78,23 +78,26 @@
     # Set up the 'chan' ensemble (TIP #208).
     namespace eval chan {
         # TIP #219. Added methods: create, postevent.
+        # TIP #287. Added methods: pendinginput, pendingoutput.
         namespace ensemble create -command ::chan -map {
-            blocked     ::fblocked
-            close       ::close
-            configure   ::fconfigure
-            copy        ::fcopy
-            create      ::tcl::chan::rCreate
-            eof         ::eof
-            event       ::fileevent
-            flush       ::flush
-            gets        ::gets
-            names       {::file channels}
-            postevent   ::tcl::chan::rPostevent
-            puts        ::puts
-            read        ::read
-            seek        ::seek
-            tell        ::tell
-            truncate    ::tcl::chan::Truncate
+            pendinginput  ::tcl::chan::PendingInput
+            pendingoutput ::tcl::chan::PendingOutput
+            blocked       ::fblocked
+            close         ::close
+            configure     ::fconfigure
+            copy          ::fcopy
+            create        ::tcl::chan::rCreate
+            eof           ::eof
+            event         ::fileevent
+            flush         ::flush
+            gets          ::gets
+            names         {::file channels}
+            postevent     ::tcl::chan::rPostevent
+            puts          ::puts
+            read          ::read
+            seek          ::seek
+            tell          ::tell
+            truncate      ::tcl::chan::Truncate
         }
     }
 
--- tests/chan.test.orig	2006-10-29 13:59:35.000000000 -0700
+++ tests/chan.test	2006-11-05 15:07:51.000000000 -0700
@@ -24,7 +24,7 @@
 } -returnCodes error -result "wrong # args: should be \"chan subcommand ?argument ...?\""
 test chan-1.2 {chan command general syntax} -body {
     chan FOOBAR
-} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate"
+} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be available, blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate"
 
 test chan-2.1 {chan command: blocked subcommand} -body {
     chan blocked foo bar
@@ -96,6 +96,112 @@
     catch {removeFile $file}
 }
 
+# TIP 287: chan pendinginput
+test chan-16.1 {chan command: pendinginput subcommand} -body {
+    chan pendinginput foo bar
+} -returnCodes error -result "wrong # args: should be \"chan pendinginput channelId\""
+test chan-16.2 {chan command: pendinginput subcommand} -body {
+    chan pendinginput stdout 
+} -result -1
+test chan-16.3 {chan command: pendinginput subcommand} -body {
+    chan pendinginput stdin
+} -result 0
+test chan-16.4 {chan command: pendinginput subcommand} -body {
+    chan pendinginput FOOBAR
+} -returnCodes error -result "can not find channel named \"FOOBAR\""
+test chan-16.5 {chan command: pendinginput subcommand} -setup {
+    set file [makeFile {} testAvailable]
+    set f [open $file w+]
+    chan configure $f -translation lf -buffering line
+} -body {
+    chan puts $f foo
+    chan puts $f bar
+    chan puts $f baz
+    chan seek $f 0
+    chan gets $f
+    chan pendinginput $f
+} -result 8 -cleanup {
+    catch {chan close $f}
+    catch {removeFile $file}
+}
+test chan-16.6 {chan command: pendinginput subcommand} -setup {
+    proc chan-16.6-accept {sock addr port} {
+        chan configure $sock -blocking 0 -buffering line -buffersize 32
+        chan event $sock readable [list chan-16.6-readable $sock]
+    }
+
+    proc chan-16.6-readable {sock} {
+        set r [chan gets $sock line]
+        set l [string length $line]
+        set e [chan eof $sock]
+        set b [chan blocked $sock]
+        set i [chan pendinginput $sock]
+
+        lappend ::chan-16.6-data $r $l $e $b $i
+
+        if {$r != -1 || $e || $l || !$b || $i > 128} {
+            set data [read $sock $i]
+            lappend ::chan-16.6-data [string range $data 0 2]
+            lappend ::chan-16.6-data [string range $data end-2 end]
+            set ::chan-16.6-done 1
+        }
+    }
+
+    proc chan-16.6-client {} {
+        chan puts -nonewline $::client ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890
+        chan flush $::client
+        after 100 chan-16.6-client
+    }
+
+    set ::server [socket -server chan-16.6-accept -myaddr 127.0.0.1 0]
+    set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]]
+    set ::chan-16.6-data [list]
+    set ::chan-16.6-done 0
+} -body {
+    after idle chan-16.6-client 
+    vwait ::chan-16.6-done
+    set ::chan-16.6-data
+} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup {
+    catch {chan close $client}
+    catch {chan close $server}
+    rename chan-16.6-accept {}
+    rename chan-16.6-readable {}
+    rename chan-16.6-client {}
+    unset -nocomplain ::chan-16.6-data
+    unset -nocomplain ::chan-16.6-done
+    unset -nocomplain ::server
+    unset -nocomplain ::client
+}
+
+# TIP 287: chan pendingoutput
+test chan-17.1 {chan command: pendingoutput subcommand} -body {
+    chan pendingoutput foo bar
+} -returnCodes error -result "wrong # args: should be \"chan pendingoutput channelId\""
+test chan-17.2 {chan command: pendingoutput subcommand} -body {
+    chan pendingoutput stdin
+} -result -1
+test chan-17.3 {chan command: pendingoutput subcommand} -body {
+    chan pendingoutput stdout
+} -result 0
+test chan-17.4 {chan command: pendingoutput subcommand} -body {
+    chan pendingoutput FOOBAR
+} -returnCodes error -result "can not find channel named \"FOOBAR\""
+test chan-17.5 {chan command: pendingoutput subcommand} -setup {
+    set file [makeFile {} testPendingOutput]
+    set f [open $file w+]
+    chan configure $f -translation lf -buffering full -buffersize 1024
+} -body {
+    set result [list]
+    chan puts $f [string repeat x 512]
+    lappend result [chan pendingoutput $f]
+    chan flush $f
+    lappend result [chan pendingoutput $f]
+} -result [list 513 0] -cleanup {
+    unset -nocomplain result
+    catch {chan close $f}
+    catch {removeFile $file}
+}
+
 cleanupTests
 return
 
--- tests/ioCmd.test.orig	2006-10-28 23:06:44.000000000 -0600
+++ tests/ioCmd.test	2006-11-05 15:00:08.000000000 -0700
@@ -628,7 +628,7 @@
 test iocmd-20.1 {chan, unknown method} {
     catch {chan foo} msg
     set msg
-} {unknown or ambiguous subcommand "foo": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, postevent, puts, read, seek, tell, or truncate}
+} {unknown or ambiguous subcommand "foo": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, pendinginput, pendingoutput, postevent, puts, read, seek, tell, or truncate}
 
 # --- --- --- --------- --------- ---------
 # chan create, and method "initalize"