| 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 |