"Fossies" - the Fresh Open Source Software Archive

Member "Apache-Session-1.93/lib/Apache/Session/Lock/File.pm" (15 Sep 2009, 7109 Bytes) of package /linux/www/Apache-Session-1.93.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "File.pm" see the Fossies "Dox" file reference documentation.

    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 
   10 package Apache::Session::Lock::File;
   11 
   12 use strict;
   13 
   14 use Fcntl qw(:flock);
   15 use Symbol;
   16 use vars qw($VERSION);
   17 
   18 $VERSION = '1.04';
   19 
   20 $Apache::Session::Lock::File::LockDirectory = '/tmp';
   21 
   22 sub new {
   23     my $class = shift;
   24     
   25     return bless { read => 0, write => 0, opened => 0, id => 0 }, $class;
   26 }
   27 
   28 sub 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 
   63 sub 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 
   85 sub 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 
  103 sub 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 
  121 sub 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 
  135 sub DESTROY {
  136     my $self = shift;
  137     
  138     $self->release_all_locks;
  139 }
  140 
  141 sub 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 
  169 1;
  170 
  171 =pod
  172 
  173 =head1 NAME
  174 
  175 Apache::Session::Lock::File - Provides mutual exclusion using flock
  176 
  177 =head1 SYNOPSIS
  178 
  179  use Apache::Session::Lock::File;
  180 
  181  my $locker = new Apache::Session::Lock::File;
  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 
  193 Apache::Session::Lock::File fulfills the locking interface of 
  194 Apache::Session.  Mutual exclusion is achieved through the use of temporary
  195 files and the C<flock> function.
  196 
  197 =head1 CONFIGURATION
  198 
  199 The module must know where to create its temporary files.  You must pass an
  200 argument in the usual Apache::Session style.  The name of the argument is
  201 LockDirectory and its value is the path where you want the lockfiles created.
  202 Example:
  203 
  204  tie %s, 'Apache::Session::Blah', $id, {LockDirectory => '/var/lock/sessions'}
  205 
  206 If you do not supply this argument, temporary files will be created in /tmp.
  207 
  208 =head1 NOTES
  209 
  210 =head2 clean
  211 
  212 This module does not unlink temporary files, because it interferes with proper
  213 locking.  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
  215 you should use a script to clean out old files from your lock directory.
  216 The meaning of old is left as a policy decision for the implementor, but a
  217 method is provided for implementing that policy.  You can use the C<clean>
  218 method of this module to remove files unmodified in the last $age seconds.
  219 Example:
  220 
  221  my $l = new Apache::Session::Lock::File;
  222  $l->clean('/var/lock/sessions', 3600) #remove files older than 1 hour
  223 
  224 =head2 acquire_read_lock
  225 
  226 Will do nothing if write lock is in effect, only set readlock flag to true.
  227 
  228 =head2 release_read_lock
  229 
  230 Will do nothing if write lock is in effect, only set readlock flag to false.
  231 
  232 =head2 Win32 and Cygwin
  233 
  234 Windows cannot escalate lock, so all locks will be exclusive.
  235 
  236 release_read_lock not supported - it is not used by Apache::Session.
  237 
  238 When deleting files, they are not locked (Win32 only).
  239 
  240 =head1 AUTHOR
  241 
  242 This module was written by Jeffrey William Baker <jwbaker@acm.org>.
  243 
  244 =head1 SEE ALSO
  245 
  246 L<Apache::Session>