summaryrefslogtreecommitdiffstats
path: root/scripts/debchange.pl
diff options
context:
space:
mode:
Diffstat (limited to 'scripts/debchange.pl')
-rwxr-xr-xscripts/debchange.pl1884
1 files changed, 1884 insertions, 0 deletions
diff --git a/scripts/debchange.pl b/scripts/debchange.pl
new file mode 100755
index 0000000..73501c3
--- /dev/null
+++ b/scripts/debchange.pl
@@ -0,0 +1,1884 @@
+#!/usr/bin/perl
+# vim: set ai shiftwidth=4 tabstop=4 expandtab:
+
+# debchange: update the debian changelog using your favorite visual editor
+# For options, see the usage message below.
+#
+# When creating a new changelog section, if either of the environment
+# variables DEBEMAIL or EMAIL is set, debchange will use this as the
+# uploader's email address (with the former taking precedence), and if
+# DEBFULLNAME or NAME is set, it will use this as the uploader's full name.
+# Otherwise, it will take the standard values for the current user or,
+# failing that, just copy the values from the previous changelog entry.
+#
+# Originally by Christoph Lameter <clameter@debian.org>
+# Modified extensively by Julian Gilbey <jdg@debian.org>
+#
+# Copyright 1999-2005 by Julian Gilbey
+#
+# 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 <https://www.gnu.org/licenses/>.
+
+use 5.008; # We're using PerlIO layers
+use strict;
+use warnings;
+use open ':utf8'; # changelogs are written with UTF-8 encoding
+use filetest 'access'; # use access rather than stat for -w
+# for checking whether user names are valid and making format() behave
+use Encode qw/decode_utf8 encode_utf8/;
+use Getopt::Long qw(:config bundling permute no_getopt_compat);
+use File::Copy;
+use File::Basename;
+use Cwd;
+use Dpkg::Vendor qw(get_current_vendor);
+use Dpkg::Changelog::Parse qw(changelog_parse);
+use Dpkg::Control;
+use Dpkg::Version;
+use Devscripts::Compression;
+use Devscripts::Debbugs;
+use POSIX qw(locale_h strftime);
+
+setlocale(LC_TIME, "C"); # so that strftime is locale independent
+
+# Predeclare functions
+sub fatal($);
+my $warnings = 0;
+
+# And global variables
+my $progname = basename($0);
+my $modified_conf_msg;
+my %env;
+my $CHGLINE; # used by the format O section at the end
+
+my $compression_re = compression_get_file_extension_regex();
+
+my $debian_distro_info;
+
+sub get_debian_distro_info {
+ return $debian_distro_info if defined $debian_distro_info;
+ eval { require Debian::DistroInfo; };
+ if ($@) {
+ printf "libdistro-info-perl is not installed, Debian release names "
+ . "are not known.\n";
+ $debian_distro_info = 0;
+ } else {
+ $debian_distro_info = DebianDistroInfo->new();
+ }
+ return $debian_distro_info;
+}
+
+my $ubuntu_distro_info;
+
+sub get_ubuntu_distro_info {
+ return $ubuntu_distro_info if defined $ubuntu_distro_info;
+ eval { require Debian::DistroInfo; };
+ if ($@) {
+ printf "libdistro-info-perl is not installed, Ubuntu release names "
+ . "are not known.\n";
+ $ubuntu_distro_info = 0;
+ } else {
+ $ubuntu_distro_info = UbuntuDistroInfo->new();
+ }
+ return $ubuntu_distro_info;
+}
+
+sub get_ubuntu_devel_distro {
+ my $ubu_info = get_ubuntu_distro_info();
+ if ($ubu_info == 0 or !$ubu_info->devel()) {
+ warn "$progname warning: Unable to determine the current Ubuntu "
+ . "development release. Using UNRELEASED instead.\n";
+ return 'UNRELEASED';
+ } else {
+ return $ubu_info->devel();
+ }
+}
+
+sub usage () {
+ print <<"EOF";
+Usage: $progname [options] [changelog entry]
+Options:
+ -a, --append
+ Append a new entry to the current changelog
+ -i, --increment
+ Increase the Debian release number, adding a new changelog entry
+ -v <version>, --newversion=<version>
+ Add a new changelog entry with version number specified
+ -e, --edit
+ Don't change version number or add a new changelog entry, just
+ opens an editor
+ -r, --release
+ Update the changelog timestamp. If the distribution is set to
+ "UNRELEASED", change it to unstable (or another distribution as
+ specified by --distribution, or the name of the current development
+ release when run under Ubuntu).
+ --force-save-on-release
+ When --release is used and an editor opened to allow inspection
+ of the changelog, require the user to save the changelog their
+ editor opened. Otherwise, the original changelog will not be
+ modified. (default)
+ --no-force-save-on-release
+ Do not do so. Note that a dummy changelog entry may be supplied
+ in order to achieve the same effect - e.g. $progname --release ""
+ The entry will not be added to the changelog but its presence will
+ suppress the editor
+ --create
+ Create a new changelog (default) or NEWS file (with --news) and
+ open for editing
+ --empty
+ When creating a new changelog, don't add any changes to it
+ (i.e. only include the header and trailer lines)
+ --package <package>
+ Specify the package name when using --create (optional)
+ --auto-nmu
+ Attempt to intelligently determine whether a change to the
+ changelog represents an NMU (default)
+ --no-auto-nmu
+ Do not do so
+ -n, --nmu
+ Increment the Debian release number for a non-maintainer upload
+ --bin-nmu
+ Increment the Debian release number for a binary non-maintainer upload
+ -q, --qa
+ Increment the Debian release number for a Debian QA Team upload
+ -R, --rebuild
+ Increment the Debian release number for a no-change rebuild
+ -s, --security
+ Increment the Debian release number for a Debian Security Team upload
+ --lts
+ Increment the Debian release number for a LTS Security Team upload
+ --team
+ Increment the Debian release number for a team upload
+ -U, --upstream
+ Increment the Debian release number without any appended derivative
+ distribution name
+ --bpo
+ Increment the Debian release number for a backports upload
+ to "bookworm-backports"
+ --stable
+ Increment the Debian release number for a stable upload.
+ -l, --local <suffix>
+ Add a suffix to the Debian version number for a local build
+ -b, --force-bad-version
+ Force a version to be less than the current one (e.g., when
+ backporting)
+ --allow-lower-version <pattern>
+ Allow a version to be less than the current one (e.g., when
+ backporting) if it matches the specified pattern
+ --force-distribution
+ Force the provided distribution to be used, even if it doesn't match
+ the list of known distributions
+ --closes nnnnn[,nnnnn,...]
+ Add entries for closing these bug numbers,
+ getting bug titles from the BTS (bug-tracking system, bugs.debian.org)
+ --[no]query
+ [Don\'t] try contacting the BTS to get bug titles (default: do query)
+ -d, --fromdirname
+ Add a new changelog entry with version taken from the directory name
+ -p, --preserve
+ Preserve the directory name
+ --no-preserve
+ Do not preserve the directory name (default)
+ --vendor <vendor>
+ Override the distributor ID from dpkg-vendor.
+ -D, --distribution <dist>
+ Use the specified distribution in the changelog entry being edited
+ -u, --urgency <urgency>
+ Use the specified urgency in the changelog entry being edited
+ -c, --changelog <changelog>
+ Specify the name of the changelog to use in place of debian/changelog
+ No directory traversal or checking is performed in this case.
+ --news <newsfile>
+ Specify that the newsfile (default debian/NEWS) is to be edited
+ --[no]multimaint
+ When appending an entry to a changelog section (-a), [do not]
+ indicate if multiple maintainers are now involved (default: do so)
+ --[no]multimaint-merge
+ When appending an entry to a changelog section, [do not] merge the
+ entry into an existing changelog section for the current author.
+ (default: do not)
+ -m, --maintmaint
+ Don\'t change (maintain) the maintainer details in the changelog entry
+ -M, --controlmaint
+ Use maintainer name and email from the debian/control Maintainer field
+ -t, --mainttrailer
+ Don\'t change (maintain) the trailer line in the changelog entry; i.e.
+ maintain the maintainer and date/time details
+ --check-dirname-level N
+ How much to check directory names:
+ N=0 never
+ N=1 only if program changes directory (default)
+ N=2 always
+ --check-dirname-regex REGEX
+ What constitutes a matching directory name; REGEX is
+ a Perl regular expression; the string \`PACKAGE\' will
+ be replaced by the package name; see manpage for details
+ (default: 'PACKAGE(-.+)?')
+ --no-conf, --noconf
+ Don\'t read devscripts config files; must be the first option given
+ --release-heuristic log|changelog
+ Select heuristic used to determine if a package has been released.
+ (default: changelog)
+ --help, -h
+ Display this help message and exit
+ --version
+ Display version information
+ At most one of -a, -i, -e, -r, -v, -d, -n, --bin-nmu, -q, --qa, -R, -s,
+ --lts, --team, --bpo, --stable, -l (or their long equivalents) may be used.
+ With no options, one of -i or -a is chosen by looking at the release
+ specified in the changelog.
+
+Default settings modified by devscripts configuration files:
+$modified_conf_msg
+EOF
+}
+
+sub version () {
+ print <<"EOF";
+This is $progname, from the Debian devscripts package, version 2.17.10
+This code is copyright 1999-2003 by Julian Gilbey, all rights reserved.
+Based on code by Christoph Lameter.
+This program comes with ABSOLUTELY NO WARRANTY.
+You are free to redistribute this code under the terms of the
+GNU General Public License, version 2 or later.
+EOF
+}
+
+# Start by setting default values
+my $check_dirname_level = 1;
+my $check_dirname_regex = 'PACKAGE(-.+)?';
+my $opt_p = 0;
+my $opt_query = 1;
+my $opt_release_heuristic = 'changelog';
+my $opt_release_heuristic_re = '^(changelog|log)$';
+my $opt_multimaint = 1;
+my $opt_multimaint_merge = 0;
+my $opt_tz = undef;
+my $opt_t = '';
+my $opt_allow_lower = '';
+my $opt_auto_nmu = 1;
+my $opt_force_save_on_release = 1;
+my $opt_vendor = undef;
+
+# Next, read configuration files and then command line
+# The next stuff is boilerplate
+
+if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) {
+ $modified_conf_msg = " (no configuration files read)";
+ shift;
+} else {
+ my @config_files = ('/etc/devscripts.conf', '~/.devscripts');
+ my %config_vars = (
+ 'DEBCHANGE_PRESERVE' => 'no',
+ 'DEBCHANGE_QUERY_BTS' => 'yes',
+ 'DEVSCRIPTS_CHECK_DIRNAME_LEVEL' => 1,
+ 'DEVSCRIPTS_CHECK_DIRNAME_REGEX' => 'PACKAGE(-.+)?',
+ 'DEBCHANGE_RELEASE_HEURISTIC' => 'changelog',
+ 'DEBCHANGE_MULTIMAINT' => 'yes',
+ 'DEBCHANGE_TZ' => $ENV{TZ}, # undef if TZ unset
+ 'DEBCHANGE_MULTIMAINT_MERGE' => 'no',
+ 'DEBCHANGE_MAINTTRAILER' => '',
+ 'DEBCHANGE_LOWER_VERSION_PATTERN' => '',
+ 'DEBCHANGE_AUTO_NMU' => 'yes',
+ 'DEBCHANGE_FORCE_SAVE_ON_RELEASE' => 'yes',
+ 'DEBCHANGE_VENDOR' => '',
+ );
+ $config_vars{'DEBCHANGE_TZ'} ||= '';
+ my %config_default = %config_vars;
+
+ my $shell_cmd;
+ # Set defaults
+ foreach my $var (keys %config_vars) {
+ $shell_cmd .= qq[$var="$config_vars{$var}";\n];
+ }
+ $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n";
+ $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n";
+ # Read back values
+ foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" }
+ my $shell_out = `/bin/bash -c '$shell_cmd'`;
+ @config_vars{ keys %config_vars } = split /\n/, $shell_out, -1;
+
+ # Check validity
+ $config_vars{'DEBCHANGE_PRESERVE'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCHANGE_PRESERVE'} = 'no';
+ $config_vars{'DEBCHANGE_QUERY_BTS'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCHANGE_QUERY_BTS'} = 'yes';
+ $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'} =~ /^[012]$/
+ or $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'} = 1;
+ $config_vars{'DEBCHANGE_RELEASE_HEURISTIC'} =~ $opt_release_heuristic_re
+ or $config_vars{'DEBCHANGE_RELEASE_HEURISTIC'} = 'changelog';
+ $config_vars{'DEBCHANGE_MULTIMAINT'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCHANGE_MULTIMAINT'} = 'yes';
+ $config_vars{'DEBCHANGE_MULTIMAINT_MERGE'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCHANGE_MULTIMAINT_MERGE'} = 'no';
+ $config_vars{'DEBCHANGE_AUTO_NMU'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCHANGE_AUTO_NMU'} = 'yes';
+ $config_vars{'DEBCHANGE_FORCE_SAVE_ON_RELEASE'} =~ /^(yes|no)$/
+ or $config_vars{'DEBCHANGE_FORCE_SAVE_ON_RELEASE'} = 'yes';
+
+ foreach my $var (sort keys %config_vars) {
+ if ($config_vars{$var} ne $config_default{$var}) {
+ $modified_conf_msg .= " $var=$config_vars{$var}\n";
+ }
+ }
+ $modified_conf_msg ||= " (none)\n";
+ chomp $modified_conf_msg;
+
+ $opt_p = $config_vars{'DEBCHANGE_PRESERVE'} eq 'yes' ? 1 : 0;
+ $opt_query = $config_vars{'DEBCHANGE_QUERY_BTS'} eq 'no' ? 0 : 1;
+ $check_dirname_level = $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'};
+ $check_dirname_regex = $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_REGEX'};
+ $opt_release_heuristic = $config_vars{'DEBCHANGE_RELEASE_HEURISTIC'};
+ $opt_multimaint = $config_vars{'DEBCHANGE_MULTIMAINT'} eq 'no' ? 0 : 1;
+ $opt_tz = $config_vars{'DEBCHANGE_TZ'};
+ $opt_multimaint_merge
+ = $config_vars{'DEBCHANGE_MULTIMAINT_MERGE'} eq 'no' ? 0 : 1;
+ $opt_t = ($config_vars{'DEBCHANGE_MAINTTRAILER'} eq 'no' ? 0 : 1)
+ if $config_vars{'DEBCHANGE_MAINTTRAILER'};
+ $opt_allow_lower = $config_vars{'DEBCHANGE_LOWER_VERSION_PATTERN'};
+ $opt_auto_nmu = $config_vars{'DEBCHANGE_AUTO_NMU'} eq 'yes';
+ $opt_force_save_on_release
+ = $config_vars{'DEBCHANGE_FORCE_SAVE_ON_RELEASE'} eq 'yes' ? 1 : 0;
+ $opt_vendor = $config_vars{'DEBCHANGE_VENDOR'};
+}
+
+# We use bundling so that the short option behaviour is the same as
+# with older debchange versions.
+my ($opt_help, $opt_version);
+my (
+ $opt_i, $opt_a, $opt_e, $opt_r, $opt_v,
+ $opt_b, $opt_d, $opt_D, $opt_u, $opt_force_dist
+);
+my (
+ $opt_n, $opt_bn, $opt_qa, $opt_R, $opt_s,
+ $opt_lts, $opt_team, $opt_U, $opt_bpo, $opt_stable,
+ $opt_l, $opt_c, $opt_m, $opt_M, $opt_create,
+ $opt_package, @closes
+);
+my ($opt_news);
+my ($opt_noconf, $opt_empty);
+
+Getopt::Long::Configure('bundling');
+GetOptions(
+ "help|h" => \$opt_help,
+ "version" => \$opt_version,
+ "i|increment" => \$opt_i,
+ "a|append" => \$opt_a,
+ "e|edit" => \$opt_e,
+ "r|release" => \$opt_r,
+ "create" => \$opt_create,
+ "package=s" => \$opt_package,
+ "v|newversion=s" => \$opt_v,
+ "b|force-bad-version" => \$opt_b,
+ "allow-lower-version=s" => \$opt_allow_lower,
+ "force-distribution" => \$opt_force_dist,
+ "d|fromdirname" => \$opt_d,
+ "p" => \$opt_p,
+ "preserve!" => \$opt_p,
+ "D|distribution=s" => \$opt_D,
+ "u|urgency=s" => \$opt_u,
+ "n|nmu" => \$opt_n,
+ "bin-nmu" => \$opt_bn,
+ "q|qa" => \$opt_qa,
+ "R|rebuild" => \$opt_R,
+ "s|security" => \$opt_s,
+ "team" => \$opt_team,
+ "U|upstream" => \$opt_U,
+ "bpo" => \$opt_bpo,
+ "lts" => \$opt_lts,
+ "stable" => \$opt_stable,
+ "l|local=s" => \$opt_l,
+ "query!" => \$opt_query,
+ "closes=s" => \@closes,
+ "c|changelog=s" => \$opt_c,
+ "news:s" => \$opt_news,
+ "multimaint!" => \$opt_multimaint,
+ "multi-maint!" => \$opt_multimaint,
+ 'multimaint-merge!' => \$opt_multimaint_merge,
+ 'multi-maint-merge!' => \$opt_multimaint_merge,
+ "m|maintmaint" => \$opt_m,
+ "M|controlmaint" => \$opt_M,
+ "t|mainttrailer!" => \$opt_t,
+ "check-dirname-level=s" => \$check_dirname_level,
+ "check-dirname-regex=s" => \$check_dirname_regex,
+ "noconf" => \$opt_noconf,
+ "no-conf" => \$opt_noconf,
+ "release-heuristic=s" => \$opt_release_heuristic,
+ "empty" => \$opt_empty,
+ "auto-nmu!" => \$opt_auto_nmu,
+ "force-save-on-release!" => \$opt_force_save_on_release,
+ "vendor=s" => \$opt_vendor,
+ )
+ or die
+"Usage: $progname [options] [changelog entry]\nRun $progname --help for more details\n";
+
+# So that we can distinguish, if required, between an explicit
+# passing of -a / -i and their values being automagically deduced
+# later on
+my $opt_a_passed = $opt_a || 0;
+my $opt_i_passed = $opt_i || 0;
+$opt_news = 'debian/NEWS' if defined $opt_news and $opt_news eq '';
+
+if ($opt_t eq '' && $opt_release_heuristic eq 'changelog') {
+ $opt_t = 1;
+}
+
+if ($opt_noconf) {
+ fatal "--no-conf is only acceptable as the first command-line option!";
+}
+if ($opt_help) { usage; exit 0; }
+if ($opt_version) { version; exit 0; }
+
+if ($check_dirname_level !~ /^[012]$/) {
+ fatal "Unrecognised --check-dirname-level value (allowed are 0,1,2)";
+}
+if ($opt_release_heuristic !~ $opt_release_heuristic_re) {
+ fatal "Allowed values for --release-heuristics are log and changelog.";
+}
+
+# Only allow at most one non-help option
+fatal
+"Only one of -a, -i, -e, -r, -v, -d, -n/--nmu, --bin-nmu, -q/--qa, -R/--rebuild, -s/--security, --lts, --team, --bpo, --stable, -l/--local is allowed;\ntry $progname --help for more help"
+ if ($opt_i ? 1 : 0)
+ + ($opt_a ? 1 : 0)
+ + ($opt_e ? 1 : 0)
+ + ($opt_r ? 1 : 0)
+ + ($opt_v ? 1 : 0)
+ + ($opt_d ? 1 : 0)
+ + ($opt_n ? 1 : 0)
+ + ($opt_bn ? 1 : 0)
+ + ($opt_qa ? 1 : 0)
+ + ($opt_R ? 1 : 0)
+ + ($opt_s ? 1 : 0)
+ + ($opt_lts ? 1 : 0)
+ + ($opt_team ? 1 : 0)
+ + ($opt_bpo ? 1 : 0)
+ + ($opt_stable ? 1 : 0)
+ + ($opt_l ? 1 : 0) > 1;
+
+# FIXME shouldn't this be later so that the user can override the urgency,
+# e.g. "-s -ulow" ?
+if ($opt_s || $opt_lts) {
+ $opt_u = "high";
+}
+
+if (defined $opt_u) {
+ fatal "Urgency can only be one of: low, medium, high, critical, emergency"
+ unless $opt_u =~ /^(low|medium|high|critical|emergency)$/;
+}
+
+# See if we're Debian, Ubuntu or someone else, if we can
+my $vendor;
+if (defined $opt_vendor && $opt_vendor) {
+ $vendor = $opt_vendor;
+} else {
+ if (defined $opt_D) {
+ # Try to guess the vendor based on the given distribution name
+ my $distro = $opt_D;
+ $distro =~ s/-.*//;
+ my $deb_info = get_debian_distro_info();
+ my $ubu_info = get_ubuntu_distro_info();
+ if ($deb_info != 0 and $deb_info->valid($distro)) {
+ $vendor = 'Debian';
+ } elsif ($ubu_info != 0 and $ubu_info->valid($distro)) {
+ $vendor = 'Ubuntu';
+ }
+ }
+ if (not defined $vendor) {
+ # Get the vendor from dpkg-vendor (dpkg-vendor --query Vendor)
+ $vendor = get_current_vendor();
+ }
+}
+$vendor ||= 'Debian';
+if ($vendor eq 'Ubuntu'
+ and ($opt_n or $opt_bn or $opt_qa or $opt_bpo or $opt_stable or $opt_lts))
+{
+ $vendor = 'Debian';
+}
+
+# Check the distro name given.
+if (defined $opt_D) {
+ if ($vendor eq 'Debian') {
+ unless ($opt_D
+ =~ /^(experimental|unstable|sid|UNRELEASED|((old){0,2}stable|testing|buster|bullseye|bookworm|trixie)(-proposed-updates|-security)?|proposed-updates)$/
+ ) {
+ my $deb_info = get_debian_distro_info();
+ my ($oldstable_backports, $stable_backports) = ("", "");
+ if ($deb_info == 0) {
+ warn
+"$progname warning: Unable to determine Debian's backport distributions.\n";
+ } else {
+ $stable_backports = $deb_info->stable() . "-backports";
+# Silence any potential warnings $deb_info emits when oldstable is no longer supported
+ local $SIG{__WARN__} = sub { };
+ my $oldstable = $deb_info->old();
+ $oldstable_backports = "$oldstable-backports" if $oldstable;
+ }
+ if ( $deb_info == 0
+ || $opt_D
+ !~ m/^(\Q$stable_backports\E|\Q$oldstable_backports\E)$/) {
+ $stable_backports = ", " . $stable_backports
+ if $stable_backports;
+ $oldstable_backports = ", " . $oldstable_backports
+ if $oldstable_backports;
+ warn "$progname warning: Recognised distributions are: \n"
+ . "experimental, unstable, testing, stable, oldstable, oldoldstable,\n"
+ . "{trixie,bookworm,bullseye,buster}-proposed-updates,\n"
+ . "{testing,stable,oldstable,oldoldstable}-proposed-updates,\n"
+ . "{trixie,bookworm,bullseye,buster}-security,\n"
+ . "{testing,stable,oldstable,oldoldstable}}-security$oldstable_backports$stable_backports and UNRELEASED.\n"
+ . "Using your request anyway.\n";
+ $warnings++ if not $opt_force_dist;
+ }
+ }
+ } elsif ($vendor eq 'Ubuntu') {
+ if ($opt_D eq 'UNRELEASED') {
+ ;
+ } else {
+ my $ubu_release = $opt_D;
+ $ubu_release =~ s/(-updates|-security|-proposed|-backports)$//;
+ my $ubu_info = get_ubuntu_distro_info();
+ if ($ubu_info == 0) {
+ warn "$progname warning: Unable to determine if $ubu_release "
+ . "is a valid Ubuntu release.\n";
+ } elsif (!$ubu_info->valid($ubu_release)) {
+ warn "$progname warning: Recognised distributions are:\n{"
+ . join(',', $ubu_info->supported())
+ . "}{,-updates,-security,-proposed,-backports} and UNRELEASED.\n"
+ . "Using your request anyway.\n";
+ $warnings++ if not $opt_force_dist;
+ }
+ }
+ } else {
+ # Unknown vendor, skip check
+ }
+}
+
+fatal
+"--closes should not be used with --news; put bug numbers in the changelog not the NEWS file"
+ if $opt_news && @closes;
+
+# hm, this can probably be used with more than just -i.
+fatal "--package can only be used with --create, --increment and --newversion"
+ if $opt_package && !($opt_create || $opt_i || $opt_v);
+
+my $changelog_path = $opt_c || $ENV{'CHANGELOG'} || 'debian/changelog';
+my $real_changelog_path = $changelog_path;
+if ($opt_news) { $changelog_path = $opt_news; }
+if ($changelog_path ne 'debian/changelog' and not $opt_news) {
+ $check_dirname_level = 0;
+}
+
+# extra --create checks
+fatal "--package cannot be used when creating a NEWS file"
+ if $opt_package && $opt_news;
+
+if ($opt_create) {
+ if ( $opt_a
+ || $opt_i
+ || $opt_e
+ || $opt_r
+ || $opt_b
+ || $opt_n
+ || $opt_bn
+ || $opt_qa
+ || $opt_R
+ || $opt_s
+ || $opt_lts
+ || $opt_team
+ || $opt_bpo
+ || $opt_stable
+ || $opt_l
+ || $opt_allow_lower) {
+ warn
+"$progname warning: ignoring -a/-i/-e/-r/-b/--allow-lower-version/-n/--bin-nmu/-q/--qa/-R/-s/--lts/--team/--bpo/--stable,-l options with --create\n";
+ $warnings++;
+ }
+ if ($opt_package && $opt_d) {
+ fatal "Can only use one of --package and -d";
+ }
+}
+
+@closes = split(/,/, join(',', @closes));
+map { s/^\#//; } @closes; # remove any leading # from bug numbers
+
+# We'll process the rest of the command line later.
+
+# Look for the changelog
+my $chdir = 0;
+if (!$opt_create) {
+ if ($changelog_path eq 'debian/changelog' or $opt_news) {
+ until (-f $changelog_path) {
+ $chdir = 1;
+ chdir '..' or fatal "Can't chdir ..: $!";
+ if (cwd() eq '/') {
+ fatal
+"Cannot find $changelog_path anywhere!\nAre you in the source code tree?\n(You could use --create if you wish to create this file.)";
+ }
+ }
+
+ # Can't write, so stop now.
+ if (!-w $changelog_path) {
+ fatal "$changelog_path is not writable!";
+ }
+ } else {
+ unless (-f $changelog_path) {
+ fatal
+"Cannot find $changelog_path!\nAre you in the correct directory?\n(You could use --create if you wish to create this file.)";
+ }
+
+ # Can't write, so stop now.
+ if (!-w $changelog_path) {
+ fatal "$changelog_path is not writable!";
+ }
+ }
+} else { # $opt_create
+ unless (-d dirname $changelog_path) {
+ fatal "Cannot find "
+ . (dirname $changelog_path)
+ . " directory!\nAre you in the correct directory?";
+ }
+ if (-f $changelog_path) {
+ fatal "File $changelog_path already exists!";
+ }
+ unless (-w dirname $changelog_path) {
+ fatal "Cannot find "
+ . (dirname $changelog_path)
+ . " directory!\nAre you in the correct directory?";
+ }
+ if ($opt_news && !-f 'debian/changelog') {
+ fatal "I can't create $opt_news without debian/changelog present";
+ }
+}
+
+#####
+
+# Find the current version number etc.
+my $changelog;
+my $PACKAGE = 'PACKAGE';
+my $VERSION = 'VERSION';
+my $MAINTAINER = 'MAINTAINER';
+my $EMAIL = 'EMAIL';
+my $DISTRIBUTION = 'UNRELEASED';
+# when updating the lines below also update the help text, the manpage and the testcases.
+my %dists = (10, 'buster', 11, 'bullseye', 12, 'bookworm', 13, 'trixie');
+my $lts_dist = '10';
+my $latest_dist = '12';
+# dist guessed from backports, SRU, security uploads...
+my $guessed_dist = '';
+my $CHANGES = '';
+# Changelog urgency, possibly propagated to NEWS files
+my $CL_URGENCY = '';
+
+if (!$opt_create || ($opt_create && $opt_news)) {
+ my $file = $opt_create ? 'debian/changelog' : $changelog_path;
+ $changelog = changelog_parse(file => $file);
+
+ # Now we've read the changelog, set some variables and then
+ # let's check the directory name is sensible
+ fatal "No package name in changelog!"
+ unless exists $changelog->{Source};
+ $PACKAGE = $changelog->{Source};
+ fatal "No version number in changelog!"
+ unless exists $changelog->{Version};
+ $VERSION = $changelog->{Version};
+ fatal "No maintainer in changelog!"
+ unless exists $changelog->{Maintainer};
+ $changelog->{Maintainer} = decode_utf8($changelog->{Maintainer});
+ ($MAINTAINER, $EMAIL) = ($changelog->{Maintainer} =~ /^([^<]*) <(.*)>/);
+ $MAINTAINER ||= '';
+ fatal "No distribution in changelog!"
+ unless exists $changelog->{Distribution};
+
+ if ($vendor eq 'Ubuntu') {
+ # In Ubuntu the development release regularly changes, don't just copy
+ # the previous name.
+ $DISTRIBUTION = get_ubuntu_devel_distro();
+ } else {
+ $DISTRIBUTION = $changelog->{Distribution};
+ }
+ fatal "No changes in changelog!"
+ unless exists $changelog->{Changes};
+
+ # Find the current package version
+ if ($opt_news) {
+ my $found_version = 0;
+ my $found_urgency = 0;
+ my $clog = changelog_parse(file => $real_changelog_path);
+ $VERSION = $clog->{Version};
+ $VERSION =~ s/~$//;
+
+ $CL_URGENCY = $clog->{Urgency};
+ }
+
+ # Is the directory name acceptable?
+ if ($check_dirname_level == 2
+ or ($check_dirname_level == 1 and $chdir)) {
+ my $re = $check_dirname_regex;
+ $re =~ s/PACKAGE/\\Q$PACKAGE\\E/g;
+ my $gooddir;
+ if ($re =~ m%/%) { $gooddir = eval "cwd() =~ /^$re\$/;"; }
+ else { $gooddir = eval "basename(cwd()) =~ /^$re\$/;"; }
+
+ if (!$gooddir) {
+ my $pwd = cwd();
+ fatal <<"EOF";
+Found debian/changelog for package $PACKAGE in the directory
+ $pwd
+but this directory name does not match the package name according to the
+regex $check_dirname_regex.
+
+To run $progname on this package, see the --check-dirname-level and
+--check-dirname-regex options; run $progname --help for more info.
+EOF
+ }
+ }
+} else {
+ # we're creating and we don't know much about our package
+ if ($opt_d) {
+ my $pwd = basename(cwd());
+ # The directory name should be <package>-<version>
+ my $version_chars = '0-9a-zA-Z+\.\-';
+ if ($pwd =~ m/^([a-z0-9][a-z0-9+\-\.]+)-([0-9][$version_chars]*)$/) {
+ $PACKAGE = $1;
+ $VERSION = "$2-1"; # introduce a Debian version of -1
+ } elsif ($pwd =~ m/^[a-z0-9][a-z0-9+\-\.]+$/) {
+ $PACKAGE = $pwd;
+ } else {
+ # don't know anything
+ }
+ }
+ if ($opt_v) {
+ $VERSION = $opt_v;
+ }
+ if ($opt_D) {
+ $DISTRIBUTION = $opt_D;
+ }
+}
+
+if ($opt_package) {
+ if ($opt_package =~ m/^[a-z0-9][a-z0-9+\-\.]+$/) {
+ $PACKAGE = $opt_package;
+ } else {
+ warn
+"$progname warning: illegal package name used with --package: $opt_package\n";
+ $warnings++;
+ }
+}
+
+# Clean up after old versions of debchange
+if (-f "debian/RELEASED") {
+ unlink("debian/RELEASED");
+}
+
+if (-e "$changelog_path.dch") {
+ fatal "The backup file $changelog_path.dch already exists --\n"
+ . "please move it before trying again";
+}
+
+# Is this a native Debian package, i.e., does it have a - in the
+# version number?
+(my $EPOCH) = ($VERSION =~ /^(\d+):/);
+(my $SVERSION = $VERSION) =~ s/^\d+://;
+(my $UVERSION = $SVERSION) =~ s/-[^-]*$//;
+
+# Check, sanitise and decode these environment variables
+check_env_utf8('DEBFULLNAME');
+check_env_utf8('NAME');
+check_env_utf8('DEBEMAIL');
+check_env_utf8('EMAIL');
+check_env_utf8('UBUMAIL');
+
+if (exists $env{'DEBEMAIL'} and $env{'DEBEMAIL'} =~ /^(.*)\s+<(.*)>$/) {
+ $env{'DEBFULLNAME'} = $1 unless exists $env{'DEBFULLNAME'};
+ $env{'DEBEMAIL'} = $2;
+}
+if (!exists $env{'DEBEMAIL'} or !exists $env{'DEBFULLNAME'}) {
+ if (exists $env{'EMAIL'} and $env{'EMAIL'} =~ /^(.*)\s+<(.*)>$/) {
+ $env{'DEBFULLNAME'} = $1 unless exists $env{'DEBFULLNAME'};
+ $env{'EMAIL'} = $2;
+ }
+}
+if (exists $env{'UBUMAIL'} and $env{'UBUMAIL'} =~ /^(.*)\s+<(.*)>$/) {
+ $env{'DEBFULLNAME'} = $1 unless exists $env{'DEBFULLNAME'};
+ $env{'UBUMAIL'} = $2;
+}
+
+# Now use the gleaned values to determine our MAINTAINER and EMAIL values
+if (!$opt_m and !$opt_M) {
+ if (exists $env{'DEBFULLNAME'}) {
+ $MAINTAINER = $env{'DEBFULLNAME'};
+ } elsif (exists $env{'NAME'}) {
+ $MAINTAINER = $env{'NAME'};
+ } else {
+ my @pw = getpwuid $<;
+ if ($pw[6]) {
+ if (my $pw = decode_utf8($pw[6])) {
+ $pw =~ s/,.*//;
+ $MAINTAINER = $pw;
+ } else {
+ warn
+"$progname warning: passwd full name field for uid $<\nis not UTF-8 encoded; ignoring\n";
+ $warnings++;
+ }
+ }
+ }
+ # Otherwise, $MAINTAINER retains its default value of the last
+ # changelog entry
+
+ # Email is easier
+ if ($vendor eq 'Ubuntu' and exists $env{'UBUMAIL'}) {
+ $EMAIL = $env{'UBUMAIL'};
+ } elsif (exists $env{'DEBEMAIL'}) {
+ $EMAIL = $env{'DEBEMAIL'};
+ } elsif (exists $env{'EMAIL'}) {
+ $EMAIL = $env{'EMAIL'};
+ } else {
+ warn
+"$progname warning: neither DEBEMAIL nor EMAIL environment variable is set\n";
+ $warnings++;
+ my $addr;
+ if (open MAILNAME, '/etc/mailname') {
+ warn
+"$progname warning: building email address from username and mailname\n";
+ $warnings++;
+ chomp($addr = <MAILNAME>);
+ close MAILNAME;
+ }
+ if (!$addr) {
+ warn
+"$progname warning: building email address from username and FQDN\n";
+ $warnings++;
+ chomp($addr = `hostname --fqdn 2>/dev/null`);
+ $addr = undef if $?;
+ }
+ if ($addr) {
+ my $user = getpwuid $<;
+ if (!$user) {
+ $addr = undef;
+ } else {
+ $addr = "$user\@$addr";
+ }
+ }
+ $EMAIL = $addr if $addr;
+ }
+ # Otherwise, $EMAIL retains its default value of the last changelog entry
+} # if (! $opt_m and ! $opt_M)
+
+if ($opt_M) {
+ if (-f 'debian/control') {
+ my $parser = Dpkg::Control->new(type => CTRL_INFO_SRC);
+ $parser->load('debian/control');
+ my $maintainer = decode_utf8($parser->{Maintainer});
+ if ($maintainer =~ /^(.*)\s+<(.*)>$/) {
+ $MAINTAINER = $1;
+ $EMAIL = $2;
+ } else {
+ fatal "$progname: invalid debian/control Maintainer field value\n";
+ }
+ } else {
+ fatal "Missing file debian/control";
+ }
+}
+
+#####
+
+if (
+ $opt_auto_nmu
+ and !$opt_v
+ and !$opt_l
+ and !$opt_s
+ and !$opt_lts
+ and !$opt_team
+ and !$opt_qa
+ and !$opt_R
+ and !$opt_bpo
+ and !$opt_bn
+ and !$opt_n
+ and !$opt_c
+ and !$opt_stable
+ and !(exists $ENV{'CHANGELOG'} and length $ENV{'CHANGELOG'})
+ and !$opt_M
+ and !$opt_create
+ and !$opt_a_passed
+ and !$opt_r
+ and !$opt_e
+ and $vendor ne 'Ubuntu'
+ and $vendor ne 'Tanglu'
+ and !(
+ $opt_release_heuristic eq 'changelog'
+ and $changelog->{Distribution} eq 'UNRELEASED'
+ and !$opt_i_passed
+ )
+) {
+
+ if (-f 'debian/control') {
+ my $parser = Dpkg::Control->new(type => CTRL_INFO_SRC);
+ $parser->load('debian/control');
+ my $uploader = decode_utf8($parser->{Uploaders}) || '';
+ $uploader =~ s/^\s+//;
+ my $maintainer = decode_utf8($parser->{Maintainer});
+ my @uploaders = split(/\s*,\s*/, $uploader);
+
+ my $packager = "$MAINTAINER <$EMAIL>";
+
+ if ( $maintainer !~ m/<packages\@qa\.debian\.org>/
+ and !grep { $_ eq $packager } ($maintainer, @uploaders)
+ and $packager ne $changelog->{Maintainer}
+ and !$opt_team) {
+ $opt_n = 1;
+ $opt_a = 0;
+ }
+ } else {
+ fatal "Missing file debian/control";
+ }
+}
+#####
+
+# Do we need to generate "closes" entries?
+
+my @closes_text = ();
+my $initial_release = 0;
+if (@closes and $opt_query) { # and we have to query the BTS
+ if (!Devscripts::Debbugs::have_soap) {
+ warn
+"$progname warning: libsoap-lite-perl not installed, so cannot query the bug-tracking system\n";
+ $opt_query = 0;
+ $warnings++;
+ # This will now go and execute the "if (@closes and ! $opt_query)" code
+ } else {
+ my $bugs = Devscripts::Debbugs::select("src:" . $PACKAGE);
+ my $statuses = Devscripts::Debbugs::status(
+ map { [bug => $_, indicatesource => 1] } @{$bugs});
+ if ($statuses eq "") {
+ warn "$progname: No bugs found for package $PACKAGE\n";
+ }
+ foreach my $close (@closes) {
+ if ($statuses and exists $statuses->{$close}) {
+ my $title = $statuses->{$close}->{subject};
+ my $pkg = $statuses->{$close}->{package};
+ $title =~ s/^($pkg|$PACKAGE): //;
+ push @closes_text,
+"Fix \"$title\" <explain what you changed and why> (Closes: \#$close)\n";
+ } else { # not our package, or wnpp
+ my $bug = Devscripts::Debbugs::status(
+ [bug => $close, indicatesource => 1]);
+ if ($bug eq "") {
+ warn
+"$progname warning: unknown bug \#$close does not belong to $PACKAGE,\n disabling closing changelog entry\n";
+ $warnings++;
+ push @closes_text,
+ "Closes?? \#$close: UNKNOWN BUG IN WRONG PACKAGE!!\n";
+ } else {
+ my $bugtitle = $bug->{$close}->{subject};
+ $bugtitle ||= '';
+ my $bugpkg = $bug->{$close}->{package};
+ $bugpkg ||= '?';
+ my $bugsrcpkg = $bug->{$close}->{source};
+ $bugsrcpkg ||= '?';
+ if ($bugsrcpkg eq $PACKAGE) {
+ warn
+"$progname warning: bug \#$close appears to be already archived,\n disabling closing changelog entry\n";
+ $warnings++;
+ push @closes_text,
+"Closes?? \#$close: ALREADY ARCHIVED? $bugtitle!!\n";
+ } elsif ($bugpkg eq 'wnpp') {
+ if ($bugtitle =~ /(^(O|RFA|ITA): )/) {
+ push @closes_text,
+"New maintainer. (Closes: \#$close: $bugtitle)\n";
+ } elsif ($bugtitle =~ /(^(RFP|ITP): )/) {
+ push @closes_text,
+"Initial release. (Closes: \#$close: $bugtitle)\n";
+ $initial_release = 1;
+ }
+ } else {
+ warn
+"$progname warning: bug \#$close belongs to package $bugpkg (src $bugsrcpkg),\n not to $PACKAGE: disabling closing changelog entry\n";
+ $warnings++;
+ push @closes_text,
+ "Closes?? \#$close: WRONG PACKAGE!! $bugtitle\n";
+ }
+ }
+ }
+ }
+ }
+}
+
+if (@closes and !$opt_query) { # and we don't have to query the BTS
+ foreach my $close (@closes) {
+ unless ($close =~ /^\d{3,}$/) {
+ warn "$progname warning: Bug number $close is invalid; ignoring\n";
+ $warnings++;
+ next;
+ }
+ push @closes_text, "Closes: \#$close: \n";
+ }
+}
+
+# Get a possible changelog entry from the command line
+my $ARGS = join(' ', @ARGV);
+my $TEXT = decode_utf8($ARGS);
+my $EMPTY_TEXT = 0;
+
+if (@ARGV and !$TEXT) {
+ if ($ARGS) {
+ warn
+"$progname warning: command-line changelog entry not UTF-8 encoded; ignoring\n";
+ $TEXT = '';
+ } else {
+ $EMPTY_TEXT = 1;
+ }
+}
+
+# Get the date
+my $DATE;
+{
+ local $ENV{TZ} = $opt_tz if $opt_tz;
+ $DATE = strftime "%a, %d %b %Y %T %z", localtime();
+}
+
+if ($opt_news && !$opt_i && !$opt_a) {
+ if ($VERSION eq $changelog->{Version} && !$opt_v && !$opt_l) {
+ $opt_a = 1;
+ } else {
+ $opt_i = 1;
+ }
+}
+
+# Are we going to have to figure things out for ourselves?
+if ( !$opt_i
+ && !$opt_v
+ && !$opt_d
+ && !$opt_a
+ && !$opt_e
+ && !$opt_r
+ && !$opt_n
+ && !$opt_bn
+ && !$opt_qa
+ && !$opt_R
+ && !$opt_s
+ && !$opt_lts
+ && !$opt_team
+ && !$opt_bpo
+ && !$opt_stable
+ && !$opt_l
+ && !$opt_create) {
+ # Yes, we are
+ if ($opt_release_heuristic eq 'log') {
+ my @UPFILES = glob("../$PACKAGE\_$SVERSION\_*.upload");
+ if (@UPFILES > 1) {
+ fatal "Found more than one appropriate .upload file!\n"
+ . "Please use an explicit -a, -i or -v option instead.";
+ } elsif (@UPFILES == 0) {
+ $opt_a = 1;
+ } else {
+ open UPFILE, "<${UPFILES[0]}"
+ or fatal "Couldn't open .upload file for reading: $!\n"
+ . "Please use an explicit -a, -i or -v option instead.";
+ while (<UPFILE>) {
+ if (
+m%^(s|Successfully uploaded) (/.*/)?\Q$PACKAGE\E\_\Q$SVERSION\E\_[\w\-\+]+\.changes %
+ ) {
+ $opt_i = 1;
+ last;
+ }
+ }
+ close UPFILE
+ or fatal "Problems experienced reading .upload file: $!\n"
+ . "Please use an explicit -a, -i or -v option instead.";
+ if (!$opt_i) {
+ warn
+"$progname warning: A successful upload of the current version was not logged\n"
+ . "in the upload log file; adding log entry to current version.\n";
+ $opt_a = 1;
+ }
+ }
+ } elsif ($opt_release_heuristic eq 'changelog') {
+ if ($changelog->{Distribution} eq 'UNRELEASED') {
+ $opt_a = 1;
+ } elsif ($EMPTY_TEXT == 1) {
+ $opt_a = 1;
+ } else {
+ $opt_i = 1;
+ }
+ } else {
+ fatal "Bad release heuristic value";
+ }
+}
+
+# Open in anticipation....
+unless ($opt_create) {
+ open S, $changelog_path
+ or fatal "Cannot open existing $changelog_path: $!";
+
+ # Read the first stanza from the changelog file
+ # We do this directly rather than reusing $changelog->{Changes}
+ # so that we have the verbatim changes rather than a (albeit very
+ # slightly) reformatted version. See Debian bug #452806
+
+ while (<S>) {
+ last if /^ --/;
+
+ $CHANGES .= $_;
+ }
+
+ chomp $CHANGES;
+
+ # Reset file pointer
+ seek(S, 0, 0);
+}
+open O, ">$changelog_path.dch"
+ or fatal "Cannot write to temporary file: $!";
+# Turn off form feeds; taken from perlform
+select((select(O), $^L = "")[0]);
+
+# Note that we now have to remove it
+my $tmpchk = 1;
+my ($NEW_VERSION, $NEW_SVERSION, $NEW_UVERSION);
+my $line;
+my $optionsok = 0;
+my $merge = 0;
+
+if ((
+ $opt_i
+ || $opt_n
+ || $opt_bn
+ || $opt_qa
+ || $opt_R
+ || $opt_s
+ || $opt_lts
+ || $opt_team
+ || $opt_bpo
+ || $opt_stable
+ || $opt_l
+ || $opt_v
+ || $opt_d
+ || ($opt_news && $VERSION ne $changelog->{Version}))
+ && !$opt_create
+) {
+
+ $optionsok = 1;
+
+ # Check that a given explicit version number is sensible.
+ if ($opt_v || $opt_d) {
+ if ($opt_v) {
+ $NEW_VERSION = $opt_v;
+ } else {
+ my $pwd = basename(cwd());
+ # The directory name should be <package>-<version>
+ my $version_chars = '0-9a-zA-Z+\.~';
+ $version_chars .= ':' if defined $EPOCH;
+ $version_chars .= '\-' if $UVERSION ne $SVERSION;
+ if ($pwd =~ m/^\Q$PACKAGE\E-([0-9][$version_chars]*)$/) {
+ $NEW_VERSION = $1;
+ if ($NEW_VERSION eq $UVERSION) {
+ # So it's a Debian-native package
+ if ($SVERSION eq $UVERSION) {
+ fatal
+"New version taken from directory ($NEW_VERSION) is equal to\n"
+ . "the current version number ($UVERSION)!";
+ }
+ # So we just increment the Debian revision
+ warn
+"$progname warning: Incrementing Debian revision without altering\nupstream version number.\n";
+ $VERSION =~ /^(.*?)([a-yA-Y][a-zA-Z]*|\d*)$/;
+ my $end = $2;
+ if ($end eq '') {
+ fatal
+"Cannot determine new Debian revision; please use -v option!";
+ }
+ $end++;
+ $NEW_VERSION = "$1$end";
+ } else {
+ $NEW_VERSION = "$EPOCH:$NEW_VERSION" if defined $EPOCH;
+ $NEW_VERSION .= "-1";
+ }
+ } else {
+ fatal
+"The directory name must be <package>-<version> for -d to work!\n"
+ . "No underscores allowed!";
+ }
+ # Don't try renaming the directory in this case!
+ $opt_p = 1;
+ }
+
+ if (version_compare($VERSION, $NEW_VERSION) == 1) {
+ if ($opt_b
+ or ($opt_allow_lower and $NEW_VERSION =~ /$opt_allow_lower/)) {
+ warn
+"$progname warning: new version ($NEW_VERSION) is less than\n"
+ . "the current version number ($VERSION).\n";
+ } else {
+ fatal "New version specified ($NEW_VERSION) is less than\n"
+ . "the current version number ($VERSION)! Use -b to force.";
+ }
+ }
+
+ ($NEW_SVERSION = $NEW_VERSION) =~ s/^\d+://;
+ ($NEW_UVERSION = $NEW_SVERSION) =~ s/-[^-]*$//;
+ }
+
+ # We use the following criteria for the version and release number:
+ # the last component of the version number is used as the
+ # release number. If this is not a Debian native package, then the
+ # upstream version number is everything up to the final '-', not
+ # including epochs.
+
+ if (!$NEW_VERSION) {
+ if ($VERSION =~ /(.*?)([a-yA-Y][a-zA-Z]*|\d+)([+~])?$/i) {
+ my $extra = $3 || '';
+ my $useextra = 0;
+ my $end = $2;
+ my $start = $1;
+ # If it's not already an NMU make it so
+ # otherwise we can be safe if we behave like dch -i
+
+ if (
+ ($opt_n or $opt_s)
+ and $vendor ne 'Ubuntu'
+ and $vendor ne 'Tanglu'
+ and ( ($VERSION eq $UVERSION and not $start =~ /\+nmu/)
+ or ($VERSION ne $UVERSION and not $start =~ /\.$/))
+ ) {
+
+ if ($VERSION eq $UVERSION) {
+ # First NMU of a Debian native package
+ $end .= "+nmu1";
+ } else {
+ $end += 0.1;
+ }
+ } elsif ($opt_bn and not $start =~ /\+b/) {
+ $end .= "+b1";
+ } elsif ($opt_qa and $start =~ /(.*?)-(\d+)\.$/) {
+ # Drop NMU revision when doing a QA upload
+ my $upstream_version = $1;
+ my $debian_revision = $2;
+ $debian_revision++;
+ $start = "$upstream_version-$debian_revision";
+ $end = "";
+ } elsif ($opt_R
+ and $vendor eq 'Ubuntu'
+ and not $start =~ /build/
+ and not $start =~ /ubuntu/) {
+ $end .= "build1";
+ } elsif ($opt_R
+ and $vendor eq 'Tanglu'
+ and not "$start$end" =~ /(b\d+)$/
+ and not $start =~ /tanglu/) {
+ $end .= "b1";
+ } elsif ($opt_bpo and not $start =~ /~bpo[0-9]+\+$/) {
+ # If it's not already a backport make it so
+ # otherwise we can be safe if we behave like dch -i
+ $end .= "~bpo$latest_dist+1";
+ } elsif ($opt_stable and not $start =~ /\+deb\d+u/) {
+ $end .= "+deb${latest_dist}u1";
+ } elsif ($opt_lts and not $start =~ /\+deb\d+u/) {
+ $end .= "+deb${lts_dist}u1";
+ $guessed_dist = $dists{$lts_dist} . '-security';
+ } elsif ($opt_l and not $start =~ /\Q$opt_l\E/) {
+ # If it's not already a local package make it so
+ # otherwise we can be safe if we behave like dch -i
+ $end .= $opt_l . "1";
+ } elsif (!$opt_news) {
+ # Don't bump the version of a NEWS file in this case as we're
+ # using the version from the changelog
+ if ( ($opt_i or $opt_s)
+ and $vendor eq 'Ubuntu'
+ and $start !~ /(ubuntu|~ppa)(\d+\.)*$/
+ and not $opt_U) {
+
+ if ($start =~ /build/) {
+ # Drop buildX suffix in favor of ubuntu1
+ $start =~ s/build//;
+ $end = "";
+ }
+ $end .= "ubuntu1";
+ } elsif (($opt_i or $opt_s)
+ and $vendor eq 'Tanglu'
+ and $start !~ /(tanglu)(\d+\.)*$/
+ and not $opt_U) {
+
+ if ("$start$end" =~ /(b\d+)$/) {
+ # Drop bX suffix in favor of tanglu1
+ $start =~ s/b$//;
+ $end = "";
+ }
+ $end .= "tanglu1";
+ } else {
+ $end++;
+ }
+
+ # Attempt to set the distribution for a stable upload correctly
+ # based on the version of the previous upload
+ if ($opt_stable || $opt_bpo || $opt_s || $opt_lts) {
+ my $previous_dist = $start;
+ $previous_dist =~ s/^.*[+~](?:deb|bpo)(\d+)(?:u\+)$/$1/;
+ if ( defined $previous_dist
+ and defined $dists{$previous_dist}) {
+ if ($opt_s || $opt_lts) {
+ $guessed_dist
+ = $dists{$previous_dist} . '-security';
+ } elsif ($opt_bpo) {
+ +$guessed_dist
+ = $dists{$previous_dist} . '-backports';
+ } elsif ($opt_stable) {
+ $guessed_dist = $dists{$previous_dist};
+ }
+ } elsif ($opt_s) {
+ $guessed_dist = $dists{$latest_dist} . '-security';
+ } elsif ($opt_lts) {
+ $guessed_dist = $dists{$lts_dist} . '-security';
+ } else {
+ # Fallback to using the previous distribution
+ $guessed_dist = $changelog->{Distribution};
+ }
+ }
+
+ if (
+ !(
+ $opt_s
+ or $opt_n
+ or $vendor eq 'Ubuntu'
+ or $vendor eq 'Tanglu'
+ )
+ ) {
+ if ($start =~ /(.*?)-(\d+)\.$/) {
+ # Drop NMU revision
+ my $upstream_version = $1;
+ my $debian_revision = $2;
+ $debian_revision++;
+ $start = "$upstream_version-$debian_revision";
+ $end = "";
+ }
+ }
+
+ if (!($opt_qa or $opt_bpo or $opt_stable or $opt_l)) {
+ $useextra = 1;
+ }
+ }
+ $NEW_VERSION = "$start$end";
+ if ($useextra) {
+ $NEW_VERSION .= $extra;
+ }
+ ($NEW_SVERSION = $NEW_VERSION) =~ s/^\d+://;
+ ($NEW_UVERSION = $NEW_SVERSION) =~ s/-[^-]*$//;
+ } else {
+ fatal "Error parsing version number: $VERSION";
+ }
+ }
+
+ if ($NEW_VERSION eq $NEW_UVERSION and $VERSION ne $UVERSION) {
+ warn
+"$progname warning: New package version is Debian native whilst previous version was not\n";
+ } elsif ($NEW_VERSION ne $NEW_UVERSION and $VERSION eq $UVERSION) {
+ warn
+"$progname warning: Previous package version was Debian native whilst new version is not\n"
+ unless $opt_n or $opt_s;
+ }
+
+ if ($opt_bpo) {
+ $guessed_dist ||= $dists{$latest_dist} . '-backports';
+ }
+ if ($opt_stable) {
+ $guessed_dist ||= $dists{$latest_dist};
+ }
+ my $distribution
+ = $opt_D
+ || $guessed_dist
+ || (
+ ($opt_release_heuristic eq 'changelog')
+ ? "UNRELEASED"
+ : $DISTRIBUTION
+ );
+
+ my $urgency = $opt_u;
+ if ($opt_news) {
+ $urgency ||= $CL_URGENCY;
+ }
+ $urgency ||= 'medium';
+
+ if ( ($opt_v or $opt_i or $opt_l or $opt_d)
+ and $opt_release_heuristic eq 'changelog'
+ and $changelog->{Distribution} eq 'UNRELEASED') {
+
+ $merge = 1;
+ } else {
+ print O "$PACKAGE ($NEW_VERSION) $distribution; urgency=$urgency";
+ print O ", binary-only=yes" if ($opt_bn);
+ print O "\n\n";
+ if ($opt_n && !$opt_news) {
+ print O " * Non-maintainer upload.\n";
+ $line = 1;
+ } elsif ($opt_bn && !$opt_news) {
+ my $arch = qx/dpkg-architecture -qDEB_BUILD_ARCH/;
+ chomp($arch);
+ print O
+" * Binary-only non-maintainer upload for $arch; no source changes.\n";
+ $line = 1;
+ } elsif ($opt_qa && !$opt_news) {
+ print O " * QA upload.\n";
+ $line = 1;
+ } elsif ($opt_s && !$opt_news) {
+ if ($vendor eq 'Ubuntu' or $vendor eq 'Tanglu') {
+ print O " * SECURITY UPDATE:\n";
+ print O " * References\n";
+ } else {
+ print O " * Non-maintainer upload by the Security Team.\n";
+ }
+ $line = 1;
+ } elsif ($opt_lts && !$opt_news) {
+ print O " * Non-maintainer upload by the LTS Security Team.\n";
+ $line = 1;
+ } elsif ($opt_team && !$opt_news) {
+ print O " * Team upload.\n";
+ $line = 1;
+ } elsif ($opt_bpo && !$opt_news) {
+ print O " * Rebuild for $guessed_dist.\n";
+ $line = 1;
+ }
+ if (@closes_text or $TEXT or $EMPTY_TEXT) {
+ foreach (@closes_text) { format_line($_, 1); }
+ if (length $TEXT) { format_line($TEXT, 1); }
+ } elsif ($opt_news) {
+ print O " \n";
+ } else {
+ print O " * \n";
+ }
+ $line += 3;
+ print O "\n -- $MAINTAINER <$EMAIL> $DATE\n\n";
+
+ # Copy the old changelog file to the new one
+ local $/ = undef;
+ print O <S>;
+ }
+}
+if (($opt_r || $opt_a || $merge) && !$opt_create) {
+ # This means we just have to generate a new * entry in changelog
+ # and if a multi-developer changelog is detected, add developer names.
+
+ $NEW_VERSION = $VERSION unless $NEW_VERSION;
+ $NEW_SVERSION = $SVERSION unless $NEW_SVERSION;
+ $NEW_UVERSION = $UVERSION unless $NEW_UVERSION;
+
+ # Read and discard maintainer line, see who made the
+ # last entry, and determine whether there are existing
+ # multi-developer changes by the current maintainer.
+ $line = -1;
+ my ($lastmaint, $nextmaint, $maintline, $count, $lastheader, $lastdist,
+ $dist_indicator);
+ my $savedline = $line;
+ while (<S>) {
+ $line++;
+ # Start of existing changes by the current maintainer
+ if (/^ \[ \Q$MAINTAINER\E \]$/ && $opt_multimaint_merge) {
+ # If there's more than one such block,
+ # we only care about the first
+ $maintline ||= $line;
+ } elsif (/^ \[ (.*) \]$/ && defined $maintline) {
+ # Start of existing changes following those by the current
+ # maintainer
+ $nextmaint ||= $1;
+ } elsif (
+m/^\w[-+0-9a-z.]* \(([^\(\) \t]+)\)((?:\s+[-+0-9a-z.]+)+)\;\s+urgency=(\w+)/i
+ ) {
+ if (defined $lastmaint) {
+ $lastheader = $_;
+ $lastdist = $2;
+ $lastdist =~ s/^\s+//;
+ undef $lastdist if $lastdist eq "UNRELEASED";
+ # Revert to our previously saved position
+ $line = $savedline;
+ last;
+ } else {
+ my $tmpver = $1;
+ $tmpver =~ s/^\s+//;
+ if ($tmpver =~ m/~bpo(\d+)\+/ && exists $dists{$1}) {
+ $dist_indicator = "$dists{$1}-backports";
+ }
+ if ($tmpver =~ m/\+deb(\d+)u/ && exists $dists{$1}) {
+ $dist_indicator = "$dists{$1}";
+ }
+ }
+ } elsif (/ \* (?:Upload to|Rebuild for) (\S+).*$/) {
+ ($dist_indicator = $1) =~ s/[!:.,;]$//;
+ chomp $dist_indicator;
+ } elsif (/^ --\s+([^<]+)\s+/ || /^ --\s+<(.+?)>/) {
+ $lastmaint = $1;
+ # Remember where we are so we can skip back afterwards
+ $savedline = $line;
+ }
+
+ if (defined $maintline && !defined $nextmaint) {
+ $maintline++;
+ }
+ }
+
+ # Munging of changelog for multimaintainer mode.
+ my $multimaint = 0;
+ if (!$opt_news) {
+ my $lastmultimaint;
+
+ # Parse the changelog for multi-maintainer maintainer lines of
+ # the form [ Full Name ] and record the last of these.
+ while ($CHANGES =~ /.*\n^\s+\[\s+([^\]]+)\s+]\s*$/mg) {
+ $lastmultimaint = $1;
+ }
+
+ if ((
+ !defined $lastmultimaint
+ && defined $lastmaint
+ && $lastmaint ne $MAINTAINER
+ && $opt_multimaint
+ )
+ || (defined $lastmultimaint && $lastmultimaint ne $MAINTAINER)
+ || (defined $nextmaint)
+ ) {
+ $multimaint = 1;
+
+ if (!$lastmultimaint) {
+ # Add a multi-maintainer header to the top of the existing
+ # changelog.
+ my $newchanges = '';
+ $CHANGES =~ s/^( .+)$/ [ $lastmaint ]\n$1/m;
+ }
+ }
+ }
+
+ # based on /usr/lib/dpkg/parsechangelog/debian
+ if ($CHANGES
+ =~ m/^\w[-+0-9a-z.]* \([^\(\) \t]+\)((?:\s+[-+0-9a-z.]+)+)\;\s+urgency=(\w+)/i
+ ) {
+ my $distribution = $1;
+ my $urgency = $2;
+ if ($opt_news) {
+ $urgency = $CL_URGENCY;
+ }
+ $distribution =~ s/^\s+//;
+ if ($opt_r) {
+ # Change the distribution from UNRELEASED for release
+ if ($distribution eq "UNRELEASED") {
+ if ($dist_indicator and not $opt_D) {
+ $distribution = $dist_indicator;
+ } elsif ($vendor eq 'Ubuntu') {
+ if ($opt_D) {
+ $distribution = $opt_D;
+ } else {
+ $distribution = get_ubuntu_devel_distro();
+ }
+ } else {
+ $distribution = $opt_D || $lastdist || "unstable";
+ }
+ } elsif ($opt_D) {
+ warn
+"$progname warning: ignoring distribution passed to --release as changelog has already been released\n";
+ }
+ # Set the start-line to 1, as we don't know what they want to edit
+ $line = 1;
+ } else {
+ $distribution = $opt_D if $opt_D;
+ }
+ $urgency = $opt_u if $opt_u;
+ $CHANGES
+ =~ s/^(\w[-+0-9a-z.]* \([^\(\) \t]+\))(?:\s+[-+0-9a-z.]+)+\;\s+urgency=\w+/$PACKAGE ($NEW_VERSION) $distribution; urgency=$urgency/i;
+ } else {
+ warn
+ "$progname: couldn't parse first changelog line, not touching it\n";
+ $warnings++;
+ }
+
+ if (defined $maintline && defined $nextmaint) {
+ # Output the lines up to the end of the current maintainer block
+ $count = 1;
+ $line = $maintline;
+ foreach (split /\n/, $CHANGES) {
+ print O $_ . "\n";
+ $count++;
+ last if $count == $maintline;
+ }
+ } else {
+ # The first lines are as we have already found
+ print O $CHANGES;
+ }
+
+ if (!$opt_r) {
+ # Add a multi-maintainer header...
+ if ($multimaint
+ and (@closes_text or $TEXT or $opt_news or !$EMPTY_TEXT)) {
+ # ...unless there already is one for this maintainer.
+ if (!defined $maintline) {
+ print O "\n [ $MAINTAINER ]\n";
+ $line += 2;
+ }
+ }
+
+ if (@closes_text or $TEXT) {
+ foreach (@closes_text) { format_line($_, 0); }
+ if (length $TEXT) { format_line($TEXT, 0); }
+ } elsif ($opt_news) {
+ print O "\n \n";
+ $line++;
+ } elsif (!$EMPTY_TEXT) {
+ print O " * \n";
+ }
+ }
+
+ if (defined $count) {
+ # Output the remainder of the changes
+ $count = 1;
+ foreach (split /\n/, $CHANGES) {
+ $count++;
+ next unless $count > $maintline;
+ print O $_ . "\n";
+ }
+ }
+
+ if ($opt_t && $opt_a) {
+ print O "\n -- $changelog->{Maintainer} $changelog->{Date}\n";
+ } else {
+ print O "\n -- $MAINTAINER <$EMAIL> $DATE\n";
+ }
+
+ if ($lastheader) {
+ print O "\n$lastheader";
+ }
+
+ # Copy the rest of the changelog file to new one
+ # Slurp the rest....
+ local $/ = undef;
+ print O <S>;
+} elsif ($opt_e && !$opt_create) {
+ # We don't do any fancy stuff with respect to versions or adding
+ # entries, we just update the timestamp and open the editor
+
+ print O $CHANGES;
+
+ if ($opt_t) {
+ print O "\n -- $changelog->{Maintainer} $changelog->{Date}\n";
+ } else {
+ print O "\n -- $MAINTAINER <$EMAIL> $DATE\n";
+ }
+
+ # Copy the rest of the changelog file to the new one
+ $line = -1;
+ while (<S>) { $line++; last if /^ --/; }
+ # Slurp the rest...
+ local $/ = undef;
+ print O <S>;
+
+ # Set the start-line to 0, as we don't know what they want to edit
+ $line = 0;
+} elsif ($opt_create) {
+ if ( !$initial_release
+ and !$opt_news
+ and !$opt_empty
+ and !$TEXT
+ and !$EMPTY_TEXT) {
+ push @closes_text, "Initial release. (Closes: \#XXXXXX)\n";
+ }
+
+ my $urgency = $opt_u;
+ if ($opt_news) {
+ $urgency ||= $CL_URGENCY;
+ }
+ $urgency ||= 'medium';
+ print O "$PACKAGE ($VERSION) $DISTRIBUTION; urgency=$urgency\n\n";
+
+ if (@closes_text or $TEXT) {
+ foreach (@closes_text) { format_line($_, 1); }
+ if (length $TEXT) { format_line($TEXT, 1); }
+ } elsif ($opt_news) {
+ print O " \n";
+ } elsif ($opt_empty) {
+ # Do nothing, but skip the empty entry
+ } else { # this can't happen, but anyway...
+ print O " * \n";
+ }
+
+ print O "\n -- $MAINTAINER <$EMAIL> $DATE\n";
+
+ $line = 1;
+} elsif (!$optionsok) {
+ fatal "Unknown changelog processing command line options - help!";
+}
+
+if (!$opt_create) {
+ close S or fatal "Error closing $changelog_path: $!";
+}
+close O or fatal "Error closing temporary $changelog_path: $!";
+
+if ($warnings) {
+ if ($warnings > 1) {
+ warn
+"$progname: Did you see those $warnings warnings? Press RETURN to continue...\n";
+ } else {
+ warn
+"$progname: Did you see that warning? Press RETURN to continue...\n";
+ }
+ my $garbage = <STDIN>;
+}
+
+# Now Run the Editor; always run if doing "closes" to give a chance to check
+if ( (!$TEXT and !$EMPTY_TEXT and !($opt_create and $opt_empty))
+ or @closes_text
+ or ($opt_create and !($PACKAGE ne 'PACKAGE' and $VERSION ne 'VERSION'))) {
+
+ my $mtime = (stat("$changelog_path.dch"))[9];
+ defined $mtime
+ or fatal
+ "Error getting modification time of temporary $changelog_path: $!";
+ $mtime--;
+ utime $mtime, $mtime, "$changelog_path.dch";
+
+ system("sensible-editor +$line $changelog_path.dch") == 0
+ or fatal "Error editing $changelog_path";
+
+ my $newmtime = (stat("$changelog_path.dch"))[9];
+ defined $newmtime
+ or fatal
+ "Error getting modification time of temporary $changelog_path: $!";
+ if ( $mtime == $newmtime
+ && !$opt_create
+ && (!$opt_r || ($opt_r && $opt_force_save_on_release))) {
+
+ warn "$progname: $changelog_path unmodified; exiting.\n";
+ exit 0;
+ }
+}
+
+copy("$changelog_path.dch", "$changelog_path")
+ or fatal "Couldn't replace $changelog_path with new version: $!";
+
+# Now find out what the new package version number is if we need to
+# rename the directory
+
+if ( (basename(cwd()) =~ m%^\Q$PACKAGE\E-\Q$UVERSION\E$%)
+ && !$opt_p
+ && !$opt_create) {
+ # Find the current version number etc.
+ my $v;
+ my $changelog = changelog_parse();
+ if (exists $changelog->{Version}) {
+ $v = Dpkg::Version->new($changelog->{Version});
+ }
+
+ fatal "No version number in debian/changelog!"
+ unless defined($v)
+ and $v->is_valid();
+
+ my ($new_version, $new_uversion);
+ $new_version = $v->as_string(omit_epoch => 1);
+ $new_uversion = $v->as_string(omit_epoch => 1, omit_revision => 1);
+
+ if ($new_uversion ne $UVERSION) {
+ # Then we rename the directory
+ if (move(cwd(), "../$PACKAGE-$new_uversion")) {
+ warn
+"$progname warning: your current directory has been renamed to:\n../$PACKAGE-$new_uversion\n";
+ } else {
+ warn "$progname warning: Couldn't rename directory: $!\n";
+ }
+ if (!$v->is_native()) {
+ # And check whether a new orig tarball exists
+ my @origs = glob("../$PACKAGE\_$new_uversion.*");
+ my $num_origs = grep {
+/^..\/\Q$PACKAGE\E_\Q$new_uversion\E\.orig\.tar\.$compression_re$/
+ } @origs;
+ if ($num_origs == 0) {
+ warn
+"$progname warning: no orig tarball found for the new version.\n";
+ }
+ }
+ }
+}
+
+exit 0;
+
+{
+ no warnings 'uninitialized';
+ # Format for standard Debian changelogs
+ format CHANGELOG =
+ * ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $CHGLINE
+ ~~ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $CHGLINE
+.
+ # Format for NEWS files.
+ format NEWS =
+ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $CHGLINE
+~~^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ $CHGLINE
+.
+}
+
+my $linecount = 0;
+
+sub format_line {
+ $CHGLINE = shift;
+ my $newentry = shift;
+
+ # Work around the fact that write() with formats
+ # seems to assume that characters are single-byte
+ # See https://rt.perl.org/Public/Bug/Display.html?id=33832
+ # and Debian bugs #473769 and #541484
+ # This relies on $CHGLINE being a sequence of unicode characters. We can
+ # compare how many unicode characters we have to how many bytes we have
+ # when encoding to utf8 and therefore how many spaces we need to pad.
+ my $count = length(encode_utf8($CHGLINE)) - length($CHGLINE);
+ $CHGLINE .= " " x $count;
+
+ print O "\n" if $opt_news && !($newentry || $linecount);
+ $linecount++;
+ my $f = select(O);
+ if ($opt_news) {
+ $~ = 'NEWS';
+ } else {
+ $~ = 'CHANGELOG';
+ }
+ write O;
+ select $f;
+}
+
+BEGIN {
+ # Initialise the variable
+ $tmpchk = 0;
+}
+
+END {
+ if ($tmpchk) {
+ unlink "$changelog_path.dch"
+ or warn "$progname warning: Could not remove $changelog_path.dch\n";
+ unlink "$changelog_path.dch~"; # emacs backup file
+ }
+}
+
+sub fatal($) {
+ my ($pack, $file, $line);
+ ($pack, $file, $line) = caller();
+ (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d;
+ $msg =~ s/\n\n$/\n/;
+ die $msg;
+}
+
+# Is the environment variable valid or not?
+sub check_env_utf8 {
+ my $envvar = $_[0];
+
+ if (exists $ENV{$envvar} and $ENV{$envvar} ne '') {
+ if (!decode_utf8($ENV{$envvar})) {
+ warn
+"$progname warning: environment variable $envvar not UTF-8 encoded; ignoring\n";
+ } else {
+ $env{$envvar} = decode_utf8($ENV{$envvar});
+ }
+ }
+}
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 21:50:39 +0000