mdw@git.distorted.org.uk Git - dpkg/blob - scripts/dpkg-checkbuilddeps.pl

   1 #!/usr/bin/perl
   2 #
   3 # dpkg-checkbuilddeps
   4 #
   5 # Copyright © 2001 Joey Hess <joeyh@debian.org>
   6 # Copyright © 2006-2009, 2011-2015 Guillem Jover <guillem@debian.org>
   7 # Copyright © 2007-2011 Raphael Hertzog <hertzog@debian.org>
   8 #
   9 # This program is free software; you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 2 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  21
  22 use strict;
  23 use warnings;
  24
  25 use Getopt::Long qw(:config posix_default bundling no_ignorecase);
  26
  27 use Dpkg ();
  28 use Dpkg::Gettext;
  29 use Dpkg::ErrorHandling;
  30 use Dpkg::Arch qw(get_host_arch);
  31 use Dpkg::Vendor qw(run_vendor_hook);
  32 use Dpkg::BuildProfiles qw(get_build_profiles set_build_profiles);
  33 use Dpkg::Deps;
  34 use Dpkg::Control::Info;
  35
  36 textdomain('dpkg-dev');
  37
  38 sub version()
  39 {
  40     printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
  41 }
  42
  43 sub usage {
  44     printf g_(
  45 'Usage: %s [<option>...] [<control-file>]')
  46     . "\n\n" . g_(
  47 'Options:
  48   -A             ignore Build-Depends-Arch and Build-Conflicts-Arch.
  49   -B             ignore Build-Depends-Indep and Build-Conflicts-Indep.
  50   -I             ignore built-in build dependencies and conflicts.
  51   -d build-deps  use given string as build dependencies instead of
  52                  retrieving them from control file
  53   -c build-conf  use given string for build conflicts instead of
  54                  retrieving them from control file
  55   -a arch        assume given host architecture
  56   -P profiles    assume given build profiles (comma-separated list)
  57   --admindir=<directory>
  58                  change the administrative directory.
  59   -?, --help     show this help message.
  60       --version  show the version.')
  61     . "\n\n" . g_(
  62 '<control-file> is the control file to process (default: debian/control).')
  63         . "\n", $Dpkg::PROGNAME;
  64 }
  65
  66 my $ignore_bd_arch = 0;
  67 my $ignore_bd_indep = 0;
  68 my $ignore_bd_builtin = 0;
  69 my ($bd_value, $bc_value);
  70 my $bp_value;
  71 my $host_arch = get_host_arch();
  72 my $admindir = $Dpkg::ADMINDIR;
  73 my @options_spec = (
  74     'help|?' => sub { usage(); exit(0); },
  75     'version' => sub { version(); exit 0; },
  76     'A' => \$ignore_bd_arch,
  77     'B' => \$ignore_bd_indep,
  78     'I' => \$ignore_bd_builtin,
  79     'd=s' => \$bd_value,
  80     'c=s' => \$bc_value,
  81     'a=s' => \$host_arch,
  82     'P=s' => \$bp_value,
  83     'admindir=s' => \$admindir,
  84 );
  85
  86 {
  87     local $SIG{__WARN__} = sub { usageerr($_[0]) };
  88     GetOptions(@options_spec);
  89 }
  90
  91 # Update currently active build profiles.
  92 set_build_profiles(split(/,/, $bp_value)) if ($bp_value);
  93 my @build_profiles = get_build_profiles();
  94
  95 my $controlfile = shift // 'debian/control';
  96
  97 my $control = Dpkg::Control::Info->new($controlfile);
  98 my $fields = $control->get_source();
  99
 100 my $facts = parse_status("$admindir/status");
 101
 102 unless (defined($bd_value) or defined($bc_value)) {
 103     my @bd_list;
 104     push @bd_list, run_vendor_hook('builtin-build-depends')
 105         if not $ignore_bd_builtin;
 106     push @bd_list, $fields->{'Build-Depends'};
 107     push @bd_list, $fields->{'Build-Depends-Arch'} if not $ignore_bd_arch;
 108     push @bd_list, $fields->{'Build-Depends-Indep'} if not $ignore_bd_indep;
 109     $bd_value = deps_concat(@bd_list);
 110
 111     my @bc_list;
 112     push @bc_list, run_vendor_hook('builtin-build-conflicts')
 113         if not $ignore_bd_builtin;
 114     push @bc_list, $fields->{'Build-Conflicts'};
 115     push @bc_list, $fields->{'Build-Conflicts-Arch'} if not $ignore_bd_arch;
 116     push @bc_list, $fields->{'Build-Conflicts-Indep'} if not $ignore_bd_indep;
 117     $bc_value = deps_concat(@bc_list);
 118 }
 119 my (@unmet, @conflicts);
 120
 121 if ($bd_value) {
 122     my $dep = deps_parse($bd_value, reduce_restrictions => 1,
 123                          build_dep => 1, build_profiles => \@build_profiles,
 124                          host_arch => $host_arch);
 125     error(g_('error occurred while parsing %s'),
 126           'Build-Depends/Build-Depends-Arch/Build-Depends-Indep')
 127         unless defined $dep;
 128     push @unmet, build_depends($dep, $facts);
 129 }
 130 if ($bc_value) {
 131     my $dep = deps_parse($bc_value, reduce_restrictions => 1, union => 1,
 132                          build_dep => 1, build_profiles => \@build_profiles,
 133                          host_arch => $host_arch);
 134     error(g_('error occurred while parsing %s'),
 135           'Build-Conflicts/Build-Conflicts-Arch/Build-Conflicts-Indep')
 136         unless defined $dep;
 137     push @conflicts, build_conflicts($dep, $facts);
 138 }
 139
 140 if (@unmet) {
 141         errormsg(g_('Unmet build dependencies: %s'),
 142                  join(' ', map { $_->output() } @unmet));
 143 }
 144 if (@conflicts) {
 145         errormsg(g_('Build conflicts: %s'),
 146                  join(' ', map { $_->output() } @conflicts));
 147 }
 148 exit 1 if @unmet || @conflicts;
 149
 150 # Silly little status file parser that returns a Dpkg::Deps::KnownFacts
 151 sub parse_status {
 152         my $status = shift;
 153
 154         my $facts = Dpkg::Deps::KnownFacts->new();
 155         local $/ = '';
 156         open(my $status_fh, '<', $status)
 157                 or syserr(g_('cannot open %s'), $status);
 158         while (<$status_fh>) {
 159                 next unless /^Status: .*ok installed$/m;
 160
 161                 my ($package) = /^Package: (.*)$/m;
 162                 my ($version) = /^Version: (.*)$/m;
 163                 my ($arch) = /^Architecture: (.*)$/m;
 164                 my ($multiarch) = /^Multi-Arch: (.*)$/m;
 165                 $facts->add_installed_package($package, $version, $arch,
 166                                               $multiarch);
 167
 168                 if (/^Provides: (.*)$/m) {
 169                         my $provides = deps_parse($1, reduce_arch => 1, union => 1);
 170                         next if not defined $provides;
 171                         foreach (grep { $_->isa('Dpkg::Deps::Simple') }
 172                                  $provides->get_deps())
 173                         {
 174                                 $facts->add_provided_package($_->{package},
 175                                     $_->{relation}, $_->{version},
 176                                     $package);
 177                         }
 178                 }
 179         }
 180         close $status_fh;
 181
 182         return $facts;
 183 }
 184
 185 # This function checks the build dependencies passed in as the first
 186 # parameter. If they are satisfied, returns false. If they are unsatisfied,
 187 # an list of the unsatisfied depends is returned.
 188 #
 189 # Additional parameters that must be passed:
 190 # * A reference to a hash of all "ok installed" the packages on the system,
 191 #   with the hash key being the package name, and the value being the
 192 #   installed version.
 193 # * A reference to a hash, where the keys are package names, and the
 194 #   value is a true value iff some package installed on the system provides
 195 #   that package (all installed packages provide themselves)
 196 #
 197 # Optionally, the architecture the package is to be built for can be passed
 198 # in as the 4th parameter. If not set, dpkg will be queried for the build
 199 # architecture.
 200 sub build_depends {
 201     my ($dep_list, $facts) = @_;
 202
 203     $dep_list->simplify_deps($facts);
 204     if ($dep_list->is_empty()) {
 205         return ();
 206     } else {
 207         return $dep_list->get_deps();
 208     }
 209 }
 210
 211 # This function is exactly like build_depends(), except it
 212 # checks for build conflicts, and returns a list of the packages
 213 # that are installed and are conflicted with.
 214 sub build_conflicts {
 215     my ($dep_list, $facts) = @_;
 216
 217     my @conflicts = ();
 218     foreach my $dep ($dep_list->get_deps()) {
 219         if ($dep->get_evaluation($facts)) {
 220             push @conflicts, $dep;
 221         }
 222     }
 223     return @conflicts;
 224 }