#!/usr/bin/perl
# reporter -- stands in for every program of a graph test (item N10; EXPERIMENTAL).  Run it
# through a symlink named after the program it replaces.  It appends one JSON line to $REPORT_LOG:
#   name, argv, its fds (what each is, how it was opened, close-on-exec), SigIgn, SigBlk, pgid, sid;
# then writes its name as one line to every fd it may write (not a terminal), closes those, reads
# every other fd that is a pipe or a file to its end, and adds the lines it got to the report.
# Exit status 1 for names starting with false or fail, else 0.
use strict; use warnings;
use POSIX ();
use JSON::PP;
(my $name = $0) =~ s{.*/}{};
my %fd;
opendir my $dir, '/proc/self/fd' or die "reporter: /proc/self/fd: $!\n";
for my $n (sort { $a <=> $b } grep /^\d+\z/ && $_ != fileno $dir, readdir $dir) {
  my $what = readlink "/proc/self/fd/$n" // next;
  open my $i, '<', "/proc/self/fdinfo/$n" or next;
  my ($f) = map /^flags:\s*([0-7]+)/ ? oct $1 : (), <$i>;
  $fd{$n} = [$what, (qw(< > <>))[$f & 3], $f & 02000000 ? 1 : 0] }
closedir $dir;
my %st = map /^(\w+):\s*(.*)/, do { open my $s, '<', '/proc/self/status'; <$s> };
my $tty = sub { -t $_[0] or $fd{$_[0]}[0] =~ m{^/dev/(?:tty|pts)} };
my @w = grep $fd{$_}[1] ne '<' && !$tty->($_), keys %fd;
for (@w) { POSIX::write($_, "$name\n", length($name) + 1) }
POSIX::close($_) for grep $fd{$_}[1] eq '>', @w;
my %got;
for my $n (sort { $a <=> $b } grep $fd{$_}[1] eq '<' && !$tty->($_) && $fd{$_}[0] =~ m{^(?:pipe:|/)}, keys %fd) {
  open my $h, '<&=', $n or next;
  $got{$n} = [sort split /\n/, do { local $/; <$h> // '' }] }
my ($pgid, $sid) = (split ' ', (do { open my $s, '<', '/proc/self/stat'; <$s> } =~ /\)\s*(.*)/)[0])[2, 3];
open my $log, '>>', $ENV{REPORT_LOG} // die "reporter: REPORT_LOG not set\n" or die "reporter: $ENV{REPORT_LOG}: $!\n";
print $log JSON::PP->new->canonical->encode({ name => $name, argv => [$0 =~ s{.*/}{}r, @ARGV], fds => \%fd,
  got => \%got, sigign => $st{SigIgn}, sigblk => $st{SigBlk}, pgid => $pgid, sid => $sid }), "\n";
exit($name =~ /^(?:false|fail)/ ? 1 : 0);
