Your IP : 216.73.216.155
| Current Path : /usr/bin/ |
|
|
| Current File : //usr/bin/dpkg-genchanges |
#!/usr/bin/perl
#
# dpkg-genchanges
#
# 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, see <http://www.gnu.org/licenses/>.
use strict;
use warnings;
use Encode;
use POSIX;
use POSIX qw(:errno_h :signal_h);
use Dpkg;
use Dpkg::Gettext;
use Dpkg::Checksums;
use Dpkg::ErrorHandling;
use Dpkg::Arch qw(get_host_arch debarch_eq debarch_is);
use Dpkg::Compression;
use Dpkg::Control::Info;
use Dpkg::Control::Fields;
use Dpkg::Control;
use Dpkg::Substvars;
use Dpkg::Vars;
use Dpkg::Changelog::Parse;
use Dpkg::Version;
textdomain("dpkg-dev");
my $controlfile = 'debian/control';
my $changelogfile = 'debian/changelog';
my $changelogformat;
my $fileslistfile = 'debian/files';
my $uploadfilesdir = '..';
my $sourcestyle = 'i';
my $quiet = 0;
my $host_arch = get_host_arch();
my $changes_format = "1.8";
my %f2p; # - file to package map
my %p2f; # - package to file map, has entries for "packagename"
my %pa2f; # - likewise, has entries for "packagename architecture"
my %p2ver; # - package to version map
my %p2arch; # - package to arch map
my %f2sec; # - file to section map
my %f2seccf; # - likewise, from control file
my %f2pri; # - file to priority map
my %f2pricf; # - likewise, from control file
my %sourcedefault; # - default values as taken from source (used for Section,
# Priority and Maintainer)
my @descriptions;
my @fileslistfiles;
my $checksums = Dpkg::Checksums->new();
my %remove; # - fields to remove
my %override;
my %archadded;
my @archvalues;
my $dsc;
my $changesdescription;
my $forcemaint;
my $forcechangedby;
my $since;
my $substvars_loaded = 0;
my $substvars = Dpkg::Substvars->new();
$substvars->set("Format", $changes_format);
use constant SOURCE => 1;
use constant ARCH_DEP => 2;
use constant ARCH_INDEP => 4;
use constant BIN => ARCH_DEP | ARCH_INDEP;
use constant ALL => BIN | SOURCE;
my $include = ALL;
sub is_sourceonly() { return $include == SOURCE; }
sub is_binaryonly() { return !($include & SOURCE); }
sub binary_opt() { return (($include == BIN) ? '-b' :
(($include == ARCH_DEP) ? '-B' :
(($include == ARCH_INDEP) ? '-A' :
internerr("binary_opt called with include=$include"))));
}
sub version {
printf _g("Debian %s version %s.\n"), $progname, $version;
printf _g("
Copyright (C) 1996 Ian Jackson.
Copyright (C) 2000,2001 Wichert Akkerman.");
printf _g("
This is free software; see the GNU General Public License version 2 or
later for copying conditions. There is NO warranty.
");
}
sub usage {
printf _g(
"Usage: %s [<option> ...]
Options:
-b binary-only build - no source files.
-B arch-specific - no source or arch-indep files.
-A only arch-indep - no source or arch-specific files.
-S source-only upload.
-c<controlfile> get control info from this file.
-l<changelogfile> get per-version info from this file.
-f<fileslistfile> get .deb files list from this file.
-v<sinceversion> include all changes later than version.
-C<changesdescription> use change description from this file.
-m<maintainer> override control's maintainer value.
-e<maintainer> override changelog's maintainer value.
-u<uploadfilesdir> directory with files (default is \`..').
-si (default) src includes orig if new upstream.
-sa source includes orig src.
-sd source is diff and .dsc only.
-q quiet - no informational messages on stderr.
-F<changelogformat> force change log format.
-V<name>=<value> set a substitution variable.
-T<varlistfile> read variables here, not debian/substvars.
-D<field>=<value> override or add a field and value.
-U<field> remove a field.
-h, --help show this help message.
--version show the version.
"), $progname;
}
while (@ARGV) {
$_=shift(@ARGV);
if (m/^-b$/) {
is_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
$include = BIN;
} elsif (m/^-B$/) {
is_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
$include = ARCH_DEP;
printf STDERR _g("%s: arch-specific upload - not including arch-independent packages")."\n", $progname;
} elsif (m/^-A$/) {
is_sourceonly && usageerr(_g("cannot combine %s and %s"), $_, "-S");
$include = ARCH_INDEP;
printf STDERR _g("%s: arch-indep upload - not including arch-specific packages")."\n", $progname;
} elsif (m/^-S$/) {
is_binaryonly && usageerr(_g("cannot combine %s and %s"), binary_opt, "-S");
$include = SOURCE;
} elsif (m/^-s([iad])$/) {
$sourcestyle= $1;
} elsif (m/^-q$/) {
$quiet= 1;
} elsif (m/^-c(.*)$/) {
$controlfile = $1;
} elsif (m/^-l(.*)$/) {
$changelogfile = $1;
} elsif (m/^-C(.*)$/) {
$changesdescription = $1;
} elsif (m/^-f(.*)$/) {
$fileslistfile = $1;
} elsif (m/^-v(.*)$/) {
$since = $1;
} elsif (m/^-T(.*)$/) {
$substvars->load($1) if -e $1;
$substvars_loaded = 1;
} elsif (m/^-m(.*)$/s) {
$forcemaint = $1;
} elsif (m/^-e(.*)$/s) {
$forcechangedby = $1;
} elsif (m/^-F([0-9a-z]+)$/) {
$changelogformat = $1;
} elsif (m/^-D([^\=:]+)[=:](.*)$/s) {
$override{$1} = $2;
} elsif (m/^-u(.*)$/) {
$uploadfilesdir = $1;
} elsif (m/^-U([^\=:]+)$/) {
$remove{$1} = 1;
} elsif (m/^-V(\w[-:0-9A-Za-z]*)[=:](.*)$/s) {
$substvars->set($1, $2);
} elsif (m/^-(h|-help)$/) {
usage();
exit(0);
} elsif (m/^--version$/) {
version();
exit(0);
} else {
usageerr(_g("unknown option \`%s'"), $_);
}
}
# Retrieve info from the current changelog entry
my %options = (file => $changelogfile);
$options{"changelogformat"} = $changelogformat if $changelogformat;
$options{"since"} = $since if defined($since);
my $changelog = changelog_parse(%options);
# Change options to retrieve info of the former changelog entry
delete $options{"since"};
$options{"count"} = 1;
$options{"offset"} = 1;
my $prev_changelog = changelog_parse(%options);
# Other initializations
my $control = Dpkg::Control::Info->new($controlfile);
my $fields = Dpkg::Control->new(type => CTRL_FILE_CHANGES);
$substvars->set_version_substvars($changelog->{"Version"});
$substvars->set_arch_substvars();
$substvars->load("debian/substvars") if -e "debian/substvars" and not $substvars_loaded;
if (defined($prev_changelog) and
version_compare_relation($changelog->{"Version"}, REL_LT,
$prev_changelog->{"Version"}))
{
warning(_g("the current version (%s) is earlier than the previous one (%s)"),
$changelog->{"Version"}, $prev_changelog->{"Version"})
# ~bpo and ~vola are backports and have lower version number by definition
unless $changelog->{"Version"} =~ /~(?:bpo|vola)/;
}
if (not is_sourceonly) {
open(FL, "<", $fileslistfile) || syserr(_g("cannot read files list file"));
while(<FL>) {
if (m/^(([-+.0-9a-z]+)_([^_]+)_([-\w]+)\.u?deb) (\S+) (\S+)$/) {
defined($p2f{"$2 $4"}) &&
warning(_g("duplicate files list entry for package %s (line %d)"),
$2, $.);
$f2p{$1}= $2;
$pa2f{"$2 $4"}= $1;
$p2f{$2} ||= [];
push @{$p2f{$2}}, $1;
$p2ver{$2}= $3;
defined($f2sec{$1}) &&
warning(_g("duplicate files list entry for file %s (line %d)"),
$1, $.);
$f2sec{$1}= $5;
$f2pri{$1}= $6;
push(@archvalues,$4) unless !$4 || $archadded{$4}++;
push(@fileslistfiles,$1);
} elsif (m/^([-+.0-9a-z]+_[^_]+_([-\w]+)\.[a-z0-9.]+) (\S+) (\S+)$/) {
# A non-deb package
$f2sec{$1}= $3;
$f2pri{$1}= $4;
push(@archvalues,$2) unless !$2 || $archadded{$2}++;
push(@fileslistfiles,$1);
} elsif (m/^([-+.,_0-9a-zA-Z]+) (\S+) (\S+)$/) {
defined($f2sec{$1}) &&
warning(_g("duplicate files list entry for file %s (line %d)"),
$1, $.);
$f2sec{$1}= $2;
$f2pri{$1}= $3;
push(@fileslistfiles,$1);
} else {
error(_g("badly formed line in files list file, line %d"), $.);
}
}
close(FL);
}
# Scan control info of source package
my $src_fields = $control->get_source();
foreach $_ (keys %{$src_fields}) {
my $v = $src_fields->{$_};
if (m/^Source$/) {
set_source_package($v);
} elsif (m/^Section$|^Priority$/i) {
$sourcedefault{$_} = $v;
} else {
field_transfer_single($src_fields, $fields);
}
}
# Scan control info of all binary packages
foreach my $pkg ($control->get_packages()) {
my $p = $pkg->{"Package"};
my $a = $pkg->{"Architecture"} || "";
my $d = $pkg->{"Description"} || "no description available";
$d = $1 if $d =~ /^(.*)\n/;
my $pkg_type = $pkg->{"Package-Type"} ||
$pkg->get_custom_field("Package-Type") || "deb";
my @f; # List of files for this binary package
push @f, @{$p2f{$p}} if defined $p2f{$p};
# Add description of all binary packages
my $desc = encode_utf8(sprintf("%-10s - %-.65s", $p, decode_utf8($d)));
$desc .= " (udeb)" if $pkg_type eq "udeb";
push @descriptions, $desc;
if (not defined($p2f{$p})) {
# No files for this package... warn if it's unexpected
if ((debarch_eq('all', $a) and ($include & ARCH_INDEP)) ||
(grep(debarch_is($host_arch, $_), split(/\s+/, $a))
and ($include & ARCH_DEP))) {
warning(_g("package %s in control file but not in files list"),
$p);
}
next; # and skip it
}
$p2arch{$p} = $a;
foreach $_ (keys %{$pkg}) {
my $v = $pkg->{$_};
if (m/^Section$/) {
$f2seccf{$_} = $v foreach (@f);
} elsif (m/^Priority$/) {
$f2pricf{$_} = $v foreach (@f);
} elsif (m/^Architecture$/) {
if (grep(debarch_is($host_arch, $_), split(/\s+/, $v))
and ($include & ARCH_DEP)) {
$v = $host_arch;
} elsif (!debarch_eq('all', $v)) {
$v = '';
}
push(@archvalues,$v) unless !$v || $archadded{$v}++;
} elsif (m/^Description$/) {
# Description in changes is computed, do not copy this field
} else {
field_transfer_single($pkg, $fields);
}
}
}
# Scan fields of dpkg-parsechangelog
foreach $_ (keys %{$changelog}) {
my $v = $changelog->{$_};
if (m/^Source$/i) {
set_source_package($v);
} elsif (m/^Maintainer$/i) {
$fields->{"Changed-By"} = $v;
} else {
field_transfer_single($changelog, $fields);
}
}
if ($changesdescription) {
open(X, "<", $changesdescription) || syserr(_g("read changesdescription"));
$fields->{'Changes'} = "\n" . join("", <X>);
close(X);
}
for my $pa (keys %pa2f) {
my ($pp, $aa) = (split / /, $pa);
defined($control->get_pkg_by_name($pp)) ||
warning(_g("package %s listed in files list but not in control info"),
$pp);
}
for my $p (keys %p2f) {
my @f = @{$p2f{$p}};
foreach my $f (@f) {
my $sec = $f2seccf{$f};
$sec ||= $sourcedefault{'Section'};
if (!defined($sec)) {
$sec = '-';
warning(_g("missing Section for binary package %s; using '-'"), $p);
}
$sec eq $f2sec{$f} || error(_g("package %s has section %s in " .
"control file but %s in files list"),
$p, $sec, $f2sec{$f});
my $pri = $f2pricf{$f};
$pri ||= $sourcedefault{'Priority'};
if (!defined($pri)) {
$pri = '-';
warning(_g("missing Priority for binary package %s; using '-'"), $p);
}
$pri eq $f2pri{$f} || error(_g("package %s has priority %s in " .
"control file but %s in files list"),
$p, $pri, $f2pri{$f});
}
}
my $origsrcmsg;
if (!is_binaryonly) {
my $sec = $sourcedefault{'Section'};
if (!defined($sec)) {
$sec = '-';
warning(_g("missing Section for source files"));
}
my $pri = $sourcedefault{'Priority'};
if (!defined($pri)) {
$pri = '-';
warning(_g("missing Priority for source files"));
}
(my $sversion = $substvars->get('source:Version')) =~ s/^\d+://;
$dsc= "$uploadfilesdir/${sourcepackage}_${sversion}.dsc";
my $dsc_fields = Dpkg::Control->new(type => CTRL_PKG_SRC);
$dsc_fields->load($dsc) || error(_g("%s is empty", $dsc));
$checksums->add_from_file($dsc, key => "$sourcepackage\_$sversion.dsc");
$checksums->add_from_control($dsc_fields, use_files_for_md5 => 1);
for my $f ($checksums->get_files()) {
$f2sec{$f} = $sec;
$f2pri{$f} = $pri;
}
# Compare upstream version to previous upstream version to decide if
# the .orig tarballs must be included
my $include_tarball;
if (defined($prev_changelog)) {
my $cur = Dpkg::Version->new($changelog->{"Version"});
my $prev = Dpkg::Version->new($prev_changelog->{"Version"});
$include_tarball = ($cur->version() ne $prev->version()) ? 1 : 0;
} else {
# No previous entry means first upload, tarball required
$include_tarball = 1;
}
my $ext = $compression_re_file_ext;
if ((($sourcestyle =~ m/i/ && not($include_tarball)) ||
$sourcestyle =~ m/d/) &&
grep(m/\.(debian\.tar|diff)\.$ext$/, $checksums->get_files()))
{
$origsrcmsg= _g("not including original source code in upload");
foreach my $f (grep m/\.orig(-.+)?\.tar\.$ext$/, $checksums->get_files()) {
$checksums->remove_file($f);
}
} else {
if ($sourcestyle =~ m/d/ &&
!grep(m/\.(debian\.tar|diff)\.$ext$/, $checksums->get_files())) {
warning(_g("ignoring -sd option for native Debian package"));
}
$origsrcmsg= _g("including full source code in upload");
}
} else {
$origsrcmsg= _g("binary-only upload - not including any source code");
}
print(STDERR "$progname: $origsrcmsg\n") ||
syserr(_g("write original source message")) unless $quiet;
$fields->{'Format'} = $substvars->get("Format");
if (!defined($fields->{'Date'})) {
chomp(my $date822 = `date -R`);
$? && subprocerr("date -R");
$fields->{'Date'}= $date822;
}
$fields->{'Binary'} = join(' ', map { $_->{'Package'} } $control->get_packages());
# Avoid overly long line by splitting over multiple lines
if (length($fields->{'Binary'}) > 980) {
$fields->{'Binary'} =~ s/(.{0,980}) /$1\n/g;
}
unshift(@archvalues,'source') unless is_binaryonly;
@archvalues = ('all') if $include == ARCH_INDEP;
@archvalues = grep {!debarch_eq('all',$_)} @archvalues
unless $include & ARCH_INDEP;
$fields->{'Architecture'} = join(' ',@archvalues);
$fields->{'Description'} = "\n" . join("\n", sort @descriptions);
$fields->{'Files'} = '';
my %filedone;
for my $f ($checksums->get_files(), @fileslistfiles) {
next if ($include == ARCH_DEP and debarch_eq('all', $p2arch{$f2p{$f}}));
next if ($include == ARCH_INDEP and not debarch_eq('all', $p2arch{$f2p{$f}}));
next if $filedone{$f}++;
my $uf = "$uploadfilesdir/$f";
$checksums->add_from_file($uf, key => $f);
$fields->{'Files'} .= "\n" . $checksums->get_checksum($f, "md5") .
" " . $checksums->get_size($f) .
" $f2sec{$f} $f2pri{$f} $f";
}
$checksums->export_to_control($fields);
# redundant with the Files field
delete $fields->{"Checksums-Md5"};
$fields->{'Source'}= $sourcepackage;
if ($fields->{'Version'} ne $substvars->get('source:Version')) {
$fields->{'Source'} .= " (" . $substvars->get('source:Version') . ")";
}
$fields->{'Maintainer'} = $forcemaint if defined($forcemaint);
$fields->{'Changed-By'} = $forcechangedby if defined($forcechangedby);
for my $f (qw(Version Distribution Maintainer Changes)) {
defined($fields->{$f}) ||
error(_g("missing information for critical output field %s"), $f);
}
for my $f (qw(Urgency)) {
defined($fields->{$f}) ||
warning(_g("missing information for output field %s"), $f);
}
for my $f (keys %override) {
$fields->{$f} = $override{$f};
}
for my $f (keys %remove) {
delete $fields->{$f};
}
$fields->output(\*STDOUT); # Note: no substitution of variables