I've refined the original implementation. The biggest change is due to a comment from Brian Hanson who noted on c.l.t:
To avoid a race condition, you should try to create the server socket first. If that succeeds, you're the first instance, so do whatever you need to do. Otherwise, connect to the server port to tell the already running process to display/raise itself (if necessary).Thanks, Brian.Comments welcome, encouraged, desired.
--[mailto:[email protected]
]Falco Paul: There is one small caveat with socket-based locking (at least on UNIX). If you open a socket (i.e., acquire the lock), and then use 'exec' to spawn a process, then your new child process will inherit the 'open' socket. So if that process (or some of its child processes) would remain to run, even after you long closed 'your' socket, then the socket will still be considered open. In fact, you wouldn't be able to open that socket while the child processes remain to hold the socket open! Something to be aware of....See close on execECS: The problem is still open in a multi-user environment. Somehow you have to use distinct sockets for distinct users.
package provide singleton
namespace eval ::singleton {
namespace export \
init \
done
# "global" array(s)
variable Singleton
}
# singleton::init --
#
# Initialize a Tcl process to be a singleton using sockets.
#
# Arguments:
# port - The TCP port to use
# onConnect - What to do when a new client tries to connect (that
# is, when another process calls init with the same
# port).
# Results:
# Raises an error if another process is already serving this port.
# Returns the server socket if this is the first instance.
proc singleton::init { port { onConnect {} } } {
variable Singleton
# If we aren't able to become a server, try to connect to the
# server so it knows another process tried to come up and can
# react.
if {[catch {socket -server \
[namespace code [list Connect $port]] $port} serverSocket]} {
# If we can't become a server, we should exit.
# Raise an error so that the caller can clean up first.
close [socket localhost $port]
set msg "There is already an application running\
on singleton port $port"
error $msg "" [list SINGLETON ENOTUNIQ $msg]
}
# Store away server socket and callback
# WUZ - create a child namespace for each port?
set Singleton($port,onConnect) $onConnect
set Singleton($port,serverSocket) $serverSocket
}
# singleton::init
# singleton::done --
#
# Clean up when a singleton process terminates.
#
# Arguments:
# port - The port passed to init
#
# Results:
# Closes the server socket and unsets vairables.
#
proc singleton::done { port } {
variable Singleton
close $Singleton($port,serverSocket)
unset Singleton($port,serverSocket)
unset Singleton($port,onConnect)
}
# singleton::done
# singleton::Connect --
#
# What to do when a new client tries to connect (that is, when
# another process calls init with the same port).
#
# Arguments:
#
# Results:
#
proc singleton::Connect { port args } {
variable Singleton
if {[info exists Singleton($port,onConnect)]} {
set command $Singleton($port,onConnect)
if {[llength $command]} {
# Evaluate it at the global scope
uplevel $command
}
}
}
# singleton::Connect
# TEST
proc comeToTop { w } {
wm deiconify $w
raise $w
focus -force $w
}
wm withdraw .
if {[catch {singleton::init 32001 {comeToTop .}}]} {
exit
}
wm deiconify .Here's another way to do it using X selections (-JE). It only works under X though...
# singleton key ?toplevel? --
#
# Ensure that only a single copy of the application is running.
# 'key' is an X selection name which is used to identify the
# application.
#
# Returns:
# 0 if a copy of the application is already running,
# 1 otherwise. If successful, arranges to raise
# the specified toplevel window whenever the user
# attempts to start a second copy.
#
proc singleton {key {toplevel .}} {
if {![catch { selection get -selection $key }]} {
return 0
}
selection handle -selection $key $toplevel [list singletonRequest $toplevel]
selection own -selection $key $toplevel
return 1
}
# singletonRequest --
# Called when another application calls [singleton]
#
proc singletonRequest {toplevel _offset _maxBytes} {
wm deiconify $toplevel
raise $toplevel
return [tk appname]
}
# Test driver:
proc main {} {
if {![singleton HELLO]} {
puts stderr "Another HELLOWORLD already running"
destroy .
} else {
button .b -text "Hello" -command [list destroy .]
pack .b -expand true -fill both
}
}Falco Paul: there is some related information on locking to be found in How do I manage lock files in a cross platform manner in Tcl. It gives implementations for (portable) socket- and file-based locking
Yet another unportable approach that is idiomatic for Windows is to register the app with DDE, and delegate new requests to the app to the existing one:
package require dde
# Establish the DDE topic
set topicName MyTopic
# See if a service with our topic is already running. If so,
# delegate to it.
set otherServices [dde services TclEval $topicName]
if { [llength $otherServices] > 0 } {
dde execute TclEval $topicName {
wm deiconify .
raise .
bell
}
exit
}
# Launch the service
dde servername $topicName
grid [label .l -text [list $topicName is running]]
grid [button .q -text Quit -command exit]Note that the dde approach, while wonderfully simple, in my experience has a 3-4 second delay! VinceThings CL thinks should be explained eventually: that implementations are all about hooks into OS resource management; that Tclkit itself implements one solution of this; that there's still little standardization in the (abstract) "name service" which might help tell when two processes are instances of the same application; SO_REUSEADDR latency ...
CT - Might there also be a solution using send? I will be looking into this in the next week or so and post my results here...
ABU 29-sep-2005Sorry, but these solutions are centered around the scenario of "one application on one computer".My needs are more general; let's think at a multi-user computer where 3 users want to run an application (e.g. a PIM) independently (i.e. there is 'one repository' for each user). Here we have 3 copies of the application running (at system level) but we want *each user* cannot start the application twice.Of course the socket-based solution cannot be applied in this case ... KPV why not just use some sort of hash of the user id to select which port to use for the socekt-based solution?A simple solution could be something like a 'semaphore' ; one semaphore for each user. Unfortunatelly I cannot find a simple, general solution in Tcl providing the capability to properly restart after an application/system crash:What if the program crashes, or the computer crashes, while the semaphore is red?Store (start-date, pid) in the semaphore and check whether a) pid is still existent and/or b) date is > last boot-date. a) handles dying application, b) dying OS.ABUIt looks interesting on Unix, but it seems to me that it is difficult to adapt this idea for Windows:
- how can I check if pid is still present ?
- how can I get the last boot-date ?
