proc acquire_lock {LOCKID} {

  global LOCK_SOCKET

  set PORT [port_map "$LOCKID"]

  # 'socket already in use' error will be our lock detection mechanism

  if { [catch {socket -server dummy_accept $PORT} SOCKET] } {
    puts "Could not acquire lock"
    return 0
  }

  set LOCK_SOCKET("$LOCKID") "$SOCKET"

  return 1

  }

  proc release_lock {LOCKID} {

  global LOCK_SOCKET

  if { [catch {close $LOCK_SOCKET("$LOCKID")} ERRORMSG] } {
    puts "Error '$ERRORMSG' on closing socket for lock '$LOCKID'"
    return 0
  }

  unset LOCK_SOCKET("$LOCKID")

  return 1

  }

  proc port_map {LOCKID} {

  # calculate our 'unique' port number using a hash function.
  # this mapping function comes from dr. KNUTH's art of programming volume 3.

  set LEN [string length $LOCKID]
  set HASH $LEN

  for {set IDX 0} {$IDX < $LEN} {incr IDX} {
    scan [string index "$LOCKID" $IDX] "%c" ASC
    set HASH [expr (($HASH<<5)^($HASH>>27))^$ASC];
  }

  # always use a prime for remainder
  # note that the prime number used here will basicly determine the maximum 
  # number of simultaneous locks

  return [expr (65535 - ($HASH % 101))]

  }

  proc dummy_accept {newsock addr port} {
  }

  proc sleep { {milliseconds 200} } {
    set sleepvar "[namespace current]::___sleep[clock seconds][expr int(rand() * 1000)]___"
    after $milliseconds [list set $sleepvar 0]
    vwait $sleepvar
    unset $sleepvar
  }

  proc acquire_lock { LOCKID {timeout 5} } {
    global LOCK_SOCKET
    set PORT [port_map "$LOCKID"]

    # 'socket already in use' error will be our lock detection mechanism
    incr timeout [clock seconds]
    while { [catch {socket -server [namespace current]::dummy_accept $PORT} SOCKET] } {
      if { [clock seconds] > $timeout } {
        puts "Could not acquire lock"
        return 0
      }
      sleep
    }

    set LOCK_SOCKET("$LOCKID") "$SOCKET"
    return 1
  }

  proc transaction { args } {
    foreach {opt val} [cmdline::getoptions args {
                {timeout.arg 5 "Seconds to try before timing out"}
                }] {
      set $opt $val
    }
    if { [acquire_lock "transaction" $timeout] } {
      eval uplevel 1 $args
      release_lock "transaction"
      return 1
    }
    return 0
  }

  transaction -timeout 3 {
    puts "starting locked process"
    sleep 1000
    puts "ending locked process"
  }

CL wants to return to this topic in terms of "singleton processes" and ... well, here's a grab bag, which I'll eventually re-organize:

Cameron: If it helps, perhaps I should label this conversation in terms of "locking"--file locking, process locking, ...

lvirden: Interesting. I guess I'm still not clear if what they REALLY want is one process at a time, or if they really want to ensure that only one process at any one time is updating or using some resource.

lvirden: In any case, Unix at least doesn't reliably make locking resources (files, processes, devices) trivial; in most cases, I find that one has to layer lots and lots of caveats or assumptions before one nears nirvana.

Cameron: You are so right to observe that. It's a natural place to start any discussion.

lvirden: I mean, one has to take into effect multiple users, multiple processors, NFS/Samba/NFS-WWW (or whatever it is called), multiple processes, remote executions, etc.

Cameron: Right: locking is difficult; that's why it deserves our attention.

lvirden: I know that JCW and I hashed it about for quite some time and he came to the conclusiong that it might be too big a problem to solve.

lvirden: I agree though that something needs to be written. And perhaps what we can do is load the page with a variety of keywords to ensure that searching finds the info.

---

Some people recommend lockf as the only reliable locking mechanism. However, here is Solaris's warning about lockf:

     Record-locking should not be used in combination with the
     fopen(3C), fread(3C), fwrite(3C) and other stdio functions.
     Instead, the more primitive, non-buffered functions (such as
     open(2)) should be used.  Unexpected results may occur in
     processes that do buffering in the user address space.  The pro-
     cess may later read/write data which is/was locked.  The stdio
     functions are the most common source of unexpected buffering.

In other words, if you have no control over how the I/O is going to occur to the file (because of an interaction with user provided code - or even with interaction with operating system code), so that you cannot guarantee that low level access to the file is all that is occuring, then you should not use lockf .

---

The Python Cookbook has a recipe [1] that might interest some Tcl file-lockers.

---

On the other hand, that python recipe appears to me to leave a lot of questions - on posix systems it depends on fcntl, which doesn't work on NFS'd files as far as I am aware, and on windows, it has dependencies on a python module that doesn't have as of yet a tcl equivalent I don't think.

DKF - As I mentioned above, locking on NFS depends on the NFS server also hosting a working rpc.lockd (i.e. a lock management daemon.) This is probably true on reasonably modern Solaris, but who knows with other UNIX systems? And then there's other networked filesystems to worry about (e.g. AFS...)

LV I'm trying to recall all the ways that the NFS locking went wrong on me when I tried it. Of course, things might be better now.

---

fsync()

---

[Explain pertinence of [2].]

---

18may04 jcw - There's a very interesting lockfile implementation in Ruby for lockfiles which presumably also works on NFS. It's Unix-specific (links, inode's), but if this is combined with a good solution for Windows, it might just be the way to achieve solid x-platform locking.

The mechanism is clearly explained on the RAA site [3], along with complete Ruby source code. I couldn't find license info, but Ruby appears to be BSD-like, at least in spirit.

Does anyone care to comment on the value and robustness of this approach?

TP - I think I first read about this approach in Marc Rochkind's book, Advanced Unix Programming [4] (which I don't have my first edition copy around right now to confirm.) I wouldn't be so certain about its use on an NFS-based file system, someone else may want to comment. Basically, this approach is fairly certain to avoid race conditions, as the link(2) system call is (should be!) atomic. The downside to this approach is that if the locking process dies, the resource remains locked until someone else cleans it up. For one of my cross platform programs (Windows & Unix), where I wanted process locking (only one instance running at one time), I used the server socket code shown above with good results.

---

RJ: I have had good experience simply using a .lock file to store/check/delete filelock entries, one line per file lock. Is there anything bad about this concept I am unaware of?

LV depends on your environment. That might work well in a simple, single user, single application environment. However, if you have multiple users, using either multiple instances, or even worse, multiple applications, accessing the file via NFS, this strategy falls down from, at the very least, buffering, etc.

---

Brian Griffin: In my experience with heterogeneous networks, the only file locking mechanism that works is the client/server model mentioned by DKF above. As proof of this, please list all real database engines that don't use a client/server model:

---

Todd Coram: But how would such a lock server work? Here is a simple Generic Lock Server that could be used to maintain locks on resources.

---

MAKR 2005-08-25: I am still looking for a way using only Tcl. My requirements are simple:

• filesystem locking (the filesystem may be shared (NFS) between hosts, or multiple applications on one host may simultaneously try to access it),
• only UNIX systems and
• using only Tcl or POSIX shell tools.

Thus I came to the conclusion the Mozilla way is the one to go: Creating a symbolic link pointing to the lock identifier. E. g. in a shell you would do:

  $ ln -s "$lockid" /path/to/lockfile
  $ ls -l /path/to/lockfile
  lrwxrwxrwx  1 makr users 18 2005-08-25 08:34 /path/to/lockfile -> makr@10.20.30.40:8896

Which is the right thing to do, because POSIX specifies for the source file: If the -s option is specified, no restrictions on the type of file or on its existence shall be made.

One cannot follow this approach in Tcl, however. If you try it you will get:

  % file link -sym /path/to/lockfile [format "%s@%s:%ld" $user $host [pid]]
  could not create new link "/path/to/lockfile" since target "makr@10.20.30.40:17028" doesn't exist

Thus either use exec with ln -s - which is what I do currently - or write your own handler for symlink(2). POSIX specifies for symlink(2) the target shall be treated only as a character string and shall not be validated as a pathname. It also specifies EEXIST as an error, implying an atomic operation.

LV so tell me, with regards to this technique, what error handling should be performed when the code attempts to create the link but the file already exists by the time the tcl interpreter attempts to create it?

MAKR well, I don't do very sophisticated error handling. If the exec fails, I look into errorCode if it contains a POSIX EEXIST error. In this case I read the link:

• is this a lock I created already (user, host and pid match)? yes -> return success, otherwise
• does this lock belong to another application on the same host? yes -> is this a stale lock? yes -> try to break and return success, otherwise
• raise an error reporting a locked filesystem (incl. user, host and pid)

If errorCode contains anything else, just hand over errorCode and errorInfo.

MAKR argh - well, you got me. The error handling applies to the symlink()-wrapper of cause. This is what I've done recently, the old code using exec just reported that a lock could not be obtained.

---

EF The TIL [5] contains an implementation of the UNIX lockfile command. I suspect that the implementation is not safe on NFS systems, but it is perhaps worth a look at. [6]