[Rohan Pall]  [http://rohanpall.com/tclerspub/x.gif]

''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.
----
04mar03 [jcw] - Thanks for fixing the bug.  It explains why lock-breaking always caused the CGI itself to fail, and the next one to work again.  Change is also in wikit itself now.