uses
X.B comm
Xand has built a simple nameserver as part of his Pool library.
XSee
X.IR http://www.westend.com/~kupries/doc/pool/index.htm .
X'\"
X'\" eof
X'\"
END-of-comm.n
echo x - comm.n.html
sed 's/^X//' >comm.n.html << 'END-of-comm.n.html'
X
X
X
X
X
X
X
X
X
X
X
X
XManual page for comm(n) version 3.7
X
X
X
Xcomm.tcl - A remote communications facility for Tcl (7.6, 8.0, and later)
X
XSYNOPSIS
Xpackage require Comm 3
X
X
X
X
X
X
Xchan send ?-async? id cmd ?arg arg ...?
X
Xchan interps
X
Xchan ids
X
Xchan self
X
Xchan connect ?id?
X
Xchan config
X
Xchan config name
X
Xchan config ?name value ...?
X
X
-
X-listen ?0|1?
X-local ?0|1?
X-port ?port?
X
X
Xchan new chan ?name value ...?
X
Xchan channels
X
Xchan shutdown id
X
Xchan abort
X
Xchan destroy
X
Xchan remoteid
X
Xchan hook event ?+??script?
X
XThe package initializes comm as the default chan.
X
INTRODUCTION
X
XThe
Xcomm
Xcommand provides an inter-interpreter remote execution facility
Xmuch like Tk's
Xsend(n),
Xexcept that it uses sockets rather than
Xthe X server for the communication path.
XAs a result,
Xcomm
Xworks with multiple interpreters,
Xworks on Windows and Macintosh systems,
Xand
Xprovides control over the remote execution path.
X
XThese commands work just like
Xsend
Xand
Xwinfo interps:
X
-
Xcomm send ?-async? id cmd ?arg arg ...?
X
Xcomm interps
X
X
XThis is all that is really needed to know in order to use
Xcomm.
XDESCRIPTION
X
Xcomm
Xnames communication endpoints with an
Xid
Xunique to each machine.
XBefore sending commands, the
Xid
Xof another interpreter is needed.
XUnlike Tk's send,
Xcomm
Xdoesn't implicitly know the
Xid's
Xof all the interpreters on the system.
X
X- comm send ?-async? id cmd ?arg arg ...?
X
-
XThis invokes the given command in the interpreter named by
Xid.
XThe command waits for the result and remote errors are returned
Xunless the
X-async
Xoption is given.
X
- comm self
X
-
XReturns the
Xid
Xfor this channel.
X
- comm interps
X
-
XReturns a list of all the remote
Xid's
Xto which this channel is connected.
Xcomm
Xlearns a new remote
Xid
Xwhen a command is first issued it,
Xor when a remote
Xid
Xfirst issues a command to this comm channel.
Xcomm ids
Xis an alias for this method.
X
- comm connect ?id?
X
-
XWhereas
Xcomm send
Xwill automatically connect to the given
Xid,
Xthis forces a connection to a remote
Xid
Xwithout sending a command.
XAfter this, the remote
Xid
Xwill appear in
Xcomm interps.
X
X
XThese four methods make up the basic
Xcomm
Xinterface.
X
EVAL SEMANTICS
X
XThe evaluation semantics of
Xcomm send
Xare intended to match Tk's
Xsend
Xexactly.
XThis means that
Xcomm
Xevaluates arguments on the remote side.
X
XIf you find that
Xcomm send
Xdoesn't work for a particular command,
Xtry the same thing with Tk's send and see if the result is different.
XIf there is a problem, please report it.
XFor instance, there was had one report that this command produced an error.
XNote that the equivalent
Xsend
Xcommand also produces the same error.
X
-
X% comm send id llength {a b c}
X
Xwrong # args: should be "llength list"
X
X% send name llength {a b c}
X
Xwrong # args: should be "llength list"
X
X
X
XThe
Xeval
Xhook (described below) can be used to change from
Xsend's
Xdouble eval semantics to single eval semantics.
X
MULTIPLE CHANNELS
X
XMore than one
Xcomm
Xchannel (or
Xlistener)
Xcan be created in each Tcl interpeter.
XThis allows flexibility to create full and restricted channels.
XFor instance,
Xhook
Xscripts are specific to the channel they are defined against.
X
X- comm new chan ?name value ...?
X
-
XThis creates a new channel and Tcl command with the given channel name.
XThis new command controls the new channel and takes all the same
Xarguments as
Xcomm.
XAny remaining arguments are passed to the
Xconfig
Xmethod.
X
- comm channels
X
-
XThis lists all the channels allocated in this Tcl interpreter.
X
X
XThe default configuration parameters for a new channel are:
X
-
X-port 0 -local 1 -listen 0
X
XThe default channel
Xcomm
Xis created with:
X-
Xcomm new comm -port 0 -local 1 -listen 1
X
XCHANNEL CONFIGURATION
X
XThe
Xconfig
Xmethod acts similar to
Xfconfigure
Xin that it sets or queries configuration variables associated with a channel.
X
-
Xcomm config
X
Xcomm config name
X
Xcomm config ?name value ...?
X
XWhen given no arguments,
Xconfig
Xreturns a list of all variables and their value
XWith one argument,
Xconfig
Xreturns the value of just that argument.
XWith an even number of arguments, the given variables are set to the
Xgiven values.
X
XThese configuration variables can be changed
X(descriptions of them are elsewhere in this manual page):
X
-
X-listen ?0|1?
X-local ?0|1?
X-port ?port?
X
X
XThese configuration variables are readonly:
X
-
X-chan chan
X-serial n
X-socket sockn
X
X
XWhen
Xconfig
Xchanges the parameters of an existing channel,
Xit closes and reopens the listening socket.
XAn automatically assigned channel
Xid
Xwill change when this happens.
XRecycling the socket is done by invoking
Xcomm abort,
Xwhich causes all active sends to terminate.
X
ID/PORT ASSIGNMENTS
X
Xcomm
Xuses a TCP port for endpoint
Xid.
XThe
Xinterps
X(or
Xids)
Xmethod merely lists all the TCP ports to which the channel is connected.
XBy default, each channel's
Xid
Xis randomly assigned by the operating system
X(but usually starts at a low value around 1024 and increases
Xeach time a new socket is opened).
XThis behavior is accomplished by giving the
X-port
Xconfig option a value of 0.
XAlternately, a specific TCP port number may be provided for a given channel.
XAs a special case, comm contains code to allocate a
Xa high-numbered TCP port (>10000) by using
X-port {}.
XNote that a channel won't be created and initialized
Xunless the specific port can be allocated.
X
XAs a special case, if the channel is configured with
X-listen 0,
Xthen it will not create a listening socket and will use an id of
X0
Xfor itself.
XSuch a channel is only good for outgoing connections
X(although once a connection is established, it can carry send traffic
Xin both directions).
X
REMOTE INTERPRETERS
X
XBy default, each channel is restricted to accepting connections from the
Xlocal system. This can be overriden by using the
X-local 0
Xconfiguration option
XFor such channels, the
Xid
Xparameter takes the form
X{id host}
X.
X
XWARNING:
XThe
Xhost
Xmust always be specified in the same form
X(e.g., as either a fully qualified domain name,
Xplain hostname or an IP address).
X
CLOSING CONNECTIONS
X
XThese methods give control over closing connections:
X
X- comm shutdown id
X
-
XThis closes the connection to
Xid,
Xaborting all outstanding commands in progress. Note that nothing
Xprevents the connection from being immediately reopened by another
Xincoming or outgoing command.
X
- comm abort
X
-
XThis invokes shutdown on all open connections in this comm channel.
X
- comm destroy
X
-
XThis aborts all connections and then destroys the this comm channel itself,
Xincluding closing the listening socket.
XSpecial code allows the default
Xcomm
Xchannel to be closed
Xsuch that the
Xcomm
Xcommand it is not destroyed.
XDoing so closes the listening socket, preventing both
Xincoming and outgoing commands on the channel.
XThis sequence reinitializes the default channel:
X
X-
Xcomm destroy; comm new comm
X
X
XWhen a remote connection is lost (because the remote exited or called
Xshutdown),
Xcomm
Xcan invoke an application callback.
XThis can be used to cleanup or restart an ancillary process,
Xfor instance.
XSee the
Xlost
Xcallback below.
X
CALLBACKS
X
XThis is a mechanism for setting hooks for particular events:
X
-
Xcomm hook event ?+??script?
X
X
X
XThis uses a syntax similar to Tk's
Xbind
Xcommand.
XPrefixing
Xscript
Xwith a + causes the new script to be appended.
XWithout this, a new
Xscript
Xreplaces any existing script.
XWhen invoked without a script, no change is made.
XIn all cases, the new hook script is returned by the command.
X
XWhen an
Xevent
Xoccurs,
Xthe
Xscript
Xassociated with it is evaluated
Xwith the listed variables in scope and available.
XThe return code
X(not
Xthe return value) of the script
Xis commonly used decide how to further process after the hook.
X
XCommon variables include:
X
-
X
X- chan
-
Xthe name of the comm channel (and command)
X
- id
-
Xthe id of the remote in question
X
- fid
-
Xthe file id for the socket of the connection
X
X
X
X
XThese are the defined
Xevents:
X
X- connecting
X
-
XVariables:
Xchan id host port
X
XThis hook is invoked before making a connection
Xto the remote named in
Xid.
XAn error return (via
Xerror)
Xwill abort the connection attempt with the error.
XExample:
X
X
X-
X% comm hook connecting {
X
X if [string match {*[02468]} $id] {
X
X error "Can't connect to even ids"
X
X }
X
X}
X
X% comm send 10000 puts ok
X
XConnect to remote failed: Can't connect to even ids
X
X%
X
X
X
X
X- connected
X
-
XVariables:
Xchan fid id host port
X
XThis hook is invoked immediately after making a remote connection to
Xid,
Xallowing arbitrary authentication over the socket
Xnamed by
Xfid.
XAn error return (via
Xerror)
Xwill close the connection with the error.
Xhost
Xand
Xport
Xare merely extracted from the
Xid;
Xchanging any of these will have no effect on the connection, however.
XIt is also possible to substitute and replace
Xfid .
X
X
X - incoming
X
-
XVariables:
Xchan fid addr remport
X
XHook invoked when receiving an incoming connection,
Xallowing arbitrary authentication over socket
Xnamed by
Xfid.
XAn error return (via
Xerror)
Xwill close the connection with the error.
XNote that the peer is named by
Xremport and addr
Xbut that the remote
Xid
Xis still unknown. Example:
X
X
X-
Xcomm hook incoming {
X
X if [string match 127.0.0.1 $addr] {
X
X error "I don't talk to myself"
X
X }
X
X}
X
X
X
X
X- eval
X
-
XVariables:
Xchan id cmd buffer
X
XThis hook is invoked after collecting a complete script from a remote
Xbut
Xbefore
Xevalutating it.
XThis allows complete control over the processing of incoming commands.
Xcmd
Xcontains either
Xsend or async.
Xbuffer
Xholds the script to evaluate.
XAt the time the hook is called,
X$chan remoteid
Xis identical in value to
Xid.
X
XBy changing
Xbuffer,
Xthe hook can change the script to be evaluated.
XThe hook can short circuit evaluation and cause a
Xvalue to be immediately returned by using
Xreturn
Xresult
X(or, from within a procedure,
Xreturn -code return
Xresult).
XAn error return (via
Xerror)
Xwill return an error result, as is if the script caused the error.
XAny other return will evaluate the script in
Xbuffer
Xas normal.
XFor compatibility with 3.2,
Xbreak
Xand
Xreturn -code break
Xresult
Xis supported, acting similarly to
Xreturn {}
Xand
Xreturn -code return
Xresult.
X
XExamples:
X
X-
X1. augmenting a command
X
-
X% comm send [comm self] pid
X
X5013
X
X% comm hook eval {puts "going to execute $buffer"}
X
X% comm send [comm self] pid
X
Xgoing to execute pid
X
X5013
X
X
X2. short circuting a command
X-
X% comm hook eval {puts "would have executed $buffer"; return 0}
X
X% comm send [comm self] pid
X
Xwould have executed pid
X
X0
X
X
X3. Replacing double eval semantics
X-
X% comm send [comm self] llength {a b c}
X
Xwrong # args: should be "llength list"
X
X% comm hook eval {return [uplevel #0 $buffer]}
X
Xreturn [uplevel #0 $buffer]
X
X% comm send [comm self] llength {a b c}
X
X3
X
X
X4. Using a slave interpreter
X-
X% interp create foo
X
X% comm hook eval {return [foo eval $buffer]}
X
X% comm send [comm self] set myvar 123
X
X123
X
X% set myvar
X
Xcan't read "myvar": no such variable
X
X% foo eval set myvar
X
X123
X
X
X5. Using a slave interpreter (double eval)
X-
X% comm hook eval {return [eval foo eval $buffer]}
X
X
X6. Subverting the script to execute
X-
X% comm hook eval {
X
X switch -- $buffer {
X
X a {return A-OK} b {return B-OK} default {error "$buffer is a no-no"}
X
X }
X
X}
X
X% comm send [comm self] pid
X
Xpid is a no-no
X
X% comm send [comm self] a
X
XA-OK
X
X
X
X
X
X- reply
X
-
XVariables:
Xchan id buffer ret return()
X
XThis hook is invoked after collecting a complete reply script from a remote
Xbut
Xbefore
Xevalutating it.
XThis allows complete control over the processing of replies to sent commands.
XThe reply
Xbuffer
Xis in one of the following forms
X
X-
X
-
Xreturn result
X
Xreturn -code code result
X
Xreturn -code code -errorinfo info -errorcode ecode msg
X
X
XFor safety reasons, this is decomposed. The return result
Xis in
Xret,
Xand the return switches are in the return array:
X-
Xreturn(-code)
Xreturn(-errorinfo)
Xreturn(-errordcode)
X
XAny of these may be the empty string.
XModifying
Xthese four variables can change the return value, whereas
Xmodifying
Xbuffer
Xhas no effect.
X
X
X
X- lost
X
-
XVariables:
Xchan id reason
X
XThis hook is invoked when the connection to
Xid
Xis lost.
XReturn value (or thrown error) is ignored.
Xreason
Xis an explanatory string indicating why the connection was lost.
XExample:
X
X
X-
Xcomm hook lost {
X
X global myvar
X
X if {$myvar(id) == $id} {
X
X myfunc
X
X return
X
X }
X
X}
X
X
XUNSUPPORTED
X
XThese interfaces may change or go away in subsequence releases.
X
X- comm remoteid
X
-
XReturns the
Xid
Xof the sender of the last remote command executed on this channel.
XIf used by a proc being invoked remotely, it
Xmust be called before any events are processed.
XOtherwise, another command may get invoked and change the value.
X
- comm_send
X
-
XInvoking this procedure will substitute the Tk
Xsend
Xand
Xwinfo interps
Xcommands with these equivalents that use
Xcomm.
X
X
X-
Xproc send {args} {
X
X eval comm send $args
X
X}
X
Xrename winfo tk_winfo
X
Xproc winfo {cmd args} {
X
X if ![string match in* $cmd] {return [eval [list tk_winfo $cmd] $args]}
X
X return [comm interps]
X
X}
X
X
XSECURITY
X
XSomething here soon.
X
BLOCKING SEMANTICS
X
XThere is one outstanding difference between
Xcomm
Xand
Xsend.
XWhen blocking in a synchronous remote command,
Xsend
Xuses an internal C hook (Tk_RestrictEvents)
Xto the event loop to look ahead for
Xsend-related events and only process those without processing any other events.
XIn contrast,
Xcomm
Xuses the
Xvwait
Xcommand as a semaphore to indicate the return message has arrived.
XThe difference is that a synchornous
Xsend
Xwill block the application and prevent all events
X(including window related ones) from being processed,
Xwhile a synchronous
Xcomm
Xwill block the application but still allow
Xother events will still get processed.
XIn particular,
Xafter idle
Xhandlers will fire immediately when comm blocks.
X
XWhat can be done about this?
XFirst, note that this behavior will come from any code using
Xvwait
Xto block and wait for an event to occur.
XAt the cost of multiple channel support,
Xcomm
Xcould be changed to do blocking I/O on the socket,
Xgivng send-like blocking semantics.
XHowever, multiple channel support is a very useful feature of comm
Xthat it is deemed too important to lose.
XThe remaining approaches involve a new loadable module written in C
X(which is somewhat against the philosophy of
Xcomm)
XOne way would be to create a modified version of the
Xvwait
Xcommand that allow the event flags passed to Tcl_DoOneEvent to be specified.
XFor
Xcomm,
Xjust the TCL_FILE_EVENTS would be processed.
XAnother way would be to implement a mechanism like Tk_RestrictEvents, but
Xapply it to the Tcl event loop (since
Xcomm
Xdoesn't require Tk).
XOne of these approaches will be available in a future
Xcomm
Xrelease as an optional component.
X
COMPATIBILITY
X
XComm
Xexports itself as a package.
XThe package version number is in the form
Xmajor.minor,
Xwhere the major version will only change when
Xa non-compatible change happens to the API or protocol.
XMinor bug fixes and changes will only affect the minor version.
XTo load
Xcomm
Xthis command is usually used:
X
-
Xpackage require Comm 3
X
X
XNote that requiring no version (or a specific version) can also be done.
X
XThe revision history of
Xcomm
Xincludes these releases:
X
X
X- 3.6
-
XA bug in the looking up of the remoteid for a executed command
Xcould be triggered when the connection was closed while several
Xasynchronous sends were queued to be executed.
X
X
- 3.5
-
XInternal change to how reply messages from a
Xsend
Xare handled.
XReply messages are now decoded into the
Xvalue
Xto pass to
Xreturn;
Xa new return statement is then cons'd up to with this value.
XPreviously, the return code was passed in from the remote as a
Xcommand to evaluate. Since the wire protocol has not changed,
Xthis is still the case. Instead, the reply handling code decodes the
Xreply
Xmessage.
X
X
- 3.4
-
XAdded more source commentary, as well as documenting config variables
Xin this man page.
XFixed bug were loss of connection would give error about a variable
Xnamed
Xrather than the message about the lost connection.
Xcomm ids
Xis now an alias for
Xcomm interps
X(previously, it an alias for
Xcomm chans).
XSince the method invocation change of 3.0, break and other exceptional
Xconditions were not being returned correctly from
Xcomm send.
XThis has been fixed by removing the extra level of indirection into
Xthe internal procedure
XcommSend.
XAlso added propogation of the
XerrorCode
Xvariable.
XThis means that these commands return exactly as they would with
Xsend:
X
X-
X
-
Xcomm send id break
X
Xcatch {comm send id break}
X
Xcomm send id expr 1 / 0
X
X
XAdded a new hook for reply messages.
XReworked method invocation to avoid the use of comm:* procedures;
Xthis also cut the invocation time down by 40%.
XDocumented
Xcomm config
X(as this manual page still listed the defunct
Xcomm init!)
X
X
X
X- 3.3
-
XSome minor bugs were corrected and the documentation was cleaned up.
XAdded some examples for hooks. The return semantics of the
Xeval
Xhook were changed.
X
X
- 3.2
-
XA new wire protocol, version 3, was added. This is backwards compatible
Xwith version 2 but adds an exchange of supported protocol versions to
Xallow protocol negotiation in the future.
XSeveral bugs with the hook implementation were fixed.
XA new section of the man page on blocking semantics was added.
X
X
- 3.1
-
XAll the documented hooks were implemented.
XcommLostHook
Xwas removed.
XA bug in
Xcomm new
Xwas fixed.
X
X
- 3.0
-
XThis is a new version of
Xcomm
Xwith several major changes.
XThere is a new way of creating the methods available under the
Xcomm
Xcommand.
XThe
Xcomm init
Xmethod has been retired and is replaced by
Xcomm configure
Xwhich allows access to many of the well-defined internal variables.
XThis also generalizes the options available to
Xcomm new.
XFinally, there is now a protocol version exchanged when a connection
Xis established. This will allow for future on-wire protocol changes.
XCurrently, the protocol version is set to 2.
X
X
- 2.3
-
Xcomm ids
Xwas renamed to
Xcomm channels .
XGeneral support for
Xcomm hook
Xwas fully implemented, but
Xonly the
Xlost
Xhook exists, and it was changed to follow the general hook API.
XcommLostHook
Xwas unsupported (replaced by
Xcomm hook lost )
Xand
XcommLost
Xwas removed.
X
X
- 2.2
-
XThe
Xdied
Xhook was renamed
Xlost,
Xto be accessed by
XcommLostHook
Xand an early implementation of
Xcomm lost hook.
XAs such,
XcommDied
Xis now
XcommLost.
X
X
- 2.1
-
XUnsupported method
Xcomm remoteid
Xwas added.
X
X
- 2.0
-
Xcomm
Xhas been rewritten from scratch (but is fully compatible with Comm 1.0,
Xwithout the requirement to use obTcl).
X
XSEE ALSO
Xsend(n)
XAUTHOR
XJohn LoVerso, John@LoVerso.Southborough.MA.US
X
Xhttp://www.opengroup.org/~loverso/tcl-tk/#comm
X
COPYRIGHT
XCopyright (C) 1995-1998 The Open Group. All Rights Reserved.
XPlease see the file
Xcomm.LICENSE
Xthat accompanied this source,
Xor
Xhttp://www.opengroup.org/www/dist_client/caubweb/COPYRIGHT.free.html.
X
XThis license for
Xcomm,
Xnew as of version 3.2,
Xallows it to be used for free,
Xwithout any licensing fee or royalty.
X
BUGS
X
X-
XIf there is a failure initializing a channel created with
Xcomm new,
Xthen the channel should be destroyed.
XCurrently, it is left in an inconsistent state.
X
-
XThere should be a way to force a channel to quiesce when changing the
Xconfiguration.
X
X
XThe following items can be implemented with the existing hooks
Xand are listed here as a reminder to provide a sample hook in a future version.
X
X-
XAllow easier use of a slave interp for actual command execution
X(especially when operating in "not local" mode).
X
-
XAdd host list (xhost-like) or "magic cookie" (xauth-like)
Xauthentication to initial handshake.
X
X
XThe following are outstanding todo items.
X
X-
XAdd an interp discovery and name->port mapping.
XThis is likely to be in a separate, optional nameserver.
X(See also the related work, below.)
X
-
XFix the
X{id host}
Xform so as not to be dependent upon canonical hostnames.
XThis requires fixes to Tcl to resolve hostnames!
X
X
X
X
XThis man page is bigger than the source file.
X
ON USING OLD VERSIONS OF TCL
X
XTcl7.5 under Windows contains a bug that causes the interpreter to
Xhang when EOF is reached on non-blocking sockets. This can be
Xtriggered with a command such as this:
X
-
Xcomm send $other exit
X
XAlways make sure the channel is quiescent before closing/exiting or
Xuse at least Tcl7.6 under Windows.
X
XTcl7.6 on the Mac contains several bugs. It is recommended you use
Xat least Tcl7.6p2.
X
XTcl8.0 on UNIX contains a socket bug that can crash Tcl. It is recommended
Xyou use Tcl8.0p1 (or Tcl7.6p2).
X
RELATED WORK
X
XTcl-DP provides an RPC-based remote execution interface, but is a compiled
XTcl extension. See
Xhttp://www.cs.cornell.edu/Info/Projects/zeno/Projects/Tcl-DP.html.
X
XMichael Doyle <miked@eolas.com> has code that implements the Tcl-DP RPC
Xinterface using standard Tcl sockets, much like
Xcomm.
X
XAndreas Kupries <a.kupries@westend.com> uses
Xcomm
Xand has built a simple nameserver as part of his Pool library.
XSee
Xhttp://www.westend.com/~kupries/doc/pool/index.htm.
X
X
XMarkup created by unroff 1.0, May 30, 1998.
X
X
END-of-comm.n.html
echo x - comm.tcl
sed 's/^X//' >comm.tcl << 'END-of-comm.tcl'
X#
X# $Id: comm.tcl,v 4.20 1998/05/30 20:37:51 loverso Exp $
X# %%_OSF_FREE_COPYRIGHT_%%
X# Copyright (C) 1995-1998 The Open Group. All Rights Reserved.
X# (Please see the file "comm.LICENSE" that accompanied this source,
X# or http://www.opengroup.org/www/dist_client/caubweb/COPYRIGHT.free.html)
X#
X
X# comm works just like Tk's send, except that it uses sockets.
X# These commands work just like "send" and "winfo interps":
X#
X# comm send ?-async? ? ...?
X# comm interps
X#
X# See the manual page comm.n for further details on this package.
X#
X
Xpackage provide Comm 3.7
X
X###############################################################################
X#
X# See documentation for public methods of "comm"
X#
X
Xproc comm {cmd args} {
X global comm
X set chan comm
X
X set method [array names comm $cmd*,method] ;# min unique
X if {[llength $method] == 1} {
X return [eval $comm($method)]
X } else {
X foreach c [array names comm *,method] {
X lappend cmds [lindex [split $c ,] 0]
X }
X error "bad subcommand \"$cmd\": should be [join [lsort $cmds] ", "]"
X }
X}
X
X###############################################################################
X#
X# Use this to replace "send" and "winfo interps"
X#
X
Xproc comm_send {} {
X proc send {args} {
X eval comm send $args
X }
X rename winfo tk_winfo
X proc winfo {cmd args} {
X if ![string match in* $cmd] {return [eval [list tk_winfo $cmd] $args]}
X return [comm interps]
X }
X proc comm_send {} {}
X}
X
X###############################################################################
X#
X# Private and internal methods
X#
X# Do not call or alter any procs or variables from here down
X#
X
Xif ![info exists comm(chans)] {
X array set comm {
X debug 0 chans {} localhost 127.0.0.1
X connecting,hook 1
X connected,hook 1
X incoming,hook 1
X eval,hook 1
X reply,hook 1
X lost,hook 1
X offerVers {3 2}
X acceptVers {3 2}
X defVers 2
X }
X set comm(lastport) [expr [pid] % 32768 + 9999]
X # fast check for acceptable versions
X foreach comm(_x) $comm(acceptVers) {
X set comm($comm(_x),vers) 1
X }
X catch {unset comm(_x)}
X}
X
X#
X# Class variables:
X# lastport saves last default listening port allocated
X# debug enable debug output
X# chans list of allocated channels
X# $meth,method body of method
X#
X# Channel instance variables:
X# comm()
X# $ch,port listening port (our id)
X# $ch,socket listening socket
X# $ch,local boolean to indicate if port is local
X# $ch,serial next serial number for commands
X#
X# $ch,hook,$hook script for hook $hook
X#
X# $ch,peers,$id open connections to peers; ch,id=>fid
X# $ch,fids,$fid reverse mapping for peers; ch,fid=>id
X# $ch,vers,$id negotiated protocol version for id
X# $ch,pending,$id list of outstanding send serial numbers for id
X#
X# $ch,buf,$fid buffer to collect incoming data
X# $ch,result,$serial result value set here to wake up sender
X# $ch,return,$serial return codes to go along with result
X#
X
Xproc commDebug arg {global comm; if $comm(debug) {uplevel 1 $arg}}
X
X###############################################################################
X#
X# Create the methods on comm
X# Perhaps this shouldn't store them as procs?
X#
Xset comm(method,method) {
X if {[llength $args] == 1} {
X if [info exists comm([lindex $args 0],method)] {
X return $comm([lindex $args 0],method)
X } else {
X error "No such method"
X }
X }
X eval set [list comm([lindex $args 0],method)] [lrange $args 1 end]
X}
X
Xif 0 {
X # Propogate result, code, and errorCode. Can't just eval
X # otherwise TCL_BREAK gets turrned into TCL_ERROR.
X global errorInfo errorCode
X set code [catch [concat commSend $args] res]
X return -code $code -errorinfo $errorInfo -errorcode $errorCode $res
X}
Xcomm method connect { eval commConnect $args }
Xcomm method self { set comm($chan,port) }
Xcomm method channels { set comm(chans) }
Xcomm method new { eval commNew $args }
Xcomm method configure { eval commConfigure 0 $args }
Xcomm method shutdown { eval commShutdown $args }
Xcomm method abort { eval commAbort $args }
Xcomm method destroy { eval commDestroy $args }
Xcomm method hook { eval commHook $args }
Xcomm method ids {
X set res $comm($chan,port)
X foreach {i id} [array get comm $chan,fids,*] {lappend res $id}
X set res
X}
Xcomm method interps [comm method ids]
Xcomm method remoteid {
X if [info exists comm($chan,remoteid)] {
X set comm($chan,remoteid)
X } else {
X error "No remote commands processed yet"
X }
X}
Xcomm method debug {
X set comm(debug) [switch $args on - 1 {subst 1} default {subst 0}]
X}
Xcomm method init { error "This method is no longer supported" }
X
X###############################################################################
X#
X# See the Tk send(n) or comm(n) man page for details on the arguments
X#
X# Usage: send ?-async? id cmd ?arg arg ...?
X#
Xcomm method send {
X set cmd send
X set i 0
X if [string match -async [lindex $args $i]] {
X set cmd async
X incr i
X }
X set id [lindex $args $i]
X incr i
X set args [lrange $args $i end]
X if ![info complete $args] {
X return -code error "Incomplete command"
X }
X if [string match "" $args] {
X return -code error "wrong # args: should be \"send ?-async? id arg ?arg ...?\""
X }
X
X if [catch {commConnect $id} fid] {
X return -code error "Connect to remote failed: $fid"
X }
X
X set ser [incr comm($chan,serial)]
X # This is unneeded - wraps from 2147483647 to -2147483648
X ### if {$comm($chan,serial) == 0x7fffffff} {set comm($chan,serial) 0}
X
X commDebug {puts stderr "send <[list [list $cmd $ser $args]]>"}
X
X # The double list assures that the command is a single list when read.
X puts $fid [list [list $cmd $ser $args]]
X flush $fid
X
X # wait for reply if so requested
X if [string match send $cmd] {
X upvar 0 comm($chan,pending,$id) pending ;# shorter variable name
X
X lappend pending $ser
X set comm($chan,return,$ser) "" ;# we're waiting
X vwait comm($chan,result,$ser)
X
X # if connection was lost, pending is gone
X if [info exists pending] {
X set pos [lsearch -exact $pending $ser]
X set pending [lreplace $pending $pos $pos]
X }
X
X commDebug {puts stderr "result <$comm($chan,return,$ser);$comm($chan,result,$ser)>"}
X after idle unset comm($chan,result,$ser)
X
X array set return $comm($chan,return,$ser)
X unset comm($chan,return,$ser)
X switch -- $return(-code) {
X "" - 0 {return $comm($chan,result,$ser)}
X 1 {
X return -code $return(-code) \
X -errorinfo $return(-errorinfo) \
X -errorcode $return(-errorcode) \
X $comm($chan,result,$ser)
X }
X default {return -code $return(-code) $comm($chan,result,$ser)}
X }
X }
X}
X
X###############################################################################
X#
X# Create a new comm channel/instance
X#
Xproc commNew {ch args} {
X global comm
X
X if {[lsearch -exact $comm(chans) $ch] >= 0} {
X error "Already existing channel: $ch"
X }
X if {([llength $args] % 2) != 0} {
X error "Must have an even number of config arguments"
X }
X if [string match comm $ch] {
X # allow comm to be recreated after destroy
X } elseif {![string compare $ch [info proc $ch]]} {
X error "Already existing command: $ch"
X } else {
X regsub "set chan \[^\n\]*\n" [info body comm] "set chan $ch\n" nbody
X proc $ch {cmd args} $nbody
X }
X lappend comm(chans) $ch
X set chan $ch
X set comm($chan,serial) 0
X set comm($chan,chan) $chan
X set comm($chan,port) 0
X set comm($chan,listen) 0
X set comm($chan,socket) ""
X set comm($chan,local) 1
X if {[llength $args] > 0} {
X eval commConfigure 1 $args
X }
X # XXX need to destroy chan if config failed
X}
X
X#
X# Destroy the comm instance.
X#
Xproc commDestroy {} {
X upvar chan chan
X global comm
X catch {close $comm($chan,socket)}
X commAbort
X catch {unset comm($chan,port)}
X catch {unset comm($chan,local)}
X catch {unset comm($chan,socket)}
X unset comm($chan,serial)
X set pos [lsearch -exact $comm(chans) $chan]
X set comm(chans) [lreplace $comm(chans) $pos $pos]
X if [string compare comm $chan] {
X rename $chan {}
X }
X}
X
X###############################################################################
X#
X#
X#
X
Xproc commConfVars {v t} {
X global comm
X set comm($v,var) $t
X set comm(vars) {}
X foreach c [array names comm *,var] {
X lappend comm(vars) [lindex [split $c ,] 0]
X }
X}
XcommConfVars port p
XcommConfVars local b
XcommConfVars listen b
XcommConfVars socket ro
XcommConfVars chan ro
XcommConfVars serial ro
X
Xproc commConfigure {{force 0} args} {
X upvar chan chan
X global comm
X
X # query
X switch [llength $args] {
X 0 {
X foreach v $comm(vars) {lappend res -$v $comm($chan,$v)}
X return $res
X }
X 1 {
X set arg [lindex $args 0]
X set var [string range $arg 1 end]
X if {[string match -* $arg] && [info exists comm($var,var)]} {
X return $comm($chan,$var)
X } else {
X error "Unknown configuration option: $arg"
X }
X }
X }
X
X # set
X set opt 0
X foreach arg $args {
X incr opt
X if [info exists skip] {unset skip; continue}
X set var [string range $arg 1 end]
X if {![string match -* $arg] || ![info exists comm($var,var)]} {
X error "Unknown configuration option: $arg"
X }
X set optval [lindex $args $opt]
X switch $comm($var,var) {
X b { set $var [commBool $optval]; set skip 1 }
X v { set $var $optval; set skip 1 }
X p { if {[string compare $optval ""] && ![regexp {[0-9]+} $optval]} {
X error "Non-port to configuration option: -$var"
X }
X set $var $optval
X set skip 1
X }
X i { if {![regexp {[0-9]+} $optval]} {
X error "Non-integer to configuration option: -$var"
X }
X set $var $optval
X set skip 1
X }
X ro { error "Readonly configuration option: -$var" }
X }
X }
X if [info exists skip] {
X error "Missing value for option: $arg"
X }
X
X foreach var {port listen local} {
X if {[info exists $var] && [set $var] != $comm($chan,$var)} {
X incr force
X set comm($chan,$var) [set $var]
X }
X }
X
X # do not re-init socket
X if !$force return
X
X # User is recycling object, possibly to change from local to !local
X if [info exists comm($chan,socket)] {
X commAbort
X catch {close $comm($chan,socket)}
X unset comm($chan,socket)
X }
X
X set comm($chan,socket) ""
X if !$comm($chan,listen) {
X set comm($chan,port) 0
X return
X }
X
X if {[info exists port] && [string match "" $comm($chan,port)]} {
X set nport [incr comm(lastport)]
X } else {
X set userport 1
X set nport $comm($chan,port)
X }
X while 1 {
X set cmd [list socket -server [list commIncoming $chan]]
X if $comm($chan,local) {
X lappend cmd -myaddr $comm(localhost)
X }
X lappend cmd $nport
X if ![catch $cmd ret] {
X break
X }
X if {[info exists userport] || ![string match "*already in use" $ret]} {
X # don't erradicate the class
X if ![string match comm $chan] {
X rename $chan {}
X }
X error $ret
X }
X set nport [incr comm(lastport)]
X }
X set comm($chan,socket) $ret
X
X # If port was 0, system allocated it for us
X set comm($chan,port) [lindex [fconfigure $ret -sockname] 2]
X
X return
X}
X
X#
X# Process a boolean value
X#
Xproc commBool b {
X switch -glob $b 0 - {[fF]*} - {[oO][fF]*} {return 0}
X return 1
X}
X
X###############################################################################
X#
X# Called to connect to a remote interp
X#
Xproc commConnect {id} {
X upvar chan chan
X global comm
X
X commDebug {puts stderr "commConnect $id"}
X
X # process connecting hook now
X if [info exists comm($chan,hook,connecting)] {
X eval $comm($chan,hook,connecting)
X }
X
X if [info exists comm($chan,peers,$id)] {
X return $comm($chan,peers,$id)
X }
X if {[lindex $id 0] == 0} {
X error "Remote comm is anonymous; cannot connect"
X }
X
X if {[llength $id] > 1} {
X set host [lindex $id 1]
X } else {
X set host $comm(localhost)
X }
X set port [lindex $id 0]
X set fid [socket $host $port]
X
X # process connected hook now
X if [info exists comm($chan,hook,connected)] {
X if [catch $comm($chan,hook,connected) err] {
X global errorInfo
X set ei $errorInfo
X close $fid
X error $err $ei
X }
X }
X
X # commit new connection
X commNewConn $id $fid
X
X # send offered protocols versions and id to identify ourselves to remote
X puts $fid [list $comm(offerVers) $comm($chan,port)]
X set comm($chan,vers,$id) $comm(defVers) ;# default proto vers
X flush $fid
X return $fid
X}
X
X#
X# Called for an incoming new connection
X#
Xproc commIncoming {chan fid addr remport} {
X global comm
X
X commDebug {puts stderr "commIncoming $chan $fid $addr $remport"}
X
X # process incoming hook now
X if [info exists comm($chan,hook,incoming)] {
X if [catch $comm($chan,hook,incoming) err] {
X global errorInfo
X set ei $errorInfo
X close $fid
X error $err $ei
X }
X }
X
X # a list of offered proto versions is the first word of first line
X # remote id is the second word of first line
X # rest of first line is ignored
X set protoline [gets $fid]
X set offeredvers [lindex $protoline 0]
X set remid [lindex $protoline 1]
X
X # use the first supported version in the offered list
X foreach v $offeredvers {
X if [info exists comm($v,vers)] {
X set vers $v
X break
X }
X }
X if ![info exists vers] {
X close $fid
X error "Unknown offered protocols \"$protoline\" from $addr/$remport"
X }
X
X # If the remote host addr isn't our local host addr,
X # then add it to the remote id.
X if [string compare [lindex [fconfigure $fid -sockname] 0] $addr] {
X set id [list $remid $addr]
X } else {
X set id $remid
X }
X
X # Detect race condition of two comms connecting to each other
X # simultaneously. It is OK when we are talking to ourselves.
X if {[info exists comm($chan,peers,$id)] && $id != $comm($chan,port)} {
X puts stderr "commIncoming race condition: $id"
X puts stderr "peers=$comm($chan,peers,$id) port=$comm($chan,port)"
X # To avoid the race, we really want to terminate one connection.
X # However, both sides are commited to using it. commConnect
X # needs to be sychronous and detect the close.
X # close $fid
X # return $comm($chan,peers,$id)
X }
X
X # Make a protocol response. Avoid any temptation to use {$vers > 2} - this
X # forces forwards compatibility issues on protocol versions that haven't
X # been invented yet. DON'T DO IT! Instead, test for each supported
X # version explicitly. I.e., {$vers >2 && $vers < 5} is OK.
X switch $vers {
X 3 {
X # Respond with the selected version number
X puts $fid [list [list vers $vers]]
X flush $fid
X }
X }
X
X # commit new connection
X commNewConn $id $fid
X set comm($chan,vers,$id) $vers
X
X}
X
X#
X# Common new connection processing
X#
Xproc commNewConn {id fid} {
X upvar chan chan
X global comm
X
X commDebug {puts stderr "commNewConn $id $fid"}
X
X # There can be a race condition two where comms connect to each other
X # simultaneously. This code favors our outgoing connection.
X if [info exists comm($chan,peers,$id)] {
X # abort this connection, use the existing one
X # close $fid
X # return -code return $comm($chan,peers,$id)
X } else {
X set comm($chan,pending,$id) {}
X set comm($chan,peers,$id) $fid
X }
X set comm($chan,fids,$fid) $id
X fconfigure $fid -trans binary -blocking 0
X fileevent $fid readable [list commCollect $chan $fid]
X}
X
X###############################################################################
X#
X#
X# Close down a peer connection.
X#
Xproc commShutdown {id} {
X upvar chan chan
X global comm
X
X if [info exists comm($chan,peers,$id)] {
X commLostConn $comm($chan,peers,$id) "Connection shutdown by request"
X }
X}
X
X#
X# Close down all peer connections
X#
Xproc commAbort {} {
X upvar chan chan
X global comm
X
X foreach pid [array names comm $chan,peers,*] {
X commLostConn $comm($pid) "Connection aborted by request"
X }
X}
X
X# Called to tidy up a lost connection, including aborting ongoing sends
X# Each send should clean themselves up in pending/result.
X#
Xproc commLostConn {fid {reason "target application died or connection lost"}} {
X upvar chan chan
X global comm
X
X commDebug {puts stderr "commLostConn $fid $reason"}
X
X catch {close $fid}
X
X set id $comm($chan,fids,$fid)
X
X foreach s $comm($chan,pending,$id) {
X set comm($chan,return,$s) {-code error}
X set comm($chan,result,$s) $reason
X }
X unset comm($chan,pending,$id)
X unset comm($chan,fids,$fid)
X catch {unset comm($chan,peers,$id)} ;# race condition
X catch {unset comm($chan,buf,$fid)}
X
X # process lost hook now
X catch {catch $comm($chan,hook,lost)}
X
X return $reason
X}
X
X###############################################################################
X#
X# Hook support
X#
X
Xproc commHook {hook {script +}} {
X upvar chan chan
X global comm
X if ![info exists comm($hook,hook)] {
X error "Unknown hook invoked"
X }
X if !$comm($hook,hook) {
X error "Unimplemented hook invoked"
X }
X if [string match + $script] {
X if [catch {set comm($chan,hook,$hook)} ret] {
X return ""
X }
X return $ret
X }
X if [string match +* $script] {
X append comm($chan,hook,$hook) \n [string range $script 1 end]
X } else {
X set comm($chan,hook,$hook) $script
X }
X}
X
X###############################################################################
X#
X# Called from the fileevent to read from fid and append to the buffer.
X# This continues until we get a whole command, which we then invoke.
X#
Xproc commCollect {chan fid} {
X global comm
X upvar #0 comm($chan,buf,$fid) data
X
X # Tcl8 may return an error on read after a close
X if {[catch {read $fid} nbuf] || [eof $fid]} {
X fileevent $fid readable {} ;# be safe
X commLostConn $fid
X return
X }
X append data $nbuf
X
X commDebug {puts stderr "collect <$data>"}
X
X # If data contains at least one complete command, we will
X # be able to take off the first element, which is a list holding
X # the command. This is true even if data isn't a well-formed
X # list overall, with unmatched open braces. This works because
X # each command in the protocol ends with a newline, thus allowing
X # lindex and lreplace to work.
X #
X # This isn't true with Tcl8.0, which will return an error until
X # the whole buffer is a valid list. This is probably OK, although
X # it could potentially cause a deadlock.
X while {![catch {set cmd [lindex $data 0]}]} {
X commDebug {puts stderr "cmd <$data>"}
X if [string match "" $cmd] break
X if [info complete $cmd] {
X set data [lreplace $data 0 0]
X after idle [list commExec $chan $fid $comm($chan,fids,$fid) $cmd]
X }
X }
X}
X
X#
X# Recv and execute a remote command, returning the result and/or error
X#
X# buffer should contain:
X# send # {cmd} execute cmd and send reply with serial #
X# async # {cmd} execute cmd but send no reply
X# reply # {cmd} execute cmd as reply to serial #
X#
X# Unknown commands are silently discarded
X#
Xproc commExec {chan fid remoteid buf} {
X global comm
X
X # these variables are documented in the hook interface
X set cmd [lindex $buf 0]
X set ser [lindex $buf 1]
X set buf [lrange $buf 2 end]
X set buffer [lindex $buf 0]
X
X # Save remoteid for "comm remoteid". This will only be valid
X # if retrieved before any additional events occur # on this channel.
X # N.B. we could have already lost the connection to remote, making
X # this id be purely informational!
X set comm($chan,remoteid) [set id $remoteid]
X
X commDebug {puts stderr "exec <$cmd,$ser,$buf>"}
X
X switch -- $cmd {
X send - async {}
X reply {
X if {![info exists comm($chan,return,$ser)]} {
X commDebug {puts stderr "No one waiting for serial \"$ser\""}
X return
X }
X
X # Decompose reply command to assure it only uses "return"
X # with no side effects.
X
X array set return {-code "" -errorinfo "" -errorcode ""}
X set ret [lindex $buffer end]
X set len [llength $buffer]
X incr len -2
X foreach {sw val} [lrange $buffer 1 $len] {
X if ![info exists return($sw)] continue
X set return($sw) $val
X }
X
X if [info exists comm($chan,hook,reply)] {
X catch $comm($chan,hook,reply)
X }
X
X # this wakes up the sender
X set comm($chan,result,$ser) $ret
X set comm($chan,return,$ser) [array get return]
X return
X }
X vers {
X set comm($chan,vers,$id) $ser
X return
X }
X default {
X commDebug {puts stderr "unknown command; discard \"$cmd\""}
X return
X }
X }
X
X # process eval hook now
X if [info exists comm($chan,hook,eval)] {
X set err [catch $comm($chan,hook,eval) ret]
X commDebug {puts stderr "eval hook res <$err,$ret>"}
X switch $err {
X 1 { ;# error
X set done 1
X }
X 2 - 3 { ;# return / break
X set err 0
X set done 1
X }
X }
X }
X
X # exec command
X if ![info exists done] {
X # Sadly, the uplevel needs to be in the catch to access the local
X # variables buffer and ret. These cannot simply be global because
X # commExec is reentrant (i.e., they could be linked to an allocated
X # serial number).
X set err [catch [concat uplevel #0 $buffer] ret]
X }
X
X commDebug {puts stderr "res <$err,$ret>"}
X
X # The double list assures that the command is a single list when read.
X if [string match send $cmd] {
X # The catch here is just in case we lose the target. Consider:
X # comm send $other comm send [comm self] exit
X catch {
X set return return
X # send error or result
X switch $err {
X 0 {}
X 1 {
X global errorInfo errorCode
X lappend return -code $err \
X -errorinfo $errorInfo \
X -errorcode $errorCode
X }
X default { lappend return -code $err}
X }
X lappend return $ret
X puts $fid [list [list reply $ser $return]]
X flush $fid
X }
X }
X}
X
X###############################################################################
X#
X# Finish creating "comm" using the default port for this interp.
X#
Xif ![info exists comm(comm,port)] {
X if [string match macintosh $tcl_platform(platform)] {
X comm new comm -port 0 -local 0 -listen 1
X set comm(localhost) [lindex [fconfigure $comm(comm,socket) -sockname] 0]
X comm config -local 1
X } else {
X comm new comm -port 0 -local 1 -listen 1
X }
X}
X
X#eof
END-of-comm.tcl
echo x - pkgIndex.tcl
sed 's/^X//' >pkgIndex.tcl << 'END-of-pkgIndex.tcl'
X# Tcl package index file, version 1.0
X# This file is generated by the "pkg_mkIndex" command
X# and sourced either when an application starts up or
X# by a "package unknown" script. It invokes the
X# "package ifneeded" command to set up package-related
X# information so that packages will be loaded automatically
X# in response to "package require" commands. When this
X# script is sourced, the variable $dir must contain the
X# full path name of this file's directory.
X
Xpackage ifneeded Comm 3.6 [list tclPkgSetup $dir Comm 3.6 {{comm.tcl source {comm comm_send}}}]
Xpackage ifneeded TclX 1.0 [list tclPkgSetup $dir TclX 1.0 {{tclXlists.tcl source {::TclX::auto_load_file ::TclX::intersect ::TclX::intersect3 ::TclX::lassign ::TclX::ldelete ::TclX::lempty ::TclX::lmatch ::TclX::lmatchs ::TclX::lrmdups ::TclX::lvarcat ::TclX::lvarpop ::TclX::lvarpush ::TclX::searchpath ::TclX::showproc ::TclX::union ::TclX::lcontains}}}]
X
END-of-pkgIndex.tcl
exit