From 3c5b94836a86c8884a99b70cd98672244adb4c75 Mon Sep 17 00:00:00 2001 From: Raphaël Hertzog Date: Thu, 17 Sep 2009 22:20:55 +0200 Subject: Dpkg::Control::Fields: official list of control fields This new module provides an official list of control fields as well as many functions to query that list and the meta-information associated to each list. --- scripts/Dpkg/Control/Fields.pm | 564 +++++++++++++++++++++++++++++++++++++++++ scripts/Makefile.am | 1 + scripts/po/POTFILES.in | 1 + 3 files changed, 566 insertions(+) create mode 100644 scripts/Dpkg/Control/Fields.pm (limited to 'scripts') diff --git a/scripts/Dpkg/Control/Fields.pm b/scripts/Dpkg/Control/Fields.pm new file mode 100644 index 000000000..a58632098 --- /dev/null +++ b/scripts/Dpkg/Control/Fields.pm @@ -0,0 +1,564 @@ +# Copyright © 2007-2009 Raphaël Hertzog +# +# This program is free software; you can 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 program 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, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +package Dpkg::Control::Fields; + +use strict; +use warnings; + +use base qw(Exporter); +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Control::Types; +use Dpkg::Checksums qw(@check_supported %check_supported); + +our @EXPORT = qw(field_capitalize field_is_official field_is_allowed_in + field_transfer_single field_transfer_all + field_list_src_dep field_list_pkg_dep field_get_dep_type + field_ordered_list field_register + field_insert_after field_insert_before); + +use constant { + ALL_PKG => CTRL_INFO_PKG | CTRL_APT_PKG | CTRL_PKG_DEB | CTRL_FILE_STATUS, + ALL_SRC => CTRL_INFO_SRC | CTRL_APT_SRC | CTRL_PKG_SRC, + ALL_CHANGES => CTRL_FILE_CHANGES | CTRL_CHANGELOG, +}; + +# The canonical list of fields + +# Note that fields used only in dpkg's available file are not listed +# Deprecated fields of dpkg's status file are also not listed +our %FIELDS = ( + 'Architecture' => { + allowed => (ALL_PKG | ALL_SRC | CTRL_FILE_CHANGES) & (~CTRL_INFO_SRC), + }, + 'Binary' => { + allowed => CTRL_PKG_SRC | CTRL_FILE_CHANGES, + }, + 'Breaks' => { + allowed => ALL_PKG, + dependency => 'union', + dep_order => 7, + }, + 'Bugs' => { + allowed => (ALL_PKG | CTRL_INFO_SRC | CTRL_FILE_VENDOR) & (~CTRL_INFO_PKG), + }, + 'Build-Conflicts' => { + allowed => ALL_SRC, + dependency => 'union', + dep_order => 3, + }, + 'Build-Conflicts-Indep' => { + allowed => ALL_SRC, + dependency => 'union', + dep_order => 4, + }, + 'Build-Depends' => { + allowed => ALL_SRC, + dependency => 'normal', + dep_order => 1, + }, + 'Build-Depends-Indep' => { + allowed => ALL_SRC, + dependency => 'normal', + dep_order => 2, + }, + 'Changed-By' => { + allowed => CTRL_FILE_CHANGES, + }, + 'Changes' => { + allowed => ALL_CHANGES, + }, + 'Closes' => { + allowed => ALL_CHANGES, + }, + 'Conffiles' => { + allowed => CTRL_FILE_STATUS, + }, + 'Config-Version' => { + allowed => CTRL_FILE_STATUS, + }, + 'Conflicts' => { + allowed => ALL_PKG, + dependency => 'union', + dep_order => 6, + }, + 'Date' => { + allowed => ALL_CHANGES, + }, + 'Depends' => { + allowed => ALL_PKG, + dependency => 'normal', + dep_order => 2, + }, + 'Description' => { + allowed => ALL_PKG | CTRL_FILE_CHANGES, + }, + 'Directory' => { + allowed => CTRL_APT_SRC, + }, + 'Distribution' => { + allowed => ALL_CHANGES, + }, + 'Dm-Upload-Allowed' => { + allowed => ALL_SRC, + }, + 'Enhances' => { + allowed => ALL_PKG, + dependency => 'union', + dep_order => 5, + }, + 'Essential' => { + allowed => ALL_PKG, + }, + 'Filename' => { + allowed => CTRL_APT_PKG, + }, + 'Files' => { + allowed => CTRL_PKG_SRC | CTRL_FILE_CHANGES, + }, + 'Format' => { + allowed => CTRL_PKG_SRC | CTRL_FILE_CHANGES, + }, + 'Homepage' => { + allowed => ALL_SRC | ALL_PKG, + }, + 'Installed-Size' => { + allowed => ALL_PKG & ~CTRL_INFO_PKG, + }, + 'Installer-Menu-Item' => { + allowed => ALL_PKG, + }, + 'Kernel-Version' => { + allowed => ALL_PKG, + }, + 'Origin' => { + allowed => (ALL_PKG | ALL_SRC) & (~CTRL_INFO_PKG), + }, + 'Maintainer' => { + allowed => CTRL_PKG_DEB | ALL_SRC | ALL_CHANGES, + }, + 'Multi-Arch' => { + allowed => ALL_PKG, + }, + 'Package' => { + allowed => ALL_PKG, + }, + 'Package-Type' => { + allowed => ALL_PKG, + }, + 'Parent' => { + allowed => CTRL_FILE_VENDOR, + }, + 'Pre-Depends' => { + allowed => ALL_PKG, + dependency => 'normal', + dep_order => 1, + }, + 'Priority' => { + allowed => CTRL_INFO_SRC | ALL_PKG, + }, + 'Provides' => { + allowed => ALL_PKG, + dependency => 'union', + dep_order => 9, + }, + 'Recommends' => { + allowed => ALL_PKG, + dependency => 'normal', + dep_order => 3, + }, + 'Replaces' => { + allowed => ALL_PKG, + dependency => 'union', + dep_order => 8, + }, + 'Section' => { + allowed => CTRL_INFO_SRC | ALL_PKG, + }, + 'Size' => { + allowed => CTRL_APT_PKG, + }, + 'Source' => { + allowed => (ALL_PKG | ALL_SRC | ALL_CHANGES) & + (~(CTRL_APT_SRC | CTRL_INFO_PKG)), + }, + 'Standards-Version' => { + allowed => ALL_SRC, + }, + 'Status' => { + allowed => CTRL_FILE_STATUS, + }, + 'Subarchitecture' => { + allowed => ALL_PKG, + }, + 'Suggests' => { + allowed => ALL_PKG, + dependency => 'normal', + dep_order => 4, + }, + 'Tag' => { + allowed => ALL_PKG, + }, + 'Task' => { + allowed => ALL_PKG, + }, + 'Triggers-Awaited' => { + allowed => CTRL_FILE_STATUS, + }, + 'Triggers-Pending' => { + allowed => CTRL_FILE_STATUS, + }, + 'Uploaders' => { + allowed => ALL_SRC, + }, + 'Urgency' => { + allowed => ALL_CHANGES, + }, + 'Vcs-Browser' => { + allowed => ALL_SRC, + }, + 'Vcs-Arch' => { + allowed => ALL_SRC, + }, + 'Vcs-Bzr' => { + allowed => ALL_SRC, + }, + 'Vcs-Cvs' => { + allowed => ALL_SRC, + }, + 'Vcs-Darcs' => { + allowed => ALL_SRC, + }, + 'Vcs-Git' => { + allowed => ALL_SRC, + }, + 'Vcs-Hg' => { + allowed => ALL_SRC, + }, + 'Vcs-Mtn' => { + allowed => ALL_SRC, + }, + 'Vcs-Svn' => { + allowed => ALL_SRC, + }, + 'Vendor' => { + allowed => CTRL_FILE_VENDOR, + }, + 'Vendor-Url' => { + allowed => CTRL_FILE_VENDOR, + }, + 'Version' => { + allowed => (ALL_PKG | ALL_SRC | ALL_CHANGES) & + (~(CTRL_INFO_SRC | CTRL_INFO_PKG)), + }, +); + +my @checksum_fields = map { field_capitalize("Checksums-$_") } @check_supported; +my @sum_fields = map { $_ eq "md5" ? "MD5sum" : field_capitalize($_) } + @check_supported; +&field_register($_, CTRL_PKG_SRC | CTRL_FILE_CHANGES) foreach @checksum_fields; +&field_register($_, CTRL_APT_PKG) foreach @sum_fields; + +our %FIELD_ORDER = ( + CTRL_PKG_DEB() => [ + qw(Package Package-Type Source Version Kernel-Version Architecture + Subarchitecture Installer-Menu-Item Essential Origin Bugs + Maintainer Installed-Size), &field_list_pkg_dep(), + qw(Section Priority Multi-Arch Homepage Description Tag Task) + ], + CTRL_PKG_SRC() => [ + qw(Format Source Binary Architecture Version Origin Maintainer + Uploaders Dm-Upload-Allowed Homepage Standards-Version Vcs-Browser + Vcs-Arch Vcs-Bzr Vcs-Cvs Vcs-Darcs Vcs-Git Vcs-Hg Vcs-Mtn + Vcs-Svn), &field_list_src_dep(), @checksum_fields, qw(Files) + ], + CTRL_FILE_CHANGES() => [ + qw(Format Date Source Binary Architecture Version Distribution + Urgency Maintainer Changed-By Description Closes Changes), + @checksum_fields, qw(Files) + ], + CTRL_CHANGELOG() => [ + qw(Source Version Distribution Urgency Maintainer Date Closes + Changes Timestamp Header Items Trailer Urgency_comment + Urgency_lc) + ], + CTRL_FILE_STATUS() => [ # Same as fieldinfos in lib/dpkg/parse.c + qw(Package Essential Status Priority Section Installed-Size Origin + Maintainer Bugs Architecture Source Version Config-Version + Replaces Provides Depends Pre-Depends Recommends Suggests Breaks + Conflicts Enhances Conffiles Description Triggers-Pending + Triggers-Awaited) + ], +); +# Order for CTRL_APT_PKG is derived from CTRL_PKG_DEB +$FIELD_ORDER{CTRL_APT_PKG()} = [ @{$FIELD_ORDER{CTRL_PKG_DEB()}} ]; +&field_insert_before(CTRL_APT_PKG, 'Section', 'Filename', 'Size', @sum_fields); +# Order for CTRL_APT_SRC is derived from CTRL_PKG_SRC +$FIELD_ORDER{CTRL_APT_SRC()} = [ @{$FIELD_ORDER{CTRL_PKG_SRC()}} ]; +@{$FIELD_ORDER{CTRL_APT_SRC()}} = map { $_ eq "Source" ? "Package" : $_ } + @{$FIELD_ORDER{CTRL_PKG_SRC()}}; +&field_insert_before(CTRL_APT_SRC, "Checksums-Md5", "Directory"); + +=head1 NAME + +Dpkg::Control::Fields - manage (list of official) control fields + +=head1 DESCRIPTION + +The modules contains a list of fieldnames with associated meta-data explaining +in which type of control information they are allowed. The types are the +CTRL_* constants exported by Dpkg::Control. + +=head1 FUNCTIONS + +=over 4 + +=item my $f = field_capitalize($field_name) + +Returns the field name properly capitalized. All characters are lowercase, +except the first of each word (words are separated by a dash in field names). + +=cut + +sub field_capitalize($) { + my $field = lc(shift); + # Some special cases due to history + return "MD5sum" if $field eq "md5sum"; + return uc($field) if exists $check_supported{$field}; + # Generic case + return join '-', map { ucfirst } split /-/, $field; +} + +=item field_is_official($fname) + +Returns true if the field is official and known. + +=cut + +sub field_is_official($) { + return exists $FIELDS{field_capitalize($_[0])}; +} + +=item field_is_allowed_in($fname, @types) + +Returns true (1) if the field $fname is allowed in all the types listed in +the list. Note that you can use type sets instead of individual types (ex: +CTRL_FILE_CHANGES | CTRL_CHANGELOG). + +field_allowed_in(A|B, C) returns true only if the field is allowed in C +and either A or B. + +Undef is returned for non-official fields. + +=cut + +sub field_is_allowed_in($@) { + my ($field, @types) = @_; + $field = field_capitalize($field); + return undef unless field_is_official($field); + + return 0 if not scalar(@types); + foreach my $type (@types) { + next if $type == CTRL_UNKNOWN; # Always allowed + return 0 unless $FIELDS{$field}{'allowed'} & $type; + } + return 1; +} + +=item field_transfer_single($from, $to, $field) + +If appropriate, copy the value of the field named $field taken from the +$from Dpkg::Control object to the $to Dpkg::Control object. + +Official fields are copied only if the field is allowed in both types of +objects. Custom fields are not copied except if the target object matches +the target destination encoded in the field name. The initial X denoting +custom fields can be followed by one or more letters among "S" (Source: +corresponds to CTRL_PKG_SRC), "B" (Binary: corresponds to CTRL_PKG_DEB) or "C" +(Changes: corresponds to CTRL_FILE_CHANGES). + +Returns undef if nothing has been copied or the name of the new field +added to $to otherwise. + +=cut + +sub field_transfer_single($$_) { + my ($from, $to, $field) = @_; + my ($from_type, $to_type) = ($from->get_type(), $to->get_type()); + $field = field_capitalize($field); + + if (field_is_allowed_in($field, $from_type, $to_type)) { + $to->{$field} = $from->{$field}; + return $field; + } elsif ($field =~ /^X([SBC]*)-/i) { + my $dest = $1; + if (($dest =~ /B/i and $to_type == CTRL_PKG_DEB) or + ($dest =~ /S/i and $to_type == CTRL_PKG_SRC) or + ($dest =~ /C/i and $to_type == CTRL_FILE_CHANGES)) + { + my $new = $field; + $new =~ s/^X([SBC]*)-//i; + $to->{$new} = $from->{$field}; + return $new; + } + } elsif (not field_is_allowed_in($field, $from_type)) { + warning(_g("unknown information field '%s' in input data in %s"), + $field, $from->get_option("name") || _g("control information")); + } + return undef; +} + +=item field_transfer_all($from, $to) + +Transfer all appropriate fields from $from to $to. Calls +field_transfer_single() on all fields available in $from. + +Returns the list of fields that have been added to $to. + +=cut + +sub field_transfer_all($$) { + my ($from, $to) = @_; + my (@res, $res); + foreach my $k (keys %$from) { + $res = field_transfer_single($from, $to, $k); + push @res, $res if $res and defined wantarray; + } + return @res; +} + +=item field_ordered_list($type) + +Returns an ordered list of fields for a given type of control information. +This list can be used to output the fields in a predictable order. +The list might be empty for types where the order does not matter much. + +=cut + +sub field_ordered_list($) { + my ($type) = @_; + return @{$FIELD_ORDER{$type}} if exists $FIELD_ORDER{$type}; + return (); +} + +=item field_list_src_dep() + +List of fields that contains dependencies-like information in a source +Debian package. + +=cut + +sub field_list_src_dep() { + return sort { + $FIELDS{$a}{'dep_order'} <=> $FIELDS{$b}{'dep_order'} + } grep { + field_is_allowed_in($_, CTRL_PKG_SRC) and + exists $FIELDS{$_}{'dependency'} + } keys %FIELDS; +} + +=item field_list_pkg_dep() + +List of fields that contains dependencies-like information in a binary +Debian package. The fields that express real dependencies are sorted from +the stronger to the weaker. + +=cut + +sub field_list_pkg_dep() { + my @keys = keys %FIELDS; + return sort { + $FIELDS{$a}{'dep_order'} <=> $FIELDS{$b}{'dep_order'} + } grep { + field_is_allowed_in($_, CTRL_PKG_DEB) and + exists $FIELDS{$_}{'dependency'} + } @keys; +} + +=item field_get_dep_type($field) + +Return the type of the dependency expressed by the given field. Can +either be "normal" for a real dependency field (Pre-Depends, Depends, ...) +or "union" for other relation fields sharing the same syntax (Conflicts, +Breaks, ...). Returns undef for fields which are not dependencies. + +=cut + +sub field_get_dep_type($) { + my $field = field_capitalize($_[0]); + return undef unless field_is_official($field); + return $FIELDS{$field}{'dependency'} if exists $FIELDS{$field}{'dependency'}; + return undef; +} + +=item field_register($field, $allowed_types, %opts) + +Register a new field as being allowed in control information of specified +types. %opts is optional + +=cut + +sub field_register($$;@) { + my ($field, $types, %opts) = @_; + $field = field_capitalize($field); + $FIELDS{$field} = { + allowed => $types, + %opts + }; +} + +=item field_insert_after($type, $ref, @fields) + +Place field after another one ($ref) in output of control information of +type $type. + +=cut +sub field_insert_after($$@) { + my ($type, $field, @fields) = @_; + return 0 if not exists $FIELD_ORDER{$type}; + ($field, @fields) = map { field_capitalize($_) } ($field, @fields); + @{$FIELD_ORDER{$type}} = map { + ($_ eq $field) ? ($_, @fields) : $_ + } @{$FIELD_ORDER{$type}}; + return 1; +} + +=item field_insert_before($type, $ref, @fields) + +Place field before another one ($ref) in output of control information of +type $type. + +=cut +sub field_insert_before($$@) { + my ($type, $field, @fields) = @_; + return 0 if not exists $FIELD_ORDER{$type}; + ($field, @fields) = map { field_capitalize($_) } ($field, @fields); + @{$FIELD_ORDER{$type}} = map { + ($_ eq $field) ? (@fields, $_) : $_ + } @{$FIELD_ORDER{$type}}; + return 1; +} + +=back + +=head1 AUTHOR + +Raphaël Hertzog . + +=cut + +1; diff --git a/scripts/Makefile.am b/scripts/Makefile.am index 13e58b11a..630fdff02 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -96,6 +96,7 @@ nobase_dist_perllib_DATA = \ Dpkg/Checksums.pm \ Dpkg/Compression.pm \ Dpkg/Control.pm \ + Dpkg/Control/Fields.pm \ Dpkg/Control/Info.pm \ Dpkg/Control/Hash.pm \ Dpkg/Control/Types.pm \ diff --git a/scripts/po/POTFILES.in b/scripts/po/POTFILES.in index 97d68a5a8..85de51ea8 100644 --- a/scripts/po/POTFILES.in +++ b/scripts/po/POTFILES.in @@ -19,6 +19,7 @@ scripts/Dpkg/Changelog.pm scripts/Dpkg/Changelog/Debian.pm scripts/Dpkg/Checksums.pm scripts/Dpkg/Control.pm +scripts/Dpkg/Control/Fields.pm scripts/Dpkg/Control/Info.pm scripts/Dpkg/Control/Hash.pm scripts/Dpkg/Control/Types.pm -- cgit v1.2.3