chiark / gitweb /
dgit: aptget: un-disable cache clean
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 11ca5f53bcbe3f02b2dfda4d2b5edf6a55aaca8e..b7e7f7eb6e49ff2585ce465753dea3ae0e8c12f6 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -36,6 +36,8 @@ use Digest::SHA;
 use Digest::MD5;
 use List::Util qw(any);
 use List::MoreUtils qw(pairwise);
+use Text::Glob qw(match_glob);
+use Fcntl qw(:DEFAULT :flock);
 use Carp;
 
 use Debian::Dgit;
@@ -102,6 +104,8 @@ our (@gpg) = qw(gpg);
 our (@sbuild) = qw(sbuild);
 our (@ssh) = 'ssh';
 our (@dgit) = qw(dgit);
+our (@aptget) = qw(apt-get);
+our (@aptcache) = qw(apt-cache);
 our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
 our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git);
 our (@dpkggenchanges) = qw(dpkg-genchanges);
@@ -119,6 +123,8 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
                      'ssh' => \@ssh,
                      'dgit' => \@dgit,
                      'git' => \@git,
+                     'apt-get' => \@aptget,
+                     'apt-cache' => \@aptcache,
                      'dpkg-source' => \@dpkgsource,
                      'dpkg-buildpackage' => \@dpkgbuildpackage,
                      'dpkg-genchanges' => \@dpkggenchanges,
@@ -510,7 +516,7 @@ sub act_scary () { return !$dryrun_level; }
 
 sub printdone {
     if (!$dryrun_level) {
-       progress "dgit ok: @_";
+       progress "$us ok: @_";
     } else {
        progress "would be ok: @_ (but dry run only)";
     }
@@ -580,11 +586,13 @@ sub cmd_help () {
 our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
 
 our %defcfg = ('dgit.default.distro' => 'debian',
+              'dgit-suite.*-security.distro' => 'debian-security',
               'dgit.default.username' => '',
               'dgit.default.archive-query-default-component' => 'main',
               'dgit.default.ssh' => 'ssh',
               'dgit.default.archive-query' => 'madison:',
               'dgit.default.sshpsql-dbname' => 'service=projectb',
+              'dgit.default.aptget-components' => 'main',
               'dgit.default.dgit-tag-format' => 'new,old,maint',
               # old means "repo server accepts pushes with old dgit tags"
               # new means "repo server accepts pushes with new dgit tags"
@@ -616,6 +624,11 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit-distro.debian.git-url-suffix' => '',
               'dgit-distro.debian.upload-host' => 'ftp-master', # for dput
               'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
+ 'dgit-distro.debian-security.archive-query' => 'aptget:',
+ 'dgit-distro.debian-security.mirror' => 'http://security.debian.org/debian-security/',
+ 'dgit-distro.debian-security.aptget-suite-map' => 's#-security$#/updates#',
+ 'dgit-distro.debian-security.aptget-suite-rmap' => 's#$#-security#',
+ 'dgit-distro.debian-security.nominal-distro' => 'debian',
  'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*',
  'dgit-distro.debian-backports.mirror' => 'http://backports.debian.org/debian-backports/',
               'dgit-distro.ubuntu.git-check' => 'false',
@@ -694,11 +707,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 +823,8 @@ sub access_distros () {
     unshift @l, $instead_distro;
     @l = grep { defined } @l;
 
+    push @l, access_nomdistro();
+
     if (access_forpush()) {
        @l = map { ("$_/push", $_) } @l;
     }
@@ -979,6 +1010,8 @@ our %rmad;
 
 sub archive_query ($;@) {
     my ($method) = shift @_;
+    fail "this operation does not support multiple comma-separated suites"
+       if $isuite =~ m/,/;
     my $query = access_cfg('archive-query','RETURN-UNDEF');
     $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'";
     my $proto = $1;
@@ -997,6 +1030,17 @@ sub pool_dsc_subpath ($$) {
     return "/pool/$component/$prefix/$package/".dscfn($vsn);
 }
 
+sub cfg_apply_map ($$$) {
+    my ($varref, $what, $mapspec) = @_;
+    return unless $mapspec;
+
+    printdebug "config $what EVAL{ $mapspec; }\n";
+    $_ = $$varref;
+    eval "package Dgit::Config; $mapspec;";
+    die $@ if $@;
+    $$varref = $_;
+}
+
 #---------- `ftpmasterapi' archive query method (nascent) ----------
 
 sub archive_api_query_cmd ($) {
@@ -1109,6 +1153,168 @@ sub file_in_archive_ftpmasterapi {
     my $info = api_query($data, "file_in_archive/$pat", 1);
 }
 
+#---------- `aptget' archive query method ----------
+
+our $aptget_base;
+our $aptget_releasefile;
+our $aptget_configpath;
+
+sub aptget_aptget   () { return @aptget,   qw(-c), $aptget_configpath; }
+sub aptget_aptcache () { return @aptcache, qw(-c), $aptget_configpath; }
+
+sub aptget_cache_clean {
+    runcmd_ordryrun_local qw(sh -ec),
+       'cd "$1"; find -atime +30 -type f -print0 | xargs -0r rm --',
+       'x', $aptget_base;
+}
+
+sub aptget_lock_acquire () {
+    my $lockfile = "$aptget_base/lock";
+    open APTGET_LOCK, '>', $lockfile or die "open $lockfile: $!";
+    flock APTGET_LOCK, LOCK_EX or die "lock $lockfile: $!";
+}
+
+sub aptget_prep ($) {
+    my ($data) = @_;
+    return if defined $aptget_base;
+
+    badcfg "aptget archive query method takes no data part"
+       if length $data;
+
+    my $cache = $ENV{XDG_CACHE_DIR} // "$ENV{HOME}/.cache";
+
+    ensuredir $cache;
+    ensuredir "$cache/dgit";
+    my $cachekey =
+       access_cfg('aptget-cachekey','RETURN-UNDEF')
+       // access_nomdistro();
+
+    $aptget_base = "$cache/dgit/aptget";
+    ensuredir $aptget_base;
+
+    my $quoted_base = $aptget_base;
+    die "$quoted_base contains bad chars, cannot continue"
+       if $quoted_base =~ m/["\\]/; # apt.conf(5) says no escaping :-/
+
+    ensuredir $aptget_base;
+
+    aptget_lock_acquire();
+
+    aptget_cache_clean();
+
+    $aptget_configpath = "$aptget_base/apt.conf#$cachekey";
+    my $sourceslist = "source.list#$cachekey";
+
+    my $aptsuites = $isuite;
+    cfg_apply_map(\$aptsuites, 'suite map',
+                 access_cfg('aptget-suite-map', 'RETURN-UNDEF'));
+
+    open SRCS, ">", "$aptget_base/$sourceslist" or die $!;
+    printf SRCS "deb-src %s %s %s\n",
+       access_cfg('mirror'),
+       $aptsuites,
+       access_cfg('aptget-components')
+       or die $!;
+
+    ensuredir "$aptget_base/cache";
+    ensuredir "$aptget_base/lists";
+
+    open CONF, ">", $aptget_configpath or die $!;
+    print CONF <<END;
+Debug::NoLocking "true";
+APT::Get::List-Cleanup "false";
+#clear APT::Update::Post-Invoke-Success;
+Dir::Etc::SourceList "$quoted_base/$sourceslist";
+Dir::State::Lists "$quoted_base/lists";
+Dir::Etc::preferences "$quoted_base/preferences";
+Dir::Cache::srcpkgcache "$quoted_base/cache/srcs#$cachekey";
+Dir::Cache::pkgcache "$quoted_base/cache/pkgs#$cachekey";
+END
+
+    foreach my $key (qw(
+                       Dir::Cache
+                       Dir::State
+                       Dir::Cache::Archives
+                       Dir::Etc::SourceParts
+                       Dir::Etc::preferencesparts
+                     )) {
+       ensuredir "$aptget_base/$key";
+       print CONF "$key \"$quoted_base/$key\";\n" or die $!;
+    };
+
+    my $oldatime = (time // die $!) - 1;
+    foreach my $oldlist (<$aptget_base/lists/*Release>) {
+       next unless stat_exists $oldlist;
+       my ($mtime) = (stat _)[9];
+       utime $oldatime, $mtime, $oldlist or die "$oldlist $!";
+    }
+
+    runcmd_ordryrun_local aptget_aptget(), qw(update);
+
+    my @releasefiles;
+    foreach my $oldlist (<$aptget_base/lists/*Release>) {
+       next unless stat_exists $oldlist;
+       my ($atime) = (stat _)[8];
+       next if $atime == $oldatime;
+       push @releasefiles, $oldlist;
+    }
+    my @inreleasefiles = grep { m#/InRelease$# } @releasefiles;
+    @releasefiles = @inreleasefiles if @inreleasefiles;
+    die "apt updated wrong number of Release files (@releasefiles), erk"
+       unless @releasefiles == 1;
+
+    ($aptget_releasefile) = @releasefiles;
+}
+
+sub canonicalise_suite_aptget {
+    my ($proto,$data) = @_;
+    aptget_prep($data);
+
+    my $release = parsecontrol $aptget_releasefile, "Release file", 1;
+
+    foreach my $name (qw(Codename Suite)) {
+       my $val = $release->{$name};
+       if (defined $val) {
+           printdebug "release file $name: $val\n";
+           $val =~ m/^$suite_re$/o or fail
+ "Release file ($aptget_releasefile) specifies intolerable $name";
+           cfg_apply_map(\$val, 'suite rmap',
+                         access_cfg('aptget-suite-rmap', 'RETURN-UNDEF'));
+           return $val
+       }
+    }
+    return $isuite;
+}
+
+sub archive_query_aptget {
+    my ($proto,$data) = @_;
+    aptget_prep($data);
+
+    ensuredir "$aptget_base/source";
+    foreach my $old (<$aptget_base/source/*.dsc>) {
+       unlink $old or die "$old: $!";
+    }
+
+    my $showsrc = cmdoutput aptget_aptcache(), qw(showsrc), $package;
+    return () unless $showsrc =~ m/^package:\s*\Q$package\E\s*$/mi;
+    # avoids apt-get source failing with ambiguous error code
+
+    runcmd_ordryrun_local
+       shell_cmd 'cd "$1"/source; shift', $aptget_base,
+       aptget_aptget(), qw(--download-only --only-source source), $package;
+
+    my @dscs = <$aptget_base/source/*.dsc>;
+    fail "apt-get source did not produce a .dsc" unless @dscs;
+    fail "apt-get source produced several .dscs (@dscs)" unless @dscs==1;
+
+    my $pre_dsc = parsecontrol $dscs[0], $dscs[0], 1;
+
+    use URI::Escape;
+    my $uri = "file://". uri_escape $dscs[0];
+    $uri =~ s{\%2f}{/}gi;
+    return [ (getfield $pre_dsc, 'Version'), $uri ];
+}
+
 #---------- `dummyapicat' archive query method ----------
 
 sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
@@ -1358,6 +1564,8 @@ sub canonicalise_suite () {
     $csuite = archive_query('canonicalise_suite');
     if ($isuite ne $csuite) {
        progress "canonical suite name for $isuite is $csuite";
+    } else {
+       progress "canonical suite name is $csuite";
     }
 }
 
@@ -1829,7 +2037,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 () {
@@ -2271,9 +2481,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;
 
@@ -2408,7 +2618,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) = @_;
@@ -2442,6 +2652,24 @@ sub mergeinfo_version ($) {
     return getfield( (mergeinfo_getclogp $_[0]), 'Version' );
 }
 
+sub fetch_from_archive_record_1 ($) {
+    my ($hash) = @_;
+    runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
+           'DGIT_ARCHIVE', $hash;
+    cmdoutput @git, qw(log -n2), $hash;
+    # ... gives git a chance to complain if our commit is malformed
+}
+
+sub fetch_from_archive_record_2 ($) {
+    my ($hash) = @_;
+    my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
+    if (act_local()) {
+       cmdoutput @upd_cmd;
+    } else {
+       dryrun_report @upd_cmd;
+    }
+}
+
 sub fetch_from_archive () {
     ensure_setup_existing_tree();
 
@@ -2755,10 +2983,7 @@ END
        if $lastpush_hash;
     $chkff->($lastfetch_hash, 'local tracking tip (last fetch)');
 
-    runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
-           'DGIT_ARCHIVE', $hash;
-    cmdoutput @git, qw(log -n2), $hash;
-    # ... gives git a chance to complain if our commit is malformed
+    fetch_from_archive_record_1($hash);
 
     if (defined $skew_warning_vsn) {
        mkpath '.git/dgit';
@@ -2778,12 +3003,7 @@ END
     }
 
     if ($lastfetch_hash ne $hash) {
-       my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
-       if (act_local()) {
-           cmdoutput @upd_cmd;
-       } else {
-           dryrun_report @upd_cmd;
-       }
+       fetch_from_archive_record_2($hash);
     }
 
     lrfetchref_used lrfetchref();
@@ -2854,19 +3074,207 @@ sub setup_new_tree () {
     setup_useremail();
 }
 
+sub multisuite_suite_child ($$$) {
+    my ($tsuite, $merginputs, $fn) = @_;
+    # in child, sets things up, calls $fn->(), and returns undef
+    # in parent, returns canonical suite name for $tsuite
+    my $canonsuitefh = IO::File::new_tmpfile;
+    my $pid = fork // die $!;
+    if (!$pid) {
+       $isuite = $tsuite;
+       $us .= " [$isuite]";
+       $debugprefix .= " ";
+       progress "fetching $tsuite...";
+       canonicalise_suite();
+       print $canonsuitefh $csuite, "\n" or die $!;
+       close $canonsuitefh or die $!;
+       $fn->();
+       return undef;
+    }
+    waitpid $pid,0 == $pid or die $!;
+    fail "failed to obtain $tsuite: ".waitstatusmsg() if $? && $?!=256*4;
+    seek $canonsuitefh,0,0 or die $!;
+    local $csuite = <$canonsuitefh>;
+    die $! unless defined $csuite && chomp $csuite;
+    if ($? == 256*4) {
+       printdebug "multisuite $tsuite missing\n";
+       return $csuite;
+    }
+    printdebug "multisuite $tsuite ok (canon=$csuite)\n";
+    push @$merginputs, {
+        Ref => lrref,
+        Info => $csuite,
+    };
+    return $csuite;
+}
+
+sub fork_for_multisuite ($) {
+    my ($before_fetch_merge) = @_;
+    # if nothing unusual, just returns ''
+    #
+    # if multisuite:
+    # returns 0 to caller in child, to do first of the specified suites
+    # in child, $csuite is not yet set
+    #
+    # returns 1 to caller in parent, to finish up anything needed after
+    # in parent, $csuite is set to canonicalised portmanteau
+
+    my $org_isuite = $isuite;
+    my @suites = split /\,/, $isuite;
+    return '' unless @suites > 1;
+    printdebug "fork_for_multisuite: @suites\n";
+
+    my @mergeinputs;
+
+    my $cbasesuite = multisuite_suite_child($suites[0], \@mergeinputs,
+                                           sub { });
+    return 0 unless defined $cbasesuite;
+
+    fail "package $package missing in (base suite) $cbasesuite"
+       unless @mergeinputs;
+
+    my @csuites = ($cbasesuite);
+
+    $before_fetch_merge->();
+
+    foreach my $tsuite (@suites[1..$#suites]) {
+       my $csubsuite = multisuite_suite_child($tsuite, \@mergeinputs,
+                                              sub {
+            @end = ();
+            fetch();
+           exit 0;
+       });
+       # xxx collecte the ref here
+
+       $csubsuite =~ s/^\Q$cbasesuite\E-/-/;
+       push @csuites, $csubsuite;
+    }
+
+    foreach my $mi (@mergeinputs) {
+       my $ref = git_get_ref $mi->{Ref};
+       die "$mi->{Ref} ?" unless length $ref;
+       $mi->{Commit} = $ref;
+    }
+
+    $csuite = join ",", @csuites;
+
+    my $previous = git_get_ref lrref;
+    if ($previous) {
+       unshift @mergeinputs, {
+            Commit => $previous,
+            Info => "local combined tracking branch",
+            Warning =>
+ "archive seems to have rewound: local tracking branch is ahead!",
+        };
+    }
+
+    foreach my $ix (0..$#mergeinputs) {
+       $mergeinputs[$ix]{Index} = $ix;
+    }
+
+    @mergeinputs = sort {
+       -version_compare(mergeinfo_version $a,
+                        mergeinfo_version $b) # highest version first
+           or
+       $a->{Index} <=> $b->{Index}; # earliest in spec first
+    } @mergeinputs;
+
+    my @needed;
+
+  NEEDED:
+    foreach my $mi (@mergeinputs) {
+       printdebug "multisuite merge check $mi->{Info}\n";
+       foreach my $previous (@needed) {
+           next unless is_fast_fwd $mi->{Commit}, $previous->{Commit};
+           printdebug "multisuite merge un-needed $previous->{Info}\n";
+           next NEEDED;
+       }
+       push @needed, $mi;
+       printdebug "multisuite merge this-needed\n";
+       $mi->{Character} = '+';
+    }
+
+    $needed[0]{Character} = '*';
+
+    my $output = $needed[0]{Commit};
+
+    if (@needed > 1) {
+       printdebug "multisuite merge nontrivial\n";
+       my $tree = cmdoutput qw(git rev-parse), $needed[0]{Commit}.':';
+
+       my $commit = "tree $tree\n";
+       my $msg = "Combine archive branches $csuite [dgit]\n\n".
+           "Input branches:\n";
+
+       foreach my $mi (sort { $a->{Index} <=> $b->{Index} } @mergeinputs) {
+           printdebug "multisuite merge include $mi->{Info}\n";
+           $mi->{Character} //= ' ';
+           $commit .= "parent $mi->{Commit}\n";
+           $msg .= sprintf " %s  %-25s %s\n",
+               $mi->{Character},
+               (mergeinfo_version $mi),
+               $mi->{Info};
+       }
+       my $authline = clogp_authline mergeinfo_getclogp $needed[0];
+       $msg .= "\nKey\n".
+           " * marks the highest version branch, which choose to use\n".
+           " + marks each branch which was not already an ancestor\n\n".
+           "[dgit multi-suite $csuite]\n";
+       $commit .=
+           "author $authline\n".
+           "committer $authline\n\n";
+       $output = make_commit_text $commit.$msg;
+       printdebug "multisuite merge generated $output\n";
+    }
+
+    fetch_from_archive_record_1($output);
+    fetch_from_archive_record_2($output);
+
+    progress "calculated combined tracking suite $csuite";
+
+    return 1;
+}
+
+sub clone_set_head () {
+    open H, "> .git/HEAD" or die $!;
+    print H "ref: ".lref()."\n" or die $!;
+    close H or die $!;
+}
+sub clone_finish ($) {
+    my ($dstdir) = @_;
+    runcmd @git, qw(reset --hard), lrref();
+    runcmd qw(bash -ec), <<'END';
+        set -o pipefail
+        git ls-tree -r --name-only -z HEAD | \
+        xargs -0r touch -r . --
+END
+    printdone "ready for work in $dstdir";
+}
+
 sub clone ($) {
     my ($dstdir) = @_;
-    canonicalise_suite();
     badusage "dry run makes no sense with clone" unless act_local();
+
+    my $multi_fetched = fork_for_multisuite(sub {
+        printdebug "multi clone before fetch merge\n";
+        changedir $dstdir;
+    });
+    if ($multi_fetched) {
+        printdebug "multi clone after fetch merge\n";
+       clone_set_head();
+       clone_finish($dstdir);
+       exit 0;
+    }
+    printdebug "clone main body\n";
+
+    canonicalise_suite();
     my $hasgit = check_for_git();
     mkdir $dstdir or fail "create \`$dstdir': $!";
     changedir $dstdir;
     runcmd @git, qw(init -q);
+    clone_set_head();
     my $giturl = access_giturl(1);
     if (defined $giturl) {
-       open H, "> .git/HEAD" or die $!;
-       print H "ref: ".lref()."\n" or die $!;
-       close H or die $!;
        runcmd @git, qw(remote add), 'origin', $giturl;
     }
     if ($hasgit) {
@@ -2883,16 +3291,11 @@ sub clone ($) {
        runcmd @git, qw(remote add vcs-git), $vcsgiturl;
     }
     setup_new_tree();
-    runcmd @git, qw(reset --hard), lrref();
-    runcmd qw(bash -ec), <<'END';
-        set -o pipefail
-        git ls-tree -r --name-only -z HEAD | \
-        xargs -0r touch -r . --
-END
-    printdone "ready for work in $dstdir";
+    clone_finish($dstdir);
 }
 
 sub fetch () {
+    canonicalise_suite();
     if (check_for_git()) {
        git_fetch_us();
     }
@@ -2901,7 +3304,9 @@ sub fetch () {
 }
 
 sub pull () {
-    fetch();
+    my $multi_fetched = fork_for_multisuite(sub { });
+    fetch() unless $multi_fetched; # parent
+    return if $multi_fetched eq '0'; # child
     runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]",
         lrref();
     printdone "fetched to ".lrref()." and merged into HEAD";
@@ -3146,9 +3551,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" ];
 
@@ -3212,7 +3617,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);
@@ -3248,7 +3653,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);
@@ -3279,7 +3684,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) = @_;
@@ -3641,6 +4046,7 @@ sub cmd_clone {
                return if $!==&ENOENT;
                die "chdir $cwd_remove: $!";
            }
+           printdebug "clone rmonerror removing $dstdir\n";
            if (stat $dstdir) {
                rmtree($dstdir) or die "remove $dstdir: $!\n";
            } elsif (grep { $! == $_ }
@@ -3671,16 +4077,13 @@ sub fetchpullargs () {
        $package = getfield $sourcep, 'Source';
     }
     if (@ARGV==0) {
-#      $isuite = branchsuite();  # this doesn't work because dak hates canons
+       $isuite = branchsuite();
        if (!$isuite) {
            my $clogp = parsechangelog();
            $isuite = getfield $clogp, 'Distribution';
        }
-       canonicalise_suite();
-       progress "fetching from suite $csuite";
     } elsif (@ARGV==1) {
        ($isuite) = @ARGV;
-       canonicalise_suite();
     } else {
        badusage "incorrect arguments to dgit fetch or dgit pull";
     }
@@ -3689,6 +4092,8 @@ sub fetchpullargs () {
 sub cmd_fetch {
     parseopts();
     fetchpullargs();
+    my $multi_fetched = fork_for_multisuite(sub { });
+    exit 0 if $multi_fetched;
     fetch();
 }