changelog: start 9.10

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 541e8f60e2228fc9e75e816dade4b9673afdf107..4804c9bd055f39880a28676ce5ec8bac62099cd2 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -46,6 +46,7 @@ use Digest::SHA;
 use Digest::MD5;
 use List::MoreUtils qw(pairwise);
 use Text::Glob qw(match_glob);
+use Text::CSV;
 use Fcntl qw(:DEFAULT :flock);
 use Carp;
 
@@ -101,6 +102,7 @@ our %forceopts = map { $_=>0 }
     qw(unrepresentable unsupported-source-format
        dsc-changes-mismatch changes-origs-exactly
        uploading-binaries uploading-source-only
+       reusing-version
        import-gitapply-absurd
        import-gitapply-no-absurd
        import-dsc-with-dgit-field);
@@ -867,6 +869,22 @@ sub access_basedistro__noalias () {
                return $kl->{$k};
            }
        }
+       foreach my $csvf (</usr/share/distro-info/*.csv>) {
+           my $csv_distro =
+               $csvf =~ m{/(\w+)\.csv$} ? $1 : do {
+                   printdebug "skipping $csvf\n";
+                   next;
+               };
+           my $csv = Text::CSV->new({ binary => 1, auto_diag => 2 }) or die;
+           my $fh = new IO::File $csvf, "<:encoding(utf8)"
+               or die "open $csvf: $!";
+           while (my $cols = $csv->getline($fh)) {
+               next unless $cols->[2] eq $isuite;
+               return $csv_distro;
+           }
+           die "$csvf $!" if $fh->error;
+           close $fh;
+       }
        return cfg("dgit.default.distro");
     }
 }
@@ -1192,6 +1210,7 @@ sub url_fetch ($;@) {
     };
 
     my $response_body = '';
+    $setopt->(CURLOPT_FOLLOWLOCATION,  1);
     $setopt->(CURLOPT_REDIR_PROTOCOLS, CURLPROTO_HTTPS|CURLPROTO_HTTP);
     $setopt->(CURLOPT_URL,             $url);
     $setopt->(CURLOPT_NOSIGNAL,        1);
@@ -1736,7 +1755,7 @@ sub get_archive_dsc () {
     foreach my $vinfo (@vsns) {
        my ($vsn,$vsn_dscurl,$digester,$digest) = @$vinfo;
        $dscurl = $vsn_dscurl;
-       $dscdata = url_fetch($dscurl);
+       $dscdata = url_fetch($dscurl, Ok404 => 1 );
        if (!$dscdata) {
            $skew_warning_vsn = $vsn if !defined $skew_warning_vsn;
            next;
@@ -2015,7 +2034,7 @@ sub test_source_only_changes ($) {
     foreach my $l (split /\n/, getfield $changes, 'Files') {
         $l =~ m/\S+$/ or next;
         # \.tar\.[a-z0-9]+ covers orig.tar and the tarballs in native packages
-        unless ($& =~ m/(?:\.dsc|\.diff\.gz|\.tar\.[a-z0-9]+|_source\.buildinfo)$/) {
+        unless ($& =~ m/(?:\.dsc|\.diff\.gz|$tarball_f_ext_re|_source\.buildinfo)$/) {
             print f_ "purportedly source-only changes polluted by %s\n", $&;
             return 0;
         }
@@ -3853,6 +3872,7 @@ sub vcs_git_url_of_ctrl ($) {
     my $vcsgiturl = $ctrl->{'Vcs-Git'};
     if (length $vcsgiturl) {
        $vcsgiturl =~ s/\s+-b\s+\S+//g;
+       $vcsgiturl =~ s/\s+\[[^][]*\]//g;
     }
     return $vcsgiturl;
 }
@@ -4583,6 +4603,20 @@ END
 
     confess unless !!$made_split_brain == do_split_brain();
 
+    my $tagname = debiantag_new $cversion, access_nomdistro();
+    if (!(forceing[qw(reusing-version)]) && git_get_ref "refs/tags/$tagname") {
+       supplementary_message '';
+       print STDERR f_ <<END, $cversion;
+
+Version %s has already been tagged (pushed?)
+If this was a failed (or incomplete or rejected) upload by you, just
+add a new changelog stanza for a new version number and try again.
+END
+       fail f_ <<END, $tagname;
+Tag %s already exists.
+END
+    }
+
     changedir $playground;
     progress f_ "checking that %s corresponds to HEAD", $dscfn;
     runcmd qw(dpkg-source -x --),
@@ -6661,6 +6695,31 @@ sub build_prep ($) {
     }
 }
 
+sub maybe_warn_opt_confusion ($$$) {
+    my ($subcommand, $willrun, $optsref) = @_;
+    foreach (@$optsref) {
+       if (m/^(?: --dry-run  $
+                | --damp-run $
+                | --clean= | -w[gcnd]
+                | --(?:include|ignore)-dirty$
+                | --quilt= | --gbp$ | --dpm$ | --baredebian
+                | --split-view=
+                | --build-products-dir=
+                )/x) {
+           print STDERR f_ <<END, $&, $subcommand or die $!;
+warning: dgit option %s must be passed before %s on dgit command line
+END
+       } elsif (m/^(?: -C
+                     | --no-sign  $
+                     | -k
+                     )/x) {
+           print STDERR f_ <<END, $&, $subcommand, $willrun or die $!;
+warning: option %s should probably be passed to dgit before %s sub-command on the dgit command line, so that it is seen by dgit and not simply passed to %s
+END
+       }
+    }
+}
+
 sub changesopts_initial () {
     my @opts =@changesopts[1..$#changesopts];
 }
@@ -6834,6 +6893,7 @@ sub postbuild_mergechanges_vanilla ($) {
 
 sub cmd_build {
     build_prep_early();
+    maybe_warn_opt_confusion 'build', 'dpkg-buildpackage', \@ARGV;
     $buildproductsdir eq '..' or print STDERR +(f_ <<END, $us, $us);
 %s: warning: build-products-dir set, but not supported by dpkg-buildpackage
 %s: warning: build-products-dir will be ignored; files will go to ..
@@ -6861,6 +6921,7 @@ sub pre_gbp_build {
 
 sub cmd_gbp_build {
     build_prep_early();
+    maybe_warn_opt_confusion 'gbp-build', 'gbp buildpackage', \@ARGV;
 
     # gbp can make .origs out of thin air.  In my tests it does this
     # even for a 1.0 format package, with no origs present.  So I
@@ -7068,6 +7129,7 @@ sub binary_builder {
 
 sub cmd_sbuild {
     build_prep_early();
+    maybe_warn_opt_confusion 'sbuild', 'sbuild', \@ARGV;
     binary_builder(\@sbuild, (__ <<END), qw(-d), $isuite, @ARGV, $dscfn);
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
@@ -7077,6 +7139,7 @@ END
 sub pbuilder ($) {
     my ($pbuilder) = @_;
     build_prep_early();
+    maybe_warn_opt_confusion 'pbuilder', 'pbuilder', \@ARGV;
     # @ARGV is allowed to contain only things that should be passed to
     # pbuilder under debbuildopts; just massage those
     my $wantsrc = massage_dbp_args \@ARGV;