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::Main;
10## nofilter(TidyAll::Plugin::OTRS::Perl::Dumper)
11## nofilter(TidyAll::Plugin::OTRS::Perl::Require)
12
13use strict;
14use warnings;
15
16use Digest::MD5 qw(md5_hex);
17use Data::Dumper;
18use File::stat;
19use Unicode::Normalize;
20use List::Util qw();
21use Fcntl qw(:flock);
22use Encode;
23use Math::Random::Secure qw();
24
25use Kernel::System::VariableCheck qw(IsStringWithData);
26
27our @ObjectDependencies = (
28    'Kernel::System::Encode',
29    'Kernel::System::Log',
30    'Kernel::System::Storable',
31);
32
33=head1 NAME
34
35Kernel::System::Main - main object
36
37=head1 DESCRIPTION
38
39All main functions to load modules, die, and handle files.
40
41=head1 PUBLIC INTERFACE
42
43=head2 new()
44
45create new object. Do not use it directly, instead use:
46
47    my $MainObject = $Kernel::OM->Get('Kernel::System::Main');
48
49=cut
50
51sub new {
52    my ( $Type, %Param ) = @_;
53
54    # allocate new hash for object
55    my $Self = {};
56    bless( $Self, $Type );
57
58    return $Self;
59}
60
61=head2 Require()
62
63require/load a module
64
65    my $Loaded = $MainObject->Require(
66        'Kernel::System::Example',
67        Silent => 1,                # optional, no log entry if module was not found
68    );
69
70=cut
71
72sub Require {
73    my ( $Self, $Module, %Param ) = @_;
74
75    if ( !$Module ) {
76        $Kernel::OM->Get('Kernel::System::Log')->Log(
77            Priority => 'error',
78            Message  => 'Need module!',
79        );
80        return;
81    }
82
83    eval {
84        my $FileName = $Module =~ s{::}{/}smxgr;
85        require $FileName . '.pm';
86    };
87
88    # Handle errors.
89    if ($@) {
90
91        if ( !$Param{Silent} ) {
92            my $Message = $@;
93            $Kernel::OM->Get('Kernel::System::Log')->Log(
94                Caller   => 1,
95                Priority => 'error',
96                Message  => $Message,
97            );
98        }
99
100        return;
101    }
102
103    return 1;
104}
105
106=head2 RequireBaseClass()
107
108require/load a module and add it as a base class to the
109calling package, if not already present (this check is needed
110for persistent environments).
111
112    my $Loaded = $MainObject->RequireBaseClass(
113        'Kernel::System::Example',
114    );
115
116=cut
117
118sub RequireBaseClass {
119    my ( $Self, $Module ) = @_;
120
121    # Load the module, if not already loaded.
122    return if !$Self->Require($Module);
123
124    no strict 'refs';    ## no critic
125    my $CallingClass = caller(0);
126
127    # Check if the base class was already loaded.
128    # This can happen in persistent environments as mod_perl (see bug#9686).
129    if ( List::Util::first { $_ eq $Module } @{"${CallingClass}::ISA"} ) {
130        return 1;    # nothing to do now
131    }
132
133    push @{"${CallingClass}::ISA"}, $Module;
134
135    return 1;
136}
137
138=head2 Die()
139
140to die
141
142    $MainObject->Die('some message to die');
143
144=cut
145
146sub Die {
147    my ( $Self, $Message ) = @_;
148
149    $Message = $Message || 'Died!';
150
151    # log message
152    $Kernel::OM->Get('Kernel::System::Log')->Log(
153        Caller   => 1,
154        Priority => 'error',
155        Message  => $Message,
156    );
157
158    exit;
159}
160
161=head2 FilenameCleanUp()
162
163to clean up filenames which can be used in any case (also quoting is done)
164
165    my $Filename = $MainObject->FilenameCleanUp(
166        Filename => 'me_to/alal.xml',
167        Type     => 'Local', # Local|Attachment|MD5
168    );
169
170    my $Filename = $MainObject->FilenameCleanUp(
171        Filename => 'some:file.xml',
172        Type     => 'MD5', # Local|Attachment|MD5
173    );
174
175=cut
176
177sub FilenameCleanUp {
178    my ( $Self, %Param ) = @_;
179
180    if ( !IsStringWithData( $Param{Filename} ) ) {
181        $Kernel::OM->Get('Kernel::System::Log')->Log(
182            Priority => 'error',
183            Message  => 'Need Filename!',
184        );
185        return;
186    }
187
188    # escape if cleanup is not needed
189    if ( $Param{NoFilenameClean} ) {
190        return $Param{Filename};
191    }
192
193    my $Type = lc( $Param{Type} || 'local' );
194
195    if ( $Type eq 'md5' ) {
196        $Kernel::OM->Get('Kernel::System::Encode')->EncodeOutput( \$Param{Filename} );
197        $Param{Filename} = md5_hex( $Param{Filename} );
198    }
199
200    # replace invalid token for attachment file names
201    elsif ( $Type eq 'attachment' ) {
202
203        # trim whitespace
204        $Param{Filename} =~ s/^\s+|\r|\n|\s+$//g;
205
206        # strip leading dots
207        $Param{Filename} =~ s/^\.+//;
208
209        # only whitelisted characters allowed in filename for security
210        $Param{Filename} =~ s/[^\w\-+.#_]/_/g;
211
212        # Enclosed alphanumerics are kept on older Perl versions, make sure to replace them too.
213        $Param{Filename} =~ s/[\x{2460}-\x{24FF}]/_/g;
214
215        # replace utf8 and iso
216        $Param{Filename} =~ s/(\x{00C3}\x{00A4}|\x{00A4})/ae/g;
217        $Param{Filename} =~ s/(\x{00C3}\x{00B6}|\x{00B6})/oe/g;
218        $Param{Filename} =~ s/(\x{00C3}\x{00BC}|\x{00FC})/ue/g;
219        $Param{Filename} =~ s/(\x{00C3}\x{009F}|\x{00C4})/Ae/g;
220        $Param{Filename} =~ s/(\x{00C3}\x{0096}|\x{0096})/Oe/g;
221        $Param{Filename} =~ s/(\x{00C3}\x{009C}|\x{009C})/Ue/g;
222        $Param{Filename} =~ s/(\x{00C3}\x{009F}|\x{00DF})/ss/g;
223        $Param{Filename} =~ s/-+/-/g;
224
225        # separate filename and extension
226        my $FileName = $Param{Filename};
227        my $FileExt  = '';
228        if ( $Param{Filename} =~ /(.*)\.+([^.]+)$/ ) {
229            $FileName = $1;
230            $FileExt  = '.' . $2;
231        }
232
233        if ( length $FileName ) {
234            my $ModifiedName = $FileName . $FileExt;
235
236            while ( length encode( 'UTF-8', $ModifiedName ) > 220 ) {
237
238                # Remove character by character starting from the end of the filename string
239                #   until we get acceptable 220 byte long filename size including extension.
240                if ( length $FileName > 1 ) {
241                    chop $FileName;
242                }
243
244                # If we reached minimum filename length, remove characters from the end of the extension string.
245                else {
246                    chop $FileExt;
247                }
248
249                $ModifiedName = $FileName . $FileExt;
250            }
251            $Param{Filename} = $ModifiedName;
252        }
253    }
254    else {
255
256        # trim whitespace
257        $Param{Filename} =~ s/^\s+|\r|\n|\s+$//g;
258
259        # strip leading dots
260        $Param{Filename} =~ s/^\.+//;
261
262        # only whitelisted characters allowed in filename for security
263        if ( !$Param{NoReplace} ) {
264            $Param{Filename} =~ s/[^\w\-+.#_]/_/g;
265
266            # Enclosed alphanumerics are kept on older Perl versions, make sure to replace them too.
267            $Param{Filename} =~ s/[\x{2460}-\x{24FF}]/_/g;
268        }
269
270        # separate filename and extension
271        my $FileName = $Param{Filename};
272        my $FileExt  = '';
273        if ( $Param{Filename} =~ /(.*)\.+([^.]+)$/ ) {
274            $FileName = $1;
275            $FileExt  = '.' . $2;
276        }
277
278        if ( length $FileName ) {
279            my $ModifiedName = $FileName . $FileExt;
280
281            while ( length encode( 'UTF-8', $ModifiedName ) > 220 ) {
282
283                # Remove character by character starting from the end of the filename string
284                #   until we get acceptable 220 byte long filename size including extension.
285                if ( length $FileName > 1 ) {
286                    chop $FileName;
287                }
288
289                # If we reached minimum filename length, remove characters from the end of the extension string.
290                else {
291                    chop $FileExt;
292                }
293
294                $ModifiedName = $FileName . $FileExt;
295            }
296
297            $Param{Filename} = $ModifiedName;
298        }
299    }
300
301    return $Param{Filename};
302}
303
304=head2 FileRead()
305
306to read files from file system
307
308    my $ContentSCALARRef = $MainObject->FileRead(
309        Directory => 'c:\some\location',
310        Filename  => 'file2read.txt',
311        # or Location
312        Location  => 'c:\some\location\file2read.txt',
313    );
314
315    my $ContentARRAYRef = $MainObject->FileRead(
316        Directory => 'c:\some\location',
317        Filename  => 'file2read.txt',
318        # or Location
319        Location  => 'c:\some\location\file2read.txt',
320
321        Result    => 'ARRAY', # optional - SCALAR|ARRAY
322    );
323
324    my $ContentSCALARRef = $MainObject->FileRead(
325        Directory       => 'c:\some\location',
326        Filename        => 'file2read.txt',
327        # or Location
328        Location        => 'c:\some\location\file2read.txt',
329
330        Mode            => 'binmode', # optional - binmode|utf8
331        Type            => 'Local',   # optional - Local|Attachment|MD5
332        Result          => 'SCALAR',  # optional - SCALAR|ARRAY
333        DisableWarnings => 1,         # optional
334    );
335
336=cut
337
338sub FileRead {
339    my ( $Self, %Param ) = @_;
340
341    my $FH;
342    if ( $Param{Filename} && $Param{Directory} ) {
343
344        # filename clean up
345        $Param{Filename} = $Self->FilenameCleanUp(
346            Filename => $Param{Filename},
347            Type     => $Param{Type} || 'Local',    # Local|Attachment|MD5
348        );
349        $Param{Location} = "$Param{Directory}/$Param{Filename}";
350    }
351    elsif ( $Param{Location} ) {
352
353        # filename clean up
354        $Param{Location} =~ s{//}{/}xmsg;
355    }
356    else {
357        $Kernel::OM->Get('Kernel::System::Log')->Log(
358            Priority => 'error',
359            Message  => 'Need Filename and Directory or Location!',
360        );
361
362    }
363
364    # set open mode
365    my $Mode = '<';
366    if ( $Param{Mode} && $Param{Mode} =~ m{ \A utf-?8 \z }xmsi ) {
367        $Mode = '<:utf8';
368    }
369
370    # return if file can not open
371    if ( !open $FH, $Mode, $Param{Location} ) {    ## no critic
372        my $Error = $!;
373
374        if ( !$Param{DisableWarnings} ) {
375
376            # Check if file exists only if system was not able to open it (to get better error message).
377            if ( !-e $Param{Location} ) {
378                $Kernel::OM->Get('Kernel::System::Log')->Log(
379                    Priority => 'error',
380                    Message  => "File '$Param{Location}' doesn't exist!",
381                );
382            }
383            else {
384                $Kernel::OM->Get('Kernel::System::Log')->Log(
385                    Priority => 'error',
386                    Message  => "Can't open '$Param{Location}': $Error",
387                );
388            }
389        }
390        return;
391    }
392
393    # lock file (Shared Lock)
394    if ( !flock $FH, LOCK_SH ) {
395        if ( !$Param{DisableWarnings} ) {
396            $Kernel::OM->Get('Kernel::System::Log')->Log(
397                Priority => 'error',
398                Message  => "Can't lock '$Param{Location}': $!",
399            );
400        }
401    }
402
403    # enable binmode
404    if ( !$Param{Mode} || $Param{Mode} =~ m{ \A binmode }xmsi ) {
405        binmode $FH;
406    }
407
408    # read file as array
409    if ( $Param{Result} && $Param{Result} eq 'ARRAY' ) {
410
411        # read file content at once
412        my @Array = <$FH>;
413        close $FH;
414
415        return \@Array;
416    }
417
418    # read file as string
419    my $String = do { local $/; <$FH> };
420    close $FH;
421
422    return \$String;
423}
424
425=head2 FileWrite()
426
427to write data to file system
428
429    my $FileLocation = $MainObject->FileWrite(
430        Directory => 'c:\some\location',
431        Filename  => 'file2write.txt',
432        # or Location
433        Location  => 'c:\some\location\file2write.txt',
434
435        Content   => \$Content,
436    );
437
438    my $FileLocation = $MainObject->FileWrite(
439        Directory  => 'c:\some\location',
440        Filename   => 'file2write.txt',
441        # or Location
442        Location   => 'c:\some\location\file2write.txt',
443
444        Content    => \$Content,
445        Mode       => 'binmode', # binmode|utf8
446        Type       => 'Local',   # optional - Local|Attachment|MD5
447        Permission => '644',     # optional - unix file permissions
448    );
449
450Platform note: MacOS (HFS+) stores filenames as Unicode C<NFD> internally,
451and DirectoryRead() will also report them as C<NFD>.
452
453=cut
454
455sub FileWrite {
456    my ( $Self, %Param ) = @_;
457
458    if ( $Param{Filename} && $Param{Directory} ) {
459
460        # filename clean up
461        $Param{Filename} = $Self->FilenameCleanUp(
462            Filename        => $Param{Filename},
463            Type            => $Param{Type} || 'Local',    # Local|Attachment|MD5
464            NoFilenameClean => $Param{NoFilenameClean},
465            NoReplace       => $Param{NoReplace},
466        );
467        $Param{Location} = "$Param{Directory}/$Param{Filename}";
468    }
469    elsif ( $Param{Location} ) {
470
471        # filename clean up
472        $Param{Location} =~ s/\/\//\//g;
473    }
474    else {
475        $Kernel::OM->Get('Kernel::System::Log')->Log(
476            Priority => 'error',
477            Message  => 'Need Filename and Directory or Location!',
478        );
479    }
480
481    # set open mode (if file exists, lock it on open, done by '+<')
482    my $Exists;
483    if ( -f $Param{Location} ) {
484        $Exists = 1;
485    }
486    my $Mode = '>';
487    if ($Exists) {
488        $Mode = '+<';
489    }
490    if ( $Param{Mode} && $Param{Mode} =~ /^(utf8|utf\-8)/i ) {
491        $Mode = '>:utf8';
492        if ($Exists) {
493            $Mode = '+<:utf8';
494        }
495    }
496
497    # return if file can not open
498    my $FH;
499    if ( !open $FH, $Mode, $Param{Location} ) {    ## no critic
500        $Kernel::OM->Get('Kernel::System::Log')->Log(
501            Priority => 'error',
502            Message  => "Can't write '$Param{Location}': $!",
503        );
504        return;
505    }
506
507    # lock file (Exclusive Lock)
508    if ( !flock $FH, LOCK_EX ) {
509        $Kernel::OM->Get('Kernel::System::Log')->Log(
510            Priority => 'error',
511            Message  => "Can't lock '$Param{Location}': $!",
512        );
513    }
514
515    # empty file first (needed if file is open by '+<')
516    truncate $FH, 0;
517
518    # enable binmode
519    if ( !$Param{Mode} || lc $Param{Mode} eq 'binmode' ) {
520
521        # make sure, that no utf8 stamp exists (otherway perl will do auto convert to iso)
522        $Kernel::OM->Get('Kernel::System::Encode')->EncodeOutput( $Param{Content} );
523
524        # set file handle to binmode
525        binmode $FH;
526    }
527
528    # write file if content is not undef
529    if ( defined ${ $Param{Content} } ) {
530        print $FH ${ $Param{Content} };
531    }
532
533    # write empty file if content is undef
534    else {
535        print $FH '';
536    }
537
538    # close the filehandle
539    close $FH;
540
541    # set permission
542    if ( $Param{Permission} ) {
543        if ( length $Param{Permission} == 3 ) {
544            $Param{Permission} = "0$Param{Permission}";
545        }
546        chmod( oct( $Param{Permission} ), $Param{Location} );
547    }
548
549    return $Param{Filename} if $Param{Filename};
550    return $Param{Location};
551}
552
553=head2 FileDelete()
554
555to delete a file from file system
556
557    my $Success = $MainObject->FileDelete(
558        Directory       => 'c:\some\location',
559        Filename        => 'me_to/alal.xml',
560        # or Location
561        Location        => 'c:\some\location\me_to\alal.xml'
562
563        Type            => 'Local',   # optional - Local|Attachment|MD5
564        DisableWarnings => 1, # optional
565    );
566
567=cut
568
569sub FileDelete {
570    my ( $Self, %Param ) = @_;
571
572    if ( $Param{Filename} && $Param{Directory} ) {
573
574        # filename clean up
575        $Param{Filename} = $Self->FilenameCleanUp(
576            Filename  => $Param{Filename},
577            Type      => $Param{Type} || 'Local',    # Local|Attachment|MD5
578            NoReplace => $Param{NoReplace},
579        );
580        $Param{Location} = "$Param{Directory}/$Param{Filename}";
581    }
582    elsif ( $Param{Location} ) {
583
584        # filename clean up
585        $Param{Location} =~ s/\/\//\//g;
586    }
587    else {
588        $Kernel::OM->Get('Kernel::System::Log')->Log(
589            Priority => 'error',
590            Message  => 'Need Filename and Directory or Location!',
591        );
592    }
593
594    # try to delete file
595    if ( !unlink( $Param{Location} ) ) {
596        my $Error = $!;
597
598        if ( !$Param{DisableWarnings} ) {
599
600            # Check if file exists only in case that delete failed.
601            if ( !-e $Param{Location} ) {
602                $Kernel::OM->Get('Kernel::System::Log')->Log(
603                    Priority => 'error',
604                    Message  => "File '$Param{Location}' doesn't exist!",
605                );
606            }
607            else {
608                $Kernel::OM->Get('Kernel::System::Log')->Log(
609                    Priority => 'error',
610                    Message  => "Can't delete '$Param{Location}': $Error",
611                );
612            }
613        }
614
615        return;
616    }
617
618    return 1;
619}
620
621=head2 FileGetMTime()
622
623get timestamp of file change time
624
625    my $FileMTime = $MainObject->FileGetMTime(
626        Directory => 'c:\some\location',
627        Filename  => 'me_to/alal.xml',
628        # or Location
629        Location  => 'c:\some\location\me_to\alal.xml'
630    );
631
632=cut
633
634sub FileGetMTime {
635    my ( $Self, %Param ) = @_;
636
637    my $FH;
638    if ( $Param{Filename} && $Param{Directory} ) {
639
640        # filename clean up
641        $Param{Filename} = $Self->FilenameCleanUp(
642            Filename => $Param{Filename},
643            Type     => $Param{Type} || 'Local',    # Local|Attachment|MD5
644        );
645        $Param{Location} = "$Param{Directory}/$Param{Filename}";
646    }
647    elsif ( $Param{Location} ) {
648
649        # filename clean up
650        $Param{Location} =~ s{//}{/}xmsg;
651    }
652    else {
653        $Kernel::OM->Get('Kernel::System::Log')->Log(
654            Priority => 'error',
655            Message  => 'Need Filename and Directory or Location!',
656        );
657
658    }
659
660    # get file metadata
661    my $Stat = stat( $Param{Location} );
662
663    if ( !$Stat ) {
664        my $Error = $!;
665
666        if ( !$Param{DisableWarnings} ) {
667
668            # Check if file exists only if system was not able to open it (to get better error message).
669            if ( !-e $Param{Location} ) {
670                $Kernel::OM->Get('Kernel::System::Log')->Log(
671                    Priority => 'error',
672                    Message  => "File '$Param{Location}' doesn't exist!"
673                );
674            }
675            else {
676                $Kernel::OM->Get('Kernel::System::Log')->Log(
677                    Priority => 'error',
678                    Message  => "Cannot stat file '$Param{Location}': $Error",
679                );
680            }
681        }
682        return;
683    }
684
685    return $Stat->mtime();
686}
687
688=head2 MD5sum()
689
690get an C<MD5> sum of a file or a string
691
692    my $MD5Sum = $MainObject->MD5sum(
693        Filename => '/path/to/me_to_alal.xml',
694    );
695
696    my $MD5Sum = $MainObject->MD5sum(
697        String => \$SomeString,
698    );
699
700    # note: needs more memory!
701    my $MD5Sum = $MainObject->MD5sum(
702        String => $SomeString,
703    );
704
705=cut
706
707sub MD5sum {
708    my ( $Self, %Param ) = @_;
709
710    if ( !$Param{Filename} && !defined( $Param{String} ) ) {
711        $Kernel::OM->Get('Kernel::System::Log')->Log(
712            Priority => 'error',
713            Message  => 'Need Filename or String!',
714        );
715        return;
716    }
717
718    # md5sum file
719    if ( $Param{Filename} ) {
720
721        # open file
722        my $FH;
723        if ( !open $FH, '<', $Param{Filename} ) {    ## no critic
724            my $Error = $!;
725
726            # Check if file exists only if system was not able to open it (to get better error message).
727            if ( !-e $Param{Filename} ) {
728                $Kernel::OM->Get('Kernel::System::Log')->Log(
729                    Priority => 'error',
730                    Message  => "File '$Param{Filename}' doesn't exist!",
731                );
732            }
733            else {
734                $Kernel::OM->Get('Kernel::System::Log')->Log(
735                    Priority => 'error',
736                    Message  => "Can't read '$Param{Filename}': $Error",
737                );
738            }
739            return;
740        }
741
742        binmode $FH;
743        my $MD5sum = Digest::MD5->new()->addfile($FH)->hexdigest();
744        close $FH;
745
746        return $MD5sum;
747    }
748
749    # get encode object
750    my $EncodeObject = $Kernel::OM->Get('Kernel::System::Encode');
751
752    # md5sum string
753    if ( !ref $Param{String} ) {
754        $EncodeObject->EncodeOutput( \$Param{String} );
755        return md5_hex( $Param{String} );
756    }
757
758    # md5sum scalar reference
759    if ( ref $Param{String} eq 'SCALAR' ) {
760        $EncodeObject->EncodeOutput( $Param{String} );
761        return md5_hex( ${ $Param{String} } );
762    }
763
764    $Kernel::OM->Get('Kernel::System::Log')->Log(
765        Priority => 'error',
766        Message  => "Need a SCALAR reference like 'String => \$Content' in String param.",
767    );
768
769    return;
770}
771
772=head2 Dump()
773
774dump variable to an string
775
776    my $Dump = $MainObject->Dump(
777        $SomeVariable,
778    );
779
780    my $Dump = $MainObject->Dump(
781        {
782            Key1 => $SomeVariable,
783        },
784    );
785
786    dump only in ascii characters (> 128 will be marked as \x{..})
787
788    my $Dump = $MainObject->Dump(
789        $SomeVariable,
790        'ascii', # ascii|binary - default is binary
791    );
792
793=cut
794
795sub Dump {
796    my ( $Self, $Data, $Type ) = @_;
797
798    # check needed data
799    if ( !defined $Data ) {
800        $Kernel::OM->Get('Kernel::System::Log')->Log(
801            Priority => 'error',
802            Message  => "Need \$String in Dump()!"
803        );
804        return;
805    }
806
807    # check type
808    if ( !$Type ) {
809        $Type = 'binary';
810    }
811    if ( $Type ne 'ascii' && $Type ne 'binary' ) {
812        $Kernel::OM->Get('Kernel::System::Log')->Log(
813            Priority => 'error',
814            Message  => "Invalid Type '$Type'!"
815        );
816        return;
817    }
818
819    # mild pretty print
820    $Data::Dumper::Indent = 1;
821
822    # sort hash keys
823    $Data::Dumper::Sortkeys = 1;
824
825    # This Dump() is using Data::Dumper with a utf8 workarounds to handle
826    # the bug [rt.cpan.org #28607] Data::Dumper::Dumper is dumping utf8
827    # strings as latin1/8bit instead of utf8. Use Storable module used for
828    # workaround.
829    # -> http://rt.cpan.org/Ticket/Display.html?id=28607
830    if ( $Type eq 'binary' ) {
831
832        # Clone the data because we need to disable the utf8 flag in all
833        # reference variables and do not to want to do this in the orig.
834        # variables because they will still used in the system.
835        my $DataNew = $Kernel::OM->Get('Kernel::System::Storable')->Clone( Data => \$Data );
836
837        # Disable utf8 flag.
838        $Self->_Dump($DataNew);
839
840        # Dump it as binary strings.
841        my $String = Data::Dumper::Dumper( ${$DataNew} );    ## no critic
842
843        # Enable utf8 flag.
844        Encode::_utf8_on($String);
845
846        return $String;
847    }
848
849    # fallback if Storable can not be loaded
850    return Data::Dumper::Dumper($Data);                      ## no critic
851
852}
853
854=head2 DirectoryRead()
855
856reads a directory and returns an array with results.
857
858    my @FilesInDirectory = $MainObject->DirectoryRead(
859        Directory => '/tmp',
860        Filter    => 'Filenam*',
861    );
862
863    my @FilesInDirectory = $MainObject->DirectoryRead(
864        Directory => $Path,
865        Filter    => '*',
866    );
867
868read all files in subdirectories as well (recursive):
869
870    my @FilesInDirectory = $MainObject->DirectoryRead(
871        Directory => $Path,
872        Filter    => '*',
873        Recursive => 1,
874    );
875
876You can pass several additional filters at once:
877
878    my @FilesInDirectory = $MainObject->DirectoryRead(
879        Directory => '/tmp',
880        Filter    => \@MyFilters,
881    );
882
883The result strings are absolute paths, and they are converted to utf8.
884
885Use the 'Silent' parameter to suppress log messages when a directory
886does not have to exist:
887
888    my @FilesInDirectory = $MainObject->DirectoryRead(
889        Directory => '/special/optional/directory/',
890        Filter    => '*',
891        Silent    => 1,     # will not log errors if the directory does not exist
892    );
893
894Platform note: MacOS (HFS+) stores filenames as Unicode C<NFD> internally,
895and DirectoryRead() will also report them as C<NFD>.
896
897=cut
898
899sub DirectoryRead {
900    my ( $Self, %Param ) = @_;
901
902    # check needed params
903    for my $Needed (qw(Directory Filter)) {
904        if ( !$Param{$Needed} ) {
905            $Kernel::OM->Get('Kernel::System::Log')->Log(
906                Message  => "Needed $Needed: $!",
907                Priority => 'error',
908            );
909            return;
910        }
911    }
912
913    # if directory doesn't exists stop
914    if ( !-d $Param{Directory} && !$Param{Silent} ) {
915        $Kernel::OM->Get('Kernel::System::Log')->Log(
916            Message  => "Directory doesn't exist: $Param{Directory}: $!",
917            Priority => 'error',
918        );
919        return;
920    }
921
922    # check Filter param
923    if ( ref $Param{Filter} ne '' && ref $Param{Filter} ne 'ARRAY' ) {
924        $Kernel::OM->Get('Kernel::System::Log')->Log(
925            Message  => 'Filter param need to be scalar or array ref!',
926            Priority => 'error',
927        );
928        return;
929    }
930
931    # prepare non array filter
932    if ( ref $Param{Filter} ne 'ARRAY' ) {
933        $Param{Filter} = [ $Param{Filter} ];
934    }
935
936    # executes glob for every filter
937    my @GlobResults;
938    my %Seen;
939
940    for my $Filter ( @{ $Param{Filter} } ) {
941        my @Glob = glob "$Param{Directory}/$Filter";
942
943        # look for repeated values
944        NAME:
945        for my $GlobName (@Glob) {
946
947            next NAME if !-e $GlobName;
948            if ( !$Seen{$GlobName} ) {
949                push @GlobResults, $GlobName;
950                $Seen{$GlobName} = 1;
951            }
952        }
953    }
954
955    if ( $Param{Recursive} ) {
956
957        # loop protection to prevent symlinks causing lockups
958        $Param{LoopProtection}++;
959        return if $Param{LoopProtection} > 100;
960
961        # check all files in current directory
962        my @Directories = glob "$Param{Directory}/*";
963
964        DIRECTORY:
965        for my $Directory (@Directories) {
966
967            # return if file is not a directory
968            next DIRECTORY if !-d $Directory;
969
970            # repeat same glob for directory
971            my @SubResult = $Self->DirectoryRead(
972                %Param,
973                Directory => $Directory,
974            );
975
976            # add result to hash
977            for my $Result (@SubResult) {
978                if ( !$Seen{$Result} ) {
979                    push @GlobResults, $Result;
980                    $Seen{$Result} = 1;
981                }
982            }
983        }
984    }
985
986    # if no results
987    return if !@GlobResults;
988
989    # get encode object
990    my $EncodeObject = $Kernel::OM->Get('Kernel::System::Encode');
991
992    # compose normalize every name in the file list
993    my @Results;
994    for my $Filename (@GlobResults) {
995
996        # First convert filename to utf-8, with additional Check parameter
997        # to replace possible malformed characters and prevent further errors.
998        $Filename = $EncodeObject->Convert2CharsetInternal(
999            Text  => $Filename,
1000            From  => 'utf-8',
1001            Check => 1,
1002        );
1003
1004        push @Results, $Filename;
1005    }
1006
1007    # always sort the result
1008    @Results = sort @Results;
1009
1010    return @Results;
1011}
1012
1013=head2 GenerateRandomString()
1014
1015generate a random string of defined length, and of a defined alphabet.
1016defaults to a length of 16 and alphanumerics ( 0..9, A-Z and a-z).
1017
1018    my $String = $MainObject->GenerateRandomString();
1019
1020returns
1021
1022    $String = 'mHLOx7psWjMe5Pj7';
1023
1024with specific length:
1025
1026    my $String = $MainObject->GenerateRandomString(
1027        Length => 32,
1028    );
1029
1030returns
1031
1032    $String = 'azzHab72wIlAXDrxHexsI5aENsESxAO7';
1033
1034with specific length and alphabet:
1035
1036    my $String = $MainObject->GenerateRandomString(
1037        Length     => 32,
1038        Dictionary => [ 0..9, 'a'..'f' ], # hexadecimal
1039        );
1040
1041returns
1042
1043    $String = '9fec63d37078fe72f5798d2084fea8ad';
1044
1045
1046=cut
1047
1048sub GenerateRandomString {
1049    my ( $Self, %Param ) = @_;
1050
1051    my $Length = $Param{Length} || 16;
1052
1053    # The standard list of characters in the dictionary. Don't use special chars here.
1054    my @DictionaryChars = ( 0 .. 9, 'A' .. 'Z', 'a' .. 'z' );
1055
1056    # override dictionary with custom list if given
1057    if ( $Param{Dictionary} && ref $Param{Dictionary} eq 'ARRAY' ) {
1058        @DictionaryChars = @{ $Param{Dictionary} };
1059    }
1060
1061    my $DictionaryLength = scalar @DictionaryChars;
1062
1063    # generate the string
1064    my $String;
1065
1066    for ( 1 .. $Length ) {
1067
1068        my $Key = int Math::Random::Secure::rand $DictionaryLength;
1069
1070        $String .= $DictionaryChars[$Key];
1071    }
1072
1073    return $String;
1074}
1075
1076=begin Internal:
1077
1078=cut
1079
1080sub _Dump {
1081    my ( $Self, $Data ) = @_;
1082
1083    # data is not a reference
1084    if ( !ref ${$Data} ) {
1085        Encode::_utf8_off( ${$Data} );
1086
1087        return;
1088    }
1089
1090    # data is a scalar reference
1091    if ( ref ${$Data} eq 'SCALAR' ) {
1092
1093        # start recursion
1094        $Self->_Dump( ${$Data} );
1095
1096        return;
1097    }
1098
1099    # data is a hash reference
1100    if ( ref ${$Data} eq 'HASH' ) {
1101        KEY:
1102        for my $Key ( sort keys %{ ${$Data} } ) {
1103            next KEY if !defined ${$Data}->{$Key};
1104
1105            # start recursion
1106            $Self->_Dump( \${$Data}->{$Key} );
1107
1108            my $KeyNew = $Key;
1109
1110            $Self->_Dump( \$KeyNew );
1111
1112            if ( $Key ne $KeyNew ) {
1113
1114                ${$Data}->{$KeyNew} = ${$Data}->{$Key};
1115                delete ${$Data}->{$Key};
1116            }
1117        }
1118
1119        return;
1120    }
1121
1122    # data is a array reference
1123    if ( ref ${$Data} eq 'ARRAY' ) {
1124        KEY:
1125        for my $Key ( 0 .. $#{ ${$Data} } ) {
1126            next KEY if !defined ${$Data}->[$Key];
1127
1128            # start recursion
1129            $Self->_Dump( \${$Data}->[$Key] );
1130        }
1131
1132        return;
1133    }
1134
1135    # data is a ref reference
1136    if ( ref ${$Data} eq 'REF' ) {
1137
1138        # start recursion
1139        $Self->_Dump( ${$Data} );
1140
1141        return;
1142    }
1143
1144    # data is a JSON::PP::Boolean
1145    if ( ref ${$Data} eq 'JSON::PP::Boolean' ) {
1146
1147        # start recursion
1148        $Self->_Dump( ${$Data} );
1149
1150        return;
1151    }
1152
1153    $Kernel::OM->Get('Kernel::System::Log')->Log(
1154        Priority => 'error',
1155        Message  => "Unknown ref '" . ref( ${$Data} ) . "'!",
1156    );
1157
1158    return;
1159}
1160
11611;
1162
1163=end Internal:
1164
1165=head1 TERMS AND CONDITIONS
1166
1167This software is part of the OTRS project (L<https://otrs.org/>).
1168
1169This software comes with ABSOLUTELY NO WARRANTY. For details, see
1170the enclosed file COPYING for license information (GPL). If you
1171did not receive this file, see L<https://www.gnu.org/licenses/gpl-3.0.txt>.
1172
1173=cut
1174