File Coverage

blib/lib/Apache/Session/Lock/Semaphore.pm
Criterion Covered Total %
statement 63 73 86.3
branch 18 26 69.2
condition 3 10 30.0
subroutine 12 13 92.3
pod 0 7 0.0
total 96 129 74.4


line stmt bran cond sub pod time code
1             ############################################################################
2             #
3             # Apache::Session::Lock::Semaphore
4             # IPC Semaphore locking for Apache::Session
5             # Copyright(c) 1998, 1999, 2000 Jeffrey William Baker (jwbaker@acm.org)
6             # Distribute under the Artistic License
7             #
8             ############################################################################
9              
10             package Apache::Session::Lock::Semaphore;
11              
12 1     1   1100 use strict;
  1         1  
  1         27  
13 1     1   3 use Config;
  1         1  
  1         37  
14 1     1   4 use IPC::SysV qw(IPC_CREAT S_IRWXU SEM_UNDO);
  1         1  
  1         66  
15 1     1   6 use IPC::Semaphore;
  1         1  
  1         32  
16 1     1   6 use vars qw($VERSION);
  1         1  
  1         120  
17              
18             $VERSION = '1.01';
19              
20             sub BEGIN {
21              
22 1 50   1   15 if ($Config{'osname'} eq 'linux') {
23             #More semaphores on Linux means less lock contention
24 1         2 $Apache::Session::Lock::Semaphore::nsems = 32;
25             }
26             else {
27 0         0 $Apache::Session::Lock::Semaphore::nsems = 16;
28             }
29            
30 1         571 $Apache::Session::Lock::Semaphore::sem_key = 31818;
31             }
32              
33             sub new {
34 4     4 0 2400 my $class = shift;
35 4         7 my $session = shift;
36            
37             my $nsems = $session->{args}->{NSems} ||
38 4   33     16 $Apache::Session::Lock::Semaphore::nsems;
39            
40             my $sem_key = $session->{args}->{SemaphoreKey} ||
41 4   33     11 $Apache::Session::Lock::Semaphore::sem_key;
42              
43 4         25 return bless {read => 0, write => 0, sem => undef, nsems => $nsems,
44             read_sem => undef, sem_key => $sem_key}, $class;
45             }
46              
47             sub acquire_read_lock {
48 8     8 0 3476 my $self = shift;
49 8         11 my $session = shift;
50              
51 8 50       26 return if $self->{read};
52 8 50       19 return if $self->{write};
53              
54 8 100       16 if (!$self->{sem}) {
55             $self->{sem} = new IPC::Semaphore($self->{sem_key}, $self->{nsems},
56 4   50     25 IPC_CREAT | S_IRWXU) || die $!;
57             }
58            
59 8 100       174 if (!defined $self->{read_sem}) {
60             #The number of semaphores (2^2-2^4, typically) is much less than
61             #the potential number of session ids (2^128, typically), we need
62             #to hash the session id to choose a sempahore. This hash routine
63             #was stolen from Kernighan's The Practice of Programming.
64              
65 4         5 my $read_sem = 0;
66 4         17 foreach my $el (split(//, $session->{data}->{_session_id})) {
67 12         16 $read_sem = 31 * $read_sem + ord($el);
68             }
69 4         13 $read_sem %= ($self->{nsems}/2);
70            
71 4         5 $self->{read_sem} = $read_sem;
72             }
73            
74             #The sempahore block is divided into two halves. The lower half
75             #holds the read sempahores, and the upper half holds the write
76             #semaphores. Thus we can do atomic upgrade of a read lock to a
77             #write lock.
78            
79             $self->{sem}->op($self->{read_sem} + $self->{nsems}/2, 0, SEM_UNDO,
80 8         31 $self->{read_sem}, 1, SEM_UNDO);
81            
82 8         156 $self->{read} = 1;
83             }
84              
85             sub acquire_write_lock {
86 8     8 0 5018 my $self = shift;
87 8         8 my $session = shift;
88              
89 8 50       22 return if($self->{write});
90              
91 8 50       18 if (!$self->{sem}) {
92             $self->{sem} = new IPC::Semaphore($self->{sem_key}, $self->{nsems},
93 0   0     0 IPC_CREAT | S_IRWXU) || die $!;
94             }
95            
96 8 50       17 if (!defined $self->{read_sem}) {
97             #The number of semaphores (2^2-2^4, typically) is much less than
98             #the potential number of session ids (2^128, typically), we need
99             #to hash the session id to choose a sempahore. This hash routine
100             #was stolen from Kernighan's The Practice of Programming.
101              
102 0         0 my $read_sem = 0;
103 0         0 foreach my $el (split(//, $session->{data}->{_session_id})) {
104 0         0 $read_sem = 31 * $read_sem + ord($el);
105             }
106 0         0 $read_sem %= ($self->{nsems}/2);
107            
108 0         0 $self->{read_sem} = $read_sem;
109             }
110            
111 8 100       22 $self->release_read_lock($session) if $self->{read};
112              
113             $self->{sem}->op($self->{read_sem}, 0, SEM_UNDO,
114             $self->{read_sem} + $self->{nsems}/2, 0, SEM_UNDO,
115 8         24 $self->{read_sem} + $self->{nsems}/2, 1, SEM_UNDO);
116            
117 8         126 $self->{write} = 1;
118             }
119              
120             sub release_read_lock {
121 8     8 0 8 my $self = shift;
122              
123 8         7 my $session = shift;
124            
125 8 50       15 return unless $self->{read};
126              
127 8         19 $self->{sem}->op($self->{read_sem}, -1, SEM_UNDO);
128            
129 8         112 $self->{read} = 0;
130             }
131              
132             sub release_write_lock {
133 8     8 0 1608 my $self = shift;
134 8         16 my $session = shift;
135            
136 8 50       22 return unless $self->{write};
137            
138 8         35 $self->{sem}->op($self->{read_sem} + $self->{nsems}/2, -1, SEM_UNDO);
139              
140 8         109 $self->{write} = 0;
141             }
142              
143             sub release_all_locks {
144 8     8 0 26 my $self = shift;
145 8         23 my $session = shift;
146              
147 8 100       21 if($self->{read}) {
148 4         9 $self->release_read_lock($session);
149             }
150 8 100       17 if($self->{write}) {
151 4         7 $self->release_write_lock($session);
152             }
153            
154 8         11 $self->{read} = 0;
155 8         11 $self->{write} = 0;
156             }
157              
158             sub hash {
159 0     0 0   my $key = shift;
160 0           my $nsems = shift;
161 0           my $hash = 0;
162              
163              
164             }
165              
166             1;
167              
168              
169             =pod
170              
171             =head1 NAME
172              
173             Apache::Session::Lock::Semaphore - Provides mutual exclusion through sempahores
174              
175             =head1 SYNOPSIS
176              
177             use Apache::Session::Lock::Semaphore;
178            
179             my $locker = new Apache::Session::Lock::Semaphore;
180            
181             $locker->acquire_read_lock($ref);
182             $locker->acquire_write_lock($ref);
183             $locker->release_read_lock($ref);
184             $locker->release_write_lock($ref);
185             $locker->release_all_locks($ref);
186              
187             =head1 DESCRIPTION
188              
189             Apache::Session::Lock::Sempahore fulfills the locking interface of
190             Apache::Session. Mutual exclusion is achieved through system semaphores and
191             the IPC::Semaphore module.
192              
193             =head1 CONFIGURATION
194              
195             The module must know how many semaphores to use, and what semaphore key to
196             use. The number of semaphores has an impact on performance. More semaphores
197             meansless lock contention. You should use the maximum number of sempahores
198             that your platform will allow. On stock NetBSD, OpenBSD, and Solaris systems,
199             this is probably 16. On Linux 2.2, this is 32. This module tries to guess
200             the number based on your operating system, but it is safer to configure it
201             yourself.
202              
203             To set the number of semaphores, you need to pass an argument in the usual
204             Apache::Session style. The name of the argument is NSems, and the value is
205             an integer power of 2. For example:
206              
207             tie %s, 'Apache::Session::Blah', $id, {NSems => 16};
208              
209             You may also need to configure the semaphore key that this package uses. By
210             default, it uses key 31818. You can change this using the argument
211             SemaphoreKey:
212              
213             tie %s, 'Apache::Session::Blah', $id, {NSems => 16, SemaphoreKey => 42};
214              
215             =head1 PROBLEMS
216              
217             There are a few problems that people frequently encounter when using this
218             package.
219              
220             If you get an invalid argument message, that usually means that the system
221             is unhappy with the number of semaphores that you requested. Try decreasing
222             the number of semaphores. The semaphore blocks that this package creates
223             are persistent until the system is rebooted, so if you request 8 sempahores
224             one time and 16 sempahores the next, it won't work. Use the system
225             commands ipcs and ipcrm to inspect and remove unwanted semphore blocks.
226              
227             =head1 AUTHOR
228              
229             This module was written by Jeffrey William Baker .
230              
231             =head1 SEE ALSO
232              
233             L