Merge pull request #1798 from RotherOSS/issue-#1795-filename_clean_up

Issue #1795 filename clean up
RotherOSS · May 30, 2022 · 5916715 · 5916715
2 parents 907f980 + 66b06f2
commit 5916715
Show file tree

Hide file tree

Showing 3 changed files with 247 additions and 132 deletions.
diff --git a/Kernel/System/Main.pm b/Kernel/System/Main.pm
@@ -192,18 +192,39 @@ sub Die {
 
 =head2 FilenameCleanUp()
 
-to clean up filenames which can be used in any case (also quoting is done)
+to clean up filenames for various use cases.
 
-    my $Filename = $MainObject->FilenameCleanUp(
-        Filename => 'me_to/alal.xml',
-        Type     => 'Local', # Local|Attachment|MD5
+The parameter C<NoFilenameClean> implements the no-op case and returns the unchanged parameter C<Filename>.
+
+    # returns 'some_file_name & shutdown'
+    my $Filename        = $MainObject->FilenameCleanUp(
+        Filename        => 'some_file_name & shutdown'
+        Type            => 'Local',
+        NoFilenameClean => 1,
     );
 
+Possible types are 'Local', 'Attachment', 'MD5'. For unknown types 'Local' is assumed.
+
+    # return 32 chars in the range 0..9 and a..f
     my $Filename = $MainObject->FilenameCleanUp(
         Filename => 'some:file.xml',
-        Type     => 'MD5', # Local|Attachment|MD5
+        Type     => 'MD5',
+    );
+
+When the type is 'Local' then the additional parameter C<NoReplace> is considered as well. When the
+parameter is either not passed or not set to a true value, then all characters
+not matching C< qr/[^\w\-+.#]/ > are replaced by an underscore. Not that C<\w> matches beyond the ASCII range,
+see the character class XPosixWord for details,
+L<https://perldoc.perl.org/perluniprops#Properties-accessible-through-%5Cp%7B%7D-and-%5CP%7B%7D>.
+
+    my $Filename = $MainObject->FilenameCleanUp(
+        Filename => 'me_to/alal.xml',
+        Type     => 'Local',
     );
 
+The Type 'S3' is like 'Local' with two differences. First, the option 'NoReplace' is always ignored. Secondly, the
+characters B<+> and B<#> are also replaced by an underscore.
+
 =cut
 
 sub FilenameCleanUp {
@@ -214,23 +235,24 @@ sub FilenameCleanUp {
             Priority => 'error',
             Message  => 'Need Filename!',
         );
+
         return;
     }
 
-    # escape if cleanup is not needed
-    if ( $Param{NoFilenameClean} ) {
-        return $Param{Filename};
-    }
+    # Escape if cleaning up is not wanted.
+    # This is used in FileWrite() when the exact filenname should be used.
+    return $Param{Filename} if $Param{NoFilenameClean};
 
     my $Type = lc( $Param{Type} || 'local' );
 
     if ( $Type eq 'md5' ) {
         $Kernel::OM->Get('Kernel::System::Encode')->EncodeOutput( \$Param{Filename} );
-        $Param{Filename} = md5_hex( $Param{Filename} );
+
+        return md5_hex( $Param{Filename} );
     }
 
     # replace invalid token for attachment file names
-    elsif ( $Type eq 'attachment' ) {
+    if ( $Type eq 'attachment' ) {
 
         # trim whitespace
         $Param{Filename} =~ s/^\s+|\r|\n|\s+$//g;
@@ -284,52 +306,63 @@ sub FilenameCleanUp {
             }
             $Param{Filename} = $ModifiedName;
         }
+
+        return $Param{Filename};
     }
-    else {
 
-        # trim whitespace
-        $Param{Filename} =~ s/^\s+|\r|\n|\s+$//g;
+    # 'Local' or 'S3' or fallback for missing or unknown types
 
-        # strip leading dots
-        $Param{Filename} =~ s/^\.+//;
+    # trim whitespace
+    $Param{Filename} =~ s/^\s+|\r|\n|\s+$//g;
 
-        # only whitelisted characters allowed in filename for security
-        if ( !$Param{NoReplace} ) {
-            $Param{Filename} =~ s/[^\w\-+.#_]/_/g;
+    # strip leading dots
+    $Param{Filename} =~ s/^\.+//;
 
-            # Enclosed alphanumerics are kept on older Perl versions, make sure to replace them too.
-            $Param{Filename} =~ s/[\x{2460}-\x{24FF}]/_/g;
-        }
+    # only whitelisted characters allowed in filename for security
+    if ( $Type eq 's3' ) {
 
-        # separate filename and extension
-        my $FileName = $Param{Filename};
-        my $FileExt  = '';
-        if ( $Param{Filename} =~ /(.*)\.+([^.]+)$/ ) {
-            $FileName = $1;
-            $FileExt  = '.' . $2;
-        }
+        # not that '+' and '#' are also replaced by '_'
+        # no need to have '_' explicitly in the character class, as that case is covered by \w
+        $Param{Filename} =~ s/[^\w\-.]/_/g;
+    }
+    elsif ( !$Param{NoReplace} ) {
 
-        if ( length $FileName ) {
-            my $ModifiedName = $FileName . $FileExt;
+        # 'Local' or fallback for missing or unknown types
+        $Param{Filename} =~ s/[^\w\-+.#_]/_/g;
 
-            while ( length encode( 'UTF-8', $ModifiedName ) > 220 ) {
+        # Enclosed alphanumerics are kept on older Perl versions, make sure to replace them too.
+        # TODO: find out when the behavior has changed
+        $Param{Filename} =~ s/[\x{2460}-\x{24FF}]/_/g;
+    }
 
-                # Remove character by character starting from the end of the filename string
-                #   until we get acceptable 220 byte long filename size including extension.
-                if ( length $FileName > 1 ) {
-                    chop $FileName;
-                }
+    # separate filename and extension
+    my $FileName = $Param{Filename};
+    my $FileExt  = '';
+    if ( $Param{Filename} =~ /(.*)\.+([^.]+)$/ ) {
+        $FileName = $1;
+        $FileExt  = '.' . $2;
+    }
 
-                # If we reached minimum filename length, remove characters from the end of the extension string.
-                else {
-                    chop $FileExt;
-                }
+    if ( length $FileName ) {
+        my $ModifiedName = $FileName . $FileExt;
 
-                $ModifiedName = $FileName . $FileExt;
+        while ( length encode( 'UTF-8', $ModifiedName ) > 220 ) {
+
+            # Remove character by character starting from the end of the filename string
+            #   until we get acceptable 220 byte long filename size including extension.
+            if ( length $FileName > 1 ) {
+                chop $FileName;
             }
 
-            $Param{Filename} = $ModifiedName;
+            # If we reached minimum filename length, remove characters from the end of the extension string.
+            else {
+                chop $FileExt;
+            }
+
+            $ModifiedName = $FileName . $FileExt;
         }
+
+        $Param{Filename} = $ModifiedName;
     }
 
     return $Param{Filename};

diff --git a/Kernel/System/Ticket/Article/Backend/MIMEBase/ArticleStorageS3.pm b/Kernel/System/Ticket/Article/Backend/MIMEBase/ArticleStorageS3.pm
@@ -190,12 +190,12 @@ sub ArticleWriteAttachment {
     }
 
     # Perform FilenameCleanUp here already to check for
-    #   conflicting existing attachment files correctly
+    # conflicting existing attachment files correctly.
+    # The type 'S3' also cleans up the chars '+' and '#'
     my $MainObject   = $Kernel::OM->Get('Kernel::System::Main');
     my $OrigFilename = $MainObject->FilenameCleanUp(
-        Filename  => $Param{Filename},
-        Type      => 'Local',
-        NoReplace => 1,
+        Filename => $Param{Filename},
+        Type     => 'S3',
     );
 
     # check for conflicts in the attachment file names