This file is indexed.

/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