[pmg-devel] [PATCH v2 pmg-api] fix #4536: parse original filenames from gzip files

[Leo Nunner]

GZIP provides the possiblity to store the original filename in the
optional FNAME header field, which we can use for 'Match Archive
Filename' rules.

IO::Uncompress::Gunzip is explicitly recommended for this purpose by the
documentation on Compress::Zlib, so an additional imnport was
introduced here. Consequently, libio-compress-perl was added as an extra
dependency to the debian control file.

Signed-off-by: Leo Nunner <l.nunner at proxmox.com>
---
Changes since v1:
    - add libio-compress-perl as a dependency
    - only add the name from the header to the list of filenames, don't
      actually use it as a path to store anything

 debian/control    | 2 ++
 src/PMG/Unpack.pm | 8 ++++++++
 2 files changed, 10 insertions(+)

diff --git a/debian/control b/debian/control
index 3e4ba77..93ad72c 100644
--- a/debian/control
+++ b/debian/control
@@ -12,6 +12,7 @@ Build-Depends: debhelper (>= 12~),
                libfile-readbackwards-perl,
                libfile-sync-perl,
                libhtml-scrubber-perl,
+               libio-compress-perl,
                liblockfile-simple-perl,
                libmime-tools-perl,
                libnet-ldap-perl,
@@ -56,6 +57,7 @@ Depends: apt (>= 2~),
          libhtml-parser-perl,
          libhtml-scrubber-perl,
          libhtml-tree-perl,
+         libio-compress-perl,
          libjs-qrcodejs (>= 1.20201119),
          liblockfile-simple-perl,
          libmail-spf-perl,
diff --git a/src/PMG/Unpack.pm b/src/PMG/Unpack.pm
index d4fe454..cc5a345 100755
--- a/src/PMG/Unpack.pm
+++ b/src/PMG/Unpack.pm
@@ -7,6 +7,7 @@ use IO::Select;
 use Xdgmime;
 use Compress::Zlib qw(gzopen);
 use Compress::Bzip2 qw(bzopen);
+use IO::Uncompress::Gunzip;
 use File::Path;
 use File::Temp qw(tempdir);
 use File::Basename;
@@ -298,6 +299,13 @@ sub uncompress_file {
 	$maxsize = min2 ($maxsize, $filesize * $self->{maxratio});
     }
 
+    if($app eq 'guzip' && (my $z = IO::Uncompress::Gunzip->new($filename))) {
+	# the name (FNAME) field is optional in GZIP archives, so we won't
+	# always have a value here
+	my $header = $z->getHeaderInfo();
+	$self->add_glob_mime_type($header->{Name}) if $header->{Name};
+    }
+
     $self->add_glob_mime_type ($newname);
 
     my $outfd;
-- 
2.30.2