diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | lib/PublicInbox/IO.pm | 10 | ||||
| -rw-r--r-- | lib/PublicInbox/Import.pm | 6 | ||||
| -rw-r--r-- | lib/PublicInbox/LeiMirror.pm | 26 | ||||
| -rw-r--r-- | lib/PublicInbox/LeiRediff.pm | 9 | ||||
| -rw-r--r-- | lib/PublicInbox/MailDiff.pm | 18 | ||||
| -rw-r--r-- | lib/PublicInbox/SolverGit.pm | 38 | ||||
| -rw-r--r-- | t/io.t | 33 |
8 files changed, 78 insertions, 63 deletions
@@ -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} = { @@ -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; |