dgit: config: Allow dgit-suite.PATTERN.distro

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 8264f3e576a625e37cecb9c30bfe70f3596fd9a4..41b7ac845808bf554f56057b62ce2a86f533ff4e 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -36,6 +36,7 @@ use Digest::SHA;
 use Digest::MD5;
 use List::Util qw(any);
 use List::MoreUtils qw(pairwise);
+use Text::Glob qw(match_glob);
 use Carp;
 
 use Debian::Dgit;
@@ -694,11 +695,27 @@ sub access_basedistro () {
     if (defined $idistro) {
        return $idistro;
     } else {   
-       return cfg("dgit-suite.$isuite.distro",
-                  "dgit.default.distro");
+       my $def = cfg("dgit-suite.$isuite.distro", 'RETURN-UNDEF');
+       return $def if defined $def;
+       foreach my $src (@gitcfgsources, 'internal') {
+           my $kl = $src eq 'internal' ? \%defcfg : $gitcfgs{$src};
+           next unless $kl;
+           foreach my $k (keys %$kl) {
+               next unless $k =~ m#^dgit-suite\.(.*)\.distro$#;
+               my $dpat = $1;
+               next unless match_glob $dpat, $isuite;
+               return $kl->{$k};
+           }
+       }
+       return cfg("dgit.default.distro");
     }
 }
 
+sub access_nomdistro () {
+    my $base = access_basedistro();
+    return cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base;
+}
+
 sub access_quirk () {
     # returns (quirk name, distro to use instead or undef, quirk-specific info)
     my $basedistro = access_basedistro();
@@ -794,6 +811,8 @@ sub access_distros () {
     unshift @l, $instead_distro;
     @l = grep { defined } @l;
 
+    push @l, access_nomdistro();
+
     if (access_forpush()) {
        @l = map { ("$_/push", $_) } @l;
     }
@@ -923,10 +942,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 +1005,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 +1116,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 +1158,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 +1265,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 +1321,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 +1384,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;
@@ -1822,7 +1848,9 @@ sub check_for_vendor_patches () {
     vendor_patches_distro(Dpkg::Vendor::get_current_vendor(),
                         "Dpkg::Vendor \`current vendor'");
     vendor_patches_distro(access_basedistro(),
-                         "distro being accessed");
+                         "(base) distro being accessed");
+    vendor_patches_distro(access_nomdistro(),
+                         "(nominal) distro being accessed");
 }
 
 sub generate_commits_from_dsc () {
@@ -2264,9 +2292,9 @@ sub git_fetch_us () {
     my @specs = deliberately_not_fast_forward ? qw(tags/*) :
        map { "tags/$_" }
        (quiltmode_splitbrain
-        ? (map { $_->('*',access_basedistro) }
+        ? (map { $_->('*',access_nomdistro) }
            \&debiantag_new, \&debiantag_maintview)
-        : debiantags('*',access_basedistro));
+        : debiantags('*',access_nomdistro));
     push @specs, server_branch($csuite);
     push @specs, qw(heads/*) if deliberately_not_fast_forward;
 
@@ -2401,7 +2429,7 @@ END
        Dumper(\%lrfetchrefs_f);
 
     my %here;
-    my @tagpats = debiantags('*',access_basedistro);
+    my @tagpats = debiantags('*',access_nomdistro);
 
     git_for_each_ref([map { "refs/tags/$_" } @tagpats], sub {
        my ($objid,$objtype,$fullrefname,$reftail) = @_;
@@ -3139,9 +3167,9 @@ sub splitbrain_pseudomerge ($$$$) {
 
     if (defined $overwrite_version) {
     } elsif (!eval {
-       my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro;
+       my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_nomdistro;
        my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag");
-       my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro;
+       my $t_dgit = debiantag_new $i_arch_v->[0], access_nomdistro;
        my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag");
        my $i_archive = [ $archive_hash, "current archive contents" ];
 
@@ -3205,7 +3233,7 @@ sub push_parse_changelog ($) {
     fail "-p specified $package but changelog specified $clogpackage"
        unless $package eq $clogpackage;
     my $cversion = getfield $clogp, 'Version';
-    my $tag = debiantag($cversion, access_basedistro);
+    my $tag = debiantag($cversion, access_nomdistro);
     runcmd @git, qw(check-ref-format), $tag;
 
     my $dscfn = dscfn($cversion);
@@ -3241,7 +3269,7 @@ sub push_tagwants ($$$$) {
         };
     }
     foreach my $tw (@tagwants) {
-       $tw->{Tag} = $tw->{TagFn}($cversion, access_basedistro);
+       $tw->{Tag} = $tw->{TagFn}($cversion, access_nomdistro);
        $tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; };
     }
     printdebug 'push_tagwants: ', Dumper(\@_, \@tagwants);
@@ -3272,7 +3300,7 @@ sub push_mktags ($$ $$ $) {
     # to control the "tagger" (b) we can do remote signing
     my $authline = clogp_authline $clogp;
     my $delibs = join(" ", "",@deliberatelies);
-    my $declaredistro = access_basedistro();
+    my $declaredistro = access_nomdistro();
 
     my $mktag = sub {
        my ($tw) = @_;