Version 9 of Locking Metakit for CGI

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
  }

And then in your CGI script, make sure to first get a lock, then override exit, then release the lock at the end of your script. Do all three of these things, and you should not have any problems.

    set lock [file join $dir rp.lock]
    if {![::locktower::acquire $lock]} {
      # The error will kill the script and send me an email.  Thanks to [cgi.tcl]
      error "can't acquire lock: $lock"
    }
    # Make sure the lock is always released.
    rename ::exit ::my_exit
    proc ::exit {args} {
      global lock
      ::locktower::release $lock
      eval ::my_exit $args
      return
    }


    # The real code of the CGI.  Here we wait 4 seconds to mimic a fat script.
    after 4000



    # Release the lock as we exit the CGI.  Do not forget to do this.
    ::locktower::release $lock

I heartily recommend using Don Libes cgi.tcl, it works great and tastes yummy too.