1#!/usr/bin/perl
2# -*- tab-width: 4; indent-tabs-mode: t; cperl-indent-level: 4 -*-
3# vim: set ai shiftwidth=4 tabstop=4 expandtab:
4#   Copyright (C) Patrick Schoenfeld
5#                 2015 Johannes Schauer Marin Rodrigues <josch@debian.org>
6#                 2017 James McCoy <jamessan@debian.org>
7#
8# This program is free software; you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation; either version 2 of the License, or
11# (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful,
14# but WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16# GNU General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License along
19# with this program; if not, write to the Free Software Foundation, Inc.,
20# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
21
22=head1 NAME
23
24build-rdeps - find packages that depend on a specific package to build (reverse build depends)
25
26=head1 SYNOPSIS
27
28B<build-rdeps> I<package>
29
30=head1 DESCRIPTION
31
32B<build-rdeps> searches for all packages that build-depend on the specified package.
33
34The default behaviour is to just `grep` for the given dependency in the
35Build-Depends field of apt's Sources files.
36
37If the package dose-extra >= 4.0 is installed, then a more complete reverse
38build dependency computation is carried out. In particular, with that package
39installed, build-rdeps will find transitive reverse dependencies, respect
40architecture and build profile restrictions, take Provides relationships,
41Conflicts, Pre-Depends, Build-Depends-Arch and versioned dependencies into
42account and correctly resolve multiarch relationships for crossbuild reverse
43dependency resolution.  (This tends to be a slow process due to the complexity
44of the package interdependencies.)
45
46=head1 OPTIONS
47
48=over 4
49
50=item B<-u>, B<--update>
51
52Run apt-get update before searching for build-depends.
53
54=item B<-s>, B<--sudo>
55
56Use sudo when running apt-get update. Has no effect if -u is omitted.
57
58=item B<--distribution>
59
60Select another distribution, which is searched for build-depends.
61
62=item B<--only-main>
63
64Ignore contrib and non-free
65
66=item B<--exclude-component>
67
68Ignore the given component (e.g. main, contrib, non-free).
69
70=item B<--origin>
71
72Restrict the search to only the specified origin (such as "Debian").
73
74=item B<-m>, B<--print-maintainer>
75
76Print the value of the maintainer field for each package.
77
78=item B<--host-arch>
79
80Explicitly set the host architecture. The default is the value of
81`dpkg-architecture -qDEB_HOST_ARCH`. This option only works if dose-extra >=
824.0 is installed.
83
84=item B<--build-arch>
85
86Explicitly set the build architecture. The default is the value of
87`dpkg-architecture -qDEB_BUILD_ARCH`. This option only works if dose-extra >=
884.0 is installed.
89
90=item B<--no-arch-all>, B<--no-arch-any>
91
92Ignore Build-Depends-Indep or Build-Depends-Arch while looking for reverse
93dependencies.
94
95=item B<--old>
96
97Force the old simple behaviour without dose-ceve support even if dose-extra >=
984.0 is installed.  (This tends to be faster.)
99
100Notice, that the old behaviour only finds direct dependencies, ignores virtual
101dependencies, does not find transitive dependencies and does not take version
102relationships, architecture restrictions, build profiles or multiarch
103relationships into account.
104
105=item B<--quiet>
106
107Don't print meta information (header, counter). Making it easier to use in
108scripts.
109
110=item B<-d>, B<--debug>
111
112Run the debug mode
113
114=item B<--help>
115
116Show the usage information.
117
118=item B<--version>
119
120Show the version information.
121
122=back
123
124=head1 REQUIREMENTS
125
126The tool requires apt Sources files to be around for the checked components.
127In the default case this means that in /var/lib/apt/lists files need to be
128around for main, contrib and non-free.
129
130In practice this means one needs to add one deb-src line for each component,
131e.g.
132
133deb-src http://<mirror>/debian <dist> main contrib non-free
134
135and run apt-get update afterwards or use the update option of this tool.
136
137=cut
138
139use warnings;
140use strict;
141use File::Basename;
142use Getopt::Long qw(:config bundling permute no_getopt_compat);
143
144use Dpkg::Control;
145use Dpkg::Vendor qw(get_current_vendor);
146
147my $progname = basename($0);
148my $version  = '1.0';
149my $use_ceve = 0;
150my $ceve_compatible;
151my $opt_debug;
152my $opt_update;
153my $opt_sudo;
154my $opt_maintainer;
155my $opt_mainonly;
156my $opt_distribution;
157my $opt_origin = 'Debian';
158my @opt_exclude_components;
159my $opt_buildarch;
160my $opt_hostarch;
161my $opt_without_ceve;
162my $opt_quiet;
163my $opt_noarchall;
164my $opt_noarchany;
165
166sub version {
167    print <<"EOT";
168This is $progname $version, from the Debian devscripts package, v. ###VERSION###
169This code is copyright by Patrick Schoenfeld, all rights reserved.
170It comes with ABSOLUTELY NO WARRANTY. You are free to redistribute this code
171under the terms of the GNU General Public License, version 2 or later.
172EOT
173    exit(0);
174}
175
176sub usage {
177    print <<"EOT";
178usage: $progname packagename
179       $progname --help
180       $progname --version
181
182Searches for all packages that build-depend on the specified package.
183
184Options:
185   -u, --update                   Run apt-get update before searching for build-depends.
186                                  (needs root privileges)
187   -s, --sudo                     Use sudo when running apt-get update
188                                  (has no effect when -u is omitted)
189   -q, --quiet                    Don't print meta information
190   -d, --debug                    Enable the debug mode
191   -m, --print-maintainer         Print the maintainer information (experimental)
192   --distribution distribution    Select a distribution to search for build-depends
193                                  (Default: unstable)
194   --origin origin                Select an origin to search for build-depends
195                                  (Default: Debian)
196   --only-main                    Ignore contrib and non-free
197   --exclude-component COMPONENT  Ignore the specified component (can be given multiple times)
198   --host-arch                    Set the host architecture (requires dose-extra >= 4.0)
199   --build-arch                   Set the build architecture (requires dose-extra >= 4.0)
200   --no-arch-all                  Ignore Build-Depends-Indep
201   --no-arch-any                  Ignore Build-Depends-Arch
202   --old                          Use the old simple reverse dependency resolution
203
204EOT
205    version;
206}
207
208sub test_ceve {
209    return $ceve_compatible if defined $ceve_compatible;
210
211    # test if the debsrc input and output format is supported by the installed
212    # ceve version
213    system('dose-ceve -T debsrc debsrc:///dev/null > /dev/null 2>&1');
214    if ($? == -1) {
215        print STDERR "DEBUG: dose-ceve cannot be executed: $!\n"
216          if ($opt_debug);
217        $ceve_compatible = 0;
218    } elsif ($? == 0) {
219        $ceve_compatible = 1;
220    } else {
221        print STDERR "DEBUG: dose-ceve is too old\n" if ($opt_debug);
222        $ceve_compatible = 0;
223    }
224    return $ceve_compatible;
225}
226
227sub is_devel_release {
228    my $ctrl = shift;
229    if (get_current_vendor() eq 'Debian') {
230        return $ctrl->{Suite} eq 'unstable' || $ctrl->{Codename} eq 'sid';
231    } else {
232        return $ctrl->{Suite} eq 'devel';
233    }
234}
235
236sub indextargets {
237    my @cmd = ('apt-get', 'indextargets', 'DefaultEnabled: yes');
238
239    if (!$use_ceve) {
240        # ceve needs both Packages and Sources
241        push(@cmd, 'Created-By: Sources');
242    }
243
244    if ($opt_origin) {
245        push(@cmd, "Origin: $opt_origin");
246    }
247
248    if ($opt_mainonly) {
249        push(@cmd, 'Component: main');
250    }
251
252    print STDERR 'DEBUG: Running ' . join(' ', map { "'$_'" } @cmd) . "\n"
253      if $opt_debug;
254    return @cmd;
255}
256
257# Gather information about the available package/source lists.
258#
259# Returns a hash reference following this structure:
260#
261# <site> => {
262#     <suite> => {
263#         <component> => {
264#             sources => $src_fname,
265#             <arch1> => $arch1_fname,
266#             ...,
267#         },
268#     },
269# ...,
270sub collect_files {
271    my %info = ();
272
273    open(my $targets, '-|', indextargets());
274
275    until (eof $targets) {
276        my $ctrl = Dpkg::Control->new(type => CTRL_UNKNOWN);
277        if (!$ctrl->parse($targets, 'apt-get indextargets')) {
278            next;
279        }
280        # Only need Sources/Packages stanzas
281        if (   $ctrl->{'Created-By'} ne 'Packages'
282            && $ctrl->{'Created-By'} ne 'Sources') {
283            next;
284        }
285
286        # In expected components
287        if (   !$opt_mainonly
288            && exists $ctrl->{Component}
289            && @opt_exclude_components) {
290            my $invalid_component = '(?:'
291              . join('|', map { "\Q$_\E" } @opt_exclude_components) . ')';
292            if ($ctrl->{Component} =~ m/$invalid_component/) {
293                next;
294            }
295        }
296
297        # And the provided distribution
298        if ($opt_distribution) {
299            if (   $ctrl->{Suite} !~ m/\Q$opt_distribution\E/
300                && $ctrl->{Codename} !~ m/\Q$opt_distribution\E/) {
301                next;
302            }
303        } elsif (!is_devel_release($ctrl)) {
304            next;
305        }
306
307        $info{ $ctrl->{Site} }{ $ctrl->{Suite} }{ $ctrl->{Component} } ||= {};
308        my $ref
309          = $info{ $ctrl->{Site} }{ $ctrl->{Suite} }{ $ctrl->{Component} };
310
311        if ($ctrl->{'Created-By'} eq 'Sources') {
312            $ref->{sources} = $ctrl->{Filename};
313            print STDERR "DEBUG: Added source file: $ctrl->{Filename}\n"
314              if $opt_debug;
315        } else {
316            $ref->{ $ctrl->{Architecture} } = $ctrl->{Filename};
317        }
318    }
319    close($targets);
320
321    return \%info;
322}
323
324sub findreversebuilddeps {
325    my ($package, $info) = @_;
326    my $count = 0;
327
328    my $source_file = $info->{sources};
329    if ($use_ceve) {
330        die "build arch undefined" if !defined $opt_buildarch;
331        die "host arch undefined"  if !defined $opt_hostarch;
332
333        my $buildarch_file = $info->{$opt_buildarch};
334        my $hostarch_file  = $info->{$opt_hostarch};
335
336        my @ceve_cmd = (
337            'dose-ceve',             '-T',
338            'debsrc',                '-r',
339            $package,                '-G',
340            'pkg',                   "--deb-native-arch=$opt_buildarch",
341            "deb://$buildarch_file", "debsrc://$source_file"
342        );
343        if ($opt_buildarch ne $opt_hostarch) {
344            push(@ceve_cmd,
345                "--deb-host-arch=$opt_hostarch",
346                "deb://$hostarch_file");
347        }
348        push(@ceve_cmd, "--deb-drop-b-d-indep") if ($opt_noarchall);
349        push(@ceve_cmd, "--deb-drop-b-d-arch")  if ($opt_noarchany);
350        my %sources;
351        print STDERR 'DEBUG: executing: ' . join(' ', @ceve_cmd)
352          if ($opt_debug);
353        open(SOURCES, '-|', @ceve_cmd);
354        while (<SOURCES>) {
355            next unless s/^Package:\s+//;
356            chomp;
357            $sources{$_} = 1;
358        }
359        for my $source (sort keys %sources) {
360            print $source;
361            if ($opt_maintainer) {
362                my $maintainer
363                  = `apt-cache showsrc $source | grep-dctrl -n -s Maintainer '' | sort -u`;
364                print " ($maintainer)";
365            }
366            print "\n";
367            $count += 1;
368        }
369    } else {
370        open(my $out, '-|', '/usr/lib/apt/apt-helper', 'cat-file',
371            $source_file)
372          or die
373"$progname: Unable to run \"apt-helper cat-file '$source_file'\": $!";
374
375        my %packages;
376        until (eof $out) {
377            my $ctrl = Dpkg::Control->new(type => CTRL_INDEX_SRC);
378            if (!$ctrl->parse($out, 'apt-helper cat-file')) {
379                next;
380            }
381            print STDERR "$ctrl\n" if ($opt_debug);
382            for my $relation (
383                qw(Build-Depends Build-Depends-Indep Build-Depends-Arch)) {
384                if (exists $ctrl->{$relation}) {
385                    if ($ctrl->{$relation}
386                        =~ m/^(.*\s)?\Q$package\E(?::[a-zA-Z0-9][a-zA-Z0-9-]*)?([\s,]|$)/
387                    ) {
388                        $packages{ $ctrl->{Package} }{Maintainer}
389                          = $ctrl->{Maintainer};
390                    }
391                }
392            }
393        }
394
395        close($out);
396
397        while (my $depending_package = each(%packages)) {
398            print $depending_package;
399            if ($opt_maintainer) {
400                print " ($packages{$depending_package}->{'Maintainer'})";
401            }
402            print "\n";
403            $count += 1;
404        }
405    }
406
407    if (!$opt_quiet) {
408        if ($count == 0) {
409            print "No reverse build-depends found for $package.\n\n";
410        } else {
411            print
412"\nFound a total of $count reverse build-depend(s) for $package.\n\n";
413        }
414    }
415}
416
417if ($#ARGV < 0) { usage; exit(0); }
418
419GetOptions(
420    "u|update"            => \$opt_update,
421    "s|sudo"              => \$opt_sudo,
422    "m|print-maintainer"  => \$opt_maintainer,
423    "distribution=s"      => \$opt_distribution,
424    "only-main"           => \$opt_mainonly,
425    "exclude-component=s" => \@opt_exclude_components,
426    "origin=s"            => \$opt_origin,
427    "host-arch=s"         => \$opt_hostarch,
428    "build-arch=s"        => \$opt_buildarch,
429    "no-arch-all"         => \$opt_noarchall,
430    "no-arch-any"         => \$opt_noarchany,
431    #   "profiles=s" => \$opt_profiles, # FIXME: add build profile support
432    #                                            once dose-ceve has a
433    #                                            --deb-profiles option
434    "old"       => \$opt_without_ceve,
435    "q|quiet"   => \$opt_quiet,
436    "d|debug"   => \$opt_debug,
437    "h|help"    => sub { usage; },
438    "v|version" => sub { version; }) or do { usage; exit 1; };
439
440my $package = shift;
441
442if (!$package) {
443    die "$progname: missing argument. expecting packagename\n";
444}
445
446print STDERR "DEBUG: Package => $package\n" if ($opt_debug);
447
448if ($opt_hostarch) {
449    if ($opt_without_ceve) {
450        die
451"$progname: the --host-arch option cannot be used together with --old\n";
452    }
453    if (test_ceve()) {
454        $use_ceve = 1;
455    } else {
456        die
457"$progname: the --host-arch option requires dose-extra >= 4.0 to be installed\n";
458    }
459}
460
461if ($opt_buildarch) {
462    if ($opt_without_ceve) {
463        die
464"$progname: the --build-arch option cannot be used together with --old\n";
465    }
466    if (test_ceve()) {
467        $use_ceve = 1;
468    } else {
469        die
470"$progname: the --build-arch option requires dose-extra >= 4.0 to be installed\n";
471    }
472}
473
474# if ceve usage has not been activated yet, check if it can be activated
475if (!$use_ceve and !$opt_without_ceve) {
476    if (test_ceve()) {
477        $use_ceve = 1;
478    } else {
479        print STDERR
480"WARNING: dose-extra >= 4.0 is not installed. Falling back to old unreliable behaviour.\n";
481    }
482}
483
484if ($use_ceve) {
485    if (system('command -v grep-dctrl >/dev/null 2>&1')) {
486        die
487"$progname: Fatal error. grep-dctrl is not available.\nPlease install the 'dctrl-tools' package.\n";
488    }
489
490    # set hostarch and buildarch if they have not been set yet
491    if (!$opt_hostarch) {
492        $opt_hostarch = `dpkg-architecture --query DEB_HOST_ARCH`;
493        chomp $opt_hostarch;
494    }
495    if (!$opt_buildarch) {
496        $opt_buildarch = `dpkg-architecture --query DEB_BUILD_ARCH`;
497        chomp $opt_buildarch;
498    }
499    print STDERR "DEBUG: running with dose-ceve resolver\n" if ($opt_debug);
500    print STDERR "DEBUG: buildarch=$opt_buildarch hostarch=$opt_hostarch\n"
501      if ($opt_debug);
502} else {
503    print STDERR "DEBUG: running with old resolver\n" if ($opt_debug);
504}
505
506if ($opt_update) {
507    print STDERR "DEBUG: Updating apt-cache before search\n" if ($opt_debug);
508    my @cmd;
509    if ($opt_sudo) {
510        print STDERR "DEBUG: Using sudo to become root\n" if ($opt_debug);
511        push(@cmd, 'sudo');
512    }
513    push(@cmd, 'apt-get', 'update');
514    system @cmd;
515}
516
517my $file_info = collect_files();
518
519if (!%{$file_info}) {
520    die
521"$progname: unable to find sources files.\nDid you forget to run apt-get update (or add --update to this command)?";
522}
523
524foreach my $site (sort keys %{$file_info}) {
525    foreach my $suite (sort keys %{ $file_info->{$site} }) {
526        foreach my $comp (qw(main contrib non-free)) {
527            if (exists $file_info->{$site}{$suite}{$comp}) {
528                if (!$opt_quiet) {
529                    print "Reverse Build-depends in ${comp}:\n";
530                    print "------------------------------\n\n";
531                }
532                findreversebuilddeps($package,
533                    $file_info->{$site}{$suite}{$comp});
534            }
535        }
536    }
537}
538
539=head1 LICENSE
540
541This code is copyright by Patrick Schoenfeld
542<schoenfeld@debian.org>, all rights reserved.
543This program comes with ABSOLUTELEY NO WARRANTY.
544You are free to redistribute this code under the terms of the
545GNU General Public License, version 2 or later.
546
547=head1 AUTHOR
548
549Patrick Schoenfeld <schoenfeld@debian.org>
550
551=cut
552