mirror of
https://git.dpkg.org/git/dpkg/dupload.git
synced 2025-04-13 06:04:01 +00:00
125 lines
3.4 KiB
Perl
Executable File
125 lines
3.4 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# Copyright © 2019-2025 Guillem Jover <guillem@debian.org>
|
|
#
|
|
# 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 strict;
|
|
use warnings;
|
|
|
|
use File::Basename;
|
|
use Dpkg::Control;
|
|
|
|
my $changes_path = $ARGV[0];
|
|
my $dsc_path;
|
|
|
|
my $changes = Dpkg::Control->new(type => CTRL_FILE_CHANGES);
|
|
$changes->load($changes_path);
|
|
|
|
my $dist = $changes->{Distribution};
|
|
my $arch = $changes->{Architecture};
|
|
my $area = 'main';
|
|
my $autobuild = 'yes';
|
|
|
|
# Lookup the .dsc file.
|
|
foreach my $file (split /\n[ \t]*/, $changes->{Files}) {
|
|
next unless $file =~ /\.dsc$/;
|
|
|
|
my @part = split ' ', $file;
|
|
my $section = $part[2];
|
|
$dsc_path = $part[4];
|
|
|
|
if ($section =~ m{([^/]+)/[^/]+}) {
|
|
$area = $1;
|
|
}
|
|
last;
|
|
}
|
|
|
|
# If this is a non-free upload, determine whether the source is marked as
|
|
# auto-buildable.
|
|
if ($area =~ m/^non-free/) {
|
|
my (undef, $base_dir) = fileparse($changes_path);
|
|
|
|
my $dsc = Dpkg::Control->new(type => CTRL_PKG_SRC);
|
|
$dsc->load("$base_dir/$dsc_path");
|
|
|
|
$autobuild = $dsc->{Autobuild} // 'no';
|
|
}
|
|
|
|
my $to_sid = 0;
|
|
if ($dist eq 'unstable' || $dist eq 'sid') {
|
|
$to_sid = 1;
|
|
}
|
|
|
|
my $what;
|
|
|
|
if ($to_sid && $area eq 'main' && $arch ne 'source') {
|
|
$what = 'binary';
|
|
|
|
print <<'WARN'
|
|
|
|
Warning: Uploading binary packages to the unstable main Debian suite will
|
|
prevent them from migrating to testing, and be part of the next stable
|
|
release. Uploading binary packages is necessary for NEW and binary-NEW
|
|
processing, but remember that you need to do a source-only upload once
|
|
these have been ACCEPTED so that they can migrate. For more information,
|
|
please read:
|
|
|
|
<https://lists.debian.org/debian-devel-announce/2019/07/msg00002.html>
|
|
|
|
WARN
|
|
}
|
|
|
|
if ($to_sid && $area =~ m/^non-free/ && $arch eq 'source' && $autobuild eq 'no') {
|
|
$what = 'source';
|
|
print <<'WARN'
|
|
|
|
Warning: Uploading source-only packages that are not marked as auto-buildable
|
|
to the unstable non-free Debian area will prevent them from migrating to
|
|
testing and be part of the next stable release, as the binary packages will
|
|
never get built.
|
|
|
|
<https://www.debian.org/doc/manuals/developers-reference/ch05.en.html#marking-non-free-packages-as-auto-buildable>
|
|
|
|
WARN
|
|
}
|
|
|
|
if (defined $what) {
|
|
print <<'WARN';
|
|
Note: If you are always aware of this and do not want to be warned, you
|
|
can disable this hook in the configuration file, skip it via --skip-hooks
|
|
or the one-off environment variable DUPLOAD_SKIP_HOOKS, or alternatively
|
|
you can reply to the following prompt.
|
|
|
|
WARN
|
|
|
|
my $accept = 'yes';
|
|
print "Do you want to upload $what packages ($accept/NO)? ";
|
|
|
|
my $prompt = <STDIN>;
|
|
chomp $prompt;
|
|
|
|
if ($prompt eq $accept) {
|
|
print " Ok, proceeding with the upload.\n";
|
|
print "\n";
|
|
} else {
|
|
warn " Ok, aborting the upload.\n";
|
|
warn "\n";
|
|
exit 1;
|
|
}
|
|
}
|
|
|
|
exit 0;
|