#    debsigs: Package signing/verification system
#    Copyright (C) 2000   Progeny Linux Systems, Inc. <jgoerzen@progeny.com>
#    Copyright (C) 2009   Peter Pentchev <roam@ringlet.net>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

package Debian::debsigs::forktools;

use strict;
use warnings;

use IO::Pipe;
use IO::Handle;
use POSIX ":sys_wait_h";

use Exporter ();
use vars qw($VERSION $CVSVERSION @EXPORT_OK);
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [qw(&forkreader &forkwriter &forkboth &assertsuccess)] );
Exporter::export_ok_tags('all');

#my $CVSVERSION = '$Progeny: forktools.pm,v 1.9 2001/05/09 11:21:52 epg Exp $'; #'
#my ($VERSION) = $CVSVERSION =~ /^\$Progeny: .+,v ([0-9.]+) /;
our $VERSION = '1.10';

use vars @EXPORT_OK;

# The forkreader will generate a new fd that is used to read from the
# forked program.  If you want to write to it, a writer fd may be passed.

sub forkreader {
  my ($outputfd, @args) = @_;

  my $pipe = new IO::Pipe;
  my $pid = fork();
  if ($pid < 0) {
    die "Couldn't fork: $!";
  }

  if ($pid) {			# Parent
    $pipe->reader();		# Re-bless into the reader.
    if (wantarray()) {
      return ($pipe, $pid);
    }
    return $pipe;		# And return for use by the program.
  } else {			# Child.
    $pipe->writer();		# Make into the writer.
    my $fd = $pipe->fileno;
    open(STDOUT, ">&$fd");	# Send standard output to the pipe.
    if ($outputfd) {		# If they specified an input fd, dup it.
      my $fd = $outputfd->fileno;
      open(STDIN, "<&$fd");
    }
    exec(@args) or die "Couldn't exec: $!\n";
  }
}

sub forkwriter {
  my ($inputfd, @args) = @_;

  my $pipe = new IO::Pipe;
  my $pid = fork();
  if ($pid < 0) {
    die "Couldn't fork: $!";
  }

  if ($pid) {			# Parent.
    $pipe->writer();		# Re-bless into the writer.
    if (wantarray()) {
      return ($pipe, $pid);
    }
    return $pipe;		# And return for use by the program.
  } else {			# Child.
    $pipe->reader();
    my $fd = $pipe->fileno;
    open(STDIN, "<&$fd");
    if ($inputfd) {
      my $fd = $inputfd->fileno;
      open(STDOUT, ">&$fd");
    }
    exec(@args) or die "Couldn't exec: $!\n";
  }
}

sub forkboth {
  my ($outputfd, $inputfd, @args) = @_;
  my $pid = fork();
  if ($pid < 0) {
    die "Couldn't fork: $!";
  }

  if ($pid) {			# Parent.
    return $pid;
  } else {			# Child.
    my $fd = $outputfd->fileno;
    open(STDIN, "<&$fd");
    $fd = $inputfd->fileno;
    open(STDOUT, ">&$fd");
    exec(@args) or die "Couldn't exec: $!\n";
  }
}

sub assertsuccess {
  my ($pid, $package, $block) = @_;

  my $res = waitpid($pid, (defined($block) && $block) ? 0 : &WNOHANG);
  my $code = $?;
  return if ($res < 1);		# bad pid or not exited, ok.
  my $ec = WEXITSTATUS($code);
  die "Program $package ($pid) failed with code $code (exit $ec)" if ($code);
  # print STDERR "Program $package ($pid) exited successfully.\n";
}

1;