| Subject: | Insecure Dependecy in taint mode regarding Cache::File::purge and Cache::File::clear |
Dear Shlomi Fish,
Thank you very much for maintaining this wonderful, pure-perl Cache module.
I noticed in my CGI web application a problem when running under taint mode (perl -wT). Both $cache->purge and $cache->clear led in my case to an Insecure Dependency error. Attached you find two simple tests and a simple patch to fix the problem. For the clear function it was sufficient to use the newer remove_tree instead of rmtree and for purge a simple untaint of the $shakey helped me.
It would be great, if you could solve these issues in the next version...
Thanks in advance,
Max
| Subject: | File.pm.patch |
--- ./File.pm 2017-09-21 21:36:49.422003194 +0200
+++ ./File_Patch.pm 2017-09-21 21:45:06.967023894 +0200
@@ -29,7 +29,7 @@ use Digest::SHA qw(sha1_hex);
use Fcntl qw(LOCK_EX LOCK_NB);
use Symbol ();
use File::Spec;
-use File::Path;
+use File::Path qw(remove_tree mkpath);
use File::NFSLock;
use DB_File;
use Storable;
@@ -133,17 +133,18 @@ sub purge {
my $keys;
($minimum, $keys) = $expheap->extract_minimum_dup();
- foreach (@$keys) {
+ foreach my $key (@$keys) {
# update all the indexes (remove references to this key)
- my $path = $self->cache_file_path($_);
+ my $path = $self->cache_file_path($key);
+
- my $index_entries = $self->get_index_entries($_)
- or warnings::warnif('Cache', "missing index entry for $_");
- delete $$index{$_};
+ my $index_entries = $self->get_index_entries($key)
+ or warnings::warnif('Cache', "missing index entry for $key");
+ delete $$index{$key};
- $ageheap->delete($$index_entries{age}, $_)
+ $ageheap->delete($$index_entries{age}, $key)
if $$index_entries{age};
- $useheap->delete($$index_entries{lastuse}, $_)
+ $useheap->delete($$index_entries{lastuse}, $key)
if $$index_entries{lastuse};
# reduce the cache size and count
@@ -167,7 +168,7 @@ sub clear {
my $fh = Symbol::gensym();
$self->lock();
-
+
# Find each directory entries are stored in and remove them
opendir($fh, $self->{root})
or die "Can't opendir ".$self->{root}.": $!";
@@ -177,7 +178,7 @@ sub clear {
File::Spec->no_upwards(readdir($fh));
closedir($fh);
- rmtree(\@stores,0,1);
+ remove_tree(\@stores,0,1);
# remove the index files
unlink($self->{expheap});
@@ -391,6 +392,11 @@ sub cache_file_path {
my ($key) = @_;
my $shakey = sha1_hex($key);
+
+ # untaint $shakey
+ $shakey =~ /^([0-9a-f]+)/;
+ $shakey = $1;
+
my (@path) = unpack('A2'x$self->{depth}.'A*', $shakey);
if (wantarray) {
| Subject: | test_clear.pl |
#! /usr/bin/perl -wT
use Cache::File;
my $cache = Cache::File->new('cache_root' => '/home/maximilian/tmp');
my $key = 'test';
$cache->set($key, "Hello", 2);
$cache->clear;
| Subject: | test_purge.pl |
#! /usr/bin/perl -wT
use Cache::File;
my $cache = Cache::File->new('cache_root' => '/home/maximilian/tmp');
my $key = 'test';
$cache->set($key, "Hello", 2);
sleep 3;
$cache->purge;