Chris Wood wrote:
I am in the process of developing a CGI program using GNU Pascal. The = CGI program is to be used in a Linux environment. It is a database CGI = script and I would like to have one running process of the CGI script = have exclusive write access. I was hoping that someone could provide me = with an example, or a place where I can find further (detailed) = information, of using the flock() function from the C library in a GNU = Pascal program. I also need to know how to detect when a file is = locked. A million thanks for your time and help.
The best way (WRT portability and security for future versions) is currently to write a small C wrapper. This is because "constants" (i.e., #defines) from a C header cannot be easily made available in Pascal. (I hope one day GPC will have a C header translator which would solve the problem more elegantly.)
What you need to know from the Pascal side is that `GetFile' returns a C file (i.e., a `FILE *') for a Pascal file. The file handle (integer), which is needed by flock(), can then be obtained by the libc function fileno().
So, here's an example. First the C wrapper (fileno.c):
#include <stdio.h> #include <sys/file.h>
typedef unsigned char Boolean;
int filelock (FILE*, Boolean, Boolean); int filelock (FILE* f, Boolean Exclusive, Boolean NoBlock) { return flock (fileno (f), (Exclusive ? LOCK_EX : LOCK_SH) | (NoBlock ? LOCK_NB : 0)); }
int fileunlock (FILE*); int fileunlock (FILE* f) { return flock (fileno (f), LOCK_UN); }
Now a test program:
program FileLockDemo;
uses GPC;
{$L fileno.c} function FileLock (f : CFilePtr; Exclusive, NoBlock : Boolean) : Integer; C; function FileUnlock (f : CFilePtr) : Integer; C;
var a, b : Text;
begin Rewrite (a, 'foo.bar'); Reset (b, 'foo.bar');
{ Non-exclusive locks, succeed } Writeln (FileLock (GetFile (a), False, True)); Writeln (FileLock (GetFile (b), False, True));
{ Exclusive lock, fails } Writeln (FileLock (GetFile (a), True, True));
{ Remove the non-exclusive locks, succeed } Writeln (FileUnLock (GetFile (a))); Writeln (FileUnLock (GetFile (b)));
{ Exclusive lock, succeeds } Writeln (FileLock (GetFile (a), True, True));
{ Another exclusive lock, fails } Writeln (FileLock (GetFile (b), True, True));
{ An exclusive lock *with* blocking, will block the program forever! } Writeln (FileLock (GetFile (b), True, False)); end.
As the example shows, you can find out if a file is locked, by trying to lock it without blocking (and removing the lock again if not needed). I don't know if there's another way to check...
Frank
-- Frank Heckenbach, frank@fjf.gnu.de http://fjf.gnu.de/ PGP and GPG keys: http://fjf.gnu.de/plan