[PATCH 09/14] io: introduce write_file helper sub

[Eric Wong <e@80x24.org>]

This is pretty convenient way to create files for diff
generation in both WWW and lei.  The test suite should also be
able to take advantage of it.
---
 MANIFEST                     |  1 +
 lib/PublicInbox/IO.pm        | 10 +++++++++-
 lib/PublicInbox/Import.pm    |  6 ++----
 lib/PublicInbox/LeiMirror.pm | 26 +++++++++---------------
 lib/PublicInbox/LeiRediff.pm |  9 +++------
 lib/PublicInbox/MailDiff.pm  | 18 ++++++++---------
 lib/PublicInbox/SolverGit.pm | 38 ++++++++++++------------------------
 t/io.t                       | 33 +++++++++++++++++++++++++++++++
 8 files changed, 78 insertions(+), 63 deletions(-)
 create mode 100644 t/io.t

diff --git a/MANIFEST b/MANIFEST
index 479c09de..51dcffaf 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -488,6 +488,7 @@ t/index-git-times.t
 t/indexlevels-mirror-v1.t
 t/indexlevels-mirror.t
 t/init.t
+t/io.t
 t/ipc.t
 t/iso-2202-jp.eml
 t/kqnotify.t
diff --git a/lib/PublicInbox/IO.pm b/lib/PublicInbox/IO.pm
index 63850a52..4c92566d 100644
--- a/lib/PublicInbox/IO.pm
+++ b/lib/PublicInbox/IO.pm
@@ -4,8 +4,9 @@
 # supports reaping of children tied to a pipe or socket
 package PublicInbox::IO;
 use v5.12;
-use parent qw(IO::Handle);
+use parent qw(IO::Handle Exporter);
 use PublicInbox::DS qw(awaitpid);
+our @EXPORT_OK = qw(write_file);
 
 # TODO: this can probably be the new home for read_all, try_cat
 # and maybe even buffered read/readline...
@@ -51,4 +52,11 @@ sub DESTROY {
 	$io->SUPER::DESTROY;
 }
 
+sub write_file ($$@) { # mode, filename, LIST (for print)
+	use autodie qw(open close);
+	open(my $fh, shift, shift);
+	print $fh @_;
+	defined(wantarray) && !wantarray ? $fh : close $fh;
+}
+
 1;
diff --git a/lib/PublicInbox/Import.pm b/lib/PublicInbox/Import.pm
index dfba34b9..5b0201c6 100644
--- a/lib/PublicInbox/Import.pm
+++ b/lib/PublicInbox/Import.pm
@@ -18,7 +18,7 @@ use PublicInbox::MDA;
 use PublicInbox::Eml;
 use PublicInbox::IO;
 use POSIX qw(strftime);
-use autodie qw(read close socketpair);
+use autodie qw(socketpair);
 use Carp qw(croak);
 use Socket qw(AF_UNIX SOCK_STREAM);
 use PublicInbox::Git qw(read_all);
@@ -462,9 +462,7 @@ EOM
 	while (my ($fn, $contents) = splice(@fn_contents, 0, 2)) {
 		my $f = $dir.'/'.$fn;
 		next if -f $f;
-		open my $fh, '>', $f;
-		print $fh $contents;
-		close $fh;
+		PublicInbox::IO::write_file '>', $f, $contents;
 	}
 }
 
diff --git a/lib/PublicInbox/LeiMirror.pm b/lib/PublicInbox/LeiMirror.pm
index 71f41a11..8542c587 100644
--- a/lib/PublicInbox/LeiMirror.pm
+++ b/lib/PublicInbox/LeiMirror.pm
@@ -8,6 +8,7 @@ use parent qw(PublicInbox::IPC);
 use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
 use IO::Compress::Gzip qw(gzip $GzipError);
 use PublicInbox::Spawn qw(spawn run_wait run_die run_qx);
+use PublicInbox::IO qw(write_file);
 use File::Path ();
 use File::Temp ();
 use File::Spec ();
@@ -481,21 +482,18 @@ sub forkgroup_prep {
 	my $dir = "$os/$fg.git";
 	if (!-d $dir && !$self->{dry_run}) {
 		PublicInbox::Import::init_bare($dir);
-		open my $fh, '+>>', "$dir/config";
-		print $fh <<EOM;
+		write_file '+>>', "$dir/config", <<EOM;
 [repack]
 	useDeltaIslands = true
 [pack]
 	island = refs/remotes/([^/]+)/
 EOM
-		close $fh;
 	}
 	my $key = $self->{-key} // die 'BUG: no -key';
 	my $rn = substr(sha256_hex($key), 0, 16);
 	if (!-d $self->{cur_dst} && !$self->{dry_run}) {
 		PublicInbox::Import::init_bare($self->{cur_dst});
-		open my $fh, '+>>', "$self->{cur_dst}/config";
-		print $fh <<EOM;
+		write_file '+>>', "$self->{cur_dst}/config", <<EOM;
 ; rely on the "$rn" remote in the
 ; $fg fork group for fetches
 ; only uncomment the following iff you detach from fork groups
@@ -504,7 +502,6 @@ EOM
 ;	fetch = +refs/*:refs/*
 ;	mirror = true
 EOM
-		close $fh;
 	}
 	if (!$self->{dry_run}) {
 		my $alt = File::Spec->rel2abs("$dir/objects");
@@ -691,9 +688,11 @@ EOM
 sub init_placeholder ($$$) {
 	my ($src, $edst, $ent) = @_;
 	PublicInbox::Import::init_bare($edst);
-	my $f = "$edst/config";
-	open my $fh, '>>', $f;
-	print $fh <<EOM;
+	my @owner = defined($ent->{owner}) ? (<<EOM) : ();
+[gitweb]
+	owner = $ent->{owner}
+EOM
+	write_file '>>', "$edst/config", <<EOM, @owner;
 [remote "origin"]
 	url = $src
 	fetch = +refs/*:refs/*
@@ -703,18 +702,11 @@ sub init_placeholder ($$$) {
 ; will not fetch updates for it unless write permission is added.
 ; Hint: chmod +w $edst
 EOM
-	print $fh <<EOM if defined($ent->{owner});
-[gitweb]
-	owner = $ent->{owner}
-EOM
-	close $fh;
 	my %map = (head => 'HEAD', description => undef);
 	while (my ($key, $fn) = each %map) {
 		my $val = $ent->{$key} // next;
 		$fn //= $key;
-		open $fh, '>', "$edst/$fn";
-		say $fh $val;
-		close $fh;
+		write_file '>', "$edst/$fn", $val;
 	}
 }
 
diff --git a/lib/PublicInbox/LeiRediff.pm b/lib/PublicInbox/LeiRediff.pm
index fdff4b4b..35728330 100644
--- a/lib/PublicInbox/LeiRediff.pm
+++ b/lib/PublicInbox/LeiRediff.pm
@@ -114,12 +114,9 @@ EOM
 	if (!$rw->{-tmp}) {
 		my $d = "$self->{rdtmp}/for_tree.git";
 		-d $d or PublicInbox::Import::init_bare($d);
-		my $f = "$d/objects/info/alternates"; # always overwrite
-		open my $fh, '>', $f or die "open $f: $!";
-		for my $git (@{$self->{gits}}) {
-			print $fh $git->git_path('objects'),"\n";
-		}
-		close $fh or die "close $f: $!";
+		# always overwrite
+		PublicInbox::IO::write_file '>', "$d/objects/info/alternates",
+			map { $_->git_path('objects')."\n" } @{$self->{gits}};
 		$rw = PublicInbox::Git->new($d);
 	}
 	my $w = popen_wr(['git', "--git-dir=$rw->{git_dir}",
diff --git a/lib/PublicInbox/MailDiff.pm b/lib/PublicInbox/MailDiff.pm
index 908f223c..c7b991f1 100644
--- a/lib/PublicInbox/MailDiff.pm
+++ b/lib/PublicInbox/MailDiff.pm
@@ -9,14 +9,14 @@ use PublicInbox::ViewDiff qw(flush_diff);
 use PublicInbox::GitAsyncCat;
 use PublicInbox::ContentDigestDbg;
 use PublicInbox::Qspawn;
+use PublicInbox::IO qw(write_file);
+use autodie qw(close mkdir);
 
 sub write_part { # Eml->each_part callback
 	my ($ary, $self) = @_;
 	my ($part, $depth, $idx) = @$ary;
 	if ($idx ne '1' || $self->{-raw_hdr}) { # lei mail-diff --raw-header
-		open my $fh, '>', "$self->{curdir}/$idx.hdr" or die "open: $!";
-		print $fh ${$part->{hdr}} or die "print $!";
-		close $fh or die "close $!";
+		write_file '>', "$self->{curdir}/$idx.hdr", ${$part->{hdr}};
 	}
 	my $ct = $part->content_type || 'text/plain';
 	my ($s, $err) = msg_part_text($part, $ct);
@@ -24,22 +24,20 @@ sub write_part { # Eml->each_part callback
 	$s //= $part->body;
 	$s =~ s/\r\n/\n/gs; # TODO: consider \r+\n to match View
 	$s =~ s/\s*\z//s;
-	open my $fh, '>:utf8', "$self->{curdir}/$idx.$sfx" or die "open: $!";
-	print $fh $s or die "print $!";
-	close $fh or die "close $!";
+	write_file '>:utf8', "$self->{curdir}/$idx.$sfx", $s;
 }
 
 # public
 sub dump_eml ($$$) {
 	my ($self, $dir, $eml) = @_;
 	local $self->{curdir} = $dir;
-	mkdir $dir or die "mkdir($dir): $!";
+	mkdir $dir;
 	$eml->each_part(\&write_part, $self);
-	open my $fh, '>', "$dir/content_digest" or die "open: $!";
+	my $fh = write_file '>', "$dir/content_digest";
 	my $dig = PublicInbox::ContentDigestDbg->new($fh);
 	content_digest($eml, $dig);
-	print $fh "\n", $dig->hexdigest, "\n" or die "print $!";
-	close $fh or die "close: $!";
+	say $fh "\n", $dig->hexdigest;
+	close $fh;
 }
 
 # public
diff --git a/lib/PublicInbox/SolverGit.pm b/lib/PublicInbox/SolverGit.pm
index 23d4d3d1..ba3c94cb 100644
--- a/lib/PublicInbox/SolverGit.pm
+++ b/lib/PublicInbox/SolverGit.pm
@@ -11,8 +11,10 @@ package PublicInbox::SolverGit;
 use strict;
 use v5.10.1;
 use File::Temp 0.19 (); # 0.19 for ->newdir
+use autodie qw(mkdir);
 use Fcntl qw(SEEK_SET);
 use PublicInbox::Git qw(git_unquote git_quote);
+use PublicInbox::IO qw(write_file);
 use PublicInbox::MsgIter qw(msg_part_text);
 use PublicInbox::Qspawn;
 use PublicInbox::Tmpfile;
@@ -199,9 +201,7 @@ sub extract_diff ($$) {
 	my $path = ++$self->{tot};
 	$di->{n} = $path;
 	my $f = _tmp($self)->dirname."/$path";
-	open(my $tmp, '>:utf8', $f) or die "open($f): $!";
-	print $tmp $di->{hdr_lines}, $patch or die "print(tmp): $!";
-	close $tmp or die "close(tmp): $!";
+	write_file '>:utf8', $f, $di->{hdr_lines}, $patch;
 
 	# for debugging/diagnostics:
 	$di->{ibx} = $want->{cur_ibx};
@@ -291,36 +291,24 @@ sub do_git_init ($) {
 	my ($self) = @_;
 	my $git_dir = _tmp($self)->dirname.'/git';
 
-	foreach ('', qw(objects refs objects/info refs/heads)) {
-		mkdir("$git_dir/$_") or die "mkdir $_: $!";
-	}
-	open my $fh, '>', "$git_dir/config" or die "open git/config: $!";
+	mkdir("$git_dir/$_") for ('', qw(objects refs objects/info refs/heads));
 	my $first = $self->{gits}->[0];
 	my $fmt = $first->object_format;
-	my $v = defined($$fmt) ? 1 : 0;
-	print $fh <<EOF or die "print git/config $!";
+	my ($v, @ext) = defined($$fmt) ? (1, <<EOM) : (0);
+[extensions]
+	objectformat = $$fmt
+EOM
+	write_file '>', "$git_dir/config", <<EOF, @ext;
 [core]
 	repositoryFormatVersion = $v
 	filemode = true
 	bare = false
 	logAllRefUpdates = false
 EOF
-	print $fh <<EOM if defined($$fmt);
-[extensions]
-	objectformat = $$fmt
-EOM
-	close $fh or die "close git/config: $!";
-
-	open $fh, '>', "$git_dir/HEAD" or die "open git/HEAD: $!";
-	print $fh "ref: refs/heads/master\n" or die "print git/HEAD: $!";
-	close $fh or die "close git/HEAD: $!";
-
-	my $f = 'objects/info/alternates';
-	open $fh, '>', "$git_dir/$f" or die "open: $f: $!";
-	foreach my $git (@{$self->{gits}}) {
-		print $fh $git->git_path('objects'),"\n" or die "print $f: $!";
-	}
-	close $fh or die "close: $f: $!";
+	write_file '>', "$git_dir/HEAD", "ref: refs/heads/master\n";
+	write_file '>', "$git_dir/objects/info/alternates", map {
+			$_->git_path('objects')."\n"
+		} @{$self->{gits}};
 	my $tmp_git = $self->{tmp_git} = PublicInbox::Git->new($git_dir);
 	$tmp_git->{-tmp} = $self->{tmp};
 	$self->{git_env} = {
diff --git a/t/io.t b/t/io.t
new file mode 100644
index 00000000..4c7a97a3
--- /dev/null
+++ b/t/io.t
@@ -0,0 +1,33 @@
+#!perl -w
+# Copyright (C) all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+use v5.12;
+use PublicInbox::TestCommon;
+my $tmpdir = tmpdir;
+use_ok 'PublicInbox::IO';
+use PublicInbox::Spawn qw(which run_qx);
+
+# only test failures
+SKIP: {
+skip 'linux only test' if $^O ne 'linux';
+my $strace = which('strace') or skip 'strace missing for test';
+my $v = run_qx([$strace, '--version']);
+$v =~ m!version\s+([1-9]+\.[0-9]+)! or xbail "no strace --version: $v";
+$v = eval("v$1");
+$v ge v4.16 or skip "$strace too old for syscall injection (".
+		sprintf('v%vd', $v). ' < v4.16)';
+my $env = { PERL5LIB => join(':', @INC) };
+my $opt = { 1 => \my $out, 2 => \my $err };
+my $dst = "$tmpdir/dst";
+my $tr = "$tmpdir/tr";
+my $cmd = [ $strace, "-o$tr", "-P$dst",
+		'-e', 'inject=writev,write:error=EIO',
+		$^X, qw(-w -MPublicInbox::IO=write_file -e),
+		q[write_file '>', $ARGV[0], 'hello world'], $dst ];
+xsys($cmd, $env, $opt);
+isnt($?, 0, 'write failed');
+like($err, qr/\bclose\b/, 'close error noted');
+is(-s $dst, 0, 'file created and empty after EIO');
+} # /SKIP
+
+done_testing;