/usr/share/perl5/Apache/Session/Lock/File.pm is in libapache-session-perl 1.93-2.
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 | ############################################################################
#
# Apache::Session::Lock::File
# flock(2) locking for Apache::Session
# Copyright(c) 1998, 1999, 2000, 2004 Jeffrey William Baker (jwbaker@acm.org)
# Distribute under the Perl License
#
############################################################################
package Apache::Session::Lock::File;
use strict;
use Fcntl qw(:flock);
use Symbol;
use vars qw($VERSION);
$VERSION = '1.04';
$Apache::Session::Lock::File::LockDirectory = '/tmp';
sub new {
my $class = shift;
return bless { read => 0, write => 0, opened => 0, id => 0 }, $class;
}
sub acquire_read_lock {
if ($^O eq 'MSWin32' or $^O eq 'cygwin') {
#Windows cannot escalate lock, so all locks will be exclusive
return &acquire_write_lock;
}
#Works for acquire_read_lock => acquire_write_lock => release_all_locks
#This hack does not support release_read_lock
#Changed by Alexandr Ciornii, 2006-06-21
my $self = shift;
my $session = shift;
return if $self->{read};
#does not support release_read_lock
if (!$self->{opened}) {
my $fh = Symbol::gensym();
my $LockDirectory = $session->{args}->{LockDirectory} ||
$Apache::Session::Lock::File::LockDirectory;
open($fh, "+>".$LockDirectory."/Apache-Session-".$session->{data}->{_session_id}.".lock") || die "Could not open file (".$LockDirectory."/Apache-Session-".$session->{data}->{_session_id}.".lock) for writing: $!";
$self->{fh} = $fh;
$self->{opened} = 1;
}
if (!$self->{write}) {
#acquiring read lock, when write lock is in effect will clear write lock
flock($self->{fh}, LOCK_SH) || die "Cannot lock: $!";
}
$self->{read} = 1;
}
sub acquire_write_lock {
my $self = shift;
my $session = shift;
return if $self->{write};
if (!$self->{opened}) {
my $fh = Symbol::gensym();
my $LockDirectory = $session->{args}->{LockDirectory} ||
$Apache::Session::Lock::File::LockDirectory;
open($fh, "+>".$LockDirectory."/Apache-Session-".$session->{data}->{_session_id}.".lock") || die "Could not open file (".$LockDirectory."/Apache-Session-".$session->{data}->{_session_id}.".lock) for writing: $!";
$self->{fh} = $fh;
$self->{opened} = 1;
}
flock($self->{fh}, LOCK_EX) || die "Cannot lock: $!";
$self->{write} = 1;
}
sub release_read_lock {
if ($^O eq 'MSWin32' or $^O eq 'cygwin') {
die "release_read_lock is not supported on Win32 or Cygwin";
}
my $self = shift;
my $session = shift;
die "No read lock to release in release_read_lock" unless $self->{read};
if (!$self->{write}) {
flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!";
close $self->{fh} || die "Could no close file: $!";
$self->{opened} = 0;
}
$self->{read} = 0;
}
sub release_write_lock {
my $self = shift;
my $session = shift;
die "No write lock acquired" unless $self->{write};
if ($self->{read}) {
flock($self->{fh}, LOCK_SH) || die "Cannot lock: $!";
}
else {
flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!";
close $self->{fh} || die "Could not close file: $!";
$self->{opened} = 0;
}
$self->{write} = 0;
}
sub release_all_locks {
my $self = shift;
my $session = shift;
if ($self->{opened}) {
flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!";
close $self->{fh} || die "Could not close file: $!";
}
$self->{opened} = 0;
$self->{read} = 0;
$self->{write} = 0;
}
sub DESTROY {
my $self = shift;
$self->release_all_locks;
}
sub clean {
my $self = shift;
my $dir = shift;
my $time = shift;
my $now = time();
opendir(DIR, $dir) || die "Could not open directory $dir: $!";
my @files = readdir(DIR);
foreach my $file (@files) {
if ($file =~ /^Apache-Session.*\.lock$/) {
if ($now - (stat($dir.'/'.$file))[8] >= $time) {
if ($^O eq 'MSWin32') {
#Windows cannot unlink open file
unlink($dir.'/'.$file) || next;
} else {
open(FH, "+>$dir/".$file) || next;
flock(FH, LOCK_EX) || next;
unlink($dir.'/'.$file) || next;
flock(FH, LOCK_UN);
close(FH);
}
}
}
}
closedir(DIR);
}
1;
=pod
=head1 NAME
Apache::Session::Lock::File - Provides mutual exclusion using flock
=head1 SYNOPSIS
use Apache::Session::Lock::File;
my $locker = new Apache::Session::Lock::File;
$locker->acquire_read_lock($ref);
$locker->acquire_write_lock($ref);
$locker->release_read_lock($ref);
$locker->release_write_lock($ref);
$locker->release_all_locks($ref);
$locker->clean($dir, $age);
=head1 DESCRIPTION
Apache::Session::Lock::File fulfills the locking interface of
Apache::Session. Mutual exclusion is achieved through the use of temporary
files and the C<flock> function.
=head1 CONFIGURATION
The module must know where to create its temporary files. You must pass an
argument in the usual Apache::Session style. The name of the argument is
LockDirectory and its value is the path where you want the lockfiles created.
Example:
tie %s, 'Apache::Session::Blah', $id, {LockDirectory => '/var/lock/sessions'}
If you do not supply this argument, temporary files will be created in /tmp.
=head1 NOTES
=head2 clean
This module does not unlink temporary files, because it interferes with proper
locking. This can cause problems on certain systems (Linux) whose file systems
(ext2) do not perform well with lots of files in one directory. To prevent this
you should use a script to clean out old files from your lock directory.
The meaning of old is left as a policy decision for the implementor, but a
method is provided for implementing that policy. You can use the C<clean>
method of this module to remove files unmodified in the last $age seconds.
Example:
my $l = new Apache::Session::Lock::File;
$l->clean('/var/lock/sessions', 3600) #remove files older than 1 hour
=head2 acquire_read_lock
Will do nothing if write lock is in effect, only set readlock flag to true.
=head2 release_read_lock
Will do nothing if write lock is in effect, only set readlock flag to false.
=head2 Win32 and Cygwin
Windows cannot escalate lock, so all locks will be exclusive.
release_read_lock not supported - it is not used by Apache::Session.
When deleting files, they are not locked (Win32 only).
=head1 AUTHOR
This module was written by Jeffrey William Baker <jwbaker@acm.org>.
=head1 SEE ALSO
L<Apache::Session>
|