1# -- 2# Copyright (C) 2001-2020 OTRS AG, https://otrs.com/ 3# -- 4# This software comes with ABSOLUTELY NO WARRANTY. For details, see 5# the enclosed file COPYING for license information (GPL). If you 6# did not receive this file, see https://www.gnu.org/licenses/gpl-3.0.txt. 7# -- 8 9package Kernel::System::Cache::FileStorable; 10 11use strict; 12use warnings; 13 14use POSIX; 15use Digest::MD5 qw(); 16use File::Path qw(); 17use File::Find qw(); 18 19our @ObjectDependencies = ( 20 'Kernel::Config', 21 'Kernel::System::Encode', 22 'Kernel::System::Log', 23 'Kernel::System::Main', 24 'Kernel::System::Storable', 25); 26 27sub new { 28 my ( $Type, %Param ) = @_; 29 30 # allocate new hash for object 31 my $Self = {}; 32 bless( $Self, $Type ); 33 34 # get config object 35 my $ConfigObject = $Kernel::OM->Get('Kernel::Config'); 36 37 my $TempDir = $ConfigObject->Get('TempDir'); 38 $Self->{CacheDirectory} = $TempDir . '/CacheFileStorable'; 39 40 # check if cache directory exists and in case create one 41 for my $Directory ( $TempDir, $Self->{CacheDirectory} ) { 42 if ( !-e $Directory ) { 43 ## no critic 44 if ( !mkdir( $Directory, 0770 ) ) { 45 ## use critic 46 $Kernel::OM->Get('Kernel::System::Log')->Log( 47 Priority => 'error', 48 Message => "Can't create directory '$Directory': $!", 49 ); 50 } 51 } 52 } 53 54 # Specify how many levels of subdirectories to use, can be 0, 1 or more. 55 $Self->{'Cache::SubdirLevels'} = $ConfigObject->Get('Cache::SubdirLevels'); 56 $Self->{'Cache::SubdirLevels'} //= 2; 57 58 return $Self; 59} 60 61sub Set { 62 my ( $Self, %Param ) = @_; 63 64 for my $Needed (qw(Type Key Value TTL)) { 65 if ( !defined $Param{$Needed} ) { 66 $Kernel::OM->Get('Kernel::System::Log')->Log( 67 Priority => 'error', 68 Message => "Need $Needed!" 69 ); 70 return; 71 } 72 } 73 74 my $Dump = $Kernel::OM->Get('Kernel::System::Storable')->Serialize( 75 Data => { 76 TTL => time() + $Param{TTL}, 77 Value => $Param{Value}, 78 }, 79 ); 80 81 my ( $Filename, $CacheDirectory ) = $Self->_GetFilenameAndCacheDirectory(%Param); 82 83 if ( !-e $CacheDirectory ) { 84 85 # Create directory. This could fail if another process creates the 86 # same directory, so don't use the return value. 87 File::Path::mkpath( $CacheDirectory, 0, 0770 ); ## no critic 88 89 if ( !-e $CacheDirectory ) { 90 $Kernel::OM->Get('Kernel::System::Log')->Log( 91 Priority => 'error', 92 Message => "Can't create directory '$CacheDirectory': $!", 93 ); 94 return; 95 } 96 } 97 my $FileLocation = $Kernel::OM->Get('Kernel::System::Main')->FileWrite( 98 99 # Use Location rather than Filename and Directory to skip the (unneeded) filename clean-up for better performance. 100 Location => $CacheDirectory . '/' . $Filename, 101 Content => \$Dump, 102 Type => 'Local', 103 Mode => 'binmode', 104 Permission => '660', 105 ); 106 107 return if !$FileLocation; 108 return 1; 109} 110 111sub Get { 112 my ( $Self, %Param ) = @_; 113 114 # check needed stuff 115 for my $Needed (qw(Type Key)) { 116 if ( !defined $Param{$Needed} ) { 117 $Kernel::OM->Get('Kernel::System::Log')->Log( 118 Priority => 'error', 119 Message => "Need $Needed!" 120 ); 121 return; 122 } 123 } 124 125 my ( $Filename, $CacheDirectory ) = $Self->_GetFilenameAndCacheDirectory(%Param); 126 127 my $Content = $Kernel::OM->Get('Kernel::System::Main')->FileRead( 128 129 # Use Location rather than Filename and Directory to skip the (unneeded) filename clean-up for better performance. 130 Location => $CacheDirectory . '/' . $Filename, 131 Type => 'Local', 132 Mode => 'binmode', 133 DisableWarnings => 1, 134 ); 135 136 # check if cache exists 137 return if !$Content; 138 139 # Check if file has contents, due to a race condition the file could be empty, see bug#12881. 140 return if !${$Content}; 141 142 # read data structure back from file dump, use block eval for safety reasons 143 my $Storage = eval { 144 $Kernel::OM->Get('Kernel::System::Storable')->Deserialize( 145 Data => ${$Content} 146 ); 147 }; 148 if ( ref $Storage ne 'HASH' || $Storage->{TTL} < time() ) { 149 $Self->Delete(%Param); 150 return; 151 } 152 153 return $Storage->{Value}; 154} 155 156sub Delete { 157 my ( $Self, %Param ) = @_; 158 159 # check needed stuff 160 for my $Needed (qw(Type Key)) { 161 if ( !defined $Param{$Needed} ) { 162 $Kernel::OM->Get('Kernel::System::Log')->Log( 163 Priority => 'error', 164 Message => "Need $Needed!" 165 ); 166 return; 167 } 168 } 169 170 my ( $Filename, $CacheDirectory ) = $Self->_GetFilenameAndCacheDirectory(%Param); 171 172 return $Kernel::OM->Get('Kernel::System::Main')->FileDelete( 173 174 # Use Location rather than Filename and Directory to skip the (unneeded) filename clean-up for better performance. 175 Location => $CacheDirectory . '/' . $Filename, 176 Type => 'Local', 177 DisableWarnings => 1, 178 ); 179} 180 181sub CleanUp { 182 my ( $Self, %Param ) = @_; 183 184 # get main object 185 my $MainObject = $Kernel::OM->Get('Kernel::System::Main'); 186 187 my @TypeList = $MainObject->DirectoryRead( 188 Directory => $Self->{CacheDirectory}, 189 Filter => $Param{Type} || '*', 190 ); 191 192 if ( $Param{KeepTypes} ) { 193 my $KeepTypesRegex = join( '|', map {"\Q$_\E"} @{ $Param{KeepTypes} } ); 194 @TypeList = grep { $_ !~ m{/$KeepTypesRegex/?$}smx } @TypeList; 195 } 196 197 return 1 if !@TypeList; 198 199 my $FileCallback = sub { 200 201 my $CacheFile = $File::Find::name; 202 203 # Remove directory if it is empty 204 if ( -d $CacheFile ) { 205 rmdir $CacheFile; 206 return; 207 } 208 209 # For expired filed, check the content and TTL 210 if ( $Param{Expired} ) { 211 my $Content = $MainObject->FileRead( 212 213 # Use Location rather than Filename and Directory to skip the (unneeded) filename clean-up for better performance. 214 Location => $CacheFile, 215 Mode => 'binmode', 216 DisableWarnings => 1, 217 ); 218 219 if ( ref $Content eq 'SCALAR' ) { 220 my $Storage = eval { 221 $Kernel::OM->Get('Kernel::System::Storable')->Deserialize( Data => ${$Content} ); 222 }; 223 return if ( ref $Storage eq 'HASH' && $Storage->{TTL} > time() ); 224 } 225 } 226 227 # Delete all cache files; don't error out when the file doesn't 228 # exist anymore, it was probably just another process deleting it. 229 my $Success = unlink $CacheFile; 230 if ( !$Success && $! != POSIX::ENOENT ) { 231 $Kernel::OM->Get('Kernel::System::Log')->Log( 232 Priority => 'error', 233 Message => "Can't remove file $CacheFile: $!", 234 ); 235 } 236 }; 237 238 # We use finddepth so that the most deeply nested files will be deleted first, 239 # and then the directories above are already empty and can just be removed. 240 File::Find::finddepth( 241 { 242 wanted => $FileCallback, 243 no_chdir => 1, 244 }, 245 @TypeList 246 ); 247 248 return 1; 249} 250 251sub _GetFilenameAndCacheDirectory { 252 my ( $Self, %Param ) = @_; 253 254 for my $Needed (qw(Type Key)) { 255 if ( !defined $Param{$Needed} ) { 256 $Kernel::OM->Get('Kernel::System::Log')->Log( 257 Priority => 'error', 258 Message => "Need $Needed!" 259 ); 260 return; 261 } 262 } 263 264 my $Filename = $Param{Key}; 265 $Kernel::OM->Get('Kernel::System::Encode')->EncodeOutput( \$Filename ); 266 $Filename = Digest::MD5::md5_hex($Filename); 267 268 my $CacheDirectory = $Self->{CacheDirectory} . '/' . $Param{Type}; 269 270 for my $Level ( 1 .. $Self->{'Cache::SubdirLevels'} ) { 271 $CacheDirectory .= '/' . substr( $Filename, $Level - 1, 1 ); 272 } 273 274 return $Filename, $CacheDirectory; 275} 276 2771; 278