[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.

----
Note that [tcllib]'s [ncgi] is based on cgi.tcl, but the code has been
namespaced.

[Ro]: Note that this does not make it better.  Namespacing packages '''usually''' does, but in the case of cgi, where you want to hammer them out quick, the less code, the better.  [cgi.tcl] is tested, time-worn, and made by [Don Libes].

----
[Category Internet]