File Coverage

File:Dpkg/Deps/Simple.pm
Coverage:70.2%

linestmtbrancondsubpodtimecode
1# Copyright © 1998 Richard Braakman
2# Copyright © 1999 Darren Benham
3# Copyright © 2000 Sean 'Shaleh' Perry
4# Copyright © 2004 Frank Lichtenheld
5# Copyright © 2006 Russ Allbery
6# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org>
7# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org>
8#
9# This program is free software; you may redistribute it and/or modify
10# it under the terms of the GNU General Public License as published by
11# the Free Software Foundation; either version 2 of the License, or
12# (at your option) any later version.
13#
14# This is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17# GNU General Public License for more details.
18#
19# You should have received a copy of the GNU General Public License
20# along with this program.  If not, see <https://www.gnu.org/licenses/>.
21
22package Dpkg::Deps::Simple;
23
24=encoding utf8
25
26 - 75
=head1 NAME

Dpkg::Deps::Simple - represents a single dependency statement

=head1 DESCRIPTION

This class represents a single dependency statement.
It has several interesting properties:

=over 4

=item package

The package name (can be undef if the dependency has not been initialized
or if the simplification of the dependency lead to its removal).

=item relation

The relational operator: "=", "<<", "<=", ">=" or ">>". It can be
undefined if the dependency had no version restriction. In that case the
following field is also undefined.

=item version

The version.

=item arches

The list of architectures where this dependency is applicable. It is
undefined when there's no restriction, otherwise it is an
array ref. It can contain an exclusion list, in that case each
architecture is prefixed with an exclamation mark.

=item archqual

The arch qualifier of the dependency (can be undef if there is none).
In the dependency "python:any (>= 2.6)", the arch qualifier is "any".

=item restrictions

The restrictions formula for this dependency. It is undefined when there
is no restriction formula. Otherwise it is an array ref.

=back

=head1 METHODS

=over 4

=cut
76
77
1
1
1
3
0
12
use strict;
78
1
1
1
1
1
19
use warnings;
79
80our $VERSION = '1.02';
81
82
1
1
1
2
1
25
use Carp;
83
84
1
1
1
1
1
18
use Dpkg::Arch qw(debarch_is_concerned debarch_list_parse);
85
1
1
1
2
1
15
use Dpkg::BuildProfiles qw(parse_build_profiles evaluate_restriction_formula);
86
1
1
1
2
0
25
use Dpkg::Version;
87
1
1
1
2
0
22
use Dpkg::ErrorHandling;
88
1
1
1
2
0
19
use Dpkg::Gettext;
89
90
1
1
1
1
1
1
use parent qw(Dpkg::Interface::Storable);
91
92 - 118
=item $dep = Dpkg::Deps::Simple->new([$dep[, %opts]]);

Creates a new object. Some options can be set through %opts:

=over

=item host_arch

Sets the host architecture.

=item build_arch

Sets the build architecture.

=item build_dep

Specifies whether the parser should consider it a build dependency.
Defaults to 0.

=item tests_dep

Specifies whether the parser should consider it a tests dependency.
Defaults to 0.

=back

=cut
119
120sub new {
121
254
1
237
    my ($this, $arg, %opts) = @_;
122
254
346
    my $class = ref($this) || $this;
123
254
143
    my $self = {};
124
125
254
166
    bless $self, $class;
126
254
191
    $self->reset();
127
254
158
    $self->{host_arch} = $opts{host_arch};
128
254
137
    $self->{build_arch} = $opts{build_arch};
129
254
194
    $self->{build_dep} = $opts{build_dep} // 0;
130
254
190
    $self->{tests_dep} = $opts{tests_dep} // 0;
131
254
247
    $self->parse_string($arg) if defined $arg;
132
254
234
    return $self;
133}
134
135 - 140
=item $dep->reset()

Clears any dependency information stored in $dep so that $dep->is_empty()
returns true.

=cut
141
142sub reset {
143
318
1
147
    my $self = shift;
144
145
318
239
    $self->{package} = undef;
146
318
163
    $self->{relation} = undef;
147
318
179
    $self->{version} = undef;
148
318
160
    $self->{arches} = undef;
149
318
168
    $self->{archqual} = undef;
150
318
247
    $self->{restrictions} = undef;
151}
152
153 - 158
=item $dep->parse_string($dep_string)

Parses the dependency string and modifies internal properties to match the
parsed dependency.

=cut
159
160sub parse_string {
161
254
1
148
    my ($self, $dep) = @_;
162
163
254
123
    my $pkgname_re;
164
254
164
    if ($self->{tests_dep}) {
165
3
3
        $pkgname_re = qr/[\@a-zA-Z0-9][\@a-zA-Z0-9+.-]*/;
166    } else {
167
251
223
        $pkgname_re = qr/[a-zA-Z0-9][a-zA-Z0-9+.-]*/;
168    }
169
170
254
1121
    return if not $dep =~
171           m{^\s*                           # skip leading whitespace
172              ($pkgname_re)                 # package name
173              (?:                           # start of optional part
174                :                           # colon for architecture
175                ([a-zA-Z0-9][a-zA-Z0-9-]*)  # architecture name
176              )?                            # end of optional part
177              (?:                           # start of optional part
178                \s* \(                      # open parenthesis for version part
179                \s* (<<|<=|=|>=|>>|[<>])    # relation part
180                \s* ([^\)\s]+)              # do not attempt to parse version
181                \s* \)                      # closing parenthesis
182              )?                            # end of optional part
183              (?:                           # start of optional architecture
184                \s* \[                      # open bracket for architecture
185                \s* ([^\]]+)                # don't parse architectures now
186                \s* \]                      # closing bracket
187              )?                            # end of optional architecture
188              (
189                (?:                         # start of optional restriction
190                \s* <                       # open bracket for restriction
191                \s* [^>]+                   # do not parse restrictions now
192                \s* >                       # closing bracket
193                )+
194              )?                            # end of optional restriction
195              \s*$                          # trailing spaces at end
196            }x;
197
250
224
    if (defined $2) {
198
18
20
        return if $2 eq 'native' and not $self->{build_dep};
199
18
12
        $self->{archqual} = $2;
200    }
201
250
173
    $self->{package} = $1;
202
250
227
    $self->{relation} = version_normalize_relation($3) if defined $3;
203
250
179
    if (defined $4) {
204
46
39
        $self->{version} = Dpkg::Version->new($4);
205    }
206
250
181
    if (defined $5) {
207
10
12
        $self->{arches} = [ debarch_list_parse($5) ];
208    }
209
250
231
    if (defined $6) {
210
134
104
        $self->{restrictions} = [ parse_build_profiles($6) ];
211    }
212}
213
214 - 218
=item $dep->parse($fh, $desc)

Parse a dependency line from a filehandle.

=cut
219
220sub parse {
221
0
1
0
    my ($self, $fh, $desc) = @_;
222
223
0
0
    my $line = <$fh>;
224
0
0
    chomp $line;
225
0
0
    return $self->parse_string($line);
226}
227
228 - 239
=item $dep->load($filename)

Parse a dependency line from $filename.

=item $dep->output([$fh])

=item "$dep"

Returns a string representing the dependency. If $fh is set, it prints
the string to the filehandle.

=cut
240
241sub output {
242
141
1
74
    my ($self, $fh) = @_;
243
244
141
79
    my $res = $self->{package};
245
141
99
    if (defined $self->{archqual}) {
246
10
7
        $res .= ':' . $self->{archqual};
247    }
248
141
95
    if (defined $self->{relation}) {
249
30
40
        $res .= ' (' . $self->{relation} . ' ' . $self->{version} .  ')';
250    }
251
141
79
    if (defined $self->{arches}) {
252
1
1
1
1
        $res .= ' [' . join(' ', @{$self->{arches}}) . ']';
253    }
254
141
94
    if (defined $self->{restrictions}) {
255
7
7
3
5
        for my $restrlist (@{$self->{restrictions}}) {
256
10
10
6
10
            $res .= ' <' . join(' ', @{$restrlist}) . '>';
257        }
258    }
259
141
82
    if (defined $fh) {
260
0
0
0
0
        print { $fh } $res;
261    }
262
141
125
    return $res;
263}
264
265 - 269
=item $dep->save($filename)

Save the dependency into the given $filename.

=cut
270
271# _arch_is_superset(\@p, \@q)
272#
273# Returns true if the arch list @p is a superset of arch list @q.
274# The arguments can also be undef in case there's no explicit architecture
275# restriction.
276sub _arch_is_superset {
277
70
43
    my ($p, $q) = @_;
278
70
51
    my $p_arch_neg = defined $p and $p->[0] =~ /^!/;
279
70
53
    my $q_arch_neg = defined $q and $q->[0] =~ /^!/;
280
281    # If "p" has no arches, it is a superset of q and we should fall through
282    # to the version check.
283
70
46
    if (not defined $p) {
284
70
57
        return 1;
285    }
286    # If q has no arches, it is a superset of p and there are no useful
287    # implications.
288    elsif (not defined $q) {
289
0
0
        return 0;
290    }
291    # Both have arches.  If neither are negated, we know nothing useful
292    # unless q is a subset of p.
293    elsif (not $p_arch_neg and not $q_arch_neg) {
294
0
0
0
0
0
0
        my %p_arches = map { $_ => 1 } @{$p};
295
0
0
        my $subset = 1;
296
0
0
0
0
        for my $arch (@{$q}) {
297
0
0
            $subset = 0 unless $p_arches{$arch};
298        }
299
0
0
        return 0 unless $subset;
300    }
301    # If both are negated, we know nothing useful unless p is a subset of
302    # q (and therefore has fewer things excluded, and therefore is more
303    # general).
304    elsif ($p_arch_neg and $q_arch_neg) {
305
0
0
0
0
0
0
        my %q_arches = map { $_ => 1 } @{$q};
306
0
0
        my $subset = 1;
307
0
0
0
0
        for my $arch (@{$p}) {
308
0
0
            $subset = 0 unless $q_arches{$arch};
309        }
310
0
0
        return 0 unless $subset;
311    }
312    # If q is negated and p isn't, we'd need to know the full list of
313    # arches to know if there's any relationship, so bail.
314    elsif (not $p_arch_neg and $q_arch_neg) {
315
0
0
        return 0;
316    }
317    # If p is negated and q isn't, q is a subset of p if none of the
318    # negated arches in p are present in q.
319    elsif ($p_arch_neg and not $q_arch_neg) {
320
0
0
0
0
0
0
        my %q_arches = map { $_ => 1 } @{$q};
321
0
0
        my $subset = 1;
322
0
0
0
0
        for my $arch (@{$p}) {
323
0
0
            $subset = 0 if $q_arches{substr($arch, 1)};
324        }
325
0
0
        return 0 unless $subset;
326    }
327
0
0
    return 1;
328}
329
330# _arch_qualifier_implies($p, $q)
331#
332# Returns true if the arch qualifier $p and $q are compatible with the
333# implication $p -> $q, false otherwise. $p/$q can be undef/"any"/"native"
334# or an architecture string.
335#
336# Because we are handling dependencies in isolation, and the full context
337# of the implications are only known when doing dependency resolution at
338# run-time, we can only assert that they are implied if they are equal.
339#
340# For example dependencies with different arch-qualifiers cannot be simplified
341# as these depend on the state of Multi-Arch field in the package depended on.
342sub _arch_qualifier_implies {
343
70
42
    my ($p, $q) = @_;
344
345
70
81
    return $p eq $q if defined $p and defined $q;
346
53
131
    return 1 if not defined $p and not defined $q;
347
8
11
    return 0;
348}
349
350# _restrictions_imply($p, $q)
351#
352# Returns true if the restrictions $p and $q are compatible with the
353# implication $p -> $q, false otherwise.
354# NOTE: We don't try to be very clever here, so we may conservatively
355# return false when there is an implication.
356sub _restrictions_imply {
357
48
21
    my ($p, $q) = @_;
358
359
48
40
    if (not defined $p) {
360
45
27
       return 1;
361    } elsif (not defined $q) {
362
0
0
       return 0;
363    } else {
364       # Check whether set difference is empty.
365
3
2
       my %restr;
366
367
3
3
2
1
       for my $restrlist (@{$q}) {
368
3
3
2
3
           my $reststr = join ' ', sort @{$restrlist};
369
3
4
           $restr{$reststr} = 1;
370       }
371
3
3
2
1
       for my $restrlist (@{$p}) {
372
3
3
3
2
           my $reststr = join ' ', sort @{$restrlist};
373
3
3
           delete $restr{$reststr};
374       }
375
376
3
4
       return keys %restr == 0;
377    }
378}
379
380 - 386
=item $dep->implies($other_dep)

Returns 1 when $dep implies $other_dep. Returns 0 when $dep implies
NOT($other_dep). Returns undef when there is no implication. $dep and
$other_dep do not need to be of the same type.

=cut
387
388sub implies {
389
303
1
168
    my ($self, $o) = @_;
390
391
303
236
    if ($o->isa('Dpkg::Deps::Simple')) {
392        # An implication is only possible on the same package
393
276
256
        return if $self->{package} ne $o->{package};
394
395        # Our architecture set must be a superset of the architectures for
396        # o, otherwise we can't conclude anything.
397
70
52
        return unless _arch_is_superset($self->{arches}, $o->{arches});
398
399        # The arch qualifier must not forbid an implication
400        return unless _arch_qualifier_implies($self->{archqual},
401
70
50
                                              $o->{archqual});
402
403        # Our restrictions must imply the restrictions for o
404        return unless _restrictions_imply($self->{restrictions},
405
48
36
                                          $o->{restrictions});
406
407        # If o has no version clause, then our dependency is stronger
408
46
60
        return 1 if not defined $o->{relation};
409        # If o has a version clause, we must also have one, otherwise there
410        # can't be an implication
411
31
26
        return if not defined $self->{relation};
412
413        return Dpkg::Deps::deps_eval_implication($self->{relation},
414
25
25
                $self->{version}, $o->{relation}, $o->{version});
415    } elsif ($o->isa('Dpkg::Deps::AND')) {
416        # TRUE: Need to imply all individual elements
417        # FALSE: Need to NOT imply at least one individual element
418
24
12
        my $res = 1;
419
24
19
        foreach my $dep ($o->get_deps()) {
420
80
53
            my $implication = $self->implies($dep);
421
80
54
            unless (defined $implication and $implication == 1) {
422
73
36
                $res = $implication;
423
73
43
                last if defined $res;
424            }
425        }
426
24
17
        return $res;
427    } elsif ($o->isa('Dpkg::Deps::OR')) {
428        # TRUE: Need to imply at least one individual element
429        # FALSE: Need to not apply all individual elements
430        # UNDEF: The rest
431
3
2
        my $res = undef;
432
3
3
        foreach my $dep ($o->get_deps()) {
433
5
4
            my $implication = $self->implies($dep);
434
5
4
            if (defined $implication) {
435
1
1
                if (not defined $res) {
436
1
1
                    $res = $implication;
437                } else {
438
0
0
                    if ($implication) {
439
0
0
                        $res = 1;
440                    } else {
441
0
0
                        $res = 0;
442                    }
443                }
444
1
3
                last if defined $res and $res == 1;
445            }
446        }
447
3
3
        return $res;
448    } else {
449
0
0
        croak 'Dpkg::Deps::Simple cannot evaluate implication with a ' .
450              ref($o);
451    }
452}
453
454 - 459
=item $dep->get_deps()

Returns a list of sub-dependencies, which for this object it means it
returns itself.

=cut
460
461sub get_deps {
462
0
1
0
    my $self = shift;
463
464
0
0
    return $self;
465}
466
467 - 471
=item $dep->sort()

This method is a no-op for this object.

=cut
472
473
1
sub sort {
474    # Nothing to sort
475}
476
477 - 481
=item $dep->arch_is_concerned($arch)

Returns true if the dependency applies to the indicated architecture.

=cut
482
483sub arch_is_concerned {
484
30
1
18
    my ($self, $host_arch) = @_;
485
486
30
25
    return 0 if not defined $self->{package}; # Empty dep
487
24
20
    return 1 if not defined $self->{arches};  # Dep without arch spec
488
489
9
9
4
11
    return debarch_is_concerned($host_arch, @{$self->{arches}});
490}
491
492 - 498
=item $dep->reduce_arch($arch)

Simplifies the dependency to contain only information relevant to the given
architecture. This object can be left empty after this operation. This trims
off the architecture restriction list of these objects.

=cut
499
500sub reduce_arch {
501
15
1
8
    my ($self, $host_arch) = @_;
502
503
15
9
    if (not $self->arch_is_concerned($host_arch)) {
504
6
5
        $self->reset();
505    } else {
506
9
9
        $self->{arches} = undef;
507    }
508}
509
510 - 515
=item $dep->has_arch_restriction()

Returns the package name if the dependency applies only to a subset of
architectures.

=cut
516
517sub has_arch_restriction {
518
0
1
0
    my $self = shift;
519
520
0
0
    if (defined $self->{arches}) {
521
0
0
        return $self->{package};
522    } else {
523
0
0
        return ();
524    }
525}
526
527 - 531
=item $dep->profile_is_concerned()

Returns true if the dependency applies to the indicated profile.

=cut
532
533sub profile_is_concerned {
534
252
1
126
    my ($self, $build_profiles) = @_;
535
536
252
209
    return 0 if not defined $self->{package}; # Empty dep
537
194
147
    return 1 if not defined $self->{restrictions}; # Dep without restrictions
538
124
86
    return evaluate_restriction_formula($self->{restrictions}, $build_profiles);
539}
540
541 - 547
=item $dep->reduce_profiles()

Simplifies the dependency to contain only information relevant to the given
profile. This object can be left empty after this operation. This trims off
the profile restriction list of this object.

=cut
548
549sub reduce_profiles {
550
124
1
63
    my ($self, $build_profiles) = @_;
551
552
124
82
    if (not $self->profile_is_concerned($build_profiles)) {
553
58
45
        $self->reset();
554    } else {
555
66
56
        $self->{restrictions} = undef;
556    }
557}
558
559 - 568
=item $dep->get_evaluation($facts)

Evaluates the dependency given a list of installed packages and a list of
virtual packages provided. These lists are part of the Dpkg::Deps::KnownFacts
object given as parameters.

Returns 1 when it's true, 0 when it's false, undef when some information
is lacking to conclude.

=cut
569
570sub get_evaluation {
571
56
1
31
    my ($self, $facts) = @_;
572
573
56
41
    return if not defined $self->{package};
574
56
42
    return $facts->evaluate_simple_dep($self);
575}
576
577 - 583
=item $dep->simplify_deps($facts, @assumed_deps)

Simplifies the dependency as much as possible given the list of facts (see
class Dpkg::Deps::KnownFacts) and a list of other dependencies that are
known to be true.

=cut
584
585sub simplify_deps {
586
0
1
0
    my ($self, $facts) = @_;
587
588
0
0
    my $eval = $self->get_evaluation($facts);
589
0
0
    $self->reset() if defined $eval and $eval == 1;
590}
591
592 - 597
=item $dep->is_empty()

Returns true if the dependency is empty and doesn't contain any useful
information. This is true when the object has not yet been initialized.

=cut
598
599sub is_empty {
600
726
1
333
    my $self = shift;
601
602
726
586
    return not defined $self->{package};
603}
604
605 - 610
=item $dep->merge_union($other_dep)

Returns true if $dep could be modified to represent the union of both
dependencies. Otherwise returns false.

=cut
611
612sub merge_union {
613
17
1
10
    my ($self, $o) = @_;
614
615
17
14
    return 0 if not $o->isa('Dpkg::Deps::Simple');
616
17
11
    return 0 if $self->is_empty() or $o->is_empty();
617
17
20
    return 0 if $self->{package} ne $o->{package};
618
6
11
    return 0 if defined $self->{arches} or defined $o->{arches};
619
620
6
5
    if (not defined $o->{relation} and defined $self->{relation}) {
621        # Union is the non-versioned dependency
622
0
0
        $self->{relation} = undef;
623
0
0
        $self->{version} = undef;
624
0
0
        return 1;
625    }
626
627
6
5
    my $implication = $self->implies($o);
628
6
4
    my $rev_implication = $o->implies($self);
629
6
7
    if (defined $implication) {
630
4
7
        if ($implication) {
631
1
1
            $self->{relation} = $o->{relation};
632
1
1
            $self->{version} = $o->{version};
633
1
2
            return 1;
634        } else {
635
3
3
            return 0;
636        }
637    }
638
2
2
    if (defined $rev_implication) {
639
2
1
        if ($rev_implication) {
640            # Already merged...
641
2
4
            return 1;
642        } else {
643
0
            return 0;
644        }
645    }
646
0
    return 0;
647}
648
649=back
650
651 - 668
=head1 CHANGES

=head2 Version 1.02 (dpkg 1.17.10)

New methods: Add $dep->profile_is_concerned() and $dep->reduce_profiles().

=head2 Version 1.01 (dpkg 1.16.1)

New method: Add $dep->reset().

New property: recognizes the arch qualifier "any" and stores it in the
"archqual" property when present.

=head2 Version 1.00 (dpkg 1.15.6)

Mark the module as public.

=cut
669
6701;