diff options
Diffstat (limited to '')
| -rw-r--r-- | scripts/Dpkg/Deps/Simple.pm | 669 |
1 files changed, 669 insertions, 0 deletions
diff --git a/scripts/Dpkg/Deps/Simple.pm b/scripts/Dpkg/Deps/Simple.pm new file mode 100644 index 0000000..efe635c --- /dev/null +++ b/scripts/Dpkg/Deps/Simple.pm @@ -0,0 +1,669 @@ +# Copyright © 1998 Richard Braakman +# Copyright © 1999 Darren Benham +# Copyright © 2000 Sean 'Shaleh' Perry +# Copyright © 2004 Frank Lichtenheld +# Copyright © 2006 Russ Allbery +# Copyright © 2007-2009 Raphaël Hertzog <hertzog@debian.org> +# Copyright © 2008-2009, 2012-2014 Guillem Jover <guillem@debian.org> +# +# This program is free software; you may redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +package Dpkg::Deps::Simple; + +=encoding utf8 + +=head1 NAME + +Dpkg::Deps::Simple - represents a single dependency statement + +=head1 DESCRIPTION + +This object 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 + +use strict; +use warnings; + +our $VERSION = '1.02'; + +use Carp; + +use Dpkg::Arch qw(debarch_is_concerned debarch_list_parse); +use Dpkg::BuildProfiles qw(parse_build_profiles evaluate_restriction_formula); +use Dpkg::Version; +use Dpkg::ErrorHandling; +use Dpkg::Gettext; + +use parent qw(Dpkg::Interface::Storable); + +=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 + +sub new { + my ($this, $arg, %opts) = @_; + my $class = ref($this) || $this; + my $self = {}; + + bless $self, $class; + $self->reset(); + $self->{host_arch} = $opts{host_arch}; + $self->{build_arch} = $opts{build_arch}; + $self->{build_dep} = $opts{build_dep} // 0; + $self->{tests_dep} = $opts{tests_dep} // 0; + $self->parse_string($arg) if defined $arg; + return $self; +} + +=item $dep->reset() + +Clears any dependency information stored in $dep so that $dep->is_empty() +returns true. + +=cut + +sub reset { + my $self = shift; + + $self->{package} = undef; + $self->{relation} = undef; + $self->{version} = undef; + $self->{arches} = undef; + $self->{archqual} = undef; + $self->{restrictions} = undef; +} + +=item $dep->parse_string($dep_string) + +Parses the dependency string and modifies internal properties to match the +parsed dependency. + +=cut + +sub parse_string { + my ($self, $dep) = @_; + + my $pkgname_re; + if ($self->{tests_dep}) { + $pkgname_re = qr/[\@a-zA-Z0-9][\@a-zA-Z0-9+.-]*/; + } else { + $pkgname_re = qr/[a-zA-Z0-9][a-zA-Z0-9+.-]*/; + } + + return if not $dep =~ + m{^\s* # skip leading whitespace + ($pkgname_re) # package name + (?: # start of optional part + : # colon for architecture + ([a-zA-Z0-9][a-zA-Z0-9-]*) # architecture name + )? # end of optional part + (?: # start of optional part + \s* \( # open parenthesis for version part + \s* (<<|<=|=|>=|>>|[<>]) # relation part + \s* ([^\)\s]+) # do not attempt to parse version + \s* \) # closing parenthesis + )? # end of optional part + (?: # start of optional architecture + \s* \[ # open bracket for architecture + \s* ([^\]]+) # don't parse architectures now + \s* \] # closing bracket + )? # end of optional architecture + ( + (?: # start of optional restriction + \s* < # open bracket for restriction + \s* [^>]+ # do not parse restrictions now + \s* > # closing bracket + )+ + )? # end of optional restriction + \s*$ # trailing spaces at end + }x; + if (defined $2) { + return if $2 eq 'native' and not $self->{build_dep}; + $self->{archqual} = $2; + } + $self->{package} = $1; + $self->{relation} = version_normalize_relation($3) if defined $3; + if (defined $4) { + $self->{version} = Dpkg::Version->new($4); + } + if (defined $5) { + $self->{arches} = [ debarch_list_parse($5) ]; + } + if (defined $6) { + $self->{restrictions} = [ parse_build_profiles($6) ]; + } +} + +=item $dep->parse($fh, $desc) + +Parse a dependency line from a filehandle. + +=cut + +sub parse { + my ($self, $fh, $desc) = @_; + + my $line = <$fh>; + chomp $line; + return $self->parse_string($line); +} + +=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 + +sub output { + my ($self, $fh) = @_; + + my $res = $self->{package}; + if (defined $self->{archqual}) { + $res .= ':' . $self->{archqual}; + } + if (defined $self->{relation}) { + $res .= ' (' . $self->{relation} . ' ' . $self->{version} . ')'; + } + if (defined $self->{arches}) { + $res .= ' [' . join(' ', @{$self->{arches}}) . ']'; + } + if (defined $self->{restrictions}) { + for my $restrlist (@{$self->{restrictions}}) { + $res .= ' <' . join(' ', @{$restrlist}) . '>'; + } + } + if (defined $fh) { + print { $fh } $res; + } + return $res; +} + +=item $dep->save($filename) + +Save the dependency into the given $filename. + +=cut + +# _arch_is_superset(\@p, \@q) +# +# Returns true if the arch list @p is a superset of arch list @q. +# The arguments can also be undef in case there's no explicit architecture +# restriction. +sub _arch_is_superset { + my ($p, $q) = @_; + my $p_arch_neg = defined $p and $p->[0] =~ /^!/; + my $q_arch_neg = defined $q and $q->[0] =~ /^!/; + + # If "p" has no arches, it is a superset of q and we should fall through + # to the version check. + if (not defined $p) { + return 1; + } + # If q has no arches, it is a superset of p and there are no useful + # implications. + elsif (not defined $q) { + return 0; + } + # Both have arches. If neither are negated, we know nothing useful + # unless q is a subset of p. + elsif (not $p_arch_neg and not $q_arch_neg) { + my %p_arches = map { $_ => 1 } @{$p}; + my $subset = 1; + for my $arch (@{$q}) { + $subset = 0 unless $p_arches{$arch}; + } + return 0 unless $subset; + } + # If both are negated, we know nothing useful unless p is a subset of + # q (and therefore has fewer things excluded, and therefore is more + # general). + elsif ($p_arch_neg and $q_arch_neg) { + my %q_arches = map { $_ => 1 } @{$q}; + my $subset = 1; + for my $arch (@{$p}) { + $subset = 0 unless $q_arches{$arch}; + } + return 0 unless $subset; + } + # If q is negated and p isn't, we'd need to know the full list of + # arches to know if there's any relationship, so bail. + elsif (not $p_arch_neg and $q_arch_neg) { + return 0; + } + # If p is negated and q isn't, q is a subset of p if none of the + # negated arches in p are present in q. + elsif ($p_arch_neg and not $q_arch_neg) { + my %q_arches = map { $_ => 1 } @{$q}; + my $subset = 1; + for my $arch (@{$p}) { + $subset = 0 if $q_arches{substr($arch, 1)}; + } + return 0 unless $subset; + } + return 1; +} + +# _arch_qualifier_implies($p, $q) +# +# Returns true if the arch qualifier $p and $q are compatible with the +# implication $p -> $q, false otherwise. $p/$q can be undef/"any"/"native" +# or an architecture string. +# +# Because we are handling dependencies in isolation, and the full context +# of the implications are only known when doing dependency resolution at +# run-time, we can only assert that they are implied if they are equal. +# +# For example dependencies with different arch-qualifiers cannot be simplified +# as these depend on the state of Multi-Arch field in the package depended on. +sub _arch_qualifier_implies { + my ($p, $q) = @_; + + return $p eq $q if defined $p and defined $q; + return 1 if not defined $p and not defined $q; + return 0; +} + +# _restrictions_imply($p, $q) +# +# Returns true if the restrictions $p and $q are compatible with the +# implication $p -> $q, false otherwise. +# NOTE: We don't try to be very clever here, so we may conservatively +# return false when there is an implication. +sub _restrictions_imply { + my ($p, $q) = @_; + + if (not defined $p) { + return 1; + } elsif (not defined $q) { + return 0; + } else { + # Check whether set difference is empty. + my %restr; + + for my $restrlist (@{$q}) { + my $reststr = join ' ', sort @{$restrlist}; + $restr{$reststr} = 1; + } + for my $restrlist (@{$p}) { + my $reststr = join ' ', sort @{$restrlist}; + delete $restr{$reststr}; + } + + return keys %restr == 0; + } +} + +=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 + +sub implies { + my ($self, $o) = @_; + + if ($o->isa('Dpkg::Deps::Simple')) { + # An implication is only possible on the same package + return if $self->{package} ne $o->{package}; + + # Our architecture set must be a superset of the architectures for + # o, otherwise we can't conclude anything. + return unless _arch_is_superset($self->{arches}, $o->{arches}); + + # The arch qualifier must not forbid an implication + return unless _arch_qualifier_implies($self->{archqual}, + $o->{archqual}); + + # Our restrictions must imply the restrictions for o + return unless _restrictions_imply($self->{restrictions}, + $o->{restrictions}); + + # If o has no version clause, then our dependency is stronger + return 1 if not defined $o->{relation}; + # If o has a version clause, we must also have one, otherwise there + # can't be an implication + return if not defined $self->{relation}; + + return Dpkg::Deps::deps_eval_implication($self->{relation}, + $self->{version}, $o->{relation}, $o->{version}); + } elsif ($o->isa('Dpkg::Deps::AND')) { + # TRUE: Need to imply all individual elements + # FALSE: Need to NOT imply at least one individual element + my $res = 1; + foreach my $dep ($o->get_deps()) { + my $implication = $self->implies($dep); + unless (defined $implication and $implication == 1) { + $res = $implication; + last if defined $res; + } + } + return $res; + } elsif ($o->isa('Dpkg::Deps::OR')) { + # TRUE: Need to imply at least one individual element + # FALSE: Need to not apply all individual elements + # UNDEF: The rest + my $res = undef; + foreach my $dep ($o->get_deps()) { + my $implication = $self->implies($dep); + if (defined $implication) { + if (not defined $res) { + $res = $implication; + } else { + if ($implication) { + $res = 1; + } else { + $res = 0; + } + } + last if defined $res and $res == 1; + } + } + return $res; + } else { + croak 'Dpkg::Deps::Simple cannot evaluate implication with a ' . + ref($o); + } +} + +=item $dep->get_deps() + +Returns a list of sub-dependencies, which for this object it means it +returns itself. + +=cut + +sub get_deps { + my $self = shift; + + return $self; +} + +=item $dep->sort() + +This method is a no-op for this object. + +=cut + +sub sort { + # Nothing to sort +} + +=item $dep->arch_is_concerned($arch) + +Returns true if the dependency applies to the indicated architecture. + +=cut + +sub arch_is_concerned { + my ($self, $host_arch) = @_; + + return 0 if not defined $self->{package}; # Empty dep + return 1 if not defined $self->{arches}; # Dep without arch spec + + return debarch_is_concerned($host_arch, @{$self->{arches}}); +} + +=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 + +sub reduce_arch { + my ($self, $host_arch) = @_; + + if (not $self->arch_is_concerned($host_arch)) { + $self->reset(); + } else { + $self->{arches} = undef; + } +} + +=item $dep->has_arch_restriction() + +Returns the package name if the dependency applies only to a subset of +architectures. + +=cut + +sub has_arch_restriction { + my $self = shift; + + if (defined $self->{arches}) { + return $self->{package}; + } else { + return (); + } +} + +=item $dep->profile_is_concerned() + +Returns true if the dependency applies to the indicated profile. + +=cut + +sub profile_is_concerned { + my ($self, $build_profiles) = @_; + + return 0 if not defined $self->{package}; # Empty dep + return 1 if not defined $self->{restrictions}; # Dep without restrictions + return evaluate_restriction_formula($self->{restrictions}, $build_profiles); +} + +=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 + +sub reduce_profiles { + my ($self, $build_profiles) = @_; + + if (not $self->profile_is_concerned($build_profiles)) { + $self->reset(); + } else { + $self->{restrictions} = undef; + } +} + +=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 + +sub get_evaluation { + my ($self, $facts) = @_; + + return if not defined $self->{package}; + return $facts->evaluate_simple_dep($self); +} + +=item $dep->simplify_deps($facts, @assumed_deps) + +Simplifies the dependency as much as possible given the list of facts (see +object Dpkg::Deps::KnownFacts) and a list of other dependencies that are +known to be true. + +=cut + +sub simplify_deps { + my ($self, $facts) = @_; + + my $eval = $self->get_evaluation($facts); + $self->reset() if defined $eval and $eval == 1; +} + +=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 + +sub is_empty { + my $self = shift; + + return not defined $self->{package}; +} + +=item $dep->merge_union($other_dep) + +Returns true if $dep could be modified to represent the union of both +dependencies. Otherwise returns false. + +=cut + +sub merge_union { + my ($self, $o) = @_; + + return 0 if not $o->isa('Dpkg::Deps::Simple'); + return 0 if $self->is_empty() or $o->is_empty(); + return 0 if $self->{package} ne $o->{package}; + return 0 if defined $self->{arches} or defined $o->{arches}; + + if (not defined $o->{relation} and defined $self->{relation}) { + # Union is the non-versioned dependency + $self->{relation} = undef; + $self->{version} = undef; + return 1; + } + + my $implication = $self->implies($o); + my $rev_implication = $o->implies($self); + if (defined $implication) { + if ($implication) { + $self->{relation} = $o->{relation}; + $self->{version} = $o->{version}; + return 1; + } else { + return 0; + } + } + if (defined $rev_implication) { + if ($rev_implication) { + # Already merged... + return 1; + } else { + return 0; + } + } + return 0; +} + +=back + +=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 + +1; |