This is a quick and dirty (and incomplete) example of a lock server for general resources. It doesn't implement the actual locking of the resources but can be used to answer the question [How do I manage lock files in a cross platform manner in Tcl].

You lock a resource by sending "L:resource_name\n". You unlock a resource with "U:resource_name\n". Once you acquire the lock, you get back a message: "LOCKED". If you do not immediately acquire the lock you are placed in a queue until your turn.

Disconnecting from the server immediately releases any locks you may have and any pending locks.

-- [Todd Coram]

 variable port 6700

 # lock(resource) -> chan ..
 # First chan int the list has the lock, the rest are queued.
 array set lock [list]

 # client(chan) -> resource
 array set client [list]

 # If you own the lock, return 1 else remove chan from queue and return 0 
 #
 proc unlock {chan res} {
    global lock client
    if {[lindex $lock($res) 0] == $chan} {
	set lock($res) [lrange $lock($res) 1 end]
	set idx [lsearch -exact $client($chan) $res]
	set client($chan) [lreplace $client($chan) $idx $idx]
        # Notify the next in line
        if {[llength $lock($res)] != 0}  {
	   puts [lindex $lock($res) 0] "LOCKED $res"
        }
	return 1
    }
    set idx [lsearch -exact $lock($res) $chan]
    if {$idx != -1} {
	set lock($res) [lreplace $lock($res) $idx $idx]
    }
    return 0
 }

 # You will either aquire the lock (return 1) or be queued (return 0).
 #
 proc lock {chan res} {
    global lock client
    lappend lock($res) $chan
    lappend client($chan) $res
    return [locked? $chan $res]
 }

 proc locked? {chan res} {
    global lock
    if {[info exists lock($res)] && [lindex $lock($res) 0 ] == $chan} {
	return 1
    }
    return 0
 }


 proc accept {chan addr port} {
    global client
    fconfigure $chan -buffering none
    fileevent $chan readable [list handle_req $chan]
    set client($chan) [list]
 }

 proc handle_req chan {
    global client lock
    if {[eof $chan]} {
	# Unlock resources
	foreach res $client($chan) {
            unlock $chan $res
	}
	unset client($chan)
	close $chan
	return
    }
    set str [gets $chan]
    foreach {req res} [split $str :] {
	switch -- $req {
	    L { 
		puts stderr "($chan) Locking $res"
		if {[lock $chan $res]}  { puts $chan "LOCKED $res" }
	    }
	    U {
		if {![info exists lock($res)]} { 
		    puts $chan "NOLOCKS $res"
		    break
		}
		if {[unlock $chan $res]} {
		    puts $chan "UNLOCK $res"
		} else {
		    puts $chan "DEQUEUED $res"
		}
	    }
	    default {
		puts $chan {HUH? Usage: L:resource or U:resource}
	    }
	    
	}
    }
 }

 socket -server [list accept] $port
 vwait forever