File Coverage

File:Dpkg/BuildFlags.pm
Coverage:75.8%

linestmtbrancondsubpodtimecode
1# Copyright © 2010-2011 Raphaël Hertzog <hertzog@debian.org>
2# Copyright © 2012-2022 Guillem Jover <guillem@debian.org>
3#
4# This program is free software; you can redistribute it and/or modify
5# it under the terms of the GNU General Public License as published by
6# the Free Software Foundation; either version 2 of the License, or
7# (at your option) any later version.
8#
9# This program is distributed in the hope that it will be useful,
10# but WITHOUT ANY WARRANTY; without even the implied warranty of
11# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12# GNU General Public License for more details.
13#
14# You should have received a copy of the GNU General Public License
15# along with this program.  If not, see <https://www.gnu.org/licenses/>.
16
17=encoding utf8
18
19 - 28
=head1 NAME

Dpkg::BuildFlags - query build flags

=head1 DESCRIPTION

This class is used by dpkg-buildflags and can be used
to query the same information.

=cut
29
30package Dpkg::BuildFlags 1.06;
31
32
9
9
9
28
9
190
use strict;
33
9
9
9
15
6
285
use warnings;
34
35
9
9
9
1027
10
116
use Dpkg ();
36
9
9
9
1124
13
267
use Dpkg::Gettext;
37
9
9
9
844
16
137
use Dpkg::BuildEnv;
38
9
9
9
819
8
382
use Dpkg::ErrorHandling;
39
9
9
9
1363
17
10390
use Dpkg::Vendor qw(run_vendor_hook);
40
41 - 53
=head1 METHODS

=over 4

=item $bf = Dpkg::BuildFlags->new()

Create a new Dpkg::BuildFlags object. It will be initialized based
on the value of several configuration files and environment variables.

If the option B<vendor_defaults> is set to false, then no vendor defaults are
initialized (it defaults to true).

=cut
54
55sub new {
56
81
1
160
    my ($this, %opts) = @_;
57
81
390
    my $class = ref($this) || $this;
58
59
81
91
    my $self = {
60    };
61
81
103
    bless $self, $class;
62
63
81
366
    $opts{vendor_defaults} //= 1;
64
65
81
137
    if ($opts{vendor_defaults}) {
66
81
140
        $self->load_vendor_defaults();
67    } else {
68
0
0
        $self->_init_vendor_defaults();
69    }
70
81
1057
    return $self;
71}
72
73sub _init_vendor_defaults {
74
81
83
    my $self = shift;
75
76
81
367
    my @flags = qw(
77        ASFLAGS
78        ASFLAGS_FOR_BUILD
79        CPPFLAGS
80        CPPFLAGS_FOR_BUILD
81        CFLAGS
82        CFLAGS_FOR_BUILD
83        CXXFLAGS
84        CXXFLAGS_FOR_BUILD
85        OBJCFLAGS
86        OBJCFLAGS_FOR_BUILD
87        OBJCXXFLAGS
88        OBJCXXFLAGS_FOR_BUILD
89        DFLAGS
90        DFLAGS_FOR_BUILD
91        FFLAGS
92        FFLAGS_FOR_BUILD
93        FCFLAGS
94        FCFLAGS_FOR_BUILD
95        LDFLAGS
96        LDFLAGS_FOR_BUILD
97    );
98
99
81
149
    $self->{features} = {};
100
81
113
    $self->{builtins} = {};
101
81
128
    $self->{optvals} = {};
102
81
1620
135
1734
    $self->{flags} = { map { $_ => '' } @flags };
103
81
1620
170
1347
    $self->{origin} = { map { $_ => 'vendor' } @flags };
104
81
1620
164
1318
    $self->{maintainer} = { map { $_ => 0 } @flags };
105}
106
107 - 111
=item $bf->load_vendor_defaults()

Reset the flags stored to the default set provided by the vendor.

=cut
112
113sub load_vendor_defaults {
114
81
1
88
    my $self = shift;
115
116
81
133
    $self->_init_vendor_defaults();
117
118    # The vendor hook will add the feature areas build flags.
119
81
264
    run_vendor_hook('update-buildflags', $self);
120}
121
122 - 126
=item $bf->load_system_config()

Update flags from the system configuration.

=cut
127
128sub load_system_config {
129
3
1
4
    my $self = shift;
130
131
3
5
    $self->update_from_conffile("$Dpkg::CONFDIR/buildflags.conf", 'system');
132}
133
134 - 138
=item $bf->load_user_config()

Update flags from the user configuration.

=cut
139
140sub load_user_config {
141
3
1
1
    my $self = shift;
142
143
3
3
    my $confdir = $ENV{XDG_CONFIG_HOME};
144
3
15
    $confdir ||= $ENV{HOME} . '/.config' if length $ENV{HOME};
145
3
3
    if (length $confdir) {
146
3
4
        $self->update_from_conffile("$confdir/dpkg/buildflags.conf", 'user');
147    }
148}
149
150 - 155
=item $bf->load_environment_config()

Update flags based on user directives stored in the environment. See
L<dpkg-buildflags(1)> for details.

=cut
156
157sub load_environment_config {
158
3
1
3
    my $self = shift;
159
160
3
3
1
8
    foreach my $flag (keys %{$self->{flags}}) {
161
60
30
        my $envvar = 'DEB_' . $flag . '_SET';
162
60
36
        if (Dpkg::BuildEnv::has($envvar)) {
163
0
0
            $self->set($flag, Dpkg::BuildEnv::get($envvar), 'env');
164        }
165
60
36
        $envvar = 'DEB_' . $flag . '_STRIP';
166
60
30
        if (Dpkg::BuildEnv::has($envvar)) {
167
0
0
            $self->strip($flag, Dpkg::BuildEnv::get($envvar), 'env');
168        }
169
60
28
        $envvar = 'DEB_' . $flag . '_APPEND';
170
60
35
        if (Dpkg::BuildEnv::has($envvar)) {
171
0
0
            $self->append($flag, Dpkg::BuildEnv::get($envvar), 'env');
172        }
173
60
37
        $envvar = 'DEB_' . $flag . '_PREPEND';
174
60
29
        if (Dpkg::BuildEnv::has($envvar)) {
175
0
0
            $self->prepend($flag, Dpkg::BuildEnv::get($envvar), 'env');
176        }
177    }
178}
179
180 - 185
=item $bf->load_maintainer_config()

Update flags based on maintainer directives stored in the environment. See
L<dpkg-buildflags(1)> for details.

=cut
186
187sub load_maintainer_config {
188
3
1
4
    my $self = shift;
189
190
3
3
3
5
    foreach my $flag (keys %{$self->{flags}}) {
191
60
31
        my $envvar = 'DEB_' . $flag . '_MAINT_SET';
192
60
33
        if (Dpkg::BuildEnv::has($envvar)) {
193
0
0
            $self->set($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
194        }
195
60
30
        $envvar = 'DEB_' . $flag . '_MAINT_STRIP';
196
60
38
        if (Dpkg::BuildEnv::has($envvar)) {
197
0
0
            $self->strip($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
198        }
199
60
31
        $envvar = 'DEB_' . $flag . '_MAINT_APPEND';
200
60
33
        if (Dpkg::BuildEnv::has($envvar)) {
201
0
0
            $self->append($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
202        }
203
60
34
        $envvar = 'DEB_' . $flag . '_MAINT_PREPEND';
204
60
34
        if (Dpkg::BuildEnv::has($envvar)) {
205
0
0
            $self->prepend($flag, Dpkg::BuildEnv::get($envvar), undef, 1);
206        }
207    }
208}
209
210
211 - 217
=item $bf->load_config()

Call successively load_system_config(), load_user_config(),
load_environment_config() and load_maintainer_config() to update the
default build flags defined by the vendor.

=cut
218
219sub load_config {
220
3
1
2
    my $self = shift;
221
222
3
6
    $self->load_system_config();
223
3
5
    $self->load_user_config();
224
3
3
    $self->load_environment_config();
225
3
6
    $self->load_maintainer_config();
226}
227
228 - 232
=item $bf->unset($flag)

Unset the build flag $flag, so that it will not be known anymore.

=cut
233
234sub unset {
235
0
1
0
    my ($self, $flag) = @_;
236
237
0
0
    delete $self->{flags}->{$flag};
238
0
0
    delete $self->{origin}->{$flag};
239
0
0
    delete $self->{maintainer}->{$flag};
240}
241
242 - 248
=item $bf->set($flag, $value, $source, $maint)

Update the build flag $flag with value $value and record its origin as
$source (if defined). Record it as maintainer modified if $maint is
defined and true.

=cut
249
250sub set {
251
21
1
51
    my ($self, $flag, $value, $src, $maint) = @_;
252
21
59
    $self->{flags}->{$flag} = $value;
253
21
72
    $self->{origin}->{$flag} = $src if defined $src;
254
21
45
    $self->{maintainer}->{$flag} = $maint if $maint;
255}
256
257 - 263
=item $bf->set_feature($area, $feature, $enabled)

Update the boolean state of whether a specific feature within a known
feature area has been enabled. The only currently known feature areas
are "future", "qa", "sanitize", "optimize", "hardening" and "reproducible".

=cut
264
265sub set_feature {
266
1863
1
1323
    my ($self, $area, $feature, $enabled) = @_;
267
1863
2075
    $self->{features}{$area}{$feature} = $enabled;
268}
269
270 - 277
=item $bf->get_feature($area, $feature)

Returns the value for the given feature within a known feature area.
This is relevant for builtin features where the feature has a ternary
state of true, false and undef, and where the latter cannot be retrieved
with use_feature().

=cut
278
279sub get_feature {
280
81
1
85
    my ($self, $area, $feature) = @_;
281
282
81
88
    return if ! $self->has_features($area);
283
81
121
    return $self->{features}{$area}{$feature};
284}
285
286 - 293
=item $bf->use_feature($area, $feature)

Returns true if the given feature within a known feature areas has been
enabled, and false otherwise.
The only currently recognized feature areas are "future", "qa", "sanitize",
"optimize", "hardening" and "reproducible".

=cut
294
295sub use_feature {
296
1830
1
1528
    my ($self, $area, $feature) = @_;
297
298
1830
1389
    return 0 if ! $self->has_features($area);
299
1830
2919
    return 0 if ! $self->{features}{$area}{$feature};
300
894
1300
    return 1;
301}
302
303 - 309
=item $bf->set_builtin($area, $feature, $enabled)

Update the boolean state of whether a specific feature within a known
feature area is handled (even if only in some architectures) as a builtin
default by the compiler.

=cut
310
311sub set_builtin {
312
243
1
235
    my ($self, $area, $feature, $enabled) = @_;
313
243
363
    $self->{builtins}{$area}{$feature} = $enabled;
314}
315
316 - 324
=item $bf->get_builtins($area)

Return, for the given area, a hash with keys as feature names, and values
as booleans indicating whether the feature is handled as a builtin default
by the compiler or not. Only features that might be handled as builtins on
some architectures are returned as part of the hash. Missing features mean
they are currently never handled as builtins by the compiler.

=cut
325
326sub get_builtins {
327
162
1
185
    my ($self, $area) = @_;
328
162
203
    return if ! exists $self->{builtins}{$area};
329
162
162
132
340
    return %{$self->{builtins}{$area}};
330}
331
332 - 337
=item $bf->set_option_value($option, $value)

B<Private> method to set the value of a build option.
Do not use outside of the dpkg project.

=cut
338
339sub set_option_value {
340
423
1
370
    my ($self, $option, $value) = @_;
341
342
423
580
    $self->{optvals}{$option} = $value;
343}
344
345 - 350
=item $bf->get_option_value($option)

B<Private> method to get the value of a build option.
Do not use outside of the dpkg project.

=cut
351
352sub get_option_value {
353
450
1
427
    my ($self, $option) = @_;
354
355
450
646
    return $self->{optvals}{$option};
356}
357
358 - 364
=item $bf->strip($flag, $value, $source, $maint)

Update the build flag $flag by stripping the flags listed in $value and
record its origin as $source (if defined). Record it as maintainer modified
if $maint is defined and true.

=cut
365
366sub strip {
367
21
1
47
    my ($self, $flag, $value, $src, $maint) = @_;
368
369
21
21
60
68
    my %strip = map { $_ => 1 } split /\s+/, $value;
370
371    $self->{flags}->{$flag} = join q{ }, grep {
372
66
92
        ! exists $strip{$_}
373
21
65
    } split q{ }, $self->{flags}{$flag};
374
21
45
    $self->{origin}->{$flag} = $src if defined $src;
375
21
45
    $self->{maintainer}->{$flag} = $maint if $maint;
376}
377
378 - 384
=item $bf->append($flag, $value, $source, $maint)

Append the options listed in $value to the current value of the flag $flag.
Record its origin as $source (if defined). Record it as maintainer modified
if $maint is defined and true.

=cut
385
386sub append {
387
3609
1
2910
    my ($self, $flag, $value, $src, $maint) = @_;
388
3609
3390
    if (length($self->{flags}->{$flag})) {
389
2097
2012
        $self->{flags}->{$flag} .= " $value";
390    } else {
391
1512
1187
        $self->{flags}->{$flag} = $value;
392    }
393
3609
2847
    $self->{origin}->{$flag} = $src if defined $src;
394
3609
4022
    $self->{maintainer}->{$flag} = $maint if $maint;
395}
396
397 - 403
=item $bf->prepend($flag, $value, $source, $maint)

Prepend the options listed in $value to the current value of the flag $flag.
Record its origin as $source (if defined). Record it as maintainer modified
if $maint is defined and true.

=cut
404
405sub prepend {
406
18
1
28
    my ($self, $flag, $value, $src, $maint) = @_;
407
18
29
    if (length($self->{flags}->{$flag})) {
408
18
35
        $self->{flags}->{$flag} = "$value " . $self->{flags}->{$flag};
409    } else {
410
0
0
        $self->{flags}->{$flag} = $value;
411    }
412
18
24
    $self->{origin}->{$flag} = $src if defined $src;
413
18
28
    $self->{maintainer}->{$flag} = $maint if $maint;
414}
415
416
417 - 424
=item $bf->update_from_conffile($file, $source)

Update the current build flags based on the configuration directives
contained in $file. See L<dpkg-buildflags(1)> for the format of the directives.

$source is the origin recorded for any build flag set or modified.

=cut
425
426sub update_from_conffile {
427
6
1
6
    my ($self, $file, $src) = @_;
428
6
2
    local $_;
429
430
6
25
    return unless -e $file;
431
0
0
    open(my $conf_fh, '<', $file) or syserr(g_('cannot read %s'), $file);
432
0
0
    while (<$conf_fh>) {
433
0
0
        chomp;
434
0
0
        next if /^\s*#/; # Skip comments
435
0
0
        next if /^\s*$/; # Skip empty lines
436
0
0
        if (/^(append|prepend|set|strip)\s+(\S+)\s+(\S.*\S)\s*$/i) {
437
0
0
            my ($op, $flag, $value) = ($1, $2, $3);
438
0
0
            unless (exists $self->{flags}->{$flag}) {
439
0
0
                warning(g_('line %d of %s mentions unknown flag %s'), $., $file, $flag);
440
0
0
                $self->{flags}->{$flag} = '';
441            }
442
0
0
            if (lc($op) eq 'set') {
443
0
0
                $self->set($flag, $value, $src);
444            } elsif (lc($op) eq 'strip') {
445
0
0
                $self->strip($flag, $value, $src);
446            } elsif (lc($op) eq 'append') {
447
0
0
                $self->append($flag, $value, $src);
448            } elsif (lc($op) eq 'prepend') {
449
0
0
                $self->prepend($flag, $value, $src);
450            }
451        } else {
452
0
0
            warning(g_('line %d of %s is invalid, it has been ignored'), $., $file);
453        }
454    }
455
0
0
    close($conf_fh);
456}
457
458 - 463
=item $bf->get($flag)

Return the value associated to the flag. It might be undef if the
flag doesn't exist.

=cut
464
465sub get {
466
1110
1
861
    my ($self, $key) = @_;
467
1110
1296
    return $self->{flags}{$key};
468}
469
470 - 475
=item $bf->get_feature_areas()

Return the feature areas (i.e. the area values has_features will return
true for).

=cut
476
477sub get_feature_areas {
478
3
1
2
    my $self = shift;
479
480
3
3
2
23
    return keys %{$self->{features}};
481}
482
483 - 488
=item $bf->get_features($area)

Return, for the given area, a hash with keys as feature names, and values
as booleans indicating whether the feature is enabled or not.

=cut
489
490sub get_features {
491
21
1
17
    my ($self, $area) = @_;
492
21
21
20
54
    return %{$self->{features}{$area}};
493}
494
495 - 500
=item $bf->get_origin($flag)

Return the origin associated to the flag. It might be undef if the
flag doesn't exist.

=cut
501
502sub get_origin {
503
15
1
22
    my ($self, $key) = @_;
504
15
39
    return $self->{origin}{$key};
505}
506
507 - 511
=item $bf->is_maintainer_modified($flag)

Return true if the flag is modified by the maintainer.

=cut
512
513sub is_maintainer_modified {
514
12
1
25
    my ($self, $key) = @_;
515
12
52
    return $self->{maintainer}{$key};
516}
517
518 - 524
=item $bf->has_features($area)

Returns true if the given area of features is known, and false otherwise.
The only currently recognized feature areas are "future", "qa", "sanitize",
"optimize", "hardening" and "reproducible".

=cut
525
526sub has_features {
527
1932
1
1371
    my ($self, $area) = @_;
528
1932
2108
    return exists $self->{features}{$area};
529}
530
531 - 535
=item $bf->has($option)

Returns a boolean indicating whether the flags exists in the object.

=cut
536
537sub has {
538
3
1
3
    my ($self, $key) = @_;
539
3
9
    return exists $self->{flags}{$key};
540}
541
542 - 546
=item @flags = $bf->list()

Returns the list of flags stored in the object.

=cut
547
548sub list {
549
75
1
64
    my $self = shift;
550
75
75
70
661
    my @list = sort keys %{$self->{flags}};
551
75
272
    return @list;
552}
553
554=back
555
556 - 597
=head1 CHANGES

=head2 Version 1.06 (dpkg 1.21.15)

New method: $bf->get_feature().

=head2 Version 1.05 (dpkg 1.21.14)

New option: 'vendor_defaults' in new().

New methods: $bf->load_vendor_defaults(), $bf->use_feature(),
$bf->set_builtin(), $bf->get_builtins().

=head2 Version 1.04 (dpkg 1.20.0)

New method: $bf->unset().

=head2 Version 1.03 (dpkg 1.16.5)

New method: $bf->get_feature_areas() to list possible values for
$bf->get_features.

New method $bf->is_maintainer_modified() and new optional parameter to
$bf->set(), $bf->append(), $bf->prepend(), $bf->strip().

=head2 Version 1.02 (dpkg 1.16.2)

New methods: $bf->get_features(), $bf->has_features(), $bf->set_feature().

=head2 Version 1.01 (dpkg 1.16.1)

New method: $bf->prepend() very similar to append(). Implement support of
the prepend operation everywhere.

New method: $bf->load_maintainer_config() that update the build flags
based on the package maintainer directives.

=head2 Version 1.00 (dpkg 1.15.7)

Mark the module as public.

=cut
598
5991;