From 3e6d1c9d3a46b2dfb1b018fc4472493e6e9c4bb1 Mon Sep 17 00:00:00 2001
From: "David E. Wheeler" <david@justatheory.com>
Date: Thu, 8 Feb 2024 18:33:31 -0500
Subject: [PATCH] Always set member perms when unzipping

Re-create `t/root/dist/pair/0.1.1/pair-0.1.1.zip` with no permissions
for groups or others to any file or directory and add tests to make sure
they are readable by all and that directories are executable by all.
This causes failures!

Change `unzip` to *always* set file permissions, with different values
for directories (which must be executable) and files (which need not be
executable for serving by the API). Fixes #15.

As a result of the re-organization of `pair-0.1.1.zip`, change the
`find_docs` tests to sort results before comparing them. Apparently
different zip files can index their members in different orders. So just
avoid the problem for the future.
---
 Changes                               |   3 ++
 lib/PGXN/API/Sync.pm                  |   2 +-
 t/indexer.t                           |  38 +++++++++++++-------------
 t/root/dist/pair/0.1.1/META.json      |   2 +-
 t/root/dist/pair/0.1.1/pair-0.1.1.zip | Bin 7982 -> 7982 bytes
 t/sync.t                              |  28 +++++++++++++++----
 6 files changed, 46 insertions(+), 27 deletions(-)

diff --git a/Changes b/Changes
index ec5ae4f..852e826 100644
--- a/Changes
+++ b/Changes
@@ -17,6 +17,9 @@ Revision history for Perl extension PGXN::API
         nor testing releases (#2).
       - Updated the SemVer regex when parsing rsync output to the official
         version published in https://regex101.com/r/vkijKf/ (#16).
+      - Fix unzipping of distributions to ensure that all directories are
+        readable and executable but not writeable by all, and that files are
+        only readable by all (#15).
 
 0.16.5  2016-06-22T18:03:05Z
       - Fixed a test failure on systems with a non-English locale, thanks to
diff --git a/lib/PGXN/API/Sync.pm b/lib/PGXN/API/Sync.pm
index d7912ab..8108ce2 100644
--- a/lib/PGXN/API/Sync.pm
+++ b/lib/PGXN/API/Sync.pm
@@ -195,7 +195,7 @@ sub unzip {
 
     foreach my $member ($zip->members) {
         # Make sure the file is readable by everyone
-        $member->unixFileAttributes($member->unixFileAttributes | 0444);
+        $member->unixFileAttributes( $member->isDirectory ? 0755 : 0444 );
         my $fn = catfile $dist_dir, split m{/} => $member->fileName;
         say "    $fn\n" if $self->verbose > 2;
         if ($member->extractToFileNamed($fn) != AZ_OK) {
diff --git a/t/indexer.t b/t/indexer.t
index 1cdc67d..3229057 100644
--- a/t/indexer.t
+++ b/t/indexer.t
@@ -1147,57 +1147,57 @@ is_deeply \@called, [qw(update_user_lists _commit)],
 # Test find_docs().
 touch(catfile $indexer->doc_root_file_for(source => $params->{meta}), qw(sql hi.mkdn));
 $params->{meta}{provides}{pair}{docfile} = 'sql/hi.mkdn';
-is_deeply [ $indexer->find_docs($params)], [
-    { filename => 'sql/hi.mkdn', extension => 'pair' },
-    { filename => 'doc/pair.md' },
+is_deeply [ sort { $a->{filename} cmp $b->{filename} } $indexer->find_docs($params)], [
     { filename => 'README.md' },
+    { filename => 'doc/pair.md' },
+    { filename => 'sql/hi.mkdn', extension => 'pair' },
 ], 'find_docs() should find specified and random doc files';
 
 $params->{meta}{no_index} = { file => ['sql/hi.mkdn'] };
-is_deeply [ $indexer->find_docs($params)], [
-    { filename => 'sql/hi.mkdn', extension => 'pair' },
-    { filename => 'doc/pair.md' },
+is_deeply [ sort { $a->{filename} cmp $b->{filename} } $indexer->find_docs($params)], [
     { filename => 'README.md' },
+    { filename => 'doc/pair.md' },
+    { filename => 'sql/hi.mkdn', extension => 'pair' },
 ], 'find_docs() no_index should be ignored for specified doc file';
 
 $params->{meta}{no_index} = { file => ['doc/pair.md'] };
-is_deeply [ $indexer->find_docs($params)], [
-    { filename => 'sql/hi.mkdn', extension => 'pair' },
+is_deeply [ sort { $a->{filename} cmp $b->{filename} } $indexer->find_docs($params)], [
     { filename => 'README.md' },
+    { filename => 'sql/hi.mkdn', extension => 'pair' },
 ], 'find_docs() should respect no_index for found docs';
 
 $params->{meta}{no_index} = { directory => ['sql'] };
-is_deeply [ $indexer->find_docs($params)], [
-    { filename => 'sql/hi.mkdn', extension => 'pair' },
-    { filename => 'doc/pair.md' },
+is_deeply [ sort { $a->{filename} cmp $b->{filename} } $indexer->find_docs($params)], [
     { filename => 'README.md' },
+    { filename => 'doc/pair.md' },
+    { filename => 'sql/hi.mkdn', extension => 'pair' },
 ], 'find_docs() should ignore no_index directory for specified doc';
 
 $params->{meta}{no_index} = { directory => ['doc'] };
-is_deeply [ $indexer->find_docs($params)], [
-    { filename => 'sql/hi.mkdn', extension => 'pair' },
+is_deeply [ sort { $a->{filename} cmp $b->{filename} } $indexer->find_docs($params)], [
     { filename => 'README.md' },
+    { filename => 'sql/hi.mkdn', extension => 'pair' },
 ], 'find_docs() should respect no_index directory for found docs';
 
 delete $params->{meta}{no_index};
 $params->{meta}{provides}{pair}{docfile} = 'foo/bar.txt';
-is_deeply [ $indexer->find_docs($params)], [
-    { filename => 'doc/pair.md' },
+is_deeply [ sort { $a->{filename} cmp $b->{filename} } $indexer->find_docs($params)], [
     { filename => 'README.md' },
+    { filename => 'doc/pair.md' },
 ], 'find_docs() should ignore non-existent specified file';
 
 $params->{meta}{provides}{pair}{docfile} = 'doc/pair.md';
-is_deeply [ $indexer->find_docs($params)], [
-    { filename => 'doc/pair.md', extension => 'pair' },
+is_deeply [ sort { $a->{filename} cmp $b->{filename} } $indexer->find_docs($params)], [
     { filename => 'README.md' },
+    { filename => 'doc/pair.md', extension => 'pair' },
 ], 'find_docs() should not return dupes';
 
 $params->{meta}{provides}{pair}{docfile} = 'doc/pair.pdf';
 touch(catfile $indexer->doc_root_file_for(source => $params->{meta}), qw(doc pair.pdf));
 
-is_deeply [ $indexer->find_docs($params)], [
-    { filename => 'doc/pair.md' },
+is_deeply [ sort { $a->{filename} cmp $b->{filename} } $indexer->find_docs($params)], [
     { filename => 'README.md' },
+    { filename => 'doc/pair.md' },
 ], 'find_docs() should ignore doc files it does not know how to parse';
 
 sub touch {
diff --git a/t/root/dist/pair/0.1.1/META.json b/t/root/dist/pair/0.1.1/META.json
index ccf5c9b..bf3da49 100644
--- a/t/root/dist/pair/0.1.1/META.json
+++ b/t/root/dist/pair/0.1.1/META.json
@@ -9,7 +9,7 @@
    "date": "2010-10-29T22:46:45Z",
    "release_status": "testing",
    "user": "theory",
-   "sha1": "703c0c485166636317c3d4bc8a1a36d512761af7",
+   "sha1": "443cbcf678a3c2f479c4c069bcb96054d9b25a32",
    "license": "postgresql",
    "provides": {
       "pair": {
diff --git a/t/root/dist/pair/0.1.1/pair-0.1.1.zip b/t/root/dist/pair/0.1.1/pair-0.1.1.zip
index a9b5e7f225db6b6b4609ec809d252b75a80951e4..ea8dfefcca1d059ce911ba974771b61d343aaca1 100644
GIT binary patch
delta 1004
zcmZ2yx6Y0yz?+$civa}Mwoc?R5dF%?z`!B`<RVK<Ru?hFAyX(~hbjZo%K<cO@(~dm
zZsqW!sihU%42&#aH*<@YF*0tQ+$3g+L&F6za}*6i;sziMzuEPWg(sVE`~`|SOXwnt
zZmyPaXXIiAyBuu06SqE!d=2+3R+hJd<#v;$1f?hDiDP%e#94;Ox;9=@VF%h}#A(U+
zb#o5qIYtgxP)(K)G{J7f<j+DV{+?_l{FDP8D2akb$QEp#C+N+{!^kAZ3^(|kq!i<U
z$uA}48NW_`AR{WjHP#jsJ1`)?AOU3xFdT4nWtc1?s|ZmEbf}N46w3j}eul|evRdLu
zF$uB&?u6AqMGcLQK#HU%zZc<}{7#k^yImqEb}e9<Y#^tK)7Tt2Db|L@cT5bEABxFO
zUM0tiQ{@FIkOLA~Ccl$X!Kvt+oD9<p*2!<=ludDXB-U1faUx3xD+9wuZUzRJTY<@!
zp`lTceeyzSRj{u_n1QiASwTt?7&6~^CfiCWnBg?gX3`TWL3RcP9exG|F{tMu20HLE
zOk6EFd5sh=Zs%;cerxL?pz<Hg=+0RvGT9yK98qRqgicnJk^nkqquAu%(h4|(pkD?Q
nPQSz^uaz;vZL4fV&I3oFt;c}2ilew$PhxU_j0P|e1mxua`(xlD

delta 985
zcmZ`%KWGzC82{e=@nSD$8ok_I?vhK2(Z$x*VlCA)kU<<0u?__Xi-U-Zx)~irR5Wx_
z(r;6;6$jCv1VO<f6m<~_PDK$>u@r^VMTsb)-%HZuuEe+9`+onv-@96_mJ3f6M5zz>
zDOW4u5wpPnB%MCH1MhJuhffU$)0!Cz%sDPZL@a8%)av)>p|j^zU{a$#t7Q~c#naMG
z|25v0{?P3`eS$UWtNIcPbp(c#VL!5dQn@J$B)nkk{*UEeYc#+(XBAkV*o@wcw86~!
z=XlUu33V1dJQh^#3~uFugSCK_uK~6C7%MSa<*qQ%8;`$)ald^%D~@o&ygZ~n@fGz}
zKET3EaK*I*xD>aUho9rAxUcFiqWKsR*OI*ae!z4x%^LW@iKVMEli9gXc2ofvi~ty5
z@izr}O_;xY9RO#vINnHVUHH+fbHBgP_zGdR1mNEkz>AWBgNZggMe6sL-#lC-=uZ(q
z55Tu?#8=5}U15t=q*)o@fw~^KM+M9&CcbM5AG2fBi00a~OE`)<T;DFqBd6Zy$?XNX
znE|)yC}6>|H_0GgD8DSW|2W<OPg%@7FTbXxmWewM;H_@POYSJ8Y}ux4ZtLhcX%Dn6
zd4<I6oOqiK&<|ezgbtOzHrDJ&chNf^8`<MzbWK`s_K2f1Xga*Wmf=3fmc4w*09+8v
q9_hLLV(iCsk_3lo>qH>^GvcXYst1oMoJu5waSP8Rwvt<a%KZn&xbtKH

diff --git a/t/sync.t b/t/sync.t
index 3528c03..83582f8 100644
--- a/t/sync.t
+++ b/t/sync.t
@@ -2,8 +2,8 @@
 
 use strict;
 use warnings;
-#use Test::More tests => 58;
-use Test::More 'no_plan';
+use Test::More tests => 65;
+# use Test::More 'no_plan';
 use File::Spec::Functions qw(catfile catdir tmpdir);
 use Test::MockModule;
 use Test::Output;
@@ -282,7 +282,7 @@ is_deeply \@users, [qw(
 ##############################################################################
 # digest_for()
 my $pgz = catfile qw(dist pair 0.1.1 pair-0.1.1.zip);
-is $sync->digest_for($pgz), '703c0c485166636317c3d4bc8a1a36d512761af7',
+is $sync->digest_for($pgz), '443cbcf678a3c2f479c4c069bcb96054d9b25a32',
     'Should get expected digest from digest_for()';
 
 ##############################################################################
@@ -323,19 +323,35 @@ my @files = (qw(
     catfile(qw(test expected base.out)),
 );
 
+my @dirs = (
+    'test',
+    catfile(qw(test expected)),
+    catfile(qw(test sql)),
+    'doc',
+    'sql',
+);
+
 my $src_dir = PGXN::API->instance->source_dir;
 my $base = catdir $src_dir, 'pair', 'pair-0.1.1';
-
-file_not_exists_ok catfile($base, $_), "$_ should not exist" for @files;
+file_not_exists_ok $base, "pair-0.1.1 directory should not exist";
 
 # Unzip it.
 ok my $zip = $sync->unzip($pgz, {name => 'pair'}), "Unzip $pgz";
 isa_ok $zip, 'Archive::Zip';
 file_exists_ok catfile($base, $_), "$_ should now exist" for @files;
 my $readall = S_IRUSR | S_IRGRP | S_IROTH;
+my $dirall = S_IRWXU | S_IRGRP | S_IXGRP | S_IROTH | S_IXOTH;
+ok(
+    ((stat $base)[2] & $dirall) == $dirall,
+    'Root directory should be writeable by owner and readable and executable by all'
+);
+ok(
+    ((stat catfile $base, $_)[2] & $dirall) == $dirall,
+    "Directory $_ should be writeable by owner and readable and executable by all"
+) for @dirs;
 ok(
     ((stat catfile $base, $_)[2] & $readall) == $readall,
-    "$_ should be readable by all",
+    "File $_ should be readable by all",
 ) for @files;
 
 # Now try a brokenated zip file.