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
# 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...
$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;
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);
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;
}
}
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 ();
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
; fetch = +refs/*:refs/*
; mirror = true
EOM
- close $fh;
}
if (!$self->{dry_run}) {
my $alt = File::Spec->rel2abs("$dir/objects");
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/*
; 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;
}
}
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}",
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);
$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
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;
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};
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} = {
--- /dev/null
+#!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;
projects / thirdparty / public-inbox.git / commitdiff
