Skip to content

Commit

Permalink
Fix race conditions in timed-build output
Browse files Browse the repository at this point in the history
Add a writefile_atomic() routine that is only used for writing complete
files, not appending or piping, and is atomic on a POSIX filesystem,
and have timed-build use that.

Reorder the locking in the classic writefile() to return the race
condition vulnerability window back to the much smaller time it was before
the introduction of UTF-8 support, to make it very unlikely to occur.

Detailed explanation of the problem and fix:

Recently I was surprised to run into a bug in Interchange's timed-build
generation routine on a client's production system.

First see the source of &Vend::Interpolate::timed_build and then look
at &Vend::File::writefile, especially this:

    open(MVLOGDATA, $file) or die "open\n";
    if ($encoding) {
        local $PerlIO::encoding::fallback = $fallback;
        binmode(MVLOGDATA, ":encoding($encoding)");
    }

    lockfile(\*MVLOGDATA, 1, 1) or die "lock\n";
    seek(MVLOGDATA, 0, 2) or die "seek\n";
    if(ref $data) {
        print(MVLOGDATA $$data) or die "write to\n";
    }
    else {
        print(MVLOGDATA $data) or die "write to\n";
    }
    unlockfile(\*MVLOGDATA) or die "unlock\n";

Note that $file will contain ">/path/to/timed_build_file" so it causes
the file to be opened in write mode and truncated.

That alone is a race condition: When a file is truncated, there's a
brief time before it's written to when it's empty and any other process
reading it will get an empty file.

The introduction of UTF-8 support has made that race window longer because
right after truncation the binmode() call is made with :encoding(UTF-8)
or whatever, which can induce dynamic Encode package loads, which is
relatively slow.

That is one bug, but the bug I encountered is different and much weirder:
Two timed build files generated by Interchange each had their contents
doubled.

That is, if the file should have contained "HORSES\n", it instead
contained "HORSES\nHORSES\n".

I've never seen such a thing before, but it happened in two separate
timed-build files that both get used right after each other in ITL,
so if it's caused by a race condition, it's believable that both would
happen in the same run because they're sequential, so the same thing
that caused it one place could cause it another.

Now let's walk through the above code as run by two concurrent
processes to see the race as it happens.

Process A runs this:

    open(MVLOGDATA, $file) or die "open\n";

And then process B runs it:

    open(MVLOGDATA, $file) or die "open\n";

Process A runs this:

    if ($encoding) {
        local $PerlIO::encoding::fallback = $fallback;
        binmode(MVLOGDATA, ":encoding($encoding)");
    }

Then process B runs it:

    if ($encoding) {
        local $PerlIO::encoding::fallback = $fallback;
        binmode(MVLOGDATA, ":encoding($encoding)");
    }

Process A runs this:

    lockfile(\*MVLOGDATA, 1, 1) or die "lock\n";

Then process B runs it and blocks on the lock:

    lockfile(\*MVLOGDATA, 1, 1) or die "lock\n";

Process A runs this:

    seek(MVLOGDATA, 0, 2) or die "seek\n";
    if(ref $data) {
        print(MVLOGDATA $$data) or die "write to\n";
    }
    else {
        print(MVLOGDATA $data) or die "write to\n";
    }
    unlockfile(\*MVLOGDATA) or die "unlock\n";

and the timed-build file is written correctly and unlocked.

That unblocks process B which now runs this:

    seek(MVLOGDATA, 0, 2) or die "seek\n";

which, oddly for this situation where we are writing to a truncated file,
seeks to the end of the file! That appears to be a recipe gotten from
the Perl flock() documentation:

    flock($fh, LOCK_EX) or die "Cannot lock mailbox - $!\n";
    # and, in case we're running on a very old UNIX
    # variant without the modern O_APPEND semantics...
    seek($fh, 0, SEEK_END) or die "Cannot seek - $!\n";

and would be harmless if the file is still truncated, but now that the
file has been written to, means we seek to the end of the file and start
writing there!

Now process B runs this:

    if(ref $data) {
        print(MVLOGDATA $$data) or die "write to\n";
    }
    else {
        print(MVLOGDATA $data) or die "write to\n";
    }
    unlockfile(\*MVLOGDATA) or die "unlock\n";

And we have two copies of the same timed-build output, one after the
other, in the same file.

This bug has always existed in this code, but I think it became many
times more likely to be encountered once the binmode() with encoding
was added because that can be so slow.

There are a few ways to try to solve the doubling problem:

1. Just remove the seek() call which appears to have been only to cope
with Unix systems that were already old and rare at the time the Perl
flock() docs were written. Then when the doubling problem hits in the
future, it'll write the same timed-build output once, then over itself
again.

If the timed-build runs return output of differing length, it could
cause the tail end of the longer one to appear after the shorter one,
which might be an even more confusing bug than this one.  But we could
call truncate() to empty the rest of the file and remove the risk of
the longer pieces remaining from before.

This isn't attractive, though, because I don't know for sure that removing
the seek() is actually safe, and on which systems.

2. Call the binmode() to set the encoding *after* taking the lock. This
seems like the right thing to do anyway, but it only narrows the window
for the race condition, and doesn't remove it entirely.

3. Overhaul the routine to use standard practice in writing a shared
file atomically.

It seems only (3) really solves both of the bugs. We can achieve our
goal with a procedure like this:

a. Open a new randomly-named temporary file in the same directory.

b. Write to it.

c. Close it.

d. Rename it over the original file.

Renaming is an atomic operation when done within a single POSIX
filesystem. It isn't atomic for reads over NFS, but writefile() didn't
support fcntl() locking for NFS anyway, so we're not making that problem
any worse.

This doesn't stop concurrent timed-build writes from happening, but they
would harmlessly replace each other in a way that would never leave an
empty or partially-written file, would keep concurrent reads from ever
getting a stale timed-build file, and doesn't need locking at all.

Thanks to Mark Johnson for review.
  • Loading branch information
jonjensen committed Sep 18, 2018
1 parent ed509da commit 38dbcd1
Show file tree
Hide file tree
Showing 2 changed files with 105 additions and 13 deletions.
114 changes: 103 additions & 11 deletions lib/Vend/File.pm
@@ -1,6 +1,6 @@
# Vend::File - Interchange file functions
#
# Copyright (C) 2002-2009 Interchange Development Group
# Copyright (C) 2002-2018 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
#
# This program was originally based on Vend 0.2 and 0.3
Expand Down Expand Up @@ -59,13 +59,17 @@ unless( $ENV{MINIVEND_DISABLE_UTF8} ) {
use Vend::Util;
use File::Path;
use File::Copy;
use File::Temp;

use subs qw(logError logGlobal);
use vars qw($VERSION @EXPORT @EXPORT_OK $errstr);
$VERSION = '2.33';

$VERSION = '2.34';

sub writefile {
my($file, $data, $opt) = @_;
my($encoding, $fallback);
ref($opt) or $opt = {};
my ($encoding, $fallback, $save_umask);

if ($::Variable->{MV_UTF8} || $Global::Variable->{MV_UTF8}) {
$encoding = $opt->{encoding} ||= 'utf8';
Expand All @@ -75,16 +79,16 @@ sub writefile {
}

$file = ">>$file" unless $file =~ /^[|>]/;
if (ref $opt and $opt->{umask}) {
$opt->{umask} = umask oct($opt->{umask});

if ($opt->{umask}) {
$save_umask = umask oct($opt->{umask});
}

eval {
unless($file =~ s/^[|]\s*//) {
if (ref $opt and $opt->{auto_create_dir}) {
if ($opt->{auto_create_dir}) {
my $dir = $file;
$dir =~ s/>+//;

## Need to make this OS-independent, requires File::Spec support
$dir =~ s:[\r\n]::g; # Just in case
$dir =~ s:(.*)/.*:$1: or $dir = '';
if($dir and ! -d $dir) {
Expand Down Expand Up @@ -137,13 +141,101 @@ sub writefile {
$status = 0;
}

if (ref $opt and defined $opt->{umask}) {
$opt->{umask} = umask oct($opt->{umask});
}
umask $save_umask if defined $save_umask;

return $status;
}


# writefile_atomic() is similar to writefile(), but:
# Only writes entire files (no appending or writing to a pipe).
# Writes first to a temporary file and then renames that into place at the expected file name, which is an atomic operation in POSIX filesystems.
#
# This removes the race conditions in writefile() where:
# * a reader can see an empty file right after truncation
# * a reader can see a a partially-written file
# * concurrent writers can double output in the file due to the lock race and seek to end (which is only needed for appending, not overwriting)
#
# It also removes the need for locking.

sub writefile_atomic {
my ($path, $data, $opt) = @_;

if ($path =~ /^\s*(?:>>|<|\+|\|)/) {
::logError(__PACKAGE__ . "::writefile_atomic can only write an entire file; invalid prefix: $path");
return;
}

# Tolerate unneeded leading > for compatibility
$path =~ s/^\s*>\s*//;

my ($encoding, $fallback, $save_umask, $tmpfile, $status);
ref($opt) or $opt = {};

if ($::Variable->{MV_UTF8} || $Global::Variable->{MV_UTF8}) {
$encoding = $opt->{encoding} || 'utf8';
undef $encoding if $encoding eq 'raw';
$fallback = $opt->{fallback} // $PERLQQ;
}

if ($opt->{umask}) {
$save_umask = umask oct($opt->{umask});
}

eval {
my $dir = $path;
$dir =~ s:[\r\n]::g; # Just in case
my $file;
if ($dir =~ s:(.*)/(.*):$1:) {
$file = $2;
}
else {
$dir = '';
$file = 'temp';
}

if ($dir and $opt->{auto_create_dir} and ! -d $dir) {
File::Path::mkpath($dir);
die "mkpath\n" unless -d $dir;
}

my $fh;
($fh, $tmpfile) = File::Temp::tempfile($file . '.XXXXXXXX', DIR => $dir);
$fh or die "open\n";
# File::Temp doesn't respect umask, so correct the file mode
chmod 0666 &~ umask(), $tmpfile or die "chmod\n";
if ($encoding) {
local $PerlIO::encoding::fallback = $fallback;
binmode $fh, ":encoding($encoding)";
}
print $fh ref($data) ? $$data : $data or die "write\n";
close $fh or die "close\n";
rename $tmpfile, $path or die "rename\n";
};
my $err = $@;
if ($err) {
chomp $err;
my $msg = ($err !~ /\W/)
? sprintf("Could not %s file '%s': %s",
$err,
$tmpfile,
$!,
)
: sprintf("Error saving file '%s': %s", $path, $err);
::logError("%s\nto write this data (excerpt):\n%s",
$msg,
substr(ref($data) ? $$data : $data, 0, 120),
);
}
else {
$status = 1;
}

umask $save_umask if defined $save_umask;

return $status;
}

sub file_modification_time {
my ($fn, $tolerate) = @_;
my @s = stat($fn) or ($tolerate and return 0) or die "Can't stat '$fn': $!\n";
Expand Down
4 changes: 2 additions & 2 deletions lib/Vend/Interpolate.pm
Expand Up @@ -5385,8 +5385,8 @@ sub timed_build {

if( ! -f $file or $secs && (stat(_))[9] < (time() - $secs) ) {
my $out = Vend::Interpolate::interpolate_html(shift);
$opt->{umask} = '22' unless defined $opt->{umask};
Vend::Util::writefile(">$file", $out, $opt );
$opt->{umask} //= '22';
Vend::File::writefile_atomic($file, $out, $opt);
$Vend::Session->{scratch} = $save_scratch if $save_scratch;
return $out;
}
Expand Down

0 comments on commit 38dbcd1

Please sign in to comment.