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