diff options
Diffstat (limited to 'dgit')
-rwxr-xr-x | dgit | 66 |
1 files changed, 64 insertions, 2 deletions
@@ -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; } @@ -4584,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 --), @@ -6662,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]; } @@ -6835,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 .. @@ -6862,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 @@ -7069,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.) @@ -7078,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; |