1############################################################################ 2# 3# Apache::Session::Lock::File 4# flock(2) locking for Apache::Session 5# Copyright(c) 1998, 1999, 2000, 2004 Jeffrey William Baker (jwbaker@acm.org) 6# Distribute under the Perl License 7# 8############################################################################ 9 10package Apache::Session::Lock::File; 11 12use strict; 13 14use Fcntl qw(:flock); 15use Symbol; 16use vars qw($VERSION); 17 18$VERSION = '1.04'; 19 20$Apache::Session::Lock::File::LockDirectory = '/tmp'; 21 22sub new { 23 my $class = shift; 24 25 return bless { read => 0, write => 0, opened => 0, id => 0 }, $class; 26} 27 28sub acquire_read_lock { 29 if ($^O eq 'MSWin32' or $^O eq 'cygwin') { 30 #Windows cannot escalate lock, so all locks will be exclusive 31 return &acquire_write_lock; 32 } 33 #Works for acquire_read_lock => acquire_write_lock => release_all_locks 34 #This hack does not support release_read_lock 35 #Changed by Alexandr Ciornii, 2006-06-21 36 37 my $self = shift; 38 my $session = shift; 39 40 return if $self->{read}; 41 #does not support release_read_lock 42 43 if (!$self->{opened}) { 44 my $fh = Symbol::gensym(); 45 46 my $LockDirectory = $session->{args}->{LockDirectory} || 47 $Apache::Session::Lock::File::LockDirectory; 48 49 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: $!"; 50 51 $self->{fh} = $fh; 52 $self->{opened} = 1; 53 } 54 55 if (!$self->{write}) { 56 #acquiring read lock, when write lock is in effect will clear write lock 57 flock($self->{fh}, LOCK_SH) || die "Cannot lock: $!"; 58 } 59 60 $self->{read} = 1; 61} 62 63sub acquire_write_lock { 64 my $self = shift; 65 my $session = shift; 66 67 return if $self->{write}; 68 69 if (!$self->{opened}) { 70 my $fh = Symbol::gensym(); 71 72 my $LockDirectory = $session->{args}->{LockDirectory} || 73 $Apache::Session::Lock::File::LockDirectory; 74 75 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: $!"; 76 77 $self->{fh} = $fh; 78 $self->{opened} = 1; 79 } 80 81 flock($self->{fh}, LOCK_EX) || die "Cannot lock: $!"; 82 $self->{write} = 1; 83} 84 85sub release_read_lock { 86 if ($^O eq 'MSWin32' or $^O eq 'cygwin') { 87 die "release_read_lock is not supported on Win32 or Cygwin"; 88 } 89 my $self = shift; 90 my $session = shift; 91 92 die "No read lock to release in release_read_lock" unless $self->{read}; 93 94 if (!$self->{write}) { 95 flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!"; 96 close $self->{fh} || die "Could no close file: $!"; 97 $self->{opened} = 0; 98 } 99 100 $self->{read} = 0; 101} 102 103sub release_write_lock { 104 my $self = shift; 105 my $session = shift; 106 107 die "No write lock acquired" unless $self->{write}; 108 109 if ($self->{read}) { 110 flock($self->{fh}, LOCK_SH) || die "Cannot lock: $!"; 111 } 112 else { 113 flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!"; 114 close $self->{fh} || die "Could not close file: $!"; 115 $self->{opened} = 0; 116 } 117 118 $self->{write} = 0; 119} 120 121sub release_all_locks { 122 my $self = shift; 123 my $session = shift; 124 125 if ($self->{opened}) { 126 flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!"; 127 close $self->{fh} || die "Could not close file: $!"; 128 } 129 130 $self->{opened} = 0; 131 $self->{read} = 0; 132 $self->{write} = 0; 133} 134 135sub DESTROY { 136 my $self = shift; 137 138 $self->release_all_locks; 139} 140 141sub clean { 142 my $self = shift; 143 my $dir = shift; 144 my $time = shift; 145 146 my $now = time(); 147 148 opendir(DIR, $dir) || die "Could not open directory $dir: $!"; 149 my @files = readdir(DIR); 150 foreach my $file (@files) { 151 if ($file =~ /^Apache-Session.*\.lock$/) { 152 if ($now - (stat($dir.'/'.$file))[8] >= $time) { 153 if ($^O eq 'MSWin32') { 154 #Windows cannot unlink open file 155 unlink($dir.'/'.$file) || next; 156 } else { 157 open(FH, "+>$dir/".$file) || next; 158 flock(FH, LOCK_EX) || next; 159 unlink($dir.'/'.$file) || next; 160 flock(FH, LOCK_UN); 161 close(FH); 162 } 163 } 164 } 165 } 166 closedir(DIR); 167} 168 1691; 170 171=pod 172 173=head1 NAME 174 175Apache::Session::Lock::File - Provides mutual exclusion using flock 176 177=head1 SYNOPSIS 178 179 use Apache::Session::Lock::File; 180 181 my $locker = Apache::Session::Lock::File->new; 182 183 $locker->acquire_read_lock($ref); 184 $locker->acquire_write_lock($ref); 185 $locker->release_read_lock($ref); 186 $locker->release_write_lock($ref); 187 $locker->release_all_locks($ref); 188 189 $locker->clean($dir, $age); 190 191=head1 DESCRIPTION 192 193Apache::Session::Lock::File fulfills the locking interface of 194Apache::Session. Mutual exclusion is achieved through the use of temporary 195files and the C<flock> function. 196 197=head1 CONFIGURATION 198 199The module must know where to create its temporary files. You must pass an 200argument in the usual Apache::Session style. The name of the argument is 201LockDirectory and its value is the path where you want the lockfiles created. 202Example: 203 204 tie %s, 'Apache::Session::Blah', $id, {LockDirectory => '/var/lock/sessions'} 205 206If you do not supply this argument, temporary files will be created in /tmp. 207 208=head1 NOTES 209 210=head2 clean 211 212This module does not unlink temporary files, because it interferes with proper 213locking. This can cause problems on certain systems (Linux) whose file systems 214(ext2) do not perform well with lots of files in one directory. To prevent this 215you should use a script to clean out old files from your lock directory. 216The meaning of old is left as a policy decision for the implementor, but a 217method is provided for implementing that policy. You can use the C<clean> 218method of this module to remove files unmodified in the last $age seconds. 219Example: 220 221 my $l = Apache::Session::Lock::File->new; 222 $l->clean('/var/lock/sessions', 3600) #remove files older than 1 hour 223 224=head2 acquire_read_lock 225 226Will do nothing if write lock is in effect, only set readlock flag to true. 227 228=head2 release_read_lock 229 230Will do nothing if write lock is in effect, only set readlock flag to false. 231 232=head2 Win32 and Cygwin 233 234Windows cannot escalate lock, so all locks will be exclusive. 235 236release_read_lock not supported - it is not used by Apache::Session. 237 238When deleting files, they are not locked (Win32 only). 239 240=head1 AUTHOR 241 242This module was written by Jeffrey William Baker <jwbaker@acm.org>. 243 244=head1 SEE ALSO 245 246L<Apache::Session> 247