[Rohan Pall] 

''2003-03-03  (March 03, 2003)''

The wonderful [Metakit] database is a very useful tool, and I use it for many of my projects, including [Tigerbliss].

I would like to use mk (shortform for [Metakit]) in harmony with [cgi.tcl].

This page documents how to lock the mk db file, so that you don't get multiple processes writing to the same file at the same time -- which will inexorably corrupt your database.

The [Wikit] package contains the locking code that I'm interested in.  I took the acquire and release code from utils.tcl, and the start up code from start.tcl.  Thanks go to [jcw].

I cleaned up the code, and fixed a bug.  Hopefully, I didn't introduce any new ones.


  package provide locktower 1.0

  namespace eval ::locktower:: {}

  proc ::locktower::acquire {lockFile {maxAge 900}} {
  
    # The logFile is in the same directory as the lockFile.
    set dir [file dirname $lockFile]
    set basename [file rootname [file tail $lockFile]]
    set logFile [file join $dir $basename].log
	
    # The number of tries to get the lock.
    set numTries 60
	
    for {set i 0} {$i < $numTries} {incr i} {
      catch {
        set fd [open $lockFile]
        set opid [gets $fd]
        close $fd
        # If the lock is stale, delete it and log it.
        if {$opid != "" && ![file exists [file join / proc $opid]]} {
          file delete $lockFile       
          set fd [open $logFile a]
          set now [clock format [clock seconds]]
          puts $fd "# $now drop lock $opid -> [pid]"
          close $fd
        }
      }
      catch {close $fd}

      if {![catch {open $lockFile {CREAT EXCL WRONLY}} fd]} {
        puts $fd [pid]
        close $fd
        return 1
      }
      after 1000
    }
  
    # If the file is older than maxAge, we grab the lock anyway.
    if {[catch {file mtime $lockFile} t]} { return 0 }
    return [expr {[clock seconds] > $t + $maxAge}]
  }

  proc ::locktower::release {lockFile} {
    file delete $lockFile
  }