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
}