CT - Hi, I would like to ask the gurus out there if there is a sensible way of getting tcl to run only one instance of a script or application that works on all the platforms that tcl does. Thanks.
AM I do not quite understand your question. Could you describe what you mean by "only one instance" ? Do you by any chance mean "one script that works everywhere"? Or are there any other aspects, like particular directories ....?
LES: I think I know what (s)he wants because I have been looking for that too. Run a script with no "exit" statement: you have one instance. Run it again: you have two instances. So, (s)he wants only one instance running at any one time. In other words, the second instance would detect the first instance (or vice versa) and let the first instance run alone, but first probably passing to the first instance whatever argument/parameter this second instance was given. You're obviously a Unix/Linux user...
AM Guilty as charged - but I also use Windows a lot. It is just that my applications usually exit from time to time :)
NEM - Try singleton application. There may be other pages on this wiki which cover the same topic.
CT - Yes I did mean what LES has described. Its due to accessing a MetaKit database which causes havoc when more than one script is updating it at the same time as MK doesnt have concurrency yet. I've had a look at the singleton application page, thanks NEM, the socket approach seems solid enough. I was considering doing a very similar thing using send which I will still look into as it may be a lighter weight solution to the socket approach. I will post the solution to that page if I implement it and it works well enough. Thanks all :)
HJG 2015-05-05 - "run only one instance" per what ?
One instance running per user/machine/cpu/cpu-core/network-interface/LAN ?
The solution depends on what exactly you want to limit, and what rights you have.
dcw - 2011-10-26 15:21:57
Seems simple for unix:
set pslst [exec ps -ef | grep mysingle.tcl]
set cntr 0
foreach i $pslst {
if { $i == "tclsh" } {
incr cntr
}
}
if { $cntr == 1 } {
puts "One instance of the script is running"
} else {
puts "$cntr instances of the script are running"
}MHo 2011-10-26: On windows, you could, for example, register yourself as a dde server with a fixed name. The very first thing each newly started instance should do then is to look if a dde server with name is already running (with dde services). Another method is to start a socket server on a specific port and try to connect to that port upon start. Or you could create a lock file and look for it... There are myriads of other methods all of which are more or less tricky...
dkf - 2011-10-27 13:43:21
One method is to use a server socket:
set socketID 12345; # Pick something
try {
socket -server {apply {{ch args} {
close $ch
raise .
}}} -myaddr localhost $socketID
} trap {POSIX EADDRINUSE} {} {
close [socket localhost $socketID]
}OK, you might want a slightly less dumb protocol (e.g., passing a filename across) but that's just a refinement.
APE - 2012-02-28 12:43:00 Same method but using catch (still using Tcl 8.5) :
set socketID 12345; # Pick something
catch {socket -server {
apply {{ch args} {
close $ch
raise .
}
}
} -myaddr localhost $socketID } msg
if {$msg == "couldn't open socket: address already in use"} {
close [socket localhost $socketID]
}JD - 2013-01-09 02:54:32
Here is my solution to making my program a single instance application. It gets the PID of the currently running instance. It then uses the 'send' command to call a function passing the PID as a parameter. The program checks to see if the PIDS match and if they do it means it is the original programming making the call. When a new instance is started, the PIDS do not match and it returns a boolean TRUE. When it gets TRUE then it exits the instance trying to start.
set appPid [pid]
proc init {} {
global appPid
set chck [send pk2gui checkInstance $appPid]
if {$chck} {
exit
}
}
proc checkInstance args {
global appPid
if {$args != $appPid} {
return 1
} else {
return 0
}
}
init Let me know what you think.
Komenor - 2013-06-02 07:27:49
If you look at the Tk8.5 documentation, page "send", you will see an example to solve your problem. But, I think that to make it simple, just start your program with the following commands :
if {[tk appname newName] != newName} {
exit
}wdb Ingenious ... if you enclose newName in quotes:
if {[tk appname newName] != "newName"} {
exit
}Won't work on Windows, as it lacks send.
dgood - 2015-05-04 Here's my little package for just this kind of thing. It need much improvement, but it works well for my purposes so far.
Edited on 2015-05-06 to be more picky about killing processes.
##
# SelfService
#
# This package creates a mechanism for a script to figure out if it is already
# running, and still sane, by using sockets to pass messages to another copy of
# itself. This is most useful for embedded system scripts which are invoked
# periodically by the operating system (i.e. systemd, cron, etc...).
#
# This only works in unix because the killOthers proc uses standard unix utils.
package provide SelfService 1.0
namespace eval selfservice {
variable S
array set S {
Port {}
Server {}
}
proc Server {chan addr port} {
fconfigure $chan -blocking 0 -buffering none
fileevent $chan readable [list selfservice::Reader $chan]
}
# Used for both query and response
proc Reader {chan} {
variable S
set line [gets $chan]
if {$line eq "STATUS"} {
puts $chan "STATUS OK"
flush $chan
} elseif {$line eq "STATUS OK"} {
set S(Response) $line
}
if {[eof $chan]} {
catch {close $chan}
}
}
# Setup server socket
# port can be 0, in which case the system will pick an open port
# In either case, S(Port) will refelct the actual opened port number
proc startup {name port} {
variable S
killOthers $name
set S(Server) [socket -server selfservice::Server $port]
set S(Port) [lindex [fconfigure $S(Server) -sockname] 2]
return $S(Server)
}
proc shutdown {} {
variable S
catch {close $S(Server)}
return $S(Server)
}
# Get the current port number
proc getPort {} {
variable S
return $S(Port)
}
# Returns bool 1 if server is up and sane, 0 otherwise
proc isOk {port} {
variable S
if {[catch {socket localhost $port} chan]} {
return 0
}
# Check to see if server is still sane
fconfigure $chan -blocking 0 -buffering none
fileevent $chan readable [list selfservice::Reader $chan]
puts $chan "STATUS"
flush $chan
set S(Response) ""
set afterId [after 5000 [list set selfservice::S(Response) "timeout"]]
vwait selfservice::S(Response)
# Shutdown channel
after cancel $afterId
catch {close $chan}
if {$S(Response) eq "STATUS OK"} {
return 1
} else {
return 0
}
}
# Kills all processes which match name
# Returns a list of the process ids which were killed
proc killOthers {name} {
# kill all processes that match pattern and are not my pid
set ps [split [exec ps -eo pid,cmd | grep $name] "\n"]
set ps [lrange $ps 0 end-1]; # Ignore the grep command itself
set killList {}
foreach p $ps {
lappend killList [lindex $p 0]
}
set killList [lsearch -all -inline -not $killList [pid]]
foreach pid $killList {
catch {exec kill -9 $pid}
}
return $killList
}
}
# Example usage
if {[selfservice::isOk 12345]} {
puts "Server is OK, exiting"
exit
} else {
puts "No response from server"
}
puts "Starting new server..."
selfservice::startup $::argv0 12345
# rest of script here...If you are on Linux, you might be able to use Lock files using atomic hard links (and yes, I know, you were looking for a cross-platform solution, but it might just also work on Windows, I've just not tried it yet)
Walter - 2016-10-31 22:07:42
I have an expect script which prompts for my password, spawns a shell, then uses 'interact' to creates a bunch of shortcut commands. I run this script when I first log on to my primary host so that any spawned local or remote connections will inherit all of my shortcuts. But since the new shell doesn't immediately exit I could accidentally rerun the command and have nested bash shortcut scripts. Note: I didn't want the script to prevent independent logins from running the same command, just prevent one single login from running the same initialization in any of its child processes.
After reading the previous replies I thought that should be easy to do by setting an environment variable then testing for it. But tcl didn't like that - it blew up anytime the environment variable wasn't already set, even if I wrapped it with 'catch'. I bet there's a way to do this but I finally just wrapped my expect script in a simple bash script, something like this:
# cat passwrap.sh
!/bin/bash -f
export POPID="BashInit$POPID"
if [ ! $POPID == "BashInit" ]; then
echo "$0 is already running..."
exit 1
fi
# Run expect script to set shortcuts
expect passout.expSurely one of you expect/tcl experts knows how to both read and write the environment variables even when the variable isn't preset. I'll keep playing with it in my spare time and post a solution if I find one first.
Walter - 2016-11-01 00:52:48
OK, that was easy once I found how to reference global (env) variables:
#!/usr/bin/expect
set SCRIPT [info script]
if { [info exists ::env(PSTAT) ] } {
puts "\n$SCRIPT is already running. Cannot restart in child process.\n"
exit 1
}
set ::env(PSTAT) "Is running"
set PPassword "L0ngP@ZZWurdThAt1cann0tTyp3wIthOutM@kingAsimpleMisteak"
spawn /bin/bash
interact {
"~!Pp" { send -- "$PPassword" }
"~PID" { send -- "$PID" }
"~!!P" { exec kill -9 $PID ;# annihilate this process }
"~!!K" { send -- "kill -9 $PID\r" ;# nuke it another way }
"~psf" { send -- "ps -ef | grep "; # find a string in ps listing }
"~Gg" { send -- "a random loooong command that I hate typing"; }
"~Hh" { send -- "Another long string that I want to shortcut"; }
"~!JJJ" { send -- "The Daily Planet: J Jonah Jameson" }
}
Now if we rerun the script from within the spawned bash/interact it will warn us and bailout without redefining everything. This is especially helpful when the script spawns lots of commands, such as xterm connections to remote hosts, that you don't want duplicated.