lib/CPAN/lib/CGI/Session/Driver/file.pm
changeset 0 414e01d06fd5
equal deleted inserted replaced
-1:000000000000 0:414e01d06fd5
       
     1 package CGI::Session::Driver::file;
       
     2 
       
     3 # $Id: file.pm 351 2006-11-24 14:16:50Z markstos $
       
     4 
       
     5 use strict;
       
     6 
       
     7 use Carp;
       
     8 use File::Spec;
       
     9 use Fcntl qw( :DEFAULT :flock :mode );
       
    10 use CGI::Session::Driver;
       
    11 use vars qw( $FileName $NoFlock $UMask $NO_FOLLOW );
       
    12 
       
    13 BEGIN {
       
    14     # keep historical behavior
       
    15 
       
    16     no strict 'refs';
       
    17     
       
    18     *FileName = \$CGI::Session::File::FileName;
       
    19 }
       
    20 
       
    21 @CGI::Session::Driver::file::ISA        = ( "CGI::Session::Driver" );
       
    22 $CGI::Session::Driver::file::VERSION    = "4.20";
       
    23 $FileName                               = "cgisess_%s";
       
    24 $NoFlock                                = 0;
       
    25 $UMask                                  = 0660;
       
    26 $NO_FOLLOW                              = eval { O_NOFOLLOW } || 0;
       
    27 
       
    28 sub init {
       
    29     my $self = shift;
       
    30     $self->{Directory} ||= File::Spec->tmpdir();
       
    31 
       
    32     unless ( -d $self->{Directory} ) {
       
    33         require File::Path;
       
    34         unless ( File::Path::mkpath($self->{Directory}) ) {
       
    35             return $self->set_error( "init(): couldn't create directory path: $!" );
       
    36         }
       
    37     }
       
    38     
       
    39     $self->{NoFlock} = $NoFlock unless exists $self->{NoFlock};
       
    40     $self->{UMask} = $UMask unless exists $self->{UMask};
       
    41     
       
    42     return 1;
       
    43 }
       
    44 
       
    45 sub _file {
       
    46     my ($self,$sid) = @_;
       
    47     return File::Spec->catfile($self->{Directory}, sprintf( $FileName, $sid ));
       
    48 }
       
    49 
       
    50 sub retrieve {
       
    51     my $self = shift;
       
    52     my ($sid) = @_;
       
    53 
       
    54     my $path = $self->_file($sid);
       
    55     
       
    56     return 0 unless -e $path;
       
    57 
       
    58     # make certain our filehandle goes away when we fall out of scope
       
    59     local *FH;
       
    60 
       
    61     if (-l $path) {
       
    62         unlink($path) or 
       
    63           return $self->set_error("retrieve(): '$path' appears to be a symlink and I couldn't remove it: $!");
       
    64         return 0; # we deleted this so we have no hope of getting back anything
       
    65     }
       
    66     sysopen(FH, $path, O_RDONLY | $NO_FOLLOW ) || return $self->set_error( "retrieve(): couldn't open '$path': $!" );
       
    67     
       
    68     $self->{NoFlock} || flock(FH, LOCK_SH) or return $self->set_error( "retrieve(): couldn't lock '$path': $!" );
       
    69 
       
    70     my $rv = "";
       
    71     while ( <FH> ) {
       
    72         $rv .= $_;
       
    73     }
       
    74     close(FH);
       
    75     return $rv;
       
    76 }
       
    77 
       
    78 
       
    79 
       
    80 sub store {
       
    81     my $self = shift;
       
    82     my ($sid, $datastr) = @_;
       
    83     
       
    84     my $path = $self->_file($sid);
       
    85     
       
    86     # make certain our filehandle goes away when we fall out of scope
       
    87     local *FH;
       
    88     
       
    89     my $mode = O_WRONLY|$NO_FOLLOW;
       
    90     
       
    91     # kill symlinks when we spot them
       
    92     if (-l $path) {
       
    93         unlink($path) or 
       
    94           return $self->set_error("store(): '$path' appears to be a symlink and I couldn't remove it: $!");
       
    95     }
       
    96     
       
    97     $mode = O_RDWR|O_CREAT|O_EXCL unless -e $path;
       
    98     
       
    99     sysopen(FH, $path, $mode, $self->{UMask}) or return $self->set_error( "store(): couldn't open '$path': $!" );
       
   100     
       
   101     # sanity check to make certain we're still ok
       
   102     if (-l $path) {
       
   103         return $self->set_error("store(): '$path' is a symlink, check for malicious processes");
       
   104     }
       
   105     
       
   106     # prevent race condition (RT#17949)
       
   107     $self->{NoFlock} || flock(FH, LOCK_EX)  or return $self->set_error( "store(): couldn't lock '$path': $!" );
       
   108     truncate(FH, 0)  or return $self->set_error( "store(): couldn't truncate '$path': $!" );
       
   109     
       
   110     print FH $datastr;
       
   111     close(FH)               or return $self->set_error( "store(): couldn't close '$path': $!" );
       
   112     return 1;
       
   113 }
       
   114 
       
   115 
       
   116 sub remove {
       
   117     my $self = shift;
       
   118     my ($sid) = @_;
       
   119 
       
   120     my $directory = $self->{Directory};
       
   121     my $file      = sprintf( $FileName, $sid );
       
   122     my $path      = File::Spec->catfile($directory, $file);
       
   123     unlink($path) or return $self->set_error( "remove(): couldn't unlink '$path': $!" );
       
   124     return 1;
       
   125 }
       
   126 
       
   127 
       
   128 sub traverse {
       
   129     my $self = shift;
       
   130     my ($coderef) = @_;
       
   131 
       
   132     unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) {
       
   133         croak "traverse(): usage error";
       
   134     }
       
   135 
       
   136     opendir( DIRHANDLE, $self->{Directory} ) 
       
   137         or return $self->set_error( "traverse(): couldn't open $self->{Directory}, " . $! );
       
   138 
       
   139     my $filename_pattern = $FileName;
       
   140     $filename_pattern =~ s/\./\\./g;
       
   141     $filename_pattern =~ s/\%s/(\.\+)/g;
       
   142     while ( my $filename = readdir(DIRHANDLE) ) {
       
   143         next if $filename =~ m/^\.\.?$/;
       
   144         my $full_path = File::Spec->catfile($self->{Directory}, $filename);
       
   145         my $mode = (stat($full_path))[2] 
       
   146             or return $self->set_error( "traverse(): stat failed for $full_path: " . $! );
       
   147         next if S_ISDIR($mode);
       
   148         if ( $filename =~ /^$filename_pattern$/ ) {
       
   149             $coderef->($1);
       
   150         }
       
   151     }
       
   152     closedir( DIRHANDLE );
       
   153     return 1;
       
   154 }
       
   155 
       
   156 
       
   157 sub DESTROY {
       
   158     my $self = shift;
       
   159 }
       
   160 
       
   161 1;
       
   162 
       
   163 __END__;
       
   164 
       
   165 =pod
       
   166 
       
   167 =head1 NAME
       
   168 
       
   169 CGI::Session::Driver::file - Default CGI::Session driver
       
   170 
       
   171 =head1 SYNOPSIS
       
   172 
       
   173     $s = new CGI::Session();
       
   174     $s = new CGI::Session("driver:file", $sid);
       
   175     $s = new CGI::Session("driver:file", $sid, {Directory=>'/tmp'});
       
   176 
       
   177 
       
   178 =head1 DESCRIPTION
       
   179 
       
   180 When CGI::Session object is created without explicitly setting I<driver>, I<file> will be assumed.
       
   181 I<file> - driver will store session data in plain files, where each session will be stored in a separate
       
   182 file.
       
   183 
       
   184 Naming conventions of session files are defined by C<$CGI::Session::Driver::file::FileName> global variable. 
       
   185 Default value of this variable is I<cgisess_%s>, where %s will be replaced with respective session ID. Should
       
   186 you wish to set your own FileName template, do so before requesting for session object:
       
   187 
       
   188     $CGI::Session::Driver::file::FileName = "%s.dat";
       
   189     $s = new CGI::Session();
       
   190 
       
   191 For backwards compatibility with 3.x, you can also use the variable name
       
   192 C<$CGI::Session::File::FileName>, which will override the one above. 
       
   193 
       
   194 =head2 DRIVER ARGUMENTS
       
   195 
       
   196 If you wish to specify a session directory, use the B<Directory> option, which denotes location of the directory 
       
   197 where session ids are to be kept. If B<Directory> is not set, defaults to whatever File::Spec->tmpdir() returns. 
       
   198 So all the three lines in the SYNOPSIS section of this manual produce the same result on a UNIX machine.
       
   199 
       
   200 If specified B<Directory> does not exist, all necessary directory hierarchy will be created.
       
   201 
       
   202 By default, sessions are created with a umask of 0660. If you wish to change the umask for a session, pass
       
   203 a B<UMask> option with an octal representation of the umask you would like for said session. 
       
   204 
       
   205 =head1 NOTES
       
   206 
       
   207 If your OS doesn't support flock, you should understand the risks of going without locking the session files. Since
       
   208 sessions tend to be used in environments where race conditions may occur due to concurrent access of files by 
       
   209 different processes, locking tends to be seen as a good and very necessary thing. If you still want to use this 
       
   210 driver but don't want flock, set C<$CGI::Session::Driver::file::NoFlock> to 1 or pass C<< NoFlock => 1 >> and this 
       
   211 driver will operate without locks.
       
   212 
       
   213 =head1 LICENSING
       
   214 
       
   215 For support and licensing see L<CGI::Session|CGI::Session>
       
   216 
       
   217 =cut