File Coverage

blib/lib/Apache/Session/Lock/File.pm
Criterion Covered Total %
statement 62 83 74.7
branch 19 48 39.6
condition 3 12 25.0
subroutine 10 12 83.3
pod 0 7 0.0
total 94 162 58.0


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