diff options
Diffstat (limited to '')
| -rw-r--r-- | scripts/Dpkg/BuildDriver/DebianRules.pm | 298 |
1 files changed, 298 insertions, 0 deletions
diff --git a/scripts/Dpkg/BuildDriver/DebianRules.pm b/scripts/Dpkg/BuildDriver/DebianRules.pm new file mode 100644 index 0000000..ffc1987 --- /dev/null +++ b/scripts/Dpkg/BuildDriver/DebianRules.pm @@ -0,0 +1,298 @@ +# Copyright © 2020-2024 Guillem Jover <guillem@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/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::BuildDriver::DebianRules - build a Debian package using debian/rules + +=head1 DESCRIPTION + +This class is used by dpkg-buildpackage to drive the build of a Debian +package, using F<debian/rules>. + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dpkg::BuildDriver::DebianRules 0.01; + +use strict; +use warnings; + +use Dpkg (); +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Path qw(find_command); +use Dpkg::BuildTypes; +use Dpkg::BuildAPI qw(get_build_api); + +=head1 METHODS + +=over 4 + +=item $bd = Dpkg::BuildDriver::DebianRules->new(%opts) + +Create a new Dpkg::BuildDriver::DebianRules object. + +Supports or requires the same Dpkg::BuildDriver->new() options. + +=cut + +sub new { + my ($this, %opts) = @_; + my $class = ref($this) || $this; + + my $self = { + ctrl => $opts{ctrl}, + root_cmd => $opts{root_cmd}, + as_root => $opts{as_root}, + debian_rules => $opts{debian_rules}, + rrr_override => $opts{rrr_override}, + }; + bless $self, $class; + + my $rrr = $self->_parse_rules_requires_root(); + + $self->{rules_requires_root} = $rrr; + + return $self; +} + +sub _setup_rootcommand { + my $self = shift; + + if ($< == 0) { + warning(g_('using a gain-root-command while being root')) + if @{$self->{root_cmd}}; + } else { + push @{$self->{root_cmd}}, 'fakeroot' + unless @{$self->{root_cmd}}; + } + + if (@{$self->{root_cmd}} && ! find_command($self->{root_cmd}[0])) { + if ($self->{root_cmd}[0] eq 'fakeroot' && $< != 0) { + error(g_("fakeroot not found, either install the fakeroot\n" . + 'package, specify a command with the -r option, ' . + 'or run this as root')); + } else { + error(g_("gain-root-command '%s' not found"), $self->{root_cmd}[0]); + } + } +} + +my %target_build = map { $_ => 1 } qw( + build + build-arch + build-indep +); +my %target_legacy_root = map { $_ => 1 } qw( + clean + binary + binary-arch + binary-indep +); +my %target_official = map { $_ => 1 } qw( + clean + build + build-arch + build-indep + binary + binary-arch + binary-indep +); + +# Check whether we are doing some kind of rootless build, and sanity check +# the fields values. +sub _parse_rules_requires_root { + my $self = shift; + + my %rrr; + my $rrr; + my $rrr_default; + my $keywords_base; + my $keywords_impl; + + if (get_build_api($self->{ctrl}) >= 1) { + $rrr_default = 'no'; + } else { + $rrr_default = 'binary-targets'; + } + + my $ctrl_src = $self->{ctrl}->get_source(); + $rrr = $self->{rrr_override} // $ctrl_src->{'Rules-Requires-Root'} // $rrr_default; + + foreach my $keyword (split ' ', $rrr) { + if ($keyword =~ m{/}) { + if ($keyword =~ m{^dpkg/target/(.*)$}p and $target_official{$1}) { + error(g_('disallowed target in %s field keyword %s'), + 'Rules-Requires-Root', $keyword); + } elsif ($keyword ne 'dpkg/target-subcommand') { + error(g_('%s field keyword "%s" is unknown in dpkg namespace'), + 'Rules-Requires-Root', $keyword); + } + $keywords_impl++; + } else { + if ($keyword ne lc $keyword and + (lc $keyword eq 'no' or lc $keyword eq 'binary-targets')) { + error(g_('%s field keyword "%s" is uppercase; use "%s" instead'), + 'Rules-Requires-Root', $keyword, lc $keyword); + } elsif (lc $keyword eq 'yes') { + error(g_('%s field keyword "%s" is invalid; use "%s" instead'), + 'Rules-Requires-Root', $keyword, 'binary-targets'); + } elsif ($keyword ne 'no' and $keyword ne 'binary-targets') { + warning(g_('%s field keyword "%s" is unknown'), + 'Rules-Requires-Root', $keyword); + } + $keywords_base++; + } + + if ($rrr{$keyword}++) { + error(g_('field %s contains duplicate keyword %s'), + 'Rules-Requires-Root', $keyword); + } + } + + if ($self->{as_root} || ! exists $rrr{no}) { + $self->_setup_rootcommand(); + } + + # Notify the children we do support R³. + $ENV{DEB_RULES_REQUIRES_ROOT} = join ' ', sort keys %rrr; + + if ($keywords_base > 1 or $keywords_base and $keywords_impl) { + error(g_('%s field contains both global and implementation specific keywords'), + 'Rules-Requires-Root'); + } elsif ($keywords_impl) { + # Set only on <implementations-keywords>. + $ENV{DEB_GAIN_ROOT_CMD} = join ' ', @{$self->{root_cmd}}; + } else { + # We should not provide the variable otherwise. + delete $ENV{DEB_GAIN_ROOT_CMD}; + } + + return \%rrr; +} + +sub _rules_requires_root { + my ($self, $target) = @_; + + return 1 if $self->{as_root}; + return 1 if $self->{rules_requires_root}{"dpkg/target/$target"}; + return 1 if $self->{rules_requires_root}{'binary-targets'} and $target_legacy_root{$target}; + return 0; +} + +sub _run_cmd { + my @cmd = @_; + printcmd(@cmd); + system @cmd and subprocerr("@cmd"); +} + +sub _run_rules_cond_root { + my ($self, $target) = @_; + + my @cmd; + push @cmd, @{$self->{root_cmd}} if $self->_rules_requires_root($target); + push @cmd, @{$self->{debian_rules}}, $target; + + _run_cmd(@cmd); +} + +=item $bd->pre_check() + +Perform build driver specific checks, before anything else. + +This checks whether the F<debian/rules> file is executable, +and if not then make it so. + +=cut + +sub pre_check { + my $self = shift; + + if (@{$self->{debian_rules}} == 1 && ! -x $self->{debian_rules}[0]) { + warning(g_('%s is not executable; fixing that'), + $self->{debian_rules}[0]); + # No checks of failures, non fatal. + chmod 0755, $self->{debian_rules}[0]; + } +} + +=item $bool = $bd->need_build_task($build_task, $binary_task) + +Returns whether we need to use the build task. + +B<Note>: This method is needed as long as we support building as root-like. +Once that is not needed this method will be deprecated. + +=cut + +sub need_build_task { + my ($self, $build_task, $binary_task) = @_; + + # If we are building rootless, there is no need to call the build target + # independently as non-root. + return 0 if not $self->_rules_requires_root($binary_task); + return 1; +} + +=item $bd->run_build_task($build_task, $binary_task) + +Executes the build task for the build. + +B<Note>: This method is needed as long as we support building as root-like. +Once that is not needed this method will be deprecated. + +=cut + +sub run_build_task { + my ($self, $build_task, $binary_task) = @_; + + # If we are building rootless, there is no need to call the build + # target independently as non-root. + if ($self->_rules_requires_root($binary_task)) { + _run_cmd(@{$self->{debian_rules}}, $build_task) + } + + return; +} + +=item $bd->run_task($task) + +Executes the given task for the build. + +=cut + +sub run_task { + my ($self, $task) = @_; + + $self->_run_rules_cond_root($task); + + return; +} + +=back + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; |