summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2006-12-01 15:55:43 (GMT)
committerdgp <dgp@users.sourceforge.net>2006-12-01 15:55:43 (GMT)
commit986958b3d40c8667b6f7232cd0d7d7c6987014a6 (patch)
treee4a04cf8dde40fdd70f655a5519108dcd36b9f83
parent84e12e85c42e0e68ff5aa6b331aa0d53962f7c5a (diff)
downloadtcl-986958b3d40c8667b6f7232cd0d7d7c6987014a6.zip
tcl-986958b3d40c8667b6f7232cd0d7d7c6987014a6.tar.gz
tcl-986958b3d40c8667b6f7232cd0d7d7c6987014a6.tar.bz2
TIP#287 IMPLEMENTATION
* doc/chan.n: New subcommand [chan pending]. * generic/tclBasic.c: Thanks to Michael Cleverly for proposal * generic/tclInt.h: and implementation. * generic/tclIOCmd.c: * library/init.tcl: * tests/chan.test: * tests/ioCmd.test:
-rw-r--r--ChangeLog10
-rw-r--r--doc/chan.n12
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclIOCmd.c70
-rw-r--r--generic/tclInt.h5
-rw-r--r--library/init.tcl4
-rw-r--r--libtommath/bn_mp_div.c6
-rw-r--r--tests/chan.test114
-rw-r--r--tests/ioCmd.test4
9 files changed, 220 insertions, 11 deletions
diff --git a/ChangeLog b/ChangeLog
index 3b93ebb..b19360d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,15 @@
2006-12-01 Don Porter <dgp@users.sourceforge.net>
+ TIP#287 IMPLEMENTATION
+
+ * doc/chan.n: New subcommand [chan pending].
+ * generic/tclBasic.c: Thanks to Michael Cleverly for proposal
+ * generic/tclInt.h: and implementation.
+ * generic/tclIOCmd.c:
+ * library/init.tcl:
+ * tests/chan.test:
+ * tests/ioCmd.test:
+
TIP#298 IMPLEMENTATION
* generic/tcl.decls: Tcl_GetBignumAndClearObj -> Tcl_TakeBignumFromObj.
diff --git a/doc/chan.n b/doc/chan.n
index 6b912c1..9e51251 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -4,7 +4,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-'\" RCS: @(#) $Id: chan.n,v 1.6 2006/11/16 09:34:17 dkf Exp $
+'\" RCS: @(#) $Id: chan.n,v 1.7 2006/12/01 15:55:44 dgp Exp $
.so man.macros
.TH chan n 8.5 Tcl "Tcl Built-In Commands"
.BS
@@ -493,6 +493,16 @@ Produces a list of all channel names. If \fIpattern\fR is specified,
only those channel names that match it (according to the rules of
\fBstring match\fR) will be returned.
.TP
+\fBchan pending \fImode channelId\fR
+.
+Depending on whether \fImode\fr is "input" or "output", returns the number of
+bytes of input or output (respectively) currently buffered
+internally for \fIchannelId\fr (especially useful in a readable event
+callback to impose application-specific limits on input 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 the mode in question.
+.TP
\fBchan postevent \fIchannelId eventSpec\fR
.
This subcommand is used by command handlers specified with \fBchan
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 5df0a81..a3fb387 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.222 2006/11/29 15:01:26 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.223 2006/12/01 15:55:44 dgp Exp $
*/
#include "tclInt.h"
@@ -574,6 +574,10 @@ Tcl_CreateInterp(void)
Tcl_CreateObjCommand(interp, "::tcl::chan::rPostevent",
TclChanPostEventObjCmd, (ClientData) NULL, NULL);
+ /* TIP #287 */
+ Tcl_CreateObjCommand(interp, "::tcl::chan::Pending",
+ TclChanPendingObjCmd, (ClientData) NULL, NULL);
+
/*
* Register the built-in functions. This is empty now that they are
* implemented as commands in the ::tcl::mathfunc namespace.
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 4b5974b..c2c1bb8 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOCmd.c,v 1.34 2006/07/20 06:17:39 das Exp $
+ * RCS: @(#) $Id: tclIOCmd.c,v 1.35 2006/12/01 15:55:44 dgp Exp $
*/
#include "tclInt.h"
@@ -1619,6 +1619,74 @@ Tcl_FcopyObjCmd(
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclChanPendingObjCmd --
+ *
+ * This function is invoked to process the Tcl "chan pending"
+ * 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 buffered input or
+ * output (depending on whether the first argument is "input" or
+ * "output"), or -1 if the channel wasn't opened for that mode.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TclChanPendingObjCmd(
+ ClientData unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *CONST objv[]) /* Argument objects. */
+{
+ Tcl_Channel chan;
+ int index, mode;
+ char *arg;
+ static CONST char *options[] = {"input", "output", (char *) NULL};
+ enum options {PENDING_INPUT, PENDING_OUTPUT};
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "mode channelId");
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "mode", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ arg = Tcl_GetString(objv[2]);
+ chan = Tcl_GetChannel(interp, arg, &mode);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+
+ switch ((enum options) index) {
+ case PENDING_INPUT:
+ if ((mode & TCL_READABLE) == 0) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_InputBuffered(chan)));
+ }
+ return TCL_OK;
+ case PENDING_OUTPUT:
+ if ((mode & TCL_WRITABLE) == 0) {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_OutputBuffered(chan)));
+ }
+ return TCL_OK;
+ }
+}
+
+/*
*----------------------------------------------------------------------
*
* Tcl_ChanTruncateObjCmd --
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 0fb2ebf..e28e849 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.299 2006/11/28 22:20:29 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.300 2006/12/01 15:55:45 dgp Exp $
*/
#ifndef _TCLINT
@@ -2465,6 +2465,9 @@ MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_CdObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *CONST objv[]);
+MODULE_SCOPE int TclChanPendingObjCmd(
+ 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[]);
diff --git a/library/init.tcl b/library/init.tcl
index 13f6d96..838aa7b 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -3,7 +3,7 @@
# Default system startup file for Tcl-based applications. Defines
# "unknown" procedure and auto-load facilities.
#
-# RCS: @(#) $Id: init.tcl,v 1.89 2006/11/20 14:28:03 dkf Exp $
+# RCS: @(#) $Id: init.tcl,v 1.90 2006/12/01 15:55:45 dgp Exp $
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -78,6 +78,7 @@ namespace eval tcl {
# Set up the 'chan' ensemble (TIP #208).
namespace eval chan {
# TIP #219. Added methods: create, postevent.
+ # TIP 287. Added method: pending.
namespace ensemble create -command ::chan -map {
blocked ::tcl::chan::blocked
close ::tcl::chan::close
@@ -89,6 +90,7 @@ namespace eval tcl {
flush ::tcl::chan::flush
gets ::tcl::chan::gets
names {::file channels}
+ pending ::tcl::chan::Pending
postevent ::tcl::chan::rPostevent
puts ::tcl::chan::puts
read ::tcl::chan::read
diff --git a/libtommath/bn_mp_div.c b/libtommath/bn_mp_div.c
index d1b5c48..b80797f 100644
--- a/libtommath/bn_mp_div.c
+++ b/libtommath/bn_mp_div.c
@@ -87,6 +87,7 @@ LBL_ERR:
#else
+#if 0
/* Integer signed division.
*
* c*b + d == a, that is, c = a/b and c = a%b
@@ -236,6 +237,7 @@ int mp_div(mp_int* a, mp_int* b, mp_int* c, mp_int* d)
return res;
}
+#endif
/* integer signed division.
* c*b + d == a [e.g. a/b, c=quotient, d=remainder]
@@ -438,5 +440,5 @@ LBL_Q:mp_clear (&q);
#endif
/* $Source: /root/tcl/repos-to-convert/tcl/libtommath/bn_mp_div.c,v $ */
-/* $Revision: 1.2 $ */
-/* $Date: 2006/12/01 00:31:32 $ */
+/* $Revision: 1.3 $ */
+/* $Date: 2006/12/01 15:55:45 $ */
diff --git a/tests/chan.test b/tests/chan.test
index f2376a3..a4d2f8e 100644
--- a/tests/chan.test
+++ b/tests/chan.test
@@ -7,7 +7,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: chan.test,v 1.5 2005/08/24 17:56:24 andreas_kupries Exp $
+# RCS: @(#) $Id: chan.test,v 1.6 2006/12/01 15:55:45 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -24,7 +24,7 @@ test chan-1.1 {chan command general syntax} -body {
} -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 blocked, close, configure, copy, create, eof, event, flush, gets, names, pending, postevent, puts, read, seek, tell, or truncate"
test chan-2.1 {chan command: blocked subcommand} -body {
chan blocked foo bar
@@ -96,6 +96,116 @@ test chan-15.2 {chan command: truncate subcommand} -setup {
catch {removeFile $file}
}
+# TIP 287: chan pending
+test chan-16.1 {chan command: pending subcommand} -body {
+ chan pending
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.2 {chan command: pending subcommand} -body {
+ chan pending stdin
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.3 {chan command: pending subcommand} -body {
+ chan pending stdin stdout stderr
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.4 {chan command: pending subcommand} -body {
+ chan pending {input output} stdout
+} -returnCodes error -result "bad mode \"input output\": must be input or output"
+test chan-16.5 {chan command: pending input subcommand} -body {
+ chan pending input stdout
+} -result -1
+test chan-16.6 {chan command: pending input subcommand} -body {
+ chan pending input stdin
+} -result 0
+test chan-16.7 {chan command: pending input subcommand} -body {
+ chan pending input FOOBAR
+} -returnCodes error -result "can not find channel named \"FOOBAR\""
+test chan-16.8 {chan command: pending input 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 pending input $f
+} -result 8 -cleanup {
+ catch {chan close $f}
+ catch {removeFile $file}
+}
+test chan-16.9 {chan command: pending input subcommand} -setup {
+ proc chan-16.9-accept {sock addr port} {
+ chan configure $sock -blocking 0 -buffering line -buffersize 32
+ chan event $sock readable [list chan-16.9-readable $sock]
+ }
+
+ proc chan-16.9-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 pending input $sock]
+
+ lappend ::chan-16.9-data $r $l $e $b $i
+
+ if {$r != -1 || $e || $l || !$b || $i > 128} {
+ set data [read $sock $i]
+ lappend ::chan-16.9-data [string range $data 0 2]
+ lappend ::chan-16.9-data [string range $data end-2 end]
+ set ::chan-16.9-done 1
+ }
+ }
+
+ proc chan-16.9-client {} {
+ chan puts -nonewline $::client ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890
+ chan flush $::client
+ after 100 chan-16.9-client
+ }
+
+ set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0]
+ set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]]
+ set ::chan-16.9-data [list]
+ set ::chan-16.9-done 0
+} -body {
+ after idle chan-16.9-client
+ vwait ::chan-16.9-done
+ set ::chan-16.9-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.9-accept {}
+ rename chan-16.9-readable {}
+ rename chan-16.9-client {}
+ unset -nocomplain ::chan-16.9-data
+ unset -nocomplain ::chan-16.9-done
+ unset -nocomplain ::server
+ unset -nocomplain ::client
+}
+test chan-16.10 {chan command: pending output subcommand} -body {
+ chan pending output stdin
+} -result -1
+test chan-16.11 {chan command: pending output subcommand} -body {
+ chan pending output stdout
+} -result 0
+test chan-16.12 {chan command: pending output subcommand} -body {
+ chan pending output FOOBAR
+} -returnCodes error -result "can not find channel named \"FOOBAR\""
+test chan-16.13 {chan command: pending output 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 pending output $f]
+ chan flush $f
+ lappend result [chan pending output $f]
+} -result [list 513 0] -cleanup {
+ unset -nocomplain result
+ catch {chan close $f}
+ catch {removeFile $file}
+}
+
cleanupTests
return
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index e2d8327..9a4a80d 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: ioCmd.test,v 1.30 2006/11/03 11:45:34 dkf Exp $
+# RCS: @(#) $Id: ioCmd.test,v 1.31 2006/12/01 15:55:45 dgp Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -628,7 +628,7 @@ test iocmd-20.0 {chan, wrong#args} {
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, pending, postevent, puts, read, seek, tell, or truncate}
# --- --- --- --------- --------- ---------
# chan create, and method "initalize"