5.28.0 regression: In-place edit without "while(<>)" does not replace files

[p5pRT]

Migrated from rt.perl.org#133659 (status was 'resolved')

Searchable as RT133659$

[p5pRT]

From @ppisar

Hello,

I'm forwarding a bug report
<https://bugzilla.redhat.com/show_bug.cgi?id=1650041> about a regression in
in-place edits first seen in perl 5.28.0​:

If perl is asked for an in-place edit with an "-i" option and the Perl code
does not use "while(<>){...}" idiom, the output file is deleted instead of
renamed back to the input file name​:

$ cat test
1
$ strace perl -i -e '$/=undef; $a=<>; $a=~s/1/2/; print $a' test
[...]
openat(AT_FDCWD, "test", O_RDONLY|O_CLOEXEC) = 3
ioctl(3, TCGETS, 0x7ffeb193f510) = -1 ENOTTY (Inappropriate ioctl for device)
lseek(3, 0, SEEK_CUR) = 0
fstat(3, {st_mode=S_IFREG|0664, st_size=2, ...}) = 0
umask(0177) = 002
getpid() = 1192
openat(AT_FDCWD, "XXH6qplJ", O_RDWR|O_CREAT|O_EXCL|O_CLOEXEC, 0600) = 4
fcntl(4, F_GETFD) = 0x1 (flags FD_CLOEXEC)
umask(002) = 0177
fcntl(4, F_SETFD, FD_CLOEXEC) = 0
ioctl(4, TCGETS, 0x7ffeb193f5a0) = -1 ENOTTY (Inappropriate ioctl for device)
lseek(4, 0, SEEK_CUR) = 0
fstat(4, {st_mode=S_IFREG|0600, st_size=0, ...}) = 0
getpid() = 1192
openat(AT_FDCWD, ".", O_RDONLY|O_NONBLOCK|O_CLOEXEC|O_DIRECTORY) = 5
fstat(5, {st_mode=S_IFDIR|S_ISVTX|0777, st_size=180, ...}) = 0
brk(NULL) = 0x55f03b859000
brk(0x55f03b87b000) = 0x55f03b87b000
fstat(4, {st_mode=S_IFREG|0600, st_size=0, ...}) = 0
fchmod(4, 0100664) = 0
fstat(3, {st_mode=S_IFREG|0664, st_size=2, ...}) = 0
read(3, "1\n", 8192) = 2
read(3, "", 8192) = 0
[...]
write(4, "2\n", 2) = 2
close(3) = 0
getpid() = 1192
close(4) = 0
unlinkat(5, "XXH6qplJ", 0) = 0
[...]
close(5) = 0
exit_group(0) = ?

Expected behvior is that the "test" file ends up with "2\n" inside. As you can
see in ther strace output, the output file was unlinked instead of renamed
from "XXH6qplJ" to "test".

I can reproduce it with 5.28.0 as well as with latest blead
v5.29.4-43-ged0ccc61a6. The example works with 5.26.2.

Reducing the reproducer I got this code that works​:

$ ./perl -Ilib -i -e '$/=undef; while ($_=<>) {s/1/2/; print}' /tmp/test

while this does not work​:

$ ./perl -Ilib -i -e '$/=undef; $_=<>; {s/1/2/; print}' /tmp/test

It seems there is a special handling for "while(<>)" that triggers the final
rename. I believe this regression comes with the more secure file replacement
introduced in 5.28.0.

By the way, perlrun POD setion for "-i" option seems out-dated as it still
reads​:

  [...] It does this by renaming the input file, opening
  the output file by the original name, and selecting that output
  file as the default for print() statements.

While the 5.28.0 code first creates a temporary file, write an output there
and then renames it back to the original name.

-- Petr

[p5pRT]

From @jkeenan

On Thu, 15 Nov 2018 11​:42​:26 GMT, ppisar wrote​:

Hello,

I'm forwarding a bug report
<https://bugzilla.redhat.com/show_bug.cgi?id=1650041> about a
regression in
in-place edits first seen in perl 5.28.0​:

If perl is asked for an in-place edit with an "-i" option and the Perl
code
does not use "while(<>){...}" idiom, the output file is deleted
instead of
renamed back to the input file name​:

[snip]

Reducing the reproducer I got this code that works​:

$ ./perl -Ilib -i -e '$/=undef; while ($_=<>) {s/1/2/; print}'
/tmp/test

while this does not work​:

$ ./perl -Ilib -i -e '$/=undef; $_=<>; {s/1/2/; print}' /tmp/test

Does anyone have any idea how to bisect this?

So far I haven't been able to figure out how to fit this into one of the examples in 'perldoc Porting/bisect-runner.pl'.

[snip]

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @tonycoz

On Thu, 15 Nov 2018 03​:42​:26 -0800, ppisar wrote​:

Expected behvior is that the "test" file ends up with "2\n" inside. As
you can
see in ther strace output, the output file was unlinked instead of
renamed
from "XXH6qplJ" to "test".

I can reproduce it with 5.28.0 as well as with latest blead
v5.29.4-43-ged0ccc61a6. The example works with 5.26.2.

Reducing the reproducer I got this code that works​:

$ ./perl -Ilib -i -e '$/=undef; while ($_=<>) {s/1/2/; print}'
/tmp/test

while this does not work​:

$ ./perl -Ilib -i -e '$/=undef; $_=<>; {s/1/2/; print}' /tmp/test

It seems there is a special handling for "while(<>)" that triggers the
final
rename. I believe this regression comes with the more secure file
replacement
introduced in 5.28.0.

It's not the while() in particular that's special, but calling <> again to iterate to the next file (or the end of the list.)

I hadn't considered the non-looping in-place editing (and none of the tests do it that I'm aware of), but I was trying to get reasonable behaviour for​:

  perl -i -pe 's/FAILED/OK/ or die' somefile

Should the file be replaced if the code dies?

I don't know a way to detect in the magic that does the clean up whether we're cleaning up due to a die or falling off the end of the code as in your case.

As a workaround you can explicitly close ARGVOUT​:

./perl -i -e 'local $/; my $s=<>; $s=~s/FAILED/OK/; print $s; close ARGVOUT'

Maybe it should always replace it like it did previously.

By the way, perlrun POD setion for "-i" option seems out-dated as it
still
reads​:

[...] It does this by renaming the input file, opening
the output file by the original name, and selecting that output
file as the default for print() statements.

While the 5.28.0 code first creates a temporary file, write an output
there
and then renames it back to the original name.

Yes, this needs to be updated.

Tony

[p5pRT]

From @ppisar

On 2018-11-15, "James E Keenan via RT" <perlbug-followup@​perl.org> wrote​:

Reducing the reproducer I got this code that works​:

$ ./perl -Ilib -i -e '$/=undef; while ($_=<>) {s/1/2/; print}'
/tmp/test

while this does not work​:

$ ./perl -Ilib -i -e '$/=undef; $_=<>; {s/1/2/; print}' /tmp/test

Does anyone have any idea how to bisect this?

So far I haven't been able to figure out how to fit this into one of
the examples in 'perldoc Porting/bisect-runner.pl'.

I finished bisecting now (using my own scripts) and it converged to this commit
(v5.27.3-66-ge0d4aead3c)​:

commit e0d4aea (HEAD, refs/bisect/bad)
Author​: Tony Cook <tony@​develop-help.com>
Date​: Wed Jan 11 14​:49​:53 2017 +1100

  (perl #127663) safer in-place editing
 
  Previously in-place editing opened the file then immediately
  *replaced* the file, so if an error occurs while writing the output,
  such as running out of space, the content of the original file is lost.
 
  This changes in-place editing to write to a work file which is renamed
  over the original only once the output file is successfully closed.
 
  It also fixes an issue with setting setuid/setgid file modes for
  recursive in-place editing.

-- Petr

[p5pRT]

From @ppisar

On 2018-11-15, "Tony Cook via RT" <perlbug-followup@​perl.org> wrote​:

It's not the while() in particular that's special, but calling <>
again to iterate to the next file (or the end of the list.)

I hadn't considered the non-looping in-place editing (and none of the
tests do it that I'm aware of), but I was trying to get reasonable
behaviour for​:

perl -i -pe 's/FAILED/OK/ or die' somefile

Should the file be replaced if the code dies?

In my opinion, the file should be kept intact if the interpreter is
going to terminate because of an error (die, exit 1, an I/O failure).
That's the point of
<https://rt.perl.org/Public/Bug/Display.html?id=57512#txn-673862> (still
not fully resolved).

However, I can image that a multiple file edit cannot have a correct
behavior​:

$ perl -i -pe 's/FAILED/OK/ or die' somefile anotherfile

because if somefile edits and replaces successfully but editing
anotherfile fails, perl as a whole command will return an error exit
code but somefile will have been already mangled. (I know perl is not
a transactional database system.) We would have to postpone the file
rename after processing all arguments and that could exhaust open file
descriptors and disk space. I don't think it's feasible to take the
multiple file usecase seriously.

I don't know a way to detect in the magic that does the clean up
whether we're cleaning up due to a die or falling off the end of the
code as in your case.

Can we decide on $@​ value? Or better on some flag that instructs perl
process to return a non-zero exit code?

As a workaround you can explicitly close ARGVOUT​:

./perl -i -e 'local $/; my $s=<>; $s=~s/FAILED/OK/; print $s; close ARGVOUT'

Yes, the explicit close helps here.

-- Petr

[p5pRT]

From @peff

Created by @peff

In perl 5.26.0 and earlier, using "-i" would modify the file even if you
left a "-p" loop early. E.g.​:

  $ echo foo >file
  $ perl -i -pe 'last' file
  $ cat file
  [no output; we left the loop before printing anything]

But in 5.28.0, the file is left untouched​:

  $ cat file
  foo

This bisects in the perl-git mirror to e0d4aea ((perl #127663) safer
in-place editing, 2017-01-11), and reproduces even on the current tip of
that mirror's master branch.

The above code is obviously a toy example to reproduce the issue. If you
want a more real-world case, the script I noticed this in was printing
the first non-comment line in a file​:

  perl -i -ne 'print && exit 0 if /^[^#]/' $file

Perl Info

Flags:
    category=core
    severity=medium

Site configuration information for perl 5.28.0:

Configured by Debian at Wed Oct 31 15:45:10 UTC 2018.

Summary of my perl5 (revision 5 version 28 subversion 0) configuration:
   
  Platform:
    osname=linux
    osvers=4.9.0
    archname=x86_64-linux-gnu-thread-multi
    uname='linux localhost 4.9.0 #1 smp debian 4.9.0 x86_64 gnulinux '
    config_args='-Dusethreads -Duselargefiles -Dcc=x86_64-linux-gnu-gcc -Dcpp=x86_64-linux-gnu-cpp -Dld=x86_64-linux-gnu-gcc -Dccflags=-DDEBIAN -Wdate-time -D_FORTIFY_SOURCE=2 -g -O2 -fdebug-prefix-map=/build/perl-wsSTqO/perl-5.28.0=. -fstack-protector-strong -Wformat -Werror=format-security -Dldflags= -Wl,-z,relro -Dlddlflags=-shared -Wl,-z,relro -Dcccdlflags=-fPIC -Darchname=x86_64-linux-gnu -Dprefix=/usr -Dprivlib=/usr/share/perl/5.28 -Darchlib=/usr/lib/x86_64-linux-gnu/perl/5.28 -Dvendorprefix=/usr -Dvendorlib=/usr/share/perl5 -Dvendorarch=/usr/lib/x86_64-linux-gnu/perl5/5.28 -Dsiteprefix=/usr/local -Dsitelib=/usr/local/share/perl/5.28.0 -Dsitearch=/usr/local/lib/x86_64-linux-gnu/perl/5.28.0 -Dman1dir=/usr/share/man/man1 -Dman3dir=/usr/share/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Dsiteman3dir=/usr/local/man/man3 -Duse64bitint -Dman1ext=1 -Dman3ext=3perl
-Dpager=/usr/bin/sensible-pager -Uafs -Ud_csh -Ud_ualarm -Uusesfio -Uusenm -Ui_libutil -Ui_xlocale -Uversiononly -DDEBUGGING=-g -Doptimize=-O2 -dEs -Duseshrplib -Dlibperl=libperl.so.5.28.0'
    hint=recommended
    useposix=true
    d_sigaction=define
    useithreads=define
    usemultiplicity=define
    use64bitint=define
    use64bitall=define
    uselongdouble=undef
    usemymalloc=n
    default_inc_excludes_dot=define
    bincompat5005=undef
  Compiler:
    cc='x86_64-linux-gnu-gcc'
    ccflags ='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64'
    optimize='-O2 -g'
    cppflags='-D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include'
    ccversion=''
    gccversion='8.2.0'
    gccosandvers=''
    intsize=4
    longsize=8
    ptrsize=8
    doublesize=8
    byteorder=12345678
    doublekind=3
    d_longlong=define
    longlongsize=8
    d_longdbl=define
    longdblsize=16
    longdblkind=3
    ivtype='long'
    ivsize=8
    nvtype='double'
    nvsize=8
    Off_t='off_t'
    lseeksize=8
    alignbytes=8
    prototype=define
  Linker and Libraries:
    ld='x86_64-linux-gnu-gcc'
    ldflags =' -fstack-protector-strong -L/usr/local/lib'
    libpth=/usr/local/lib /usr/lib/gcc/x86_64-linux-gnu/8/include-fixed /usr/include/x86_64-linux-gnu /usr/lib /lib/x86_64-linux-gnu /lib/../lib /usr/lib/x86_64-linux-gnu /usr/lib/../lib /lib
    libs=-lgdbm -lgdbm_compat -ldb -ldl -lm -lpthread -lc -lcrypt
    perllibs=-ldl -lm -lpthread -lc -lcrypt
    libc=libc-2.27.so
    so=so
    useshrplib=true
    libperl=libperl.so.5.28
    gnulibc_version='2.27'
  Dynamic Linking:
    dlsrc=dl_dlopen.xs
    dlext=so
    d_dlsymun=undef
    ccdlflags='-Wl,-E'
    cccdlflags='-fPIC'
    lddlflags='-shared -L/usr/local/lib -fstack-protector-strong'

Locally applied patches:
    DEBPKG:debian/cpan_definstalldirs - Provide a sensible INSTALLDIRS default for modules installed from CPAN.
    DEBPKG:debian/db_file_ver - https://bugs.debian.org/340047 Remove overly restrictive DB_File version check.
    DEBPKG:debian/doc_info - Replace generic man(1) instructions with Debian-specific information.
    DEBPKG:debian/enc2xs_inc - https://bugs.debian.org/290336 Tweak enc2xs to follow symlinks and ignore missing @INC directories.
    DEBPKG:debian/errno_ver - https://bugs.debian.org/343351 Remove Errno version check due to upgrade problems with long-running processes.
    DEBPKG:debian/libperl_embed_doc - https://bugs.debian.org/186778 Note that libperl-dev package is required for embedded linking
    DEBPKG:fixes/respect_umask - Respect umask during installation
    DEBPKG:debian/writable_site_dirs - Set umask approproately for site install directories
    DEBPKG:debian/extutils_set_libperl_path - EU:MM: set location of libperl.a under /usr/lib
    DEBPKG:debian/no_packlist_perllocal - Don't install .packlist or perllocal.pod for perl or vendor
    DEBPKG:debian/fakeroot - Postpone LD_LIBRARY_PATH evaluation to the binary targets.
    DEBPKG:debian/instmodsh_doc - Debian policy doesn't install .packlist files for core or vendor.
    DEBPKG:debian/ld_run_path - Remove standard libs from LD_RUN_PATH as per Debian policy.
    DEBPKG:debian/libnet_config_path - Set location of libnet.cfg to /etc/perl/Net as /usr may not be writable.
    DEBPKG:debian/perlivp - https://bugs.debian.org/510895 Make perlivp skip include directories in /usr/local
    DEBPKG:debian/squelch-locale-warnings - https://bugs.debian.org/508764 Squelch locale warnings in Debian package maintainer scripts
    DEBPKG:debian/patchlevel - https://bugs.debian.org/567489 List packaged patches for 5.28.0-3 in patchlevel.h
    DEBPKG:fixes/document_makemaker_ccflags - https://bugs.debian.org/628522 [rt.cpan.org #68613] Document that CCFLAGS should include $Config{ccflags}
    DEBPKG:debian/find_html2text - https://bugs.debian.org/640479 Configure CPAN::Distribution with correct name of html2text
    DEBPKG:debian/perl5db-x-terminal-emulator.patch - https://bugs.debian.org/668490 Invoke x-terminal-emulator rather than xterm in perl5db.pl
    DEBPKG:debian/cpan-missing-site-dirs - https://bugs.debian.org/688842 Fix CPAN::FirstTime defaults with nonexisting site dirs if a parent is writable
    DEBPKG:fixes/memoize_storable_nstore - [rt.cpan.org #77790] https://bugs.debian.org/587650 Memoize::Storable: respect 'nstore' option not respected
    DEBPKG:debian/makemaker-pasthru - https://bugs.debian.org/758471 Pass LD settings through to subdirectories
    DEBPKG:debian/makemaker-manext - https://bugs.debian.org/247370 Make EU::MakeMaker honour MANnEXT settings in generated manpage headers
    DEBPKG:debian/kfreebsd-softupdates - https://bugs.debian.org/796798 Work around Debian Bug#796798
    DEBPKG:fixes/autodie-scope - https://bugs.debian.org/798096 Fix a scoping issue with "no autodie" and the "system" sub
    DEBPKG:fixes/memoize-pod - [rt.cpan.org #89441] Fix POD errors in Memoize
    DEBPKG:debian/hurd-softupdates - https://bugs.debian.org/822735 Fix t/op/stat.t failures on hurd
    DEBPKG:fixes/math_complex_doc_great_circle - https://bugs.debian.org/697567 [rt.cpan.org #114104] Math::Trig: clarify definition of great_circle_midpoint
    DEBPKG:fixes/math_complex_doc_see_also - https://bugs.debian.org/697568 [rt.cpan.org #114105] Math::Trig: add missing SEE ALSO
    DEBPKG:fixes/math_complex_doc_angle_units - https://bugs.debian.org/731505 [rt.cpan.org #114106] Math::Trig: document angle units
    DEBPKG:fixes/cpan_web_link - https://bugs.debian.org/367291 CPAN: Add link to main CPAN web site
    DEBPKG:debian/hppa_op_optimize_workaround - https://bugs.debian.org/838613 Temporarily lower the optimization of op.c on hppa due to gcc-6 problems
    DEBPKG:debian/installman-utf8 - https://bugs.debian.org/840211 Generate man pages with UTF-8 characters
    DEBPKG:fixes/getopt-long-4 - https://bugs.debian.org/864544 [rt.cpan.org #122068] Fix issue #122068.
    DEBPKG:debian/hppa_opmini_optimize_workaround - https://bugs.debian.org/869122 Lower the optimization level of opmini.c on hppa
    DEBPKG:debian/sh4_op_optimize_workaround - https://bugs.debian.org/869373 Also lower the optimization level of op.c and opmini.c on sh4
    DEBPKG:debian/perldoc-pager - https://bugs.debian.org/870340 [rt.cpan.org #120229] Fix perldoc terminal escapes when sensible-pager is less
    DEBPKG:debian/prune_libs - https://bugs.debian.org/128355 Prune the list of libraries wanted to what we actually need.
    DEBPKG:debian/mod_paths - Tweak @INC ordering for Debian
    DEBPKG:debian/configure-regen - https://bugs.debian.org/762638 Regenerate Configure et al. after probe unit changes
    DEBPKG:debian/deprecate-with-apt - https://bugs.debian.org/747628 Point users to Debian packages of deprecated core modules
    DEBPKG:debian/disable-stack-check - https://bugs.debian.org/902779 [perl #133327] Disable debugperl stack extension checks for binary compatibility with perl
    DEBPKG:fixes/in-place-edit-handles - https://bugs.debian.org/902925 [perl #133314] (perl #133314) always close the directory handle on clean up
    DEBPKG:debian/gdbm-fatal - [perl #133295] https://bugs.debian.org/904005 Temporarily skip GDBM_File fatal.t for gdbm >= 1.15 compatibility


@INC for perl 5.28.0:
    /home/peff/local/git/current/share/perl
    /home/peff/local/share/perl/5.28.0
    /home/peff/local/share/perl
    /home/peff/local/lib/perl5/site_perl
    /home/peff/local/lib/perl/5.28.0
    /home/peff/local/lib/perl
    /home/peff/local/lib
    /etc/perl
    /usr/local/lib/x86_64-linux-gnu/perl/5.28.0
    /usr/local/share/perl/5.28.0
    /usr/lib/x86_64-linux-gnu/perl5/5.28
    /usr/share/perl5
    /usr/lib/x86_64-linux-gnu/perl/5.28
    /usr/share/perl/5.28
    /usr/local/lib/site_perl
    /usr/lib/x86_64-linux-gnu/perl-base


Environment for perl 5.28.0:
    HOME=/home/peff
    LANG=en_US.UTF-8
    LANGUAGE (unset)
    LC_COLLATE=C
    LD_LIBRARY_PATH=
    LOGDIR (unset)
    PATH=/home/peff/.bin:/home/peff/local/bin:/home/peff/local/git/current/bin:/usr/local/bin:/usr/bin:/bin:/usr/games:/home/peff/compile/node/node-v8.9.3-linux-x64/bin:/usr/local/sbin:/sbin:/usr/sbin:/home/peff/compile/gh/shell/bin:/home/peff/work/mmake/bin:/home/peff/.rvm/bin
    PERL5LIB=/home/peff/local/git/current/share/perl:/home/peff/local/share/perl:/home/peff/local/lib/perl5/site_perl:/home/peff/local/lib/perl:/home/peff/local/lib
    PERL_BADLANG (unset)
    SHELL=/bin/bash

[p5pRT]

From @jkeenan

On Mon, 19 Nov 2018 20​:23​:24 GMT, peff@​peff.net wrote​:

This is a bug report for perl from peff@​peff.net,
generated with the help of perlbug 1.41 running under perl 5.28.0.

-----------------------------------------------------------------
[Please describe your issue here]

In perl 5.26.0 and earlier, using "-i" would modify the file even if
you
left a "-p" loop early. E.g.​:

$ echo foo >file
$ perl -i -pe 'last' file
$ cat file
[no output; we left the loop before printing anything]

But in 5.28.0, the file is left untouched​:

$ cat file
foo

This bisects in the perl-git mirror to e0d4aea ((perl #127663)
safer
in-place editing, 2017-01-11), and reproduces even on the current tip
of
that mirror's master branch.

The above code is obviously a toy example to reproduce the issue. If
you
want a more real-world case, the script I noticed this in was printing
the first non-comment line in a file​:

perl -i -ne 'print && exit 0 if /^[^#]/' $file

This seems very similar to another recent report​:

https://rt-archive.perl.org/perl5/Ticket/Display.html?id=133659

TonyC, p5p list​: Could you take a look at both?

Thank you very much.

--
James E Keenan (jkeenan@​cpan.org)

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @tonycoz

On Mon, 19 Nov 2018 12​:23​:24 -0800, peff@​peff.net wrote​:

In perl 5.26.0 and earlier, using "-i" would modify the file even if
you
left a "-p" loop early. E.g.​:

$ echo foo >file
$ perl -i -pe 'last' file
$ cat file
[no output; we left the loop before printing anything]

But in 5.28.0, the file is left untouched​:

$ cat file
foo

This bisects in the perl-git mirror to e0d4aea ((perl #127663)
safer
in-place editing, 2017-01-11), and reproduces even on the current tip
of
that mirror's master branch.

The above code is obviously a toy example to reproduce the issue. If
you
want a more real-world case, the script I noticed this in was printing
the first non-comment line in a file​:

perl -i -ne 'print && exit 0 if /^[^#]/' $file

This is the same as 133659, merging.

Tony

[p5pRT]

From @tonycoz

On Fri, 16 Nov 2018 02​:44​:10 -0800, ppisar wrote​:

On 2018-11-15, "Tony Cook via RT" <perlbug-followup@​perl.org> wrote​:

It's not the while() in particular that's special, but calling <>
again to iterate to the next file (or the end of the list.)

I hadn't considered the non-looping in-place editing (and none of the
tests do it that I'm aware of), but I was trying to get reasonable
behaviour for​:

perl -i -pe 's/FAILED/OK/ or die' somefile

Should the file be replaced if the code dies?

In my opinion, the file should be kept intact if the interpreter is
going to terminate because of an error (die, exit 1, an I/O failure).
That's the point of
<https://rt.perl.org/Public/Bug/Display.html?id=57512#txn-673862>
(still
not fully resolved).

However, I can image that a multiple file edit cannot have a correct
behavior​:

$ perl -i -pe 's/FAILED/OK/ or die' somefile anotherfile

because if somefile edits and replaces successfully but editing
anotherfile fails, perl as a whole command will return an error exit
code but somefile will have been already mangled. (I know perl is not
a transactional database system.) We would have to postpone the file
rename after processing all arguments and that could exhaust open file
descriptors and disk space. I don't think it's feasible to take the
multiple file usecase seriously.

I don't know a way to detect in the magic that does the clean up
whether we're cleaning up due to a die or falling off the end of the
code as in your case.

Can we decide on $@​ value? Or better on some flag that instructs perl
process to return a non-zero exit code?

$@​ isn't useful here, it may have been set by a previous eval.

Perhaps​:

- if we're in global destruction, and PL_statusvalue ($?) is zero, treat this as a successful in-place edit (replace the original file with the work file)

This would mean all of​:

  perl -i -pe 's/FAILED/OK/ or die' somefile
  perl -i -pe 's/FAILED/OK/ or exit 1' somefile

*wouldn't* replace the file, but all of​:

  perl -i -ne 'last' somefile
  perl -i -ne 'exit' somefile

*would* replace the file.

Unfortunately non-trivial code that uses in-place editing will still have problems​:

  sub foo {
  local (*ARGV, *ARGVOUT);
  @​ARGV = @​_;
  my $d = do { local $/; <> };
  $d =~ s/FAILED/OK/;
  print $d;
  die;
  }

  eval { foo("somefile") };

at the point where ARGVOUT is cleaned up we aren't in global destruction, so the file isn't replaced.

Tony

[p5pRT]

From @tonycoz

On Mon, 19 Nov 2018 16​:31​:12 -0800, tonyc wrote​:

Unfortunately non-trivial code that uses in-place editing will still
have problems​:

sub foo {
local (*ARGV, *ARGVOUT);
@​ARGV = @​_;
my $d = do { local $/; <> };
$d =~ s/FAILED/OK/;
print $d;
die;
}

eval { foo("somefile") };

at the point where ARGVOUT is cleaned up we aren't in global
destruction, so the file isn't replaced.

Oops, the input file *is* replaced.

The attached does the simple version of the check, but doesn't handle the more complex case.

Tony

[p5pRT]

From @tonycoz

0001-perl-133659-tests-for-global-destruction-handling-of.patch

From bfcb1def3fc594025a4a38c4247f1c85e815b3fa Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 20 Nov 2018 16:43:43 +1100
Subject: (perl #133659) tests for global destruction handling of inplace
 editing

---
 t/io/inplace.t | 28 +++++++++++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

diff --git a/t/io/inplace.t b/t/io/inplace.t
index 98159e06bf..ac50f1ab77 100644
--- a/t/io/inplace.t
+++ b/t/io/inplace.t
@@ -5,7 +5,7 @@ require './test.pl';
 
 $^I = $^O eq 'VMS' ? '_bak' : '.bak';
 
-plan( tests => 6 );
+plan( tests => 8 );
 
 my @tfiles     = (tempfile(), tempfile(), tempfile());
 my @tfiles_bak = map "$_$^I", @tfiles;
@@ -91,3 +91,29 @@ SKIP:
     
     END { unlink_all(@ifiles); }
 }
+
+{
+    my @tests =
+      ( # opts, code, result, name, $TODO
+       [ "-n", "die", "bar\n", "die shouldn't touch file" ],
+       [ "-n", "last", "", "last should update file", "not implemented yet" ],
+      );
+    our $file = tempfile() ;
+
+    for my $test (@tests) {
+        (my ($opts, $code, $result, $name), our $TODO) = @$test;
+        open my $fh, ">", $file or die;
+        print $fh "bar\n";
+        close $fh;
+
+        runperl( prog => $code,
+                 switches => [ grep length, "-i", $opts ],
+                 args => [ $file ],
+                 stderr => 1, # discarded
+               );
+        open $fh, "<", $file or die;
+        my $data = do { local $/; <$fh>; };
+        close $fh;
+        is($data, $result, $name);
+    }
+}
-- 
2.11.0

[p5pRT]

From @tonycoz

0002-perl-133659-make-an-in-place-edit-successful-if-the-.patch

From 969988ae104a4f4bd7f6ce7028a2b94e6deb9eb4 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 21 Nov 2018 10:05:27 +1100
Subject: (perl #133659) make an in-place edit successful if the exit status is
 zero

during global destruction.

This means that code like:

  perl -i -ne '...; last'

will replace the input file with the in-place edit output of the file,
but:

  perl -i -ne '...; die'

or

  perl -i -ne '...; exit 1'

won't.
---
 doio.c           | 45 +++++++++++++++++++++++++--------------------
 t/io/inplace.t   |  2 +-
 t/run/switches.t |  4 ++--
 3 files changed, 28 insertions(+), 23 deletions(-)

diff --git a/doio.c b/doio.c
index 77421de1d1..9fe222e082 100644
--- a/doio.c
+++ b/doio.c
@@ -1173,34 +1173,39 @@ S_argvout_free(pTHX_ SV *io, MAGIC *mg) {
         dir = INT2PTR(DIR *, SvIV(*dir_psv));
 #endif
         if (IoIFP(io)) {
-            SV **pid_psv;
-            PerlIO *iop = IoIFP(io);
+            if (PL_phase == PERL_PHASE_DESTRUCT && PL_statusvalue == 0) {
+                (void)argvout_final(mg, (IO*)io, FALSE);
+            }
+            else {
+                SV **pid_psv;
+                PerlIO *iop = IoIFP(io);
 
-            assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
+                assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
 
-            pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
+                pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
 
-            assert(pid_psv && *pid_psv);
+                assert(pid_psv && *pid_psv);
 
-            if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
-                /* if we get here the file hasn't been closed explicitly by the
-                   user and hadn't been closed implicitly by nextargv(), so
-                   abandon the edit */
-                SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
-                const char *temp_pv = SvPVX(*temp_psv);
+                if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
+                    /* if we get here the file hasn't been closed explicitly by the
+                       user and hadn't been closed implicitly by nextargv(), so
+                       abandon the edit */
+                    SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
+                    const char *temp_pv = SvPVX(*temp_psv);
 
-                assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
-                (void)PerlIO_close(iop);
-                IoIFP(io) = IoOFP(io) = NULL;
+                    assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
+                    (void)PerlIO_close(iop);
+                    IoIFP(io) = IoOFP(io) = NULL;
 #ifdef ARGV_USE_ATFUNCTIONS
-                if (dir) {
-                    if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
-                        NotSupported(errno))
-                        (void)UNLINK(temp_pv);
-                }
+                    if (dir) {
+                        if (unlinkat(my_dirfd(dir), temp_pv, 0) < 0 &&
+                            NotSupported(errno))
+                            (void)UNLINK(temp_pv);
+                    }
 #else
-                (void)UNLINK(temp_pv);
+                    (void)UNLINK(temp_pv);
 #endif
+                }
             }
         }
 #ifdef ARGV_USE_ATFUNCTIONS
diff --git a/t/io/inplace.t b/t/io/inplace.t
index ac50f1ab77..0403cd9250 100644
--- a/t/io/inplace.t
+++ b/t/io/inplace.t
@@ -96,7 +96,7 @@ SKIP:
     my @tests =
       ( # opts, code, result, name, $TODO
        [ "-n", "die", "bar\n", "die shouldn't touch file" ],
-       [ "-n", "last", "", "last should update file", "not implemented yet" ],
+       [ "-n", "last", "", "last should update file" ],
       );
     our $file = tempfile() ;
 
diff --git a/t/run/switches.t b/t/run/switches.t
index 7ccef1e063..594cad6e7f 100644
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -429,7 +429,7 @@ __EOF__
 
     # exit or die should leave original content in file
     for my $inplace (qw/-i -i.bak/) {
-        for my $prog (qw/die exit/) {
+        for my $prog ("die", "exit 1") {
             open my $fh, ">", $work or die "$0: failed to open '$work': $!";
             print $fh $yada;
             close $fh or die "Failed to close: $!";
@@ -443,7 +443,7 @@ __EOF__
             my $data = do { local $/; <$in> };
             close $in;
             is ($data, $yada, "check original content still in file");
-            unlink $work;
+            unlink $work, "$work.bak";
         }
     }
 
-- 
2.11.0

[p5pRT]

From @tonycoz

On Wed, 21 Nov 2018 19​:15​:41 -0800, tonyc wrote​:

The attached does the simple version of the check, but doesn't handle
the more complex case.

The attached is the first step towards a solution for the more complex case, but as the tests show it doesn't handle at least one of the more painful possible ways for die_unwinding() to be interrupted (though it tries.)

Tony