DBM File Locking (FLOCK) Problem...

Posted on 2000-04-26
Last Modified: 2010-03-05
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



Question by:rhej
  • 3
  • 2
LVL 84

Expert Comment

ID: 2753897
The lock is released when you close the lock file, and you're updating %usrArray and %recArray after the close.

Author Comment

ID: 2754029
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...).
LVL 84

Accepted Solution

ozo earned 200 total points
ID: 2754300
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?

Author Comment

ID: 2755267
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.

Author Comment

ID: 2755417
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.


Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

In the distant past (last year) I hacked together a little toy that would allow a couple of Manager types to query, preview, and extract data from a number of MongoDB instances, to their tool of choice: Excel (…
Checking the Alert Log in AWS RDS Oracle can be a pain through their user interface.  I made a script to download the Alert Log, look for errors, and email me the trace files.  In this article I'll describe what I did and share my script.
Explain concepts important to validation of email addresses with regular expressions. Applies to most languages/tools that uses regular expressions. Consider email address RFCs: Look at HTML5 form input element (with type=email) regex pattern: T…

679 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question