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   94 use strict;
  1         15  
  1         87  
13 1     1   18 use Config;
  1         1056  
  1         81  
14 1     1   17 use IPC::SysV qw(IPC_CREAT S_IRWXU SEM_UNDO);
  1         86  
  1         86  
15 1     1   202 use IPC::Semaphore;
  1         9  
  1         78  
16 1     1   104 use vars qw($VERSION);
  1         10  
  1         83  
17              
18             $VERSION = '1.01';
19              
20             sub BEGIN {
21              
22 1 50   1   111     if ($Config{'osname'} eq 'linux') {
23             #More semaphores on Linux means less lock contention
24 1         257         $Apache::Session::Lock::Semaphore::nsems = 32;
25                 }
26                 else {
27 0         0         $Apache::Session::Lock::Semaphore::nsems = 16;
28                 }
29                 
30 1         12     $Apache::Session::Lock::Semaphore::sem_key = 31818;
31             }
32              
33             sub new {
34 4     4 0 39     my $class = shift;
35 4         36     my $session = shift;
36                 
37 4   33     48     my $nsems = $session->{args}->{NSems} ||
38                     $Apache::Session::Lock::Semaphore::nsems;
39                 
40 4   33     44     my $sem_key = $session->{args}->{SemaphoreKey} ||
41                     $Apache::Session::Lock::Semaphore::sem_key;
42              
43 4         89     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 85     my $self = shift;
49 8         66     my $session = shift;
50              
51 8 50       81     return if $self->{read};
52 8 50       82     return if $self->{write};
53              
54 8 100       196     if (!$self->{sem}) {
55 4   50     166         $self->{sem} = new IPC::Semaphore($self->{sem_key}, $self->{nsems},
56                         IPC_CREAT | S_IRWXU) || die $!;
57                 }
58                 
59 8 100       431     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         98         my $read_sem = 0;
66 4         70         foreach my $el (split(//, $session->{data}->{_session_id})) {
67 12         118             $read_sem = 31 * $read_sem + ord($el);
68                     }
69 4         47         $read_sem %= ($self->{nsems}/2);
70                     
71 4         37         $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 8         116     $self->{sem}->op($self->{read_sem} + $self->{nsems}/2, 0, SEM_UNDO,
80                                  $self->{read_sem}, 1, SEM_UNDO);
81                 
82 8         352     $self->{read} = 1;
83             }
84              
85             sub acquire_write_lock {
86 8     8 0 95     my $self = shift;
87 8         70     my $session = shift;
88              
89 8 50       84     return if($self->{write});
90              
91 8 50       82     if (!$self->{sem}) {
92 0   0     0         $self->{sem} = new IPC::Semaphore($self->{sem_key}, $self->{nsems},
93                         IPC_CREAT | S_IRWXU) || die $!;
94                 }
95                 
96 8 50       81     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       89     $self->release_read_lock($session) if $self->{read};
112              
113 8         120     $self->{sem}->op($self->{read_sem}, 0, SEM_UNDO,
114                                  $self->{read_sem} + $self->{nsems}/2, 0, SEM_UNDO,
115                                  $self->{read_sem} + $self->{nsems}/2, 1, SEM_UNDO);
116                 
117 8         265     $self->{write} = 1;
118             }
119              
120             sub release_read_lock {
121 8     8 0 68     my $self = shift;
122              
123 8         68     my $session = shift;
124                 
125 8 50       78     return unless $self->{read};
126              
127 8         118     $self->{sem}->op($self->{read_sem}, -1, SEM_UNDO);
128                 
129 8         236     $self->{read} = 0;
130             }
131              
132             sub release_write_lock {
133 8     8 0 69     my $self = shift;
134 8         70     my $session = shift;
135                 
136 8 50       79     return unless $self->{write};
137                 
138 8         250     $self->{sem}->op($self->{read_sem} + $self->{nsems}/2, -1, SEM_UNDO);
139              
140 8         239     $self->{write} = 0;
141             }
142              
143             sub release_all_locks {
144 8     8 0 69     my $self = shift;
145 8         68     my $session = shift;
146              
147 8 100       109     if($self->{read}) {
148 4         41         $self->release_read_lock($session);
149                 }
150 8 100       165     if($self->{write}) {
151 4         39         $self->release_write_lock($session);
152                 }
153                 
154 8         75     $self->{read} = 0;
155 8         82     $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             =head2 Cygwin
228            
229             IPC on Cygwin requires running cygserver. Without it, program will exit with
230             "Bad System call" message. It cannot be intercepted with eval.
231            
232             Read /usr/share/doc/Cygwin/cygserver.README for more information.
233            
234             =head1 AUTHOR
235            
236             This module was written by Jeffrey William Baker <jwbaker@acm.org>.
237            
238             =head1 SEE ALSO
239            
240             L<Apache::Session>
241