| Index: third_party/dpkg-dev/scripts/Dpkg/IPC.pm
 | 
| diff --git a/third_party/dpkg-dev/scripts/Dpkg/IPC.pm b/third_party/dpkg-dev/scripts/Dpkg/IPC.pm
 | 
| new file mode 100644
 | 
| index 0000000000000000000000000000000000000000..324c1008c52a82df55173ab9fcca83bddaee6e46
 | 
| --- /dev/null
 | 
| +++ b/third_party/dpkg-dev/scripts/Dpkg/IPC.pm
 | 
| @@ -0,0 +1,375 @@
 | 
| +# Copyright © 2008-2009 Raphaël Hertzog <hertzog@debian.org>
 | 
| +# Copyright © 2008 Frank Lichtenheld <djpig@debian.org>
 | 
| +#
 | 
| +# 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, see <https://www.gnu.org/licenses/>.
 | 
| +
 | 
| +package Dpkg::IPC;
 | 
| +
 | 
| +use strict;
 | 
| +use warnings;
 | 
| +
 | 
| +our $VERSION = '1.00';
 | 
| +
 | 
| +use Dpkg::ErrorHandling;
 | 
| +use Dpkg::Gettext;
 | 
| +
 | 
| +use Carp;
 | 
| +use Exporter qw(import);
 | 
| +our @EXPORT = qw(spawn wait_child);
 | 
| +
 | 
| +=encoding utf8
 | 
| +
 | 
| +=head1 NAME
 | 
| +
 | 
| +Dpkg::IPC - helper functions for IPC
 | 
| +
 | 
| +=head1 DESCRIPTION
 | 
| +
 | 
| +Dpkg::IPC offers helper functions to allow you to execute
 | 
| +other programs in an easy, yet flexible way, while hiding
 | 
| +all the gory details of IPC (Inter-Process Communication)
 | 
| +from you.
 | 
| +
 | 
| +=head1 METHODS
 | 
| +
 | 
| +=over 4
 | 
| +
 | 
| +=item spawn
 | 
| +
 | 
| +Creates a child process and executes another program in it.
 | 
| +The arguments are interpreted as a hash of options, specifying
 | 
| +how to handle the in and output of the program to execute.
 | 
| +Returns the pid of the child process (unless the wait_child
 | 
| +option was given).
 | 
| +
 | 
| +Any error will cause the function to exit with one of the
 | 
| +Dpkg::ErrorHandling functions.
 | 
| +
 | 
| +Options:
 | 
| +
 | 
| +=over 4
 | 
| +
 | 
| +=item exec
 | 
| +
 | 
| +Can be either a scalar, i.e. the name of the program to be
 | 
| +executed, or an array reference, i.e. the name of the program
 | 
| +plus additional arguments. Note that the program will never be
 | 
| +executed via the shell, so you can't specify additional arguments
 | 
| +in the scalar string and you can't use any shell facilities like
 | 
| +globbing.
 | 
| +
 | 
| +Mandatory Option.
 | 
| +
 | 
| +=item from_file, to_file, error_to_file
 | 
| +
 | 
| +Filename as scalar. Standard input/output/error of the
 | 
| +child process will be redirected to the file specified.
 | 
| +
 | 
| +=item from_handle, to_handle, error_to_handle
 | 
| +
 | 
| +Filehandle. Standard input/output/error of the child process will be
 | 
| +dup'ed from the handle.
 | 
| +
 | 
| +=item from_pipe, to_pipe, error_to_pipe
 | 
| +
 | 
| +Scalar reference or object based on IO::Handle. A pipe will be opened for
 | 
| +each of the two options and either the reading (C<to_pipe> and
 | 
| +C<error_to_pipe>) or the writing end (C<from_pipe>) will be returned in
 | 
| +the referenced scalar. Standard input/output/error of the child process
 | 
| +will be dup'ed to the other ends of the pipes.
 | 
| +
 | 
| +=item from_string, to_string, error_to_string
 | 
| +
 | 
| +Scalar reference. Standard input/output/error of the child
 | 
| +process will be redirected to the string given as reference. Note
 | 
| +that it wouldn't be strictly necessary to use a scalar reference
 | 
| +for C<from_string>, as the string is not modified in any way. This was
 | 
| +chosen only for reasons of symmetry with C<to_string> and
 | 
| +C<error_to_string>. C<to_string> and C<error_to_string> imply the
 | 
| +C<wait_child> option.
 | 
| +
 | 
| +=item wait_child
 | 
| +
 | 
| +Scalar. If containing a true value, wait_child() will be called before
 | 
| +returning. The return value of spawn() will be a true value, not the pid.
 | 
| +
 | 
| +=item nocheck
 | 
| +
 | 
| +Scalar. Option of the wait_child() call.
 | 
| +
 | 
| +=item timeout
 | 
| +
 | 
| +Scalar. Option of the wait_child() call.
 | 
| +
 | 
| +=item chdir
 | 
| +
 | 
| +Scalar. The child process will chdir in the indicated directory before
 | 
| +calling exec.
 | 
| +
 | 
| +=item env
 | 
| +
 | 
| +Hash reference. The child process will populate %ENV with the items of the
 | 
| +hash before calling exec. This allows exporting environment variables.
 | 
| +
 | 
| +=item delete_env
 | 
| +
 | 
| +Array reference. The child process will remove all environment variables
 | 
| +listed in the array before calling exec.
 | 
| +
 | 
| +=back
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub _sanity_check_opts {
 | 
| +    my (%opts) = @_;
 | 
| +
 | 
| +    croak 'exec parameter is mandatory in spawn()'
 | 
| +	unless $opts{exec};
 | 
| +
 | 
| +    my $to = my $error_to = my $from = 0;
 | 
| +    foreach (qw(file handle string pipe)) {
 | 
| +	$to++ if $opts{"to_$_"};
 | 
| +	$error_to++ if $opts{"error_to_$_"};
 | 
| +	$from++ if $opts{"from_$_"};
 | 
| +    }
 | 
| +    croak 'not more than one of to_* parameters is allowed'
 | 
| +	if $to > 1;
 | 
| +    croak 'not more than one of error_to_* parameters is allowed'
 | 
| +	if $error_to > 1;
 | 
| +    croak 'not more than one of from_* parameters is allowed'
 | 
| +	if $from > 1;
 | 
| +
 | 
| +    foreach (qw(to_string error_to_string from_string)) {
 | 
| +	if (exists $opts{$_} and
 | 
| +	    (not ref($opts{$_}) or ref($opts{$_}) ne 'SCALAR')) {
 | 
| +	    croak "parameter $_ must be a scalar reference";
 | 
| +	}
 | 
| +    }
 | 
| +
 | 
| +    foreach (qw(to_pipe error_to_pipe from_pipe)) {
 | 
| +	if (exists $opts{$_} and
 | 
| +	    (not ref($opts{$_}) or (ref($opts{$_}) ne 'SCALAR' and
 | 
| +				 not $opts{$_}->isa('IO::Handle')))) {
 | 
| +	    croak "parameter $_ must be a scalar reference or " .
 | 
| +	          'an IO::Handle object';
 | 
| +	}
 | 
| +    }
 | 
| +
 | 
| +    if (exists $opts{timeout} and defined($opts{timeout}) and
 | 
| +        $opts{timeout} !~ /^\d+$/) {
 | 
| +	croak 'parameter timeout must be an integer';
 | 
| +    }
 | 
| +
 | 
| +    if (exists $opts{env} and ref($opts{env}) ne 'HASH') {
 | 
| +	croak 'parameter env must be a hash reference';
 | 
| +    }
 | 
| +
 | 
| +    if (exists $opts{delete_env} and ref($opts{delete_env}) ne 'ARRAY') {
 | 
| +	croak 'parameter delete_env must be an array reference';
 | 
| +    }
 | 
| +
 | 
| +    return %opts;
 | 
| +}
 | 
| +
 | 
| +sub spawn {
 | 
| +    my (%opts) = _sanity_check_opts(@_);
 | 
| +    $opts{close_in_child} ||= [];
 | 
| +    my @prog;
 | 
| +    if (ref($opts{exec}) =~ /ARRAY/) {
 | 
| +	push @prog, @{$opts{exec}};
 | 
| +    } elsif (not ref($opts{exec})) {
 | 
| +	push @prog, $opts{exec};
 | 
| +    } else {
 | 
| +	croak 'invalid exec parameter in spawn()';
 | 
| +    }
 | 
| +    my ($from_string_pipe, $to_string_pipe, $error_to_string_pipe);
 | 
| +    if ($opts{to_string}) {
 | 
| +	$opts{to_pipe} = \$to_string_pipe;
 | 
| +	$opts{wait_child} = 1;
 | 
| +    }
 | 
| +    if ($opts{error_to_string}) {
 | 
| +	$opts{error_to_pipe} = \$error_to_string_pipe;
 | 
| +	$opts{wait_child} = 1;
 | 
| +    }
 | 
| +    if ($opts{from_string}) {
 | 
| +	$opts{from_pipe} = \$from_string_pipe;
 | 
| +    }
 | 
| +    # Create pipes if needed
 | 
| +    my ($input_pipe, $output_pipe, $error_pipe);
 | 
| +    if ($opts{from_pipe}) {
 | 
| +	pipe($opts{from_handle}, $input_pipe)
 | 
| +	    or syserr(_g('pipe for %s'), "@prog");
 | 
| +	${$opts{from_pipe}} = $input_pipe;
 | 
| +	push @{$opts{close_in_child}}, $input_pipe;
 | 
| +    }
 | 
| +    if ($opts{to_pipe}) {
 | 
| +	pipe($output_pipe, $opts{to_handle})
 | 
| +	    or syserr(_g('pipe for %s'), "@prog");
 | 
| +	${$opts{to_pipe}} = $output_pipe;
 | 
| +	push @{$opts{close_in_child}}, $output_pipe;
 | 
| +    }
 | 
| +    if ($opts{error_to_pipe}) {
 | 
| +	pipe($error_pipe, $opts{error_to_handle})
 | 
| +	    or syserr(_g('pipe for %s'), "@prog");
 | 
| +	${$opts{error_to_pipe}} = $error_pipe;
 | 
| +	push @{$opts{close_in_child}}, $error_pipe;
 | 
| +    }
 | 
| +    # Fork and exec
 | 
| +    my $pid = fork();
 | 
| +    syserr(_g('cannot fork for %s'), "@prog") unless defined $pid;
 | 
| +    if (not $pid) {
 | 
| +	# Define environment variables
 | 
| +	if ($opts{env}) {
 | 
| +	    foreach (keys %{$opts{env}}) {
 | 
| +		$ENV{$_} = $opts{env}{$_};
 | 
| +	    }
 | 
| +	}
 | 
| +	if ($opts{delete_env}) {
 | 
| +	    delete $ENV{$_} foreach (@{$opts{delete_env}});
 | 
| +	}
 | 
| +	# Change the current directory
 | 
| +	if ($opts{chdir}) {
 | 
| +	    chdir($opts{chdir}) or syserr(_g('chdir to %s'), $opts{chdir});
 | 
| +	}
 | 
| +	# Redirect STDIN if needed
 | 
| +	if ($opts{from_file}) {
 | 
| +	    open(STDIN, '<', $opts{from_file})
 | 
| +	        or syserr(_g('cannot open %s'), $opts{from_file});
 | 
| +	} elsif ($opts{from_handle}) {
 | 
| +	    open(STDIN, '<&', $opts{from_handle})
 | 
| +		or syserr(_g('reopen stdin'));
 | 
| +	    close($opts{from_handle}); # has been duped, can be closed
 | 
| +	}
 | 
| +	# Redirect STDOUT if needed
 | 
| +	if ($opts{to_file}) {
 | 
| +	    open(STDOUT, '>', $opts{to_file})
 | 
| +	        or syserr(_g('cannot write %s'), $opts{to_file});
 | 
| +	} elsif ($opts{to_handle}) {
 | 
| +	    open(STDOUT, '>&', $opts{to_handle})
 | 
| +		or syserr(_g('reopen stdout'));
 | 
| +	    close($opts{to_handle}); # has been duped, can be closed
 | 
| +	}
 | 
| +	# Redirect STDERR if needed
 | 
| +	if ($opts{error_to_file}) {
 | 
| +	    open(STDERR, '>', $opts{error_to_file})
 | 
| +	        or syserr(_g('cannot write %s'), $opts{error_to_file});
 | 
| +	} elsif ($opts{error_to_handle}) {
 | 
| +	    open(STDERR, '>&', $opts{error_to_handle})
 | 
| +	        or syserr(_g('reopen stdout'));
 | 
| +	    close($opts{error_to_handle}); # has been duped, can be closed
 | 
| +	}
 | 
| +	# Close some inherited filehandles
 | 
| +	close($_) foreach (@{$opts{close_in_child}});
 | 
| +	# Execute the program
 | 
| +	exec({ $prog[0] } @prog) or syserr(_g('unable to execute %s'), "@prog");
 | 
| +    }
 | 
| +    # Close handle that we can't use any more
 | 
| +    close($opts{from_handle}) if exists $opts{from_handle};
 | 
| +    close($opts{to_handle}) if exists $opts{to_handle};
 | 
| +    close($opts{error_to_handle}) if exists $opts{error_to_handle};
 | 
| +
 | 
| +    if ($opts{from_string}) {
 | 
| +	print { $from_string_pipe } ${$opts{from_string}};
 | 
| +	close($from_string_pipe);
 | 
| +    }
 | 
| +    if ($opts{to_string}) {
 | 
| +	local $/ = undef;
 | 
| +	${$opts{to_string}} = readline($to_string_pipe);
 | 
| +    }
 | 
| +    if ($opts{error_to_string}) {
 | 
| +	local $/ = undef;
 | 
| +	${$opts{error_to_string}} = readline($error_to_string_pipe);
 | 
| +    }
 | 
| +    if ($opts{wait_child}) {
 | 
| +	my $cmdline = "@prog";
 | 
| +	if ($opts{env}) {
 | 
| +	    foreach (keys %{$opts{env}}) {
 | 
| +		$cmdline = "$_=\"" . $opts{env}{$_} . "\" $cmdline";
 | 
| +	    }
 | 
| +	}
 | 
| +	wait_child($pid, nocheck => $opts{nocheck},
 | 
| +                   timeout => $opts{timeout}, cmdline => $cmdline);
 | 
| +	return 1;
 | 
| +    }
 | 
| +
 | 
| +    return $pid;
 | 
| +}
 | 
| +
 | 
| +
 | 
| +=item wait_child
 | 
| +
 | 
| +Takes as first argument the pid of the process to wait for.
 | 
| +Remaining arguments are taken as a hash of options. Returns
 | 
| +nothing. Fails if the child has been ended by a signal or
 | 
| +if it exited non-zero.
 | 
| +
 | 
| +Options:
 | 
| +
 | 
| +=over 4
 | 
| +
 | 
| +=item cmdline
 | 
| +
 | 
| +String to identify the child process in error messages.
 | 
| +Defaults to "child process".
 | 
| +
 | 
| +=item nocheck
 | 
| +
 | 
| +If true do not check the return status of the child (and thus
 | 
| +do not fail it it has been killed or if it exited with a
 | 
| +non-zero return code).
 | 
| +
 | 
| +=item timeout
 | 
| +
 | 
| +Set a maximum time to wait for the process, after that fail
 | 
| +with an error message.
 | 
| +
 | 
| +=back
 | 
| +
 | 
| +=cut
 | 
| +
 | 
| +sub wait_child {
 | 
| +    my ($pid, %opts) = @_;
 | 
| +    $opts{cmdline} ||= _g('child process');
 | 
| +    croak 'no PID set, cannot wait end of process' unless $pid;
 | 
| +    eval {
 | 
| +        local $SIG{ALRM} = sub { die "alarm\n" };
 | 
| +        alarm($opts{timeout}) if defined($opts{timeout});
 | 
| +        $pid == waitpid($pid, 0) or syserr(_g('wait for %s'), $opts{cmdline});
 | 
| +        alarm(0) if defined($opts{timeout});
 | 
| +    };
 | 
| +    if ($@) {
 | 
| +        die $@ unless $@ eq "alarm\n";
 | 
| +        error(ngettext("%s didn't complete in %d second",
 | 
| +                       "%s didn't complete in %d seconds",
 | 
| +                       $opts{timeout}),
 | 
| +              $opts{cmdline}, $opts{timeout});
 | 
| +    }
 | 
| +    unless ($opts{nocheck}) {
 | 
| +	subprocerr($opts{cmdline}) if $?;
 | 
| +    }
 | 
| +}
 | 
| +
 | 
| +1;
 | 
| +__END__
 | 
| +
 | 
| +=back
 | 
| +
 | 
| +=head1 AUTHORS
 | 
| +
 | 
| +Written by Raphaël Hertzog <hertzog@debian.org> and
 | 
| +Frank Lichtenheld <djpig@debian.org>.
 | 
| +
 | 
| +=head1 SEE ALSO
 | 
| +
 | 
| +Dpkg, Dpkg::ErrorHandling
 | 
| 
 |