Comment 2 for bug 11159

Message-Id: <email address hidden>
Date: Mon, 13 Dec 2004 09:49:24 +0100
From: Jim Meyering <email address hidden>
To: Debian Bug Tracking System <email address hidden>
Subject: perl: silent write error can lead to data loss, with patch

Package: perl
Version: 5.8.4-5
Severity: grave
Tags: security patch
Justification: causes non-serious data loss

At first I hesitated to give this the `security' tag, but if you care
about security/reliability and write to a file, then you do want this fix.
And calling this a `grave' bug might be accurate, but only if you're
constantly writing to a nearly-full disk.

I reported this upstream a couple of weeks ago, but was surprised
by the total lack of response. Maybe you'll be more interested:

  http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-12/msg00072.html
  http://rt.perl.org/rt3/index.html?q=32745

Sometimes, closing a Perl file handle succeeds even though there have
been write errors via that handle. This bug appears to affect every
version of perl from 5.005_04 to 5.9.1. I didn't build/test versions
earlier than 5.005_04, but the doio.c:do_close function in 5.003 looks
like it has the same problem.

Here's a quick demo that depends on two things:
  - you have a /dev/full device (Linux, HPUX, MaxOS-X/Darwin)
  - 131072 is a multiple of your system's I/O buffer size

  perl -e 'print "x" x 131072; close STDOUT or die "$!\n"' \
    > /dev/full 2> /dev/null && echo fail || echo ok

It prints `fail' because at least one write system call failed and Perl's
`close' mistakenly succeeded. It would print `ok' for any size output
other than a multiple of the output buffer size. On the Linux systems
I've checked, that size is 4096. On a ppc/Darwin (7.5.0) system I tested,
the buffer size was 131072.

This means that if your Perl script happens to write precisely the
wrong number of bytes to a full or corrupted disk or to a closed file
descriptor, even if you dutifully check for success when closing the
file handle, the error will go undetected.

Here's another demo. Notice that it fails (as it should) for sizes
131071 and 131073, but not for output of size 131072.

  $ perl -e 'print "x" x 131071; close STDOUT or die "$!\n"' > /dev/full
  No space left on device
  [Exit 28]
  $ perl -e 'print "x" x 131072; close STDOUT or die "$!\n"' > /dev/full
  $ perl -e 'print "x" x 131073; close STDOUT or die "$!\n"' > /dev/full
  No space left on device
  [Exit 28]

After applying the patch below, the problematic case (with size being
a multiple of 4096 in my case), now fails, as it should:

  $ ./perl -e 'print "x" x 131072; close STDOUT or die "$!\n"' > /dev/full
  No space left on device
  [Exit 28]

On a Solaris 5.9 system, which lacks /dev/full, I demonstrated
the failure with the following small script that invokes perl with
stdout closed. All invocations of perl should evoke the
`Bad file number' error. But note that on some systems the
closed-stdout test succeeds (perl detects the error) even though
the write-to-/dev/full test fails.

    #!/bin/sh
    n=1024
    for i in 1 2 3 4 5 6; do
       echo $n
       perl -e 'print "x" x '$n'; close STDOUT or die "$!\n"' >&-
       n=`expr 2 \* $n`
    done

Here's the output:

    1024
    Bad file number
    2048
    Bad file number
    4096
    Bad file number
    8192
    Bad file number
    16384
    32768

This patch fixes the bug and induces no new failures in any of
these versions:

    5.005_04
    5.6.2
    5.8.6
    5.9.1

2004-11-30 Jim Meyering <email address hidden>

 * doio.c (Perl_io_close): Make the return value depend not only on the
 success of the close itself, but also on whether the output stream had
 a previous error.

--- doio.c.orig 2004-11-29 19:41:05.747199832 +0100
+++ doio.c 2004-12-01 08:39:53.106764936 +0100
@@ -1014,11 +1014,14 @@ Perl_io_close(pTHX_ IO *io, bool not_imp
      retval = TRUE;
  else {
      if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */
- retval = (PerlIO_close(IoOFP(io)) != EOF);
+ bool prev_err = PerlIO_error(IoOFP(io));
+ retval = (PerlIO_close(IoOFP(io)) != EOF && !prev_err);
   PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */
      }
- else
- retval = (PerlIO_close(IoIFP(io)) != EOF);
+ else {
+ bool prev_err = PerlIO_error(IoIFP(io));
+ retval = (PerlIO_close(IoIFP(io)) != EOF && !prev_err);
+ }
  }
  IoOFP(io) = IoIFP(io) = Nullfp;
     }

-- System Information:
Debian Release: 3.1
  APT prefers unstable
  APT policy: (500, 'unstable'), (1, 'experimental')
Architecture: i386 (i686)
Kernel: Linux 2.6.9jmm
Locale: LANG=en_GB.iso88591, LC_CTYPE=en_GB.iso88591 (charmap=ISO-8859-1)

Versions of packages perl depends on:
ii libc6 2.3.2.ds1-19 GNU C Library: Shared libraries an
ii libdb4.2 4.2.52-17 Berkeley v4.2 Database Libraries [
ii libgdbm3 1.8.3-2 GNU dbm database routines (runtime
ii perl-base 5.8.4-5 The Pathologically Eclectic Rubbis
ii perl-modules 5.8.4-5 Core Perl modules

-- no debconf information