CasperSecurity
| Current Path : /bin/X11/X11/ |
|
|
| Current File : //bin/X11/X11/dpkg-checkbuilddeps |
#!/usr/bin/perl
#
# dpkg-checkbuilddeps
#
# Copyright © 2001 Joey Hess <joeyh@debian.org>
# Copyright © 2006-2009, 2011-2015 Guillem Jover <guillem@debian.org>
# Copyright © 2007-2011 Raphael Hertzog <hertzog@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/>.
use strict;
use warnings;
use Getopt::Long qw(:config posix_default bundling_values no_ignorecase);
use Dpkg ();
use Dpkg::Gettext;
use Dpkg::ErrorHandling;
use Dpkg::Arch qw(get_host_arch);
use Dpkg::Vendor qw(run_vendor_hook);
use Dpkg::BuildProfiles qw(get_build_profiles set_build_profiles);
use Dpkg::Deps;
use Dpkg::Control::Info;
textdomain('dpkg-dev');
sub version()
{
printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
}
sub usage {
printf g_(
'Usage: %s [<option>...] [<control-file>]')
. "\n\n" . g_(
'Options:
-A ignore Build-Depends-Arch and Build-Conflicts-Arch.
-B ignore Build-Depends-Indep and Build-Conflicts-Indep.
-I ignore built-in build dependencies and conflicts.
-d build-deps use given string as build dependencies instead of
retrieving them from control file
-c build-conf use given string for build conflicts instead of
retrieving them from control file
-a arch assume given host architecture
-P profiles assume given build profiles (comma-separated list)
--admindir=<directory>
change the administrative directory.
-?, --help show this help message.
--version show the version.')
. "\n\n" . g_(
'<control-file> is the control file to process (default: debian/control).')
. "\n", $Dpkg::PROGNAME;
}
my $ignore_bd_arch = 0;
my $ignore_bd_indep = 0;
my $ignore_bd_builtin = 0;
my ($bd_value, $bc_value);
my $bp_value;
my $host_arch = get_host_arch();
my $admindir = $Dpkg::ADMINDIR;
my @options_spec = (
'help|?' => sub { usage(); exit(0); },
'version' => sub { version(); exit 0; },
'A' => \$ignore_bd_arch,
'B' => \$ignore_bd_indep,
'I' => \$ignore_bd_builtin,
'd=s' => \$bd_value,
'c=s' => \$bc_value,
'a=s' => \$host_arch,
'P=s' => \$bp_value,
'admindir=s' => \$admindir,
);
{
local $SIG{__WARN__} = sub { usageerr($_[0]) };
GetOptions(@options_spec);
}
# Update currently active build profiles.
set_build_profiles(split(/,/, $bp_value)) if ($bp_value);
my @build_profiles = get_build_profiles();
my $controlfile = shift // 'debian/control';
my $control = Dpkg::Control::Info->new($controlfile);
my $fields = $control->get_source();
my $facts = parse_status("$admindir/status");
unless (defined($bd_value) or defined($bc_value)) {
my @bd_list;
push @bd_list, run_vendor_hook('builtin-build-depends')
if not $ignore_bd_builtin;
push @bd_list, $fields->{'Build-Depends'};
push @bd_list, $fields->{'Build-Depends-Arch'} if not $ignore_bd_arch;
push @bd_list, $fields->{'Build-Depends-Indep'} if not $ignore_bd_indep;
$bd_value = deps_concat(@bd_list);
my @bc_list;
push @bc_list, run_vendor_hook('builtin-build-conflicts')
if not $ignore_bd_builtin;
push @bc_list, $fields->{'Build-Conflicts'};
push @bc_list, $fields->{'Build-Conflicts-Arch'} if not $ignore_bd_arch;
push @bc_list, $fields->{'Build-Conflicts-Indep'} if not $ignore_bd_indep;
$bc_value = deps_concat(@bc_list);
}
my (@unmet, @conflicts);
if ($bd_value) {
my $dep = deps_parse($bd_value, reduce_restrictions => 1,
build_dep => 1, build_profiles => \@build_profiles,
host_arch => $host_arch);
error(g_('cannot parse %s field'),
'Build-Depends/Build-Depends-Arch/Build-Depends-Indep')
unless defined $dep;
push @unmet, build_depends($dep, $facts);
}
if ($bc_value) {
my $dep = deps_parse($bc_value, reduce_restrictions => 1, union => 1,
build_dep => 1, build_profiles => \@build_profiles,
host_arch => $host_arch);
error(g_('cannot parse %s field'),
'Build-Conflicts/Build-Conflicts-Arch/Build-Conflicts-Indep')
unless defined $dep;
push @conflicts, build_conflicts($dep, $facts);
}
if (@unmet) {
errormsg(g_('Unmet build dependencies: %s'),
join(' ', map { $_->output() } @unmet));
}
if (@conflicts) {
errormsg(g_('Build conflicts: %s'),
join(' ', map { $_->output() } @conflicts));
}
exit 1 if @unmet || @conflicts;
# Silly little status file parser that returns a Dpkg::Deps::KnownFacts
sub parse_status {
my $status = shift;
my $facts = Dpkg::Deps::KnownFacts->new();
local $/ = '';
open(my $status_fh, '<', $status)
or syserr(g_('cannot open %s'), $status);
while (<$status_fh>) {
next unless /^Status: .*ok installed$/m;
my ($package) = /^Package: (.*)$/m;
my ($version) = /^Version: (.*)$/m;
my ($arch) = /^Architecture: (.*)$/m;
my ($multiarch) = /^Multi-Arch: (.*)$/m;
$facts->add_installed_package($package, $version, $arch, $multiarch);
if (/^Provides: (.*)$/m) {
my $provides = deps_parse($1, reduce_arch => 1, virtual => 1, union => 1);
next if not defined $provides;
foreach (grep { $_->isa('Dpkg::Deps::Simple') }
$provides->get_deps())
{
$facts->add_provided_package($_->{package},
$_->{relation}, $_->{version},
$package);
}
}
}
close $status_fh;
return $facts;
}
# This function checks the build dependencies passed in as the first
# parameter. If they are satisfied, returns false. If they are unsatisfied,
# a list of the unsatisfied depends is returned.
#
# Additional parameters that must be passed:
# * A reference to a hash of all "ok installed" the packages on the system,
# with the hash key being the package name, and the value being the
# installed version.
# * A reference to a hash, where the keys are package names, and the
# value is a true value iff some package installed on the system provides
# that package (all installed packages provide themselves)
#
# Optionally, the architecture the package is to be built for can be passed
# in as the 4th parameter. If not set, dpkg will be queried for the build
# architecture.
sub build_depends {
my ($dep_list, $facts) = @_;
$dep_list->simplify_deps($facts);
if ($dep_list->is_empty()) {
return ();
} else {
return $dep_list->get_deps();
}
}
# This function is exactly like build_depends(), except it
# checks for build conflicts, and returns a list of the packages
# that are installed and are conflicted with.
sub build_conflicts {
my ($dep_list, $facts) = @_;
my @conflicts = ();
foreach my $dep ($dep_list->get_deps()) {
if ($dep->get_evaluation($facts)) {
push @conflicts, $dep;
}
}
return @conflicts;
}