File Coverage

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

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
22=encoding utf8
23
24 - 69
=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

=cut
70
71package Dpkg::Deps::Simple 1.02;
72
73
12
12
12
38
9
227
use strict;
74
12
12
12
21
8
362
use warnings;
75
76
12
12
12
26
7
462
use Carp;
77
78
12
12
12
26
9
350
use Dpkg::Arch qw(debarch_is_concerned debarch_list_parse);
79
12
12
12
28
21
268
use Dpkg::BuildProfiles qw(parse_build_profiles evaluate_restriction_formula);
80
12
12
12
25
4
496
use Dpkg::Version;
81
12
12
12
23
13
424
use Dpkg::ErrorHandling;
82
12
12
12
24
17
359
use Dpkg::Gettext;
83
84
12
12
12
29
11
34
use parent qw(Dpkg::Interface::Storable);
85
86 - 119
=head1 METHODS

=over 4

=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.

This option implicitly (and forcibly) enables C<build_dep> because test
dependencies are based on build dependencies (since dpkg 1.22.1).

=back

=cut
120
121sub new {
122
804
1
1104
    my ($this, $arg, %opts) = @_;
123
804
1483
    my $class = ref($this) || $this;
124
804
547
    my $self = {};
125
126
804
561
    bless $self, $class;
127
804
875
    $self->reset();
128
804
694
    $self->{host_arch} = $opts{host_arch};
129
804
668
    $self->{build_arch} = $opts{build_arch};
130
804
799
    $self->{build_dep} = $opts{build_dep} // 0;
131
804
751
    $self->{tests_dep} = $opts{tests_dep} // 0;
132
804
765
    if ($self->{tests_dep}) {
133
21
12
        $self->{build_dep} = 1;
134    }
135
136
804
1112
    $self->parse_string($arg) if defined $arg;
137
804
1049
    return $self;
138}
139
140 - 145
=item $dep->reset()

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

=cut
146
147sub reset {
148
996
1
605
    my $self = shift;
149
150
996
1077
    $self->{package} = undef;
151
996
674
    $self->{relation} = undef;
152
996
695
    $self->{version} = undef;
153
996
670
    $self->{arches} = undef;
154
996
662
    $self->{archqual} = undef;
155
996
1124
    $self->{restrictions} = undef;
156}
157
158 - 163
=item $dep->parse_string($dep_string)

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

=cut
164
165sub parse_string {
166
804
1
660
    my ($self, $dep) = @_;
167
168
804
494
    my $pkgname_re;
169
804
742
    if ($self->{tests_dep}) {
170
21
31
        $pkgname_re = qr/[\@a-zA-Z0-9][\@a-zA-Z0-9+.-]*/;
171    } else {
172
783
990
        $pkgname_re = qr/[a-zA-Z0-9][a-zA-Z0-9+.-]*/;
173    }
174
175    ## no critic (RegularExpressions::ProhibitCaptureWithoutTest)
176
804
6243
    return if not $dep =~
177           m{^\s*                           # skip leading whitespace
178              ($pkgname_re)                 # package name
179              (?:                           # start of optional part
180                :                           # colon for architecture
181                ([a-zA-Z0-9][a-zA-Z0-9-]*)  # architecture name
182              )?                            # end of optional part
183              (?:                           # start of optional part
184                \s* \(                      # open parenthesis for version part
185                \s* (<<|<=|=|>=|>>|[<>])    # relation part
186                \s* ([^\)\s]+)              # do not attempt to parse version
187                \s* \)                      # closing parenthesis
188              )?                            # end of optional part
189              (?:                           # start of optional architecture
190                \s* \[                      # open bracket for architecture
191                \s* ([^\]]+)                # don't parse architectures now
192                \s* \]                      # closing bracket
193              )?                            # end of optional architecture
194              (
195                (?:                         # start of optional restriction
196                \s* <                       # open bracket for restriction
197                \s* [^>]+                   # do not parse restrictions now
198                \s* >                       # closing bracket
199                )+
200              )?                            # end of optional restriction
201              \s*$                          # trailing spaces at end
202            }x;
203
789
974
    if (defined $2) {
204
57
125
        return if $2 eq 'native' and not $self->{build_dep};
205
57
58
        $self->{archqual} = $2;
206    }
207
789
899
    $self->{package} = $1;
208
789
981
    $self->{relation} = version_normalize_relation($3) if defined $3;
209
789
809
    if (defined $4) {
210
159
294
        $self->{version} = Dpkg::Version->new($4);
211    }
212
789
737
    if (defined $5) {
213
30
41
        $self->{arches} = [ debarch_list_parse($5) ];
214    }
215
789
997
    if (defined $6) {
216
402
418
        $self->{restrictions} = [ parse_build_profiles($6) ];
217    }
218}
219
220 - 224
=item $dep->parse($fh, $desc)

Parse a dependency line from a filehandle.

=cut
225
226sub parse {
227
0
1
0
    my ($self, $fh, $desc) = @_;
228
229
0
0
    my $line = <$fh>;
230
0
0
    chomp $line;
231
0
0
    return $self->parse_string($line);
232}
233
234 - 245
=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
246
247sub output {
248
435
1
297
    my ($self, $fh) = @_;
249
250
435
337
    my $res = $self->{package};
251
435
401
    if (defined $self->{archqual}) {
252
33
34
        $res .= ':' . $self->{archqual};
253    }
254
435
368
    if (defined $self->{relation}) {
255
90
215
        $res .= ' (' . $self->{relation} . ' ' . $self->{version} .  ')';
256    }
257
435
388
    if (defined $self->{arches}) {
258
3
3
3
5
        $res .= ' [' . join(' ', @{$self->{arches}}) . ']';
259    }
260
435
372
    if (defined $self->{restrictions}) {
261
21
21
13
22
        for my $restrlist (@{$self->{restrictions}}) {
262
30
30
15
36
            $res .= ' <' . join(' ', @{$restrlist}) . '>';
263        }
264    }
265
435
325
    if (defined $fh) {
266
0
0
0
0
        print { $fh } $res;
267    }
268
435
589
    return $res;
269}
270
271 - 275
=item $dep->save($filename)

Save the dependency into the given $filename.

=cut
276
277# _arch_is_superset(\@p, \@q)
278#
279# Returns true if the arch list @p is a superset of arch list @q.
280# The arguments can also be undef in case there's no explicit architecture
281# restriction.
282sub _arch_is_superset {
283
210
178
    my ($p, $q) = @_;
284
210
196
    my $p_arch_neg = defined $p and $p->[0] =~ /^!/;
285
210
213
    my $q_arch_neg = defined $q and $q->[0] =~ /^!/;
286
287
210
187
    if (not defined $p) {
288        # If "p" has no arches, it is a superset of q and we should fall through
289        # to the version check.
290
210
223
        return 1;
291    } elsif (not defined $q) {
292        # If q has no arches, it is a superset of p and there are no useful
293        # implications.
294
0
0
        return 0;
295    } elsif (not $p_arch_neg and not $q_arch_neg) {
296        # Both have arches.  If neither are negated, we know nothing useful
297        # unless q is a subset of p.
298
299
0
0
0
0
0
0
        my %p_arches = map { $_ => 1 } @{$p};
300
0
0
        my $subset = 1;
301
0
0
0
0
        for my $arch (@{$q}) {
302
0
0
            $subset = 0 unless $p_arches{$arch};
303        }
304
0
0
        return 0 unless $subset;
305    } elsif ($p_arch_neg and $q_arch_neg) {
306        # If both are negated, we know nothing useful unless p is a subset of
307        # q (and therefore has fewer things excluded, and therefore is more
308        # general).
309
310
0
0
0
0
0
0
        my %q_arches = map { $_ => 1 } @{$q};
311
0
0
        my $subset = 1;
312
0
0
0
0
        for my $arch (@{$p}) {
313
0
0
            $subset = 0 unless $q_arches{$arch};
314        }
315
0
0
        return 0 unless $subset;
316    } elsif (not $p_arch_neg and $q_arch_neg) {
317        # If q is negated and p isn't, we'd need to know the full list of
318        # arches to know if there's any relationship, so bail.
319
0
0
        return 0;
320    } elsif ($p_arch_neg and not $q_arch_neg) {
321        # If p is negated and q isn't, q is a subset of p if none of the
322        # negated arches in p are present in q.
323
324
0
0
0
0
0
0
        my %q_arches = map { $_ => 1 } @{$q};
325
0
0
        my $subset = 1;
326
0
0
0
0
        for my $arch (@{$p}) {
327
0
0
            $subset = 0 if $q_arches{substr($arch, 1)};
328        }
329
0
0
        return 0 unless $subset;
330    }
331
0
0
    return 1;
332}
333
334# _arch_qualifier_implies($p, $q)
335#
336# Returns true if the arch qualifier $p and $q are compatible with the
337# implication $p -> $q, false otherwise. $p/$q can be undef/"any"/"native"
338# or an architecture string.
339#
340# Because we are handling dependencies in isolation, and the full context
341# of the implications are only known when doing dependency resolution at
342# run-time, we can only assert that they are implied if they are equal.
343#
344# For example dependencies with different arch-qualifiers cannot be simplified
345# as these depend on the state of Multi-Arch field in the package depended on.
346sub _arch_qualifier_implies {
347
210
166
    my ($p, $q) = @_;
348
349
210
351
    return $p eq $q if defined $p and defined $q;
350
159
402
    return 1 if not defined $p and not defined $q;
351
24
44
    return 0;
352}
353
354# _restrictions_imply($p, $q)
355#
356# Returns true if the restrictions $p and $q are compatible with the
357# implication $p -> $q, false otherwise.
358# NOTE: We don't try to be very clever here, so we may conservatively
359# return false when there is an implication.
360sub _restrictions_imply {
361
144
105
    my ($p, $q) = @_;
362
363
144
128
    if (not defined $p) {
364
135
130
       return 1;
365    } elsif (not defined $q) {
366
0
0
       return 0;
367    } else {
368       # Check whether set difference is empty.
369
9
7
       my %restr;
370
371
9
9
7
7
       for my $restrlist (@{$q}) {
372
9
9
6
15
           my $reststr = join ' ', sort @{$restrlist};
373
9
12
           $restr{$reststr} = 1;
374       }
375
9
9
8
6
       for my $restrlist (@{$p}) {
376
9
9
8
11
           my $reststr = join ' ', sort @{$restrlist};
377
9
7
           delete $restr{$reststr};
378       }
379
380
9
21
       return keys %restr == 0;
381    }
382}
383
384 - 390
=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
391
392sub implies {
393
909
1
622
    my ($self, $o) = @_;
394
395
909
1028
    if ($o->isa('Dpkg::Deps::Simple')) {
396        # An implication is only possible on the same package
397
828
1045
        return if $self->{package} ne $o->{package};
398
399        # Our architecture set must be a superset of the architectures for
400        # o, otherwise we can't conclude anything.
401
210
253
        return unless _arch_is_superset($self->{arches}, $o->{arches});
402
403        # The arch qualifier must not forbid an implication
404        return unless _arch_qualifier_implies($self->{archqual},
405
210
226
                                              $o->{archqual});
406
407        # Our restrictions must imply the restrictions for o
408        return unless _restrictions_imply($self->{restrictions},
409
144
180
                                          $o->{restrictions});
410
411        # If o has no version clause, then our dependency is stronger
412
138
171
        return 1 if not defined $o->{relation};
413        # If o has a version clause, we must also have one, otherwise there
414        # can't be an implication
415
93
103
        return if not defined $self->{relation};
416
417        return Dpkg::Deps::deps_eval_implication($self->{relation},
418
75
121
                $self->{version}, $o->{relation}, $o->{version});
419    } elsif ($o->isa('Dpkg::Deps::AND')) {
420        # TRUE: Need to imply all individual elements
421        # FALSE: Need to NOT imply at least one individual element
422
72
50
        my $res = 1;
423
72
65
        foreach my $dep ($o->get_deps()) {
424
240
185
            my $implication = $self->implies($dep);
425
240
236
            unless (defined $implication and $implication == 1) {
426
219
132
                $res = $implication;
427
219
164
                last if defined $res;
428            }
429        }
430
72
70
        return $res;
431    } elsif ($o->isa('Dpkg::Deps::OR')) {
432        # TRUE: Need to imply at least one individual element
433        # FALSE: Need to not apply all individual elements
434        # UNDEF: The rest
435
9
7
        my $res = undef;
436
9
10
        foreach my $dep ($o->get_deps()) {
437
15
11
            my $implication = $self->implies($dep);
438
15
18
            if (defined $implication) {
439
3
3
                if (not defined $res) {
440
3
3
                    $res = $implication;
441                } elsif ($implication) {
442
0
0
                    $res = 1;
443                } else {
444
0
0
                    $res = 0;
445                }
446
3
12
                last if defined $res and $res == 1;
447            }
448        }
449
9
12
        return $res;
450    } else {
451
0
0
        croak 'Dpkg::Deps::Simple cannot evaluate implication with a ' .
452              ref($o);
453    }
454}
455
456 - 461
=item $dep->get_deps()

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

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

This method is a no-op for this object.

=cut
474
475
1
sub sort {
476    # Nothing to sort
477}
478
479 - 483
=item $dep->arch_is_concerned($arch)

Returns true if the dependency applies to the indicated architecture.

=cut
484
485sub arch_is_concerned {
486
138
1
110
    my ($self, $host_arch) = @_;
487
488
138
159
    return 0 if not defined $self->{package}; # Empty dep
489
120
153
    return 1 if not defined $self->{arches};  # Dep without arch spec
490
491
27
27
12
33
    return debarch_is_concerned($host_arch, @{$self->{arches}});
492}
493
494 - 500
=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
501
502sub reduce_arch {
503
69
1
73
    my ($self, $host_arch) = @_;
504
505
69
83
    if (not $self->arch_is_concerned($host_arch)) {
506
18
19
        $self->reset();
507    } else {
508
51
55
        $self->{arches} = undef;
509    }
510}
511
512 - 517
=item $dep->has_arch_restriction()

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

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

Returns true if the dependency applies to the indicated profile.

=cut
534
535sub profile_is_concerned {
536
804
1
497
    my ($self, $build_profiles) = @_;
537
538
804
820
    return 0 if not defined $self->{package}; # Empty dep
539
630
688
    return 1 if not defined $self->{restrictions}; # Dep without restrictions
540
372
357
    return evaluate_restriction_formula($self->{restrictions}, $build_profiles);
541}
542
543 - 549
=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
550
551sub reduce_profiles {
552
396
1
281
    my ($self, $build_profiles) = @_;
553
554
396
334
    if (not $self->profile_is_concerned($build_profiles)) {
555
174
147
        $self->reset();
556    } else {
557
222
236
        $self->{restrictions} = undef;
558    }
559}
560
561 - 570
=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
L<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
571
572sub get_evaluation {
573
168
1
164
    my ($self, $facts) = @_;
574
575
168
164
    return if not defined $self->{package};
576
168
228
    return $facts->evaluate_simple_dep($self);
577}
578
579 - 585
=item $dep->simplify_deps($facts, @assumed_deps)

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

=cut
586
587sub simplify_deps {
588
0
1
0
    my ($self, $facts) = @_;
589
590
0
0
    my $eval = $self->get_evaluation($facts);
591
0
0
    $self->reset() if defined $eval and $eval == 1;
592}
593
594 - 599
=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
600
601sub is_empty {
602
2226
1
1256
    my $self = shift;
603
604
2226
2521
    return not defined $self->{package};
605}
606
607 - 612
=item $dep->merge_union($other_dep)

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

=cut
613
614sub merge_union {
615
51
1
38
    my ($self, $o) = @_;
616
617
51
85
    return 0 if not $o->isa('Dpkg::Deps::Simple');
618
51
50
    return 0 if $self->is_empty() or $o->is_empty();
619
51
84
    return 0 if $self->{package} ne $o->{package};
620
18
53
    return 0 if defined $self->{arches} or defined $o->{arches};
621
622
18
31
    if (not defined $o->{relation} and defined $self->{relation}) {
623        # Union is the non-versioned dependency
624
0
0
        $self->{relation} = undef;
625
0
0
        $self->{version} = undef;
626
0
0
        return 1;
627    }
628
629
18
26
    my $implication = $self->implies($o);
630
18
25
    my $rev_implication = $o->implies($self);
631
18
32
    if (defined $implication) {
632
12
19
        if ($implication) {
633
3
5
            $self->{relation} = $o->{relation};
634
3
5
            $self->{version} = $o->{version};
635
3
8
            return 1;
636        } else {
637
9
40
            return 0;
638        }
639    }
640
6
33
    if (defined $rev_implication) {
641
6
9
        if ($rev_implication) {
642            # Already merged...
643
6
54
            return 1;
644        } else {
645
0
            return 0;
646        }
647    }
648
0
    return 0;
649}
650
651=back
652
653 - 670
=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
671
6721;