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