[SOLVED] Bug in file region locking under linux
lazarus / 32-Linux

----------------------------------------------------------------------
Laurie · 2013-05-05 12:03

I'm now using Lazarus more and more.  All new coding is in Lazarus,
but I've run into a problem moving a large medical application from
Delphi to Lazarus.

I'm having problems with locking a region of a file using Lazarus
1.0.8 FPC 2.6.2 Ubuntu  12.04 LTS  i386 linux gtk 2.
I used, as a test, the code from bug 0013647.
I can issue a read lock for a range of bytes from position 10 to
position 29 in a file, but I can then read from position 25 without
any errors.   The read lock should block that, right?
Am I doing something wrong or it it a bug?
Here is the code:
=====
unit laztestlocku2;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    btnOpenFile: TButton;
    btnSetReadLock: TButton;
    btnTestRead: TButton;
    btnClose: TButton;
    procedure btnCloseClick(Sender: TObject);
    procedure btnOpenFileClick(Sender: TObject);
    procedure btnSetReadLockClick(Sender: TObject);
    procedure btnTestReadClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }
uses BaseUnix;  //For file flags and TMode
Const
  Fn = '/home/laurie/test_lock';
  F_RDLCK = 0;
  F_WRLCK = 1;
  F_UNLCK = 2;
var
  F1: Integer;  //File descriptor
{$I+}
procedure TForm1.btnOpenFileClick(Sender: TObject);
var i:integer;
begin //create and open file of length 256
  If FileExists (Fn) Then DeleteFile (Fn);
  F1 := FpOpen (Fn, O_RDWR Or O_CREAT, $1B6); // $1B6 = o666
  For I := 0 To 255 Do FpWrite (F1, I, 1);
  if F1 = -1 then
    Showmessage ('unable to open file. Extended
error='+IntToStr(fpGetErrno)); //
end;

procedure TForm1.btnCloseClick(Sender: TObject);
begin  //Close test file
  FpClose(F1);
end;

procedure TForm1.btnSetReadLockClick(Sender: TObject);
Var
  Region : FLock;
Begin //Apply read lock from byte 10 to 29
  With Region Do Begin
    l_type := F_RDLCK; l_whence := SEEK_SET;
    l_start := 10; l_len := 20
    End;
  If FpFcntl (F1, F_SETLK, Region) = -1 Then
    Showmessage ('unable to apply read writelock. Extended
error='+IntToStr(fpGetErrno)); // <-- OK
end;

procedure TForm1.btnTestReadClick(Sender: TObject);
var x,val:integer;
begin  //Attempt to read byte 25 its value is 25
  x:=0;
  if FpLseek( F1, 25, Seek_Set) = -1 then
    showmessage('Seek error Extended error='+IntToStr(fpGetErrno));
  //if the region of file is read locked then we should get an error
next
  val :=FpRead(f1,x,1);
  if val <> 1 then showmessage('read error Extended
error='+IntToStr(fpGetErrno));
  showmessage('X = '+IntToStr(x));
end;


end.

----------------------------------------------------------------------
marcov · 2013-05-05 13:01

Afaik most filelocking is per process, IOW you prevent other processes
from accessing that region.

----------------------------------------------------------------------
ludob · 2013-05-05 13:15

File locking is also working between processes but read or write do
not check the locks. See
http://www.gnu.org/software/libc/manual/html_node/File-Locks.html :
QuoteThe read and write functions do not actually check to see whether
there are any locks in place. If you want to implement a locking
protocol for a file shared by multiple processes, your application
must do explicit fcntl calls to request and clear locks at the
appropriate points.

----------------------------------------------------------------------
Laurie · 2013-05-06 11:31

Thank you marcov and ludob, especially for the link.

Well I just can't get locking a region of a file (record locking) to
work.
I suspect that FPfcntl() is not returning the correct results.
Please look at the code below and see if you can replicate this
problem.

Here is simplified code...
1. Create a file, filedescriptor F1 of 256 bytes, read/write access.
2. Apply a lock from byte 10 to byte 29 with FpFcntl (F1, F_SETLK,
Region)
3. Check that a lock exists with Fpfcntl(F1, F_GETLK, Region)

Step 3 should overwrite "region" with the existing lock details
including PID.

It does not. It also reports that there is no lock.

Here are code fragements..

STEP 1
uses BaseUnix;  //For file flags and TMode
Const
  Fn = '/home/laurie/test_lock';
  F_RDLCK = 0;
  F_WRLCK = 1;
  F_UNLCK = 2;
var
  F1: Integer;  //File descriptor
{$I+}
procedure TForm1.btnOpenFileClick(Sender: TObject);
var i:integer;
begin //create and open file of length 256
  If FileExists (Fn) Then DeleteFile (Fn);
  F1 := FpOpen (Fn, O_RDWR Or O_CREAT, $1B6); // $1B6 = o666
  For I := 0 To 255 Do FpWrite (F1, I, 1);
end;

STEP 2
procedure TForm1.btnSetReadLockClick(Sender: TObject);
Var
  Region : FLock;
Begin //Apply read lock from byte 10 to 29
  With Region Do Begin
    l_type := F_RDLCK; l_whence := SEEK_SET;
    l_start := 10; l_len := 20
    End;
  If FpFcntl (F1, F_SETLK, Region) = -1 Then
    Showmessage ('unable to apply read writelock. Extended
error='+IntToStr(fpGetErrno)); // <-- OK
end;


STEP 3

procedure TForm1.btnCheckForLockClick(Sender: TObject);
Var
  Region : FLock; ret:integer;
Begin //check for a lock on bytes 10 to 29
  Region.l_type := F_WRLCK;
  Region.l_start := 10;
  Region.l_whence := SEEK_SET;
  Region.l_len := 20;
  Region.l_pid := -1;

  ret := Fpfcntl(F1, F_GETLK, Region);
  if ret < 0 then begin
    ShowMessage('Fpfcntl failed msg:'+IntToStr(fpGetErrno));
    exit;
    end;
  With Region do Case l_type of
    F_UNLCK:ShowMessage('file fd= '+IntToStr(F1)+' pid=
'+IntToStr(l_pid)+' is unlocked');
    F_RDLCK:ShowMessage('file fd= '+IntToStr(F1)+' pid=
'+IntToStr(l_pid)+' has a read lock');
    F_WRLCK:ShowMessage('file fd= '+IntToStr(F1)+' pid=
'+IntToStr(l_pid)+' has a write lock');
    end;  //case
end;


end.


Step 3 never confirms the presence of a lock and never fills in the
correct PID in Region.l_PID.

All help greatly appreciated. 
Laurie

----------------------------------------------------------------------
ludob · 2013-05-06 11:45

Are you running the code in the same process? F_GETLK will just change
the lock type of the current process if the lock was originally set by
the same process.
From the same link:
QuoteLocks are associated with processes. A process can only have one
kind of lock set for each byte of a given file.
You have to run btnSetReadLockClick from another process to test the
lock. There is no need for external file locking if everything happens
in one and the same process.

----------------------------------------------------------------------
Laurie · 2013-05-06 12:50

Thanks ludob.
You are correct.
I altered the code to open the test file but not create it.
I ran 2 instances of the program.
The first instance applies the record lock.
The second instance now opens the file, and correctly reports the PID
and the presence of a record lock.
Sometimes you just need someone to look at a problem from a different
perspective.!

After all, the record locking is to be used in a networked
environment, so I should have had 2 instances of the program running
to test it. 

I'll investigate this further, however you have pointed me in the
right direction and I'm grateful for that.
Thank you.
Laurie.