namespace eval lock { variable timeout 250; # 250ms standard-time to wait for lock and do locked operations; 0=no time limit variable lockfile [file join $::env(temp) "[pid].lock"] variable wait proc acquireLock [list "timeout $timeout" "lockfile $lockfile"] { set trystart [clock clicks -milliseconds] while {[clock clicks -milliseconds] - $trystart < $timeout || $timeout == 0} { if {![catch {open $lockfile {WRONLY CREAT EXCL}} rc]} { puts $rc "locked by pid [pid] at [clock format [clock seconds]]" flush $rc return [list $rc $lockfile] } after 10 set lock::wait 1 vwait lock::wait } return -code error "Error: timeout after $timeout ms" } proc releaseLock {info} { if {![catch {fconfigure [lindex $info 0]}]} { if {![catch { close [lindex $info 0] file delete -force [lindex $info 1] # only after file is deleted, a new open...WRONLY CREAT EXCL is possible! } rc]} { return "" } else { return -code error "Error releasing lockfile: '$rc'" } } else { return "kein gültiger Lock, ignoriert" } } proc withLock {code} { # standard options take place, use ::vars to change behaviour if {![catch {acquireLock} rc]} { catch { uplevel $code releaseLock $rc } } } } ---- '''A few quick'n'dirty Tests''' set globalVar 1 lock::withLock { puts "Dies" puts "ist" puts "ein Test: $globalVar" parray env } exit set t [lock::acquireLock 5000 ./hugo.lock] puts "(test):$t" # lock::releaseLock $t set t [lock::acquireLock 0 ./hugo.lock] set h [lock::acquireLock] puts ---$h after 600 [list lock::releaseLock "$h"] while 1 { if {![catch {lock::acquireLock 200} h]} { set x $h after 5000 {lock::releaseLock "$x"; exit} } puts -+-$h after 50 update } ---- [ulis], 2005-12-23. As I said in [Semaphores], 2003-05-31, this is THE portable manner to lock. Almost all OSes ensure that {open $lockfile {WRONLY CREAT EXCL} is an atomic operation based on a Test and Set operation. See [How do I manage lock files in a cross platform manner in Tcl] for the [NFS] exception. When available, public semaphores are more efficient.