chiark - git - mdw - dpkg/blob - scripts/Dpkg/BuildFlags.pm

   1 # Copyright © 2010-2011 Raphaël Hertzog <hertzog@debian.org>
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
  15
  16 package Dpkg::BuildFlags;
  17
  18 use strict;
  19 use warnings;
  20
  21 our $VERSION = '1.03';
  22
  23 use Dpkg ();
  24 use Dpkg::Gettext;
  25 use Dpkg::Build::Env;
  26 use Dpkg::BuildOptions;
  27 use Dpkg::ErrorHandling;
  28 use Dpkg::Vendor qw(run_vendor_hook);
  29
  30 =encoding utf8
  31
  32 =head1 NAME
  33
  34 Dpkg::BuildFlags - query build flags
  35
  36 =head1 DESCRIPTION
  37
  38 The Dpkg::BuildFlags object is used by dpkg-buildflags and can be used
  39 to query the same information.
  40
  41 =head1 METHODS
  42
  43 =over 4
  44
  45 =item $bf = Dpkg::BuildFlags->new()
  46
  47 Create a new Dpkg::BuildFlags object. It will be initialized based
  48 on the value of several configuration files and environment variables.
  49
  50 =cut
  51
  52 sub new {
  53     my ($this, %opts) = @_;
  54     my $class = ref($this) || $this;
  55
  56     my $self = {
  57     };
  58     bless $self, $class;
  59     $self->load_vendor_defaults();
  60     return $self;
  61 }
  62
  63 =item $bf->load_vendor_defaults()
  64
  65 Reset the flags stored to the default set provided by the vendor.
  66
  67 =cut
  68
  69 sub load_vendor_defaults {
  70     my $self = shift;
  71
  72     $self->{options} = {};
  73     $self->{source} = {};
  74     $self->{features} = {};
  75     my $build_opts = Dpkg::BuildOptions->new();
  76     $self->{build_options} = $build_opts;
  77     my $default_flags = $build_opts->has('noopt') ? '-g -O0' : '-g -O2';
  78     $self->{flags} = {
  79         CPPFLAGS => '',
  80         CFLAGS   => $default_flags,
  81         CXXFLAGS => $default_flags,
  82         OBJCFLAGS   => $default_flags,
  83         OBJCXXFLAGS => $default_flags,
  84         GCJFLAGS => $default_flags,
  85         FFLAGS   => $default_flags,
  86         FCFLAGS  => $default_flags,
  87         LDFLAGS  => '',
  88     };
  89     $self->{origin} = {
  90         CPPFLAGS => 'vendor',
  91         CFLAGS   => 'vendor',
  92         CXXFLAGS => 'vendor',
  93         OBJCFLAGS   => 'vendor',
  94         OBJCXXFLAGS => 'vendor',
  95         GCJFLAGS => 'vendor',
  96         FFLAGS   => 'vendor',
  97         FCFLAGS  => 'vendor',
  98         LDFLAGS  => 'vendor',
  99     };
 100     $self->{maintainer} = {
 101         CPPFLAGS => 0,
 102         CFLAGS   => 0,
 103         CXXFLAGS => 0,
 104         OBJCFLAGS   => 0,
 105         OBJCXXFLAGS => 0,
 106         GCJFLAGS => 0,
 107         FFLAGS   => 0,
 108         FCFLAGS  => 0,
 109         LDFLAGS  => 0,
 110     };
 111     # The vendor hook will add the feature areas build flags.
 112     run_vendor_hook('update-buildflags', $self);
 113 }
 114
 115 =item $bf->load_system_config()
 116
 117 Update flags from the system configuration.
 118
 119 =cut
 120
 121 sub load_system_config {
 122     my $self = shift;
 123
 124     $self->update_from_conffile("$Dpkg::CONFDIR/buildflags.conf", 'system');
 125 }
 126
 127 =item $bf->load_user_config()
 128
 129 Update flags from the user configuration.
 130
 131 =cut
 132
 133 sub load_user_config {
 134     my $self = shift;
 135
 136     my $confdir = $ENV{XDG_CONFIG_HOME};
 137     $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME};
 138     if (length $confdir) {
 139         $self->update_from_conffile("$confdir/dpkg/buildflags.conf", 'user');
 140     }
 141 }
 142
 143 =item $bf->load_environment_config()
 144
 145 Update flags based on user directives stored in the environment. See
 146 dpkg-buildflags(1) for details.
 147
 148 =cut
 149
 150 sub load_environment_config {
 151     my $self = shift;
 152
 153     foreach my $flag (keys %{$self->{flags}}) {
 154         my $envvar = 'DEB_' . $flag . '_SET';
 155         if (Dpkg::Build::Env::has($envvar)) {
 156             $self->set($flag, Dpkg::Build::Env::get($envvar), 'env');
 157         }
 158         $envvar = 'DEB_' . $flag . '_STRIP';
 159         if (Dpkg::Build::Env::has($envvar)) {
 160             $self->strip($flag, Dpkg::Build::Env::get($envvar), 'env');
 161         }
 162         $envvar = 'DEB_' . $flag . '_APPEND';
 163         if (Dpkg::Build::Env::has($envvar)) {
 164             $self->append($flag, Dpkg::Build::Env::get($envvar), 'env');
 165         }
 166         $envvar = 'DEB_' . $flag . '_PREPEND';
 167         if (Dpkg::Build::Env::has($envvar)) {
 168             $self->prepend($flag, Dpkg::Build::Env::get($envvar), 'env');
 169         }
 170     }
 171 }
 172
 173 =item $bf->load_maintainer_config()
 174
 175 Update flags based on maintainer directives stored in the environment. See
 176 dpkg-buildflags(1) for details.
 177
 178 =cut
 179
 180 sub load_maintainer_config {
 181     my $self = shift;
 182
 183     foreach my $flag (keys %{$self->{flags}}) {
 184         my $envvar = 'DEB_' . $flag . '_MAINT_SET';
 185         if (Dpkg::Build::Env::has($envvar)) {
 186             $self->set($flag, Dpkg::Build::Env::get($envvar), undef, 1);
 187         }
 188         $envvar = 'DEB_' . $flag . '_MAINT_STRIP';
 189         if (Dpkg::Build::Env::has($envvar)) {
 190             $self->strip($flag, Dpkg::Build::Env::get($envvar), undef, 1);
 191         }
 192         $envvar = 'DEB_' . $flag . '_MAINT_APPEND';
 193         if (Dpkg::Build::Env::has($envvar)) {
 194             $self->append($flag, Dpkg::Build::Env::get($envvar), undef, 1);
 195         }
 196         $envvar = 'DEB_' . $flag . '_MAINT_PREPEND';
 197         if (Dpkg::Build::Env::has($envvar)) {
 198             $self->prepend($flag, Dpkg::Build::Env::get($envvar), undef, 1);
 199         }
 200     }
 201 }
 202
 203
 204 =item $bf->load_config()
 205
 206 Call successively load_system_config(), load_user_config(),
 207 load_environment_config() and load_maintainer_config() to update the
 208 default build flags defined by the vendor.
 209
 210 =cut
 211
 212 sub load_config {
 213     my $self = shift;
 214
 215     $self->load_system_config();
 216     $self->load_user_config();
 217     $self->load_environment_config();
 218     $self->load_maintainer_config();
 219 }
 220
 221 =item $bf->set($flag, $value, $source, $maint)
 222
 223 Update the build flag $flag with value $value and record its origin as
 224 $source (if defined). Record it as maintainer modified if $maint is
 225 defined and true.
 226
 227 =cut
 228
 229 sub set {
 230     my ($self, $flag, $value, $src, $maint) = @_;
 231     $self->{flags}->{$flag} = $value;
 232     $self->{origin}->{$flag} = $src if defined $src;
 233     $self->{maintainer}->{$flag} = $maint if $maint;
 234 }
 235
 236 =item $bf->set_feature($area, $feature, $enabled)
 237
 238 Update the boolean state of whether a specific feature within a known
 239 feature area has been enabled. The only currently known feature areas
 240 are "qa", "sanitize", "hardening" and "reproducible".
 241
 242 =cut
 243
 244 sub set_feature {
 245     my ($self, $area, $feature, $enabled) = @_;
 246     $self->{features}{$area}{$feature} = $enabled;
 247 }
 248
 249 =item $bf->strip($flag, $value, $source, $maint)
 250
 251 Update the build flag $flag by stripping the flags listed in $value and
 252 record its origin as $source (if defined). Record it as maintainer modified
 253 if $maint is defined and true.
 254
 255 =cut
 256
 257 sub strip {
 258     my ($self, $flag, $value, $src, $maint) = @_;
 259     foreach my $tostrip (split(/\s+/, $value)) {
 260         next unless length $tostrip;
 261         $self->{flags}->{$flag} =~ s/(^|\s+)\Q$tostrip\E(\s+|$)/ /g;
 262     }
 263     $self->{flags}->{$flag} =~ s/^\s+//g;
 264     $self->{flags}->{$flag} =~ s/\s+$//g;
 265     $self->{origin}->{$flag} = $src if defined $src;
 266     $self->{maintainer}->{$flag} = $maint if $maint;
 267 }
 268
 269 =item $bf->append($flag, $value, $source, $maint)
 270
 271 Append the options listed in $value to the current value of the flag $flag.
 272 Record its origin as $source (if defined). Record it as maintainer modified
 273 if $maint is defined and true.
 274
 275 =cut
 276
 277 sub append {
 278     my ($self, $flag, $value, $src, $maint) = @_;
 279     if (length($self->{flags}->{$flag})) {
 280         $self->{flags}->{$flag} .= " $value";
 281     } else {
 282         $self->{flags}->{$flag} = $value;
 283     }
 284     $self->{origin}->{$flag} = $src if defined $src;
 285     $self->{maintainer}->{$flag} = $maint if $maint;
 286 }
 287
 288 =item $bf->prepend($flag, $value, $source, $maint)
 289
 290 Prepend the options listed in $value to the current value of the flag $flag.
 291 Record its origin as $source (if defined). Record it as maintainer modified
 292 if $maint is defined and true.
 293
 294 =cut
 295
 296 sub prepend {
 297     my ($self, $flag, $value, $src, $maint) = @_;
 298     if (length($self->{flags}->{$flag})) {
 299         $self->{flags}->{$flag} = "$value " . $self->{flags}->{$flag};
 300     } else {
 301         $self->{flags}->{$flag} = $value;
 302     }
 303     $self->{origin}->{$flag} = $src if defined $src;
 304     $self->{maintainer}->{$flag} = $maint if $maint;
 305 }
 306
 307
 308 =item $bf->update_from_conffile($file, $source)
 309
 310 Update the current build flags based on the configuration directives
 311 contained in $file. See dpkg-buildflags(1) for the format of the directives.
 312
 313 $source is the origin recorded for any build flag set or modified.
 314
 315 =cut
 316
 317 sub update_from_conffile {
 318     my ($self, $file, $src) = @_;
 319     local $_;
 320
 321     return unless -e $file;
 322     open(my $conf_fh, '<', $file) or syserr(g_('cannot read %s'), $file);
 323     while (<$conf_fh>) {
 324         chomp;
 325         next if /^\s*#/; # Skip comments
 326         next if /^\s*$/; # Skip empty lines
 327         if (/^(append|prepend|set|strip)\s+(\S+)\s+(\S.*\S)\s*$/i) {
 328             my ($op, $flag, $value) = ($1, $2, $3);
 329             unless (exists $self->{flags}->{$flag}) {
 330                 warning(g_('line %d of %s mentions unknown flag %s'), $., $file, $flag);
 331                 $self->{flags}->{$flag} = '';
 332             }
 333             if (lc($op) eq 'set') {
 334                 $self->set($flag, $value, $src);
 335             } elsif (lc($op) eq 'strip') {
 336                 $self->strip($flag, $value, $src);
 337             } elsif (lc($op) eq 'append') {
 338                 $self->append($flag, $value, $src);
 339             } elsif (lc($op) eq 'prepend') {
 340                 $self->prepend($flag, $value, $src);
 341             }
 342         } else {
 343             warning(g_('line %d of %s is invalid, it has been ignored'), $., $file);
 344         }
 345     }
 346     close($conf_fh);
 347 }
 348
 349 =item $bf->get($flag)
 350
 351 Return the value associated to the flag. It might be undef if the
 352 flag doesn't exist.
 353
 354 =cut
 355
 356 sub get {
 357     my ($self, $key) = @_;
 358     return $self->{flags}{$key};
 359 }
 360
 361 =item $bf->get_feature_areas()
 362
 363 Return the feature areas (i.e. the area values has_features will return
 364 true for).
 365
 366 =cut
 367
 368 sub get_feature_areas {
 369     my $self = shift;
 370
 371     return keys %{$self->{features}};
 372 }
 373
 374 =item $bf->get_features($area)
 375
 376 Return, for the given area, a hash with keys as feature names, and values
 377 as booleans indicating whether the feature is enabled or not.
 378
 379 =cut
 380
 381 sub get_features {
 382     my ($self, $area) = @_;
 383     return %{$self->{features}{$area}};
 384 }
 385
 386 =item $bf->get_origin($flag)
 387
 388 Return the origin associated to the flag. It might be undef if the
 389 flag doesn't exist.
 390
 391 =cut
 392
 393 sub get_origin {
 394     my ($self, $key) = @_;
 395     return $self->{origin}{$key};
 396 }
 397
 398 =item $bf->is_maintainer_modified($flag)
 399
 400 Return true if the flag is modified by the maintainer.
 401
 402 =cut
 403
 404 sub is_maintainer_modified {
 405     my ($self, $key) = @_;
 406     return $self->{maintainer}{$key};
 407 }
 408
 409 =item $bf->has_features($area)
 410
 411 Returns true if the given area of features is known, and false otherwise.
 412 The only currently recognized feature areas are "qa", "sanitize", "hardening"
 413 and "reproducible".
 414
 415 =cut
 416
 417 sub has_features {
 418     my ($self, $area) = @_;
 419     return exists $self->{features}{$area};
 420 }
 421
 422 =item $bf->has($option)
 423
 424 Returns a boolean indicating whether the flags exists in the object.
 425
 426 =cut
 427
 428 sub has {
 429     my ($self, $key) = @_;
 430     return exists $self->{flags}{$key};
 431 }
 432
 433 =item @flags = $bf->list()
 434
 435 Returns the list of flags stored in the object.
 436
 437 =cut
 438
 439 sub list {
 440     my $self = shift;
 441     my @list = sort keys %{$self->{flags}};
 442     return @list;
 443 }
 444
 445 =back
 446
 447 =head1 CHANGES
 448
 449 =head2 Version 1.03 (dpkg 1.16.5)
 450
 451 New method: $bf->get_feature_areas() to list possible values for
 452 $bf->get_features.
 453
 454 New method $bf->is_maintainer_modified() and new optional parameter to
 455 $bf->set(), $bf->append(), $bf->prepend(), $bf->strip().
 456
 457 =head2 Version 1.02 (dpkg 1.16.2)
 458
 459 New methods: $bf->get_features(), $bf->has_features(), $bf->set_feature().
 460
 461 =head2 Version 1.01 (dpkg 1.16.1)
 462
 463 New method: $bf->prepend() very similar to append(). Implement support of
 464 the prepend operation everywhere.
 465
 466 New method: $bf->load_maintainer_config() that update the build flags
 467 based on the package maintainer directives.
 468
 469 =head2 Version 1.00 (dpkg 1.15.7)
 470
 471 Mark the module as public.
 472
 473 =cut
 474
 475 1;