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