From: Graham Knop <haarg@haarg.org>
Date: Wed, 22 Nov 2017 17:09:59 +0000 (+0100)
Subject: try to force tar format and uid/gid
X-Git-Tag: v0.003000~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDistar.git;a=commitdiff_plain;h=42d0b436ab7761b08f91bd8614a315c0c2a9c285

try to force tar format and uid/gid

If the uid and gid of the files on disk is too large, tar will silently
upgrade the format of the tar file to include pax headers.  This will
lead to warnings or errors on decompressing.  Try to force the format to
prevent this.  This may cause the archive creation to fail, but there is
an extra check to validate the tarball later.  If using gnu tar, we can
force the uid and gid, which should prevent this issue.
---

diff --git a/lib/Distar.pm b/lib/Distar.pm
index 5a7011f..3e9d6b6 100644
--- a/lib/Distar.pm
+++ b/lib/Distar.pm
@@ -128,6 +128,53 @@ sub write_manifest_skip {
     $targets;
   }
 
+  sub init_dist {
+    my $self = shift;
+    my $pre_tar = $self->{TAR};
+    my $out = $self->SUPER::init_dist(@_);
+
+    my $tar = $self->{TAR};
+    my $gtar;
+    my $set_user;
+    my $version = `$tar --version`;
+    if ($version =~ /GNU tar/) {
+      $gtar = 1;
+    }
+    elsif (!$pre_tar && `gtar --version`) {
+      $tar = 'gtar';
+      $gtar = 1;
+    }
+    my $tarflags = $self->{TARFLAGS};
+    if (my ($flags) = $tarflags =~ /^-?([cvhlLf]+)$/) {
+      if ($flags =~ s/c// && $flags =~ s/f//) {
+        $tarflags = '--format=ustar -c'.$flags.'f';
+        if ($gtar) {
+          $tarflags = '--owner=0 --group=0 '.$tarflags;
+          $set_user = 1;
+        }
+      }
+    }
+
+    if (!$set_user) {
+      my $warn = '';
+      if ($> >= 2**21) {
+        $warn .= "uid ($>)";
+      }
+      if ($) >= 2**21) {
+        $warn .= ($warn ? ' and ' : '').'gid('.(0+$)).')';
+      }
+      if ($warn) {
+        warn "$warn too large!  Max is ".(2**21-1).".\n"
+          ."Dist creation will likely fail.  Install GNU tar to work around.\n";
+      }
+    }
+
+    $self->{TAR} = $tar;
+    $self->{TARFLAGS} = $tarflags;
+
+    $out;
+  }
+
   sub tarfile_target {
     my $self = shift;
     my $out = $self->SUPER::tarfile_target(@_);