dgit: Introduce archive_query_prepend_mirror

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 2a2eeddb2705cfcc2593cd68c7dc6c5942ba9c64..11ca5f53bcbe3f02b2dfda4d2b5edf6a55aaca8e 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -923,10 +923,10 @@ sub parsecontrolfh ($$;$) {
 }
 
 sub parsecontrol {
-    my ($file, $desc) = @_;
+    my ($file, $desc, $allowsigned) = @_;
     my $fh = new IO::Handle;
     open $fh, '<', $file or die "$file: $!";
-    my $c = parsecontrolfh($fh,$desc);
+    my $c = parsecontrolfh($fh,$desc,$allowsigned);
     $fh->error and die $!;
     close $fh;
     return $c;
@@ -986,6 +986,11 @@ sub archive_query ($;@) {
     { no strict qw(refs); &{"${method}_${proto}"}($proto,$data,@_); }
 }
 
+sub archive_query_prepend_mirror {
+    my $m = access_cfg('mirror');
+    return map { [ $_->[0], $m.$_->[1], @$_[2..$#$_] ] } @_;
+}
+
 sub pool_dsc_subpath ($$) {
     my ($vsn,$component) = @_; # $package is implict arg
     my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
@@ -1092,7 +1097,7 @@ sub archive_query_ftpmasterapi {
            if length $@;
     }
     @rows = sort { -version_compare($a->[0],$b->[0]) } @rows;
-    return @rows;
+    return archive_query_prepend_mirror @rows;
 }
 
 sub file_in_archive_ftpmasterapi {
@@ -1134,7 +1139,8 @@ sub file_in_archive_dummycatapi ($$$) {
 #---------- `madison' archive query method ----------
 
 sub archive_query_madison {
-    return map { [ @$_[0..1] ] } madison_get_parse(@_);
+    return archive_query_prepend_mirror
+       map { [ @$_[0..1] ] } madison_get_parse(@_);
 }
 
 sub madison_get_parse {
@@ -1240,7 +1246,7 @@ END
        my ($vsn,$component,$filename,$sha256sum) = @$_;
        [ $vsn, "/pool/$component/$filename",$digester,$sha256sum ];
     } @rows;
-    return @rows;
+    return archive_query_prepend_mirror @rows;
 }
 
 sub canonicalise_suite_sshpsql ($$) {
@@ -1296,7 +1302,8 @@ sub archive_query_dummycat ($$) {
     }
     C->error and die "$dpath: $!";
     close C;
-    return sort { -version_compare($a->[0],$b->[0]); } @rows;
+    return archive_query_prepend_mirror
+       sort { -version_compare($a->[0],$b->[0]); } @rows;
 }
 
 sub file_in_archive_dummycat () { return undef; }
@@ -1358,8 +1365,8 @@ sub get_archive_dsc () {
     canonicalise_suite();
     my @vsns = archive_query('archive_query');
     foreach my $vinfo (@vsns) {
-       my ($vsn,$subpath,$digester,$digest) = @$vinfo;
-       $dscurl = access_cfg('mirror').$subpath;
+       my ($vsn,$vsn_dscurl,$digester,$digest) = @$vinfo;
+       $dscurl = $vsn_dscurl;
        $dscdata = url_get($dscurl);
        if (!$dscdata) {
            $skew_warning_vsn = $vsn if !defined $skew_warning_vsn;
@@ -2292,6 +2299,8 @@ sub git_fetch_us () {
     # git fetch to try to generate it.  If we don't manage to generate
     # the target state, we try again.
 
+    printdebug "git_fetch_us specs @specs\n";
+
     my $specre = join '|', map {
        my $x = $_;
        $x =~ s/\W/\\$&/g;
@@ -2307,6 +2316,7 @@ sub git_fetch_us () {
     my $fetch_iteration = 0;
     FETCH_ITERATION:
     for (;;) {
+       printdebug "git_fetch_us iteration $fetch_iteration\n";
         if (++$fetch_iteration > 10) {
            fail "too many iterations trying to get sane fetch!";
        }
@@ -2334,10 +2344,12 @@ END
 
        # OK, now %want is exactly what we want for refs in @specs
        my @fspecs = map {
-           return () if !m/\*$/ && !exists $wantr{"refs/$_"};
+           !m/\*$/ && !exists $wantr{"refs/$_"} ? () :
            "+refs/$_:".lrfetchrefs."/$_";
        } @specs;
 
+       printdebug "git_fetch_us fspecs @fspecs\n";
+
        my @fcmd = (@git, qw(fetch -p -n -q), access_giturl(), @fspecs);
        runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(),
            @fspecs;
@@ -3195,7 +3207,10 @@ sub push_parse_changelog ($) {
     my $clogp = Dpkg::Control::Hash->new();
     $clogp->load($clogpfn) or die;
 
-    $package = getfield $clogp, 'Source';
+    my $clogpackage = getfield $clogp, 'Source';
+    $package //= $clogpackage;
+    fail "-p specified $package but changelog specified $clogpackage"
+       unless $package eq $clogpackage;
     my $cversion = getfield $clogp, 'Version';
     my $tag = debiantag($cversion, access_basedistro);
     runcmd @git, qw(check-ref-format), $tag;
@@ -5557,6 +5572,7 @@ defvalopt '',                '-k', '.+',      \$keyid;
 defvalopt '--existing-package','', '.*',      \$existing_package;
 defvalopt '--build-products-dir','','.*',     \$buildproductsdir;
 defvalopt '--clean',       '', $cleanmode_re, \$cleanmode;
+defvalopt '--package',   '-p',   $package_re, \$package;
 defvalopt '--quilt',     '', $quilt_modes_re, \$quilt_mode;
 
 defvalopt '', '-C', '.+', sub {