Subject: Path.pm change -> deltree.pl -> t/uninstall-fail failure
From: Karl Berry <[email-masked]>
To: [email-masked]
Date: Fri, 10 Jan 2020 19:37:44 -0700
List-Id: <debbugs-submit.debbugs.gnu.org>

t/ax/deltree.pl is used in t/ax/test-lib.sh's rm_rf_ function to recursively
remove a directory tree, even given directories with zero permissions,
such as intentionally created by uninstall-failsh.

Version 2.15 of Perl's File::Path (released with perl-5.28.0) has
changed behavior such that this no longer works. The result is that the
test fails with these errors:

cannot chdir to child for t/uninstall-fail.dir/__inst-dir__/share: Permission denied at /u/karl/gnu/src/akarl/t/ax/deltree.pl line 29.
cannot remove directory for t/uninstall-fail.dir/__inst-dir__: Directory not empty at /u/karl/gnu/src/akarl/t/ax/deltree.pl line 29.
cannot remove directory for t/uninstall-fail.dir: Directory not empty at /u/karl/gnu/src/akarl/t/ax/deltree.pl line 29.

(That .../share dir is the one that is intentionally mode zero.)

The relevant change in Path.pm appears to be the one below. (I'll also
attach the two Path.pm's in full, for the record.) As you can see, it
mentions a CVE (CVE-2017-6512), and thus the change is presumably
entirely intentional. I find the new long condition hard to be sure of
without a lot of experimentation, but it appears to me it is
intentionally no longer changing the mode of directories. This
incompatibility seems highly unfortunate, but I doubt it is a mistake.

So, the question is what to do about this in Automake. One option would
be to make deltree.pl notice the failure and do the chmod itself in
Perl, then redo the rmtree. Or just do the chmod before the first
rmtree.

Then I wondered, why not just do the same in the shell:

  chmod -R u+rwx "$@" || true
  rm -rf "$@"
  # If don't want to rely on rm exit status,
  # could then check if any of "$@" still exist.

Looking at the ChangeLog, Stefano made the original switch to Perl was
precisely because it was "more reliable and portable" than the previous
shell implementation, but unfortunately this is no longer the case.  The
CL entry is also below.

Re use of find (in the CL entry) vs. chmod (above), personally I don't
see the need for the fancy find conditions, since all we're going to do
is remove everything anyway, so why not blindly u+rwx everything? The
Portable Shell node in the manual does not warn about chmod -R being
problematic, and afaik it's in POSIX, for whatever that may be
worth. But nevertheless we could use find if deemed better.

On the other hand, doing it in Perl also seems perfectly feasible. It
feels a bit simpler to me to do it in sh than to call a Perl helper
script that calls a Path.pm function, but I don't have strong feelings
about it. I don't see that there is an overwhelming technical argument
one way or the other.

Jim, anyone, wdyt? We have to do something ... --thanks, karl

-----------------------------------------------------------------------------
2013-05-16  Stefano Lattarini  <[email-masked]>

	tests: use perl, not find+rm, to remove temporary directories

	The File::Path::rmtree function from perl, if used right, is
	more reliable and more portable of our past idiom:

	    find $dirs -type d ! -perm -700 -exec chmod u+rwx {} ';';
	    rm -rf $$dirs || exit 1

	at least of the face of unreadable dirs/files and other similar
	permission issues (and we have those in our test directories).

	In fact, this change fixes some spurious failures seen in
	"make distcheck" on Solaris 10.

	* t/ax/deltree.pl: New.
	* Makefile.am (EXTRA_DIST): Add it.
	(clean-local-check): Use it.
	* t/ax/test-lib.sh (rm_rf_): Use it.
-----------------------------------------------------------------------------

--- /usr/local/lib/perl5/5.24.0/File/Path.pm	2016-11-13 09:06:35.640002177 -0800
+++ /usr/local/lib/perl5/5.28.0/File/Path.pm	2018-08-02 17:41:00.645374266 -0700
@@ -354,29 +400,40 @@
 
                 # see if we can escalate privileges to get in
                 # (e.g. funny protection mask such as -w- instead of rwx)
-                $perm &= oct '7777';
-                my $nperm = $perm | oct '700';
-                if (
-                    !(
-                           $arg->{safe}
-                        or $nperm == $perm
-                        or chmod( $nperm, $root )
-                    )
-                  )
-                {
-                    _error( $arg,
-                        "cannot make child directory read-write-exec", $canon );
-                    next ROOT_DIR;
+                # This uses fchmod to avoid traversing outside of the proper
+                # location (CVE-2017-6512)
+                my $root_fh;
+                if (open($root_fh, '<', $root)) {
+                    my ($fh_dev, $fh_inode) = (stat $root_fh )[0,1];
+                    $perm &= oct '7777';
+                    my $nperm = $perm | oct '700';
+                    local $@;
+                    if (
+                        !(
+                            $data->{safe}
+                           or $nperm == $perm
+                           or !-d _
+                           or $fh_dev ne $ldev
+                           or $fh_inode ne $lino
+                           or eval { chmod( $nperm, $root_fh ) }
+                        )
+                      )
+                    {
+                        _error( $data,
+                            "cannot make child directory read-write-exec", $canon );
+                        next ROOT_DIR;
+                    }
+                    close $root_fh;
                 }
-                elsif ( !chdir($root) ) {
-                    _error( $arg, "cannot chdir to child", $canon );
+                if ( !chdir($root) ) {
+                    _error( $data, "cannot chdir to child", $canon );
                     next ROOT_DIR;
                 }
             }