• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 248
  • Last Modified:

DBM File Locking (FLOCK) Problem...

The following script is part of a login procedure.  When a user logs in, the script does the following...

If it is a new user, a counter field in a dbm is incremented and an entry is added to the same dbm containing the path to the user's record file.  The name of the record file is "rec#" (where # is the value of the counter).

The problem is that we are encountering circumstances where if two (or more) users log in at the same time (less than a second difference between each one pressing the "submit" button), the counter doesn't get incremented for each of the users.  When this happens, an entry is created for only one of the users, but the script returns the same record number (rec and counter) for all three.  We first implemented the flock control using O'Reilly's example with no success (we later found out that it causes a racing situation).  Our current script uses a "dummy" file for locking.  This improved the situation to its current status (<1 second causes error).  Please help!  The script follows:

use CGI qw(:standard);
BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File) }
use AnyDBM_File;

$myLock_SH = 1;
$myLock_EX = 2;
$myLock_NB = 4;
$myLock_UN = 8;

#path to name/record list file
my $caseRef = param("caseRef");
my $tmp = '';
until ($tmp eq '/') {
      $tmp = chop($caseRef);
substr($caseRef,0,1) = "";
$caseRef =~ s/DxR\///g;

my ($dir,$regName,$longCaseRef,$usrPW,$lockFileFlag,%usrArray,$usrArray,%recArray,$recArray,$nextFile);

      $longCaseRef = $caseRef;
      $regName = $caseRef.'/caseRec/dxr_stor';
      $lockFileFlag = $caseRef.'/caseRec/intList.txt';

my $usrName = param("dxrUser");
my $enteredPW = param("dxrPassword");
chomp $enteredPW;

my $tError = 'OK';
my $hypCount = 0;

####### open pat database file

###local *myLock;
      # Wait until database is available
                  unless ( open(myLock, ">$lockFileFlag") ) {
                        $tError = "Open lock file error  $! ";
                  unless ( flock(myLock, 2) ) {
                        $tError = "lock error  $!";
unless (tie(%usrArray,AnyDBM_File,$regName,O_RDWR,0666)) {
  $tError =  "Name/Record List file not found. <br> $!";

#is file initialized
if ($tError eq 'OK') {

######check password
      if ($usrPW = $usrArray{$usrName . 'pw'}) {
            chomp $usrPW;
            if ("$usrPW" ne "$enteredPW") {
                  $tError =  "Password not correct." ;
      } else {
                  $tError =  "Name not found." ;
if ($tError eq 'OK') {
      if ($usrFile = $usrArray{$usrName}) {
            #record of file exists open and get variables?
            if(tie(%recArray,AnyDBM_File,$usrFile,O_RDWR,0666)) {
                  $hypCount = $recArray{'hypCount'};
            } else {
                  $tError =  "Record file not opened. <br> $!";
      } else {
            #start file
            $nextFile = $usrArray{'nextFile'};
            $usrFile = $longCaseRef."/caseRec/rec" . $nextFile;
            $usrArray{$usrName} = $usrFile;
            $usrArray{'nextFile'} += 1;
            if(tie(%recArray,AnyDBM_File,$usrFile,O_RDWR|O_CREAT,0666)) {
                  $recArray{'hypCount'} = $hypCount;
            } else {
                  $tError =  "Record file not created. <br> $!";
#output hyp html page

print <<END_Hyp;
<meta http-equiv="content-type" content="text/html;charset=iso-8859-1">
<title>Log Result</title>

<body bgcolor="#E6D6BD" >
User: $usrName <BR>
Status: $tError <BR>
User Storage: $regName <BR>
Case Path: $caseRef <BR>
User Record: $usrFile <BR>$$  <BR>$txError



  • 3
  • 2
1 Solution
The lock is released when you close the lock file, and you're updating %usrArray and %recArray after the close.
rhejAuthor Commented:
I agree that the lock is closed before the modifications to recArray are complete (we don't lock this array because it is user specific and should never encounter a multiuser scenario), but the usrArray was untied before the lock was closed and was not updated afterward.  Please let me know if I am incorrect in this assumption.

Please note that both of the untie and close statements for usrArray are within an if/else statement (I apologize for the lack of indentation.  Didn't paste properly...).
you're right, I missed the unindented separate cases for the close.
But I'm now puzzled that$hypCount only seems to be set in one branch, and only used in the other?
I'm also concerned that bad values in param("caseRef") might cause a failure.
Do you ever see anything in $tError?
Do you know if AnyDBM_File is using DB_File or GDBM_File?
Do either of them need to flush after an untie?
Could you try adding sleep 30; before the close(myLock);
just to verify that it really is blocking?
rhejAuthor Commented:
The script posted is not the complete script.  For space reasons I only posted the parts that used usrArray and flock.  $hypCount refers to some of the missing portions and is actually implemented in both branches.  caseRef is also error trapped in the complete script.
The only times we have ever seen error messages from $tError have been permissions problems (script didn't have write access).
AnyDBM_File appears to be using DB_File on our testing box.  I do not know whether they need to flush.  Finding definitive information on them has been somewhat arduous.
I believe a sleep (60) has been implemented to test this, but I need to double check with the author (it's not my script).  I know that I recommended such a test, I'm just not sure he did it.  I will check and let you know.
rhejAuthor Commented:
Thanks for the assistance!  It appears to have been a flushing (sync) problem.  Implementing a sync command for the tied dbm before unlocking the lock file appears to have fixed the problem.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now