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