/usr/share/perl5/DB_File/Lock.pm is in libdb-file-lock-perl 0.05-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 | #
# DB_File::Lock
#
# by David Harris <dharris@drh.net>
#
# Copyright (c) 1999-2000 David R. Harris. All rights reserved.
# This program is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
package DB_File::Lock;
require 5.004;
use strict;
use vars qw($VERSION @ISA $locks);
@ISA = qw(DB_File);
$VERSION = '0.05';
use DB_File ();
use Fcntl qw(:flock O_RDWR O_RDONLY O_WRONLY O_CREAT);
use Carp qw(croak carp);
use Symbol ();
# import function can't be inherited, so this magic required
sub import
{
my $ourname = shift;
my @imports = @_; # dynamic scoped var, still in scope after package call in eval
my $module = caller;
my $calling = $ISA[0];
eval " package $module; import $calling, \@imports; ";
}
sub _lock_and_tie
{
my $package = shift;
## Grab the type of tie
my $tie_type = pop @_;
## There are two ways of passing data defined by DB_File
my $lock_data;
my @dbfile_data;
if ( @_ == 5 ) {
$lock_data = pop @_;
@dbfile_data = @_;
} elsif ( @_ == 2 ) {
$lock_data = pop @_;
@dbfile_data = @{$_[0]};
} else {
croak "invalid number of arguments";
}
## Decipher the lock_data
my $mode;
my $nonblocking = 0;
my $lockfile_name = $dbfile_data[0] . ".lock";
my $lockfile_mode;
if ( lc($lock_data) eq "read" ) {
$mode = "read";
} elsif ( lc($lock_data) eq "write" ) {
$mode = "write";
} elsif ( ref($lock_data) eq "HASH" ) {
$mode = lc $lock_data->{mode};
croak "invalid mode ($mode)" if ( $mode ne "read" and $mode ne "write" );
$nonblocking = $lock_data->{nonblocking};
$lockfile_name = $lock_data->{lockfile_name} if ( defined $lock_data->{lockfile_name} );
$lockfile_mode = $lock_data->{lockfile_mode};
} else {
croak "invalid lock_data ($lock_data)";
}
## Warn about opening a lockfile for writing when only locking for reading
# NOTE: This warning disabled for RECNO because RECNO seems to require O_RDWR
# even when opening only for reading.
carp "opening with write access when locking only for reading (use O_RDONLY to fix)"
if (
( $dbfile_data[1] && O_RDWR or $dbfile_data[1] && O_WRONLY ) # any kind of write access
and $mode eq "read" # and opening for reading
and $tie_type ne "TIEARRAY" # and not RECNO
);
## Determine the mode of the lockfile, if not given
# THEORY: if someone can read or write the database file, we must allow
# them to read and write the lockfile.
if ( not defined $lockfile_mode ) {
$lockfile_mode = 0600; # we must be allowed to read/write lockfile
$lockfile_mode |= 0060 if ( $dbfile_data[2] & 0060 );
$lockfile_mode |= 0006 if ( $dbfile_data[2] & 0006 );
}
## Open the lockfile, lock it, and open the database
my $lockfile_fh = Symbol::gensym();
my $saved_umask = umask(0000) if ( umask() & $lockfile_mode );
my $open_ok = sysopen($lockfile_fh, $lockfile_name, O_RDWR|O_CREAT,
$lockfile_mode);
umask($saved_umask) if ( defined $saved_umask );
$open_ok or croak "could not open lockfile ($lockfile_name)";
my $flock_flags = ($mode eq "write" ? LOCK_EX : LOCK_SH) | ($nonblocking ? LOCK_NB : 0);
if ( not flock $lockfile_fh, $flock_flags ) {
close $lockfile_fh;
return undef if ( $nonblocking );
croak "could not flock lockfile";
}
my $self = $tie_type eq "TIEHASH"
? $package->SUPER::TIEHASH(@dbfile_data)
: $package->SUPER::TIEARRAY(@dbfile_data);
if ( not $self ) {
close $lockfile_fh;
return $self;
}
## Store the info for the DESTROY function
my $id = "" . $self;
$id =~ s/^[^=]+=//; # remove the package name in case re-blessing occurs
$locks->{$id} = $lockfile_fh;
## Return the object
return $self;
}
sub TIEHASH
{
return _lock_and_tie(@_, 'TIEHASH');
}
sub TIEARRAY
{
return _lock_and_tie(@_, 'TIEARRAY');
}
sub DESTROY
{
my $self = shift;
my $id = "" . $self;
$id =~ s/^[^=]+=//;
my $lockfile_fh = $locks->{$id};
delete $locks->{$id};
$self->SUPER::DESTROY(@_);
# un-flock not needed, as we close here
close $lockfile_fh;
}
1;
__END__
=head1 NAME
DB_File::Lock - Locking with flock wrapper for DB_File
=head1 SYNOPSIS
use DB_File::Lock;
use Fcntl qw(:flock O_RDWR O_CREAT);
$locking = "read";
$locking = "write";
$locking = {
mode => "read",
nonblocking => 0,
lockfile_name => "/path/to/shared.lock",
lockfile_mode => 0600,
};
[$X =] tie %hash, 'DB_File::Lock', $filename, $flags, $mode, $DB_HASH, $locking;
[$X =] tie %hash, 'DB_File::Lock', $filename, $flags, $mode, $DB_BTREE, $locking;
[$X =] tie @array, 'DB_File::Lock', $filename, $flags, $mode, $DB_RECNO, $locking;
# or place the DB_File arguments inside a list reference:
[$X =] tie %hash, 'DB_File::Lock', [$filename, $flags, $mode, $DB_HASH], $locking;
...use the same way as DB_File for the rest of the interface...
=head1 DESCRIPTION
This module provides a wrapper for the DB_File module, adding locking.
When you need locking, simply use this module in place of DB_File and
add an extra argument onto the tie command specifying if the file should
be locked for reading or writing.
The alternative is to write code like:
open(LOCK, "<$db_filename.lock") or die;
flock(LOCK, LOCK_SH) or die;
tie(%db_hash, 'DB_File', $db_filename, O_RDONLY, 0600, $DB_HASH) or die;
... then read the database ...
untie(%db_hash);
close(LOCK);
This module lets you write
tie(%db_hash, 'DB_File::Lock', $db_filename, O_RDONLY, 0600, $DB_HASH, 'read') or die;
... then read the database ...
untie(%db_hash);
This is better for two reasons:
(1) Less cumbersome to write.
(2) A fatal exception in the code working on the database which does
not lead to process termination will probably not close the lockfile
and therefore cause a dropped lock.
=head1 USAGE DETAILS
Tie to the database file by adding an additional locking argument
to the list of arguments to be passed through to DB_File, such as:
tie(%db_hash, 'DB_File::Lock', $db_filename, O_RDONLY, 0600, $DB_HASH, 'read');
or enclose the arguments for DB_File in a list reference:
tie(%db_hash, 'DB_File::Lock', [$db_filename, O_RDONLY, 0600, $DB_HASH], 'read');
The filename used for the lockfile defaults to "$filename.lock"
(the filename of the DB_File with ".lock" appended). Using a lockfile
separate from the database file is recommended because it prevents weird
interactions with the underlying database file library
The additional locking argument added to the tie call can be:
(1) "read" -- acquires a shared lock for reading
(2) "write" -- acquires an exclusive lock for writing
(3) A hash with the following keys (all optional except for the "mode"):
=over 4
=item mode
the locking mode, "read" or "write".
=item lockfile_name
specifies the name of the lockfile to use. Default
is "$filename.lock". This is useful for locking multiple resources with
the same lockfiles.
=item nonblocking
determines if the flock call on the lockfile should
block waiting for a lock, or if it should return failure if a lock can
not be immediately attained. If "nonblocking" is set and a lock can not
be attained, the tie command will fail. Currently, I'm not sure how to
differentiate this between a failure form the DB_File layer.
=item lockfile_mode
determines the mode for the sysopen call in opening
the lockfile. The default mode will be formulated to allow anyone that
can read or write the DB_File permission to read and write the lockfile.
(This is because some systems may require that one have write access to
a file to lock it for reading, I understand.) The umask will be prevented
from applying to this mode.
=back
Note: One may import the same values from DB_File::Lock as one may import
from DB_File.
=head1 GOOD LOCKING ETIQUETTE
To avoid locking problems, realize that it is B<critical> that you release
the lock as soon as possible. See the lock as a "hot potato", something
that you must work with and get rid of as quickly as possible. See the
sections of code where you have a lock as "critical" sections. Make sure
that you call "untie" as soon as possible.
It is often better to write:
# open database file with lock
# work with database
# lots of processing not related to database
# work with database
# close database and release lock
as:
# open database file with lock
# work with database
# close database and release lock
# lots of processing not related to database
# open database file with lock
# work with database
# close database and release lock
Also realize that when acquiring two locks at the same time, a deadlock
situation can be caused.
You can enter a deadlock situation if two processes simultaneously try to
acquire locks on two separate databases. Each has locked only one of
the databases, and cannot continue without locking the second. Yet this
will never be freed because it is locked by the other process. If your
processes all ask for their DB files in the same order, this situation
cannot occur.
=head1 OTHER LOCKING MODULES
There are three locking wrappers for DB_File in CPAN right now. Each one
implements locking differently and has different goals in mind. It is
therefore worth knowing the difference, so that you can pick the right
one for your application.
Here are the three locking wrappers:
Tie::DB_Lock -- DB_File wrapper which creates copies of the database file
for read access, so that you have kind of a multiversioning concurrent
read system. However, updates are still serial. Use for databases where
reads may be lengthy and consistency problems may occur.
Tie::DB_LockFile -- DB_File wrapper that has the ability to lock and
unlock the database while it is being used. Avoids the tie-before-flock
problem by simply re-tie-ing the database when you get or drop a
lock. Because of the flexibility in dropping and re-acquiring the lock
in the middle of a session, this can be massaged into a system that will
work with long updates and/or reads if the application follows the hints
in the POD documentation.
DB_File::Lock (this module) -- extremely lightweight DB_File wrapper
that simply flocks a lockfile before tie-ing the database and drops the
lock after the untie. Allows one to use the same lockfile for multiple
databases to avoid deadlock problems, if desired. Use for databases where
updates are reads are quick and simple flock locking semantics are enough.
(This text duplicated in the POD documentation, by the way.)
=head1 AUTHOR
David Harris <dharris@drh.net>
Helpful insight from Stas Bekman <stas@stason.org>
=head1 SEE ALSO
DB_File(3).
=cut
|