lib/CPAN/lib/CGI/Session/Driver/file.pm
changeset 0 414e01d06fd5
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/lib/CPAN/lib/CGI/Session/Driver/file.pm	Sat Jan 26 15:50:53 2008 +0100
     1.3 @@ -0,0 +1,217 @@
     1.4 +package CGI::Session::Driver::file;
     1.5 +
     1.6 +# $Id: file.pm 351 2006-11-24 14:16:50Z markstos $
     1.7 +
     1.8 +use strict;
     1.9 +
    1.10 +use Carp;
    1.11 +use File::Spec;
    1.12 +use Fcntl qw( :DEFAULT :flock :mode );
    1.13 +use CGI::Session::Driver;
    1.14 +use vars qw( $FileName $NoFlock $UMask $NO_FOLLOW );
    1.15 +
    1.16 +BEGIN {
    1.17 +    # keep historical behavior
    1.18 +
    1.19 +    no strict 'refs';
    1.20 +    
    1.21 +    *FileName = \$CGI::Session::File::FileName;
    1.22 +}
    1.23 +
    1.24 +@CGI::Session::Driver::file::ISA        = ( "CGI::Session::Driver" );
    1.25 +$CGI::Session::Driver::file::VERSION    = "4.20";
    1.26 +$FileName                               = "cgisess_%s";
    1.27 +$NoFlock                                = 0;
    1.28 +$UMask                                  = 0660;
    1.29 +$NO_FOLLOW                              = eval { O_NOFOLLOW } || 0;
    1.30 +
    1.31 +sub init {
    1.32 +    my $self = shift;
    1.33 +    $self->{Directory} ||= File::Spec->tmpdir();
    1.34 +
    1.35 +    unless ( -d $self->{Directory} ) {
    1.36 +        require File::Path;
    1.37 +        unless ( File::Path::mkpath($self->{Directory}) ) {
    1.38 +            return $self->set_error( "init(): couldn't create directory path: $!" );
    1.39 +        }
    1.40 +    }
    1.41 +    
    1.42 +    $self->{NoFlock} = $NoFlock unless exists $self->{NoFlock};
    1.43 +    $self->{UMask} = $UMask unless exists $self->{UMask};
    1.44 +    
    1.45 +    return 1;
    1.46 +}
    1.47 +
    1.48 +sub _file {
    1.49 +    my ($self,$sid) = @_;
    1.50 +    return File::Spec->catfile($self->{Directory}, sprintf( $FileName, $sid ));
    1.51 +}
    1.52 +
    1.53 +sub retrieve {
    1.54 +    my $self = shift;
    1.55 +    my ($sid) = @_;
    1.56 +
    1.57 +    my $path = $self->_file($sid);
    1.58 +    
    1.59 +    return 0 unless -e $path;
    1.60 +
    1.61 +    # make certain our filehandle goes away when we fall out of scope
    1.62 +    local *FH;
    1.63 +
    1.64 +    if (-l $path) {
    1.65 +        unlink($path) or 
    1.66 +          return $self->set_error("retrieve(): '$path' appears to be a symlink and I couldn't remove it: $!");
    1.67 +        return 0; # we deleted this so we have no hope of getting back anything
    1.68 +    }
    1.69 +    sysopen(FH, $path, O_RDONLY | $NO_FOLLOW ) || return $self->set_error( "retrieve(): couldn't open '$path': $!" );
    1.70 +    
    1.71 +    $self->{NoFlock} || flock(FH, LOCK_SH) or return $self->set_error( "retrieve(): couldn't lock '$path': $!" );
    1.72 +
    1.73 +    my $rv = "";
    1.74 +    while ( <FH> ) {
    1.75 +        $rv .= $_;
    1.76 +    }
    1.77 +    close(FH);
    1.78 +    return $rv;
    1.79 +}
    1.80 +
    1.81 +
    1.82 +
    1.83 +sub store {
    1.84 +    my $self = shift;
    1.85 +    my ($sid, $datastr) = @_;
    1.86 +    
    1.87 +    my $path = $self->_file($sid);
    1.88 +    
    1.89 +    # make certain our filehandle goes away when we fall out of scope
    1.90 +    local *FH;
    1.91 +    
    1.92 +    my $mode = O_WRONLY|$NO_FOLLOW;
    1.93 +    
    1.94 +    # kill symlinks when we spot them
    1.95 +    if (-l $path) {
    1.96 +        unlink($path) or 
    1.97 +          return $self->set_error("store(): '$path' appears to be a symlink and I couldn't remove it: $!");
    1.98 +    }
    1.99 +    
   1.100 +    $mode = O_RDWR|O_CREAT|O_EXCL unless -e $path;
   1.101 +    
   1.102 +    sysopen(FH, $path, $mode, $self->{UMask}) or return $self->set_error( "store(): couldn't open '$path': $!" );
   1.103 +    
   1.104 +    # sanity check to make certain we're still ok
   1.105 +    if (-l $path) {
   1.106 +        return $self->set_error("store(): '$path' is a symlink, check for malicious processes");
   1.107 +    }
   1.108 +    
   1.109 +    # prevent race condition (RT#17949)
   1.110 +    $self->{NoFlock} || flock(FH, LOCK_EX)  or return $self->set_error( "store(): couldn't lock '$path': $!" );
   1.111 +    truncate(FH, 0)  or return $self->set_error( "store(): couldn't truncate '$path': $!" );
   1.112 +    
   1.113 +    print FH $datastr;
   1.114 +    close(FH)               or return $self->set_error( "store(): couldn't close '$path': $!" );
   1.115 +    return 1;
   1.116 +}
   1.117 +
   1.118 +
   1.119 +sub remove {
   1.120 +    my $self = shift;
   1.121 +    my ($sid) = @_;
   1.122 +
   1.123 +    my $directory = $self->{Directory};
   1.124 +    my $file      = sprintf( $FileName, $sid );
   1.125 +    my $path      = File::Spec->catfile($directory, $file);
   1.126 +    unlink($path) or return $self->set_error( "remove(): couldn't unlink '$path': $!" );
   1.127 +    return 1;
   1.128 +}
   1.129 +
   1.130 +
   1.131 +sub traverse {
   1.132 +    my $self = shift;
   1.133 +    my ($coderef) = @_;
   1.134 +
   1.135 +    unless ( $coderef && ref($coderef) && (ref $coderef eq 'CODE') ) {
   1.136 +        croak "traverse(): usage error";
   1.137 +    }
   1.138 +
   1.139 +    opendir( DIRHANDLE, $self->{Directory} ) 
   1.140 +        or return $self->set_error( "traverse(): couldn't open $self->{Directory}, " . $! );
   1.141 +
   1.142 +    my $filename_pattern = $FileName;
   1.143 +    $filename_pattern =~ s/\./\\./g;
   1.144 +    $filename_pattern =~ s/\%s/(\.\+)/g;
   1.145 +    while ( my $filename = readdir(DIRHANDLE) ) {
   1.146 +        next if $filename =~ m/^\.\.?$/;
   1.147 +        my $full_path = File::Spec->catfile($self->{Directory}, $filename);
   1.148 +        my $mode = (stat($full_path))[2] 
   1.149 +            or return $self->set_error( "traverse(): stat failed for $full_path: " . $! );
   1.150 +        next if S_ISDIR($mode);
   1.151 +        if ( $filename =~ /^$filename_pattern$/ ) {
   1.152 +            $coderef->($1);
   1.153 +        }
   1.154 +    }
   1.155 +    closedir( DIRHANDLE );
   1.156 +    return 1;
   1.157 +}
   1.158 +
   1.159 +
   1.160 +sub DESTROY {
   1.161 +    my $self = shift;
   1.162 +}
   1.163 +
   1.164 +1;
   1.165 +
   1.166 +__END__;
   1.167 +
   1.168 +=pod
   1.169 +
   1.170 +=head1 NAME
   1.171 +
   1.172 +CGI::Session::Driver::file - Default CGI::Session driver
   1.173 +
   1.174 +=head1 SYNOPSIS
   1.175 +
   1.176 +    $s = new CGI::Session();
   1.177 +    $s = new CGI::Session("driver:file", $sid);
   1.178 +    $s = new CGI::Session("driver:file", $sid, {Directory=>'/tmp'});
   1.179 +
   1.180 +
   1.181 +=head1 DESCRIPTION
   1.182 +
   1.183 +When CGI::Session object is created without explicitly setting I<driver>, I<file> will be assumed.
   1.184 +I<file> - driver will store session data in plain files, where each session will be stored in a separate
   1.185 +file.
   1.186 +
   1.187 +Naming conventions of session files are defined by C<$CGI::Session::Driver::file::FileName> global variable. 
   1.188 +Default value of this variable is I<cgisess_%s>, where %s will be replaced with respective session ID. Should
   1.189 +you wish to set your own FileName template, do so before requesting for session object:
   1.190 +
   1.191 +    $CGI::Session::Driver::file::FileName = "%s.dat";
   1.192 +    $s = new CGI::Session();
   1.193 +
   1.194 +For backwards compatibility with 3.x, you can also use the variable name
   1.195 +C<$CGI::Session::File::FileName>, which will override the one above. 
   1.196 +
   1.197 +=head2 DRIVER ARGUMENTS
   1.198 +
   1.199 +If you wish to specify a session directory, use the B<Directory> option, which denotes location of the directory 
   1.200 +where session ids are to be kept. If B<Directory> is not set, defaults to whatever File::Spec->tmpdir() returns. 
   1.201 +So all the three lines in the SYNOPSIS section of this manual produce the same result on a UNIX machine.
   1.202 +
   1.203 +If specified B<Directory> does not exist, all necessary directory hierarchy will be created.
   1.204 +
   1.205 +By default, sessions are created with a umask of 0660. If you wish to change the umask for a session, pass
   1.206 +a B<UMask> option with an octal representation of the umask you would like for said session. 
   1.207 +
   1.208 +=head1 NOTES
   1.209 +
   1.210 +If your OS doesn't support flock, you should understand the risks of going without locking the session files. Since
   1.211 +sessions tend to be used in environments where race conditions may occur due to concurrent access of files by 
   1.212 +different processes, locking tends to be seen as a good and very necessary thing. If you still want to use this 
   1.213 +driver but don't want flock, set C<$CGI::Session::Driver::file::NoFlock> to 1 or pass C<< NoFlock => 1 >> and this 
   1.214 +driver will operate without locks.
   1.215 +
   1.216 +=head1 LICENSING
   1.217 +
   1.218 +For support and licensing see L<CGI::Session|CGI::Session>
   1.219 +
   1.220 +=cut