path: root/bin/locmaint

#!/usr/bin/perl

# Copyright (C) 2015-2019 Sean Whitton
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.



# This is meant to walk me through maintenance tasks that
# can't/shouldn't happen unattended by means of host configuration
# management and/or cron jobs installed by configuration management.
#
# That includes, at least:
#
# - checking in and backing up homedirs, which I need to do on all
#   machines, not just those for which I am root
#
# - apt upgrades of bare metal hosts (other than automatic security
#   upgrades)
#
# - cleaning up temporary files, old packages etc.
#
# - backups to storage usually kept offline
#
# Assumptions we make:
#
# - We rely on my myrepos-based homedir infrastructure.
#
# - Each offline backup drive I use has a unique filesystem label.
#   This means that exactly one drive will ever be mounted to
#   /media/$USER/$foo on a given machine.
#
# Other notes:
#
# - If this script dies, it should be possible to just run it again
#   from the beginning.  I.e. it should be idempotent.
#
# - This script should run with only core Perl modules.
#
#   Additionally functionality might be enabled when non-core modules
#   are available, but this functionality should only be needed on
#   hosts where I have root.

use strict;
use warnings;
use lib "$ENV{HOME}/lib/perl5";
use constant {
    STABLE   => 'stable',
    TESTING  => 'testing',
    UNSTABLE => 'unstable',
};

use File::Basename;
use File::Find;
use File::Path qw(make_path);
use File::Spec::Functions qw(rel2abs catfile);
use Getopt::Long;
use Local::Homedir;
use Local::Interactive qw(interactive_ensure_subroutine
                          interactive_ensure_subroutine_success
                          interactive_ensure_subroutine_no_output
                          system_pty_capture
                          prompt_Yn prompt_yn get_ack show_user
                        );
use Local::MrRepo;
use Local::ScriptStatus;
use Local::Util qw(as_root);
use Scalar::Util qw(looks_like_number);
use Sys::Hostname;

# whether we have root on this host
our $can_root = 0;

# whether we should expect to have an extdrive plugged in and
# referenced on the command line
our $check_for_extdrive = 0;

# CONFIG -- edit me

# List of remote annexes, offline backups of which should be paired
# and content-synced with repos in HOME, when those exist.  Repos on a
# remote server with a git-annex branch, which are not listed here,
# will be backed up as if they were just ordinary git repos.  That's
# desirable behaviour for some annexes, which is why we don't try to
# autodetect them
our @remote_annexes = (
    { origin => "athenag:annex.git",   homedir => "lib/annex", lazy => 1 },
    { origin => "athenag:annex19.git", homedir => "annex" },
    { origin => "athenag:libpriv.git", homedir => "lib/priv" },
    { origin => "athena:wikiannex",    homedir => "lib/wikiannex" },
    { origin => "athenap:dionysus",    homedir => "lib/dionysus" });

for (getpwuid($<) . '@' . `hostname -f`) {
    chomp;

    # Code to set host-specific config based on "user@host.domain.tld"
    if (/^root@/ or /silentflame\.com$/) {
        $can_root = 1;
    }
    if (/@(zephyr|iris)\.silentflame\.com$/) {
        $check_for_extdrive = 1;
    }
}

# CODE -- no more edit me

exit main();

sub main {
    # TODO is it possible to let C-c kill processes we spawn, too?
    # myrepos might achieve this by means of its
    # terminal_friendly_spawn(), though note that a dependency of
    # locmaint on IO::Pty::Easy can be at most optional
    #
    # The basic problem here is that C-c goes to the child process,
    # not to locmaint
    $SIG{INT} = sub { say STDERR "\nlocmaint: interrupted"; exit 2 };

    # Parse command line.  If any of these get set to false, skip
    # those.  If any get set to true, do only those set to true.  If
    # none are set to true, do those which are left as 'undef'
    my $want_homedir;
    my $want_coldbkup;
    my $want_workstation_duplicity;
    my $want_sysmaint;
    my $want_skip_update;
    GetOptions('homedir|home!' => \$want_homedir,
               'coldbkup|cold!' => \$want_coldbkup,
               'workstation-duplicity|duplicity|duply!'
                 => \$want_workstation_duplicity,
               'sysmaint|sys!' => \$want_sysmaint,
               'skip-update|skip-up!' => \$want_skip_update)
      or die "failed to parse command line arguments";
    my $something_wanted = $want_homedir || $want_coldbkup
      || $want_workstation_duplicity || $want_sysmaint;
    my $do_homedir = $want_homedir // !$something_wanted;
    my $do_coldbkup = $want_coldbkup // !$something_wanted;
    my $do_workstation_duplicity =
      $want_workstation_duplicity // !$something_wanted;
    my $do_sysmaint = $want_sysmaint // !$something_wanted;
    my $skip_update = $want_skip_update // 0;

    my $coldbkup_root = shift @ARGV;
    unless (defined $coldbkup_root) {
        if ($want_coldbkup) {
            die "coldbkup requested but no dest provided on the command line";
        } elsif ($check_for_extdrive && $do_coldbkup) {
            say_bold
              ("You didn't specify a drive for coldbkup on the command line.");
            return 0 unless prompt_Yn("Continue locmaint without coldbkup?");
        }
        $do_coldbkup = 0;
    }

    do_homedir($skip_update) if $do_homedir;
    # TODO attempt to mount if not mounted
    if ($do_coldbkup) {
        $coldbkup_root = rel2abs($coldbkup_root);
        do_coldbkup($coldbkup_root);
        # TODO attempt to unmount
        # system "udisksctl unmount --object-path $coldbkup_root";
        # system "udisksctl power-off --object-path $coldbkup_root";
    }
    do_workstation_duplicity() if $do_workstation_duplicity;
    do_sysmaint() if $do_sysmaint;

    # this is useful because we spawn so many interactive shells, and
    # the user might think the script hasn't finished but is waiting
    # on the user doing something
    print "\n";
    script_status("maintainance complete");

    return 0;
}

sub do_homedir {
    my ($skip_update) = @_;

    chdir;
    normalise_mrconfig();
    src_register_all();

    # Check places where temporary files are stored
    interactive_ensure_subroutine(
              sub { empty_dir_or_list("$ENV{HOME}/tmp") },
              sub { my $empty = shift;

                    say_spaced_bullet "There are files to be cleaned up."
                      unless $empty;
                    return $empty;
                },
              "$ENV{HOME}/tmp");

    # local/big: files not included in duplicity backups
    #
    # local/tmp: files I don't want to check into a repo, but small
    # enough to include in duplicity backups, but should not stick
    # around in ~/tmp
    #
    # local/pub: files to be temporarily shared over the LAN
    unless (empty_dir_or_list("local/big")
            && empty_dir_or_list("local/tmp")
            && empty_dir_or_list("local/pub")) {
        say_spaced_bullet
          ("Consider cleaning up/annexing files in dir(s) listed above.");
        get_ack();
    }

    print "\n";
    show_user("ls --color=always --literal --classify ~",
              "Clean up any loose files in HOME.");

    my @mr_repos;
    push @mr_repos, Local::MrRepo::new_repo($_)
      foreach grep -d,
      map { /^mr list: (.+)$/; $1 // () } `mr ls`;

    # We try to update them all first, because this can take a while
    # so the machine can be left unattended.  We autoci first because
    # that increases the chance the update will succeed on its own
    unless ($skip_update) {
        script_status("trying to update all repos");
        foreach my $mr_repo (@mr_repos) {
            $mr_repo->auto_commit();
            $mr_repo->update();
        }
    }
    # Now the user-interactive walk through each repo
    foreach my $mr_repo (@mr_repos) {
        script_status("reviewing repo " . $mr_repo->toplevel);
        unless ($mr_repo->updated || $skip_update) {
            interactive_ensure_subroutine_success(sub { $mr_repo->update() },
                                                  $mr_repo->toplevel,
                                                  "try running `mr update'"
                                                 );
        }
        say_bold
          ("WARNING: status/review may not be accurate as update was skipped")
          if $skip_update;
        # If the repo supports reviewing, we hand off to that method,
        # requiring it to return a true value.  Otherwise, what we
        # require is empty status output.  We do not try to push on
        # the user's behalf, i.e., neither this script nor the
        # MrRepo::Repo classes directly execute `mr push`
        if ($mr_repo->can('review')) {
            interactive_ensure_subroutine(sub { $mr_repo->review() },
              sub { my $issues = shift;
                    say_spaced_bullet
                      ("There were issues when reviewing this repo.")
                      if $issues;
                    return !$issues; },
              $mr_repo->toplevel);
        } else {
            interactive_ensure_subroutine_no_output(sub { $mr_repo->status() },
                                                    $mr_repo->toplevel,
                                                    "`mr push' might be enough"
                                                   );
        }
    }

    # do this after in case reviewing the repos prompts me to save any
    # files this would delete
    src_cleanup();
    # look for any files outside of repos that src_cleanup() didn't
    # manage to clean up
    interactive_ensure_subroutine(\&loose_src_files, sub { return !shift },
                                  "$ENV{HOME}/src");
}

sub do_coldbkup {
    my $root = shift;

    return unless eval "use Git::Wrapper; use Net::GitHub; 1";

    my $short = basename($root);
    my $gitbk = catfile($root, "gitbk");
    die "$root is not a directory" unless -d $root;
    die "$root is not a mount point" unless grep / on $root type /, `mount`;
    unless (-d $gitbk) {
        say_bold("Looks like you haven't backed up to this media before.");
        if (prompt_yn("Create a new backup repository at $gitbk?")) {
            mkdir $gitbk or die "unable to mkdir $gitbk -- check perms";
        } else {
            say_bold("Abandoning coldbkup ..");
            return;
        }
    }

    # clean up after old backup schemes
    mkdir catfile($gitbk, "old");
    mkdir catfile($gitbk, "old", "github");
    mkdir catfile($gitbk, "old", "salsa");
    rename $_, catfile($gitbk, "old", basename($_)) for glob "$gitbk/github_*";
    rename $_, catfile($gitbk, "old", "github", basename($_))
      for glob "$gitbk/github/*.git $gitbk/github/.*.git";
    rename $_, catfile($gitbk, "old", "salsa", basename($_))
      for glob "$gitbk/salsa/*.git";

    # starred repos on GitHub
    #
    # I used to use github-backup for this but the GitHub API rate
    # limiting seemed to mean that it was never able to complete the
    # backup, even after logging in with OAUTH.  See old propellor
    # config for that in ~/doc/org/old_propellor_config.org
    my $gh = Net::GitHub->new(version => 3);
    my $starred = $gh->query('/users/spwhitton/starred');
    foreach my $repo (@$starred) {
        my $org = $repo->{full_name} =~ s|/.+$||r;
        my $org_dir = catfile($gitbk, "github", $org);
        mkdir $org_dir unless -d $org_dir;
        backup_repo($repo->{clone_url}, catfile($org_dir, $repo->{name}));

        # could run `github-backup --no-forks` in the repo at this
        # point, to grab metadata non-recursively
    }

    # athena main repos
    mkdir catfile($gitbk, "athena");
    my @athena_repos = map {
        if (m|^/srv/git/repositories/priv/(.+)\.git$|) {
            { uri => "athenap:$1", dir => "priv/$1.git" }
        } elsif (m|^/srv/git/repositories/(.+)\.git$|) {
            { uri => "athena:$1", dir => "$1.git" }
        }
    } `ssh athena find /srv/git/repositories -name "*.git" -type d 2>/dev/null`;
    backup_repo($_->{uri}, catfile($gitbk, "athena", $_->{dir}))
      for @athena_repos;

    # athena gcrypt repos
    mkdir catfile($gitbk, "athena_gcrypt");
    my @gcrypt_repos
      = map { m|^/srv/gcrypt/(.+)$|; { uri => "athenag:$1", dir => "$1" } }
      `ssh athena find /srv/gcrypt -name "*.git" -type d`;
    chomp @gcrypt_repos;
    backup_repo($_->{uri}, catfile($gitbk, "athena_gcrypt", $_->{dir}))
      for @gcrypt_repos;

    # repos from Debian's salsa
    mkdir catfile($gitbk, "salsa");
    if (open my $fh,
        '<', catfile($ENV{HOME}, "doc", "conf", "coldbkup", "salsa")) {
        while (<$fh>) {
            m|^https://salsa\.debian\.org/(.+)$| or next;
            my $uri = $&;
            my $dest = $1;
            $uri .= "/" if $uri =~ /\.git\z/;
            $uri .= ".git/" unless /\.git\/\z/;
            backup_repo($uri, catfile($gitbk, "salsa", $dest));
        }
    } else {
        say_bold
          ("WARNING: not backing up salsa repos: couldn't read list of repos");
        get_ack();
    }

    # If I have other repos to back up at some point, could create
    # ~/doc/conf/otherrepos.csv which specifies URIs and dests (the
    # latter possibly abbreviated in some way)
}

sub do_workstation_duplicity {
    return unless eval "use Date::Manip; 1";

    my $profile = hostname() . "-" . getpwuid($<) . "-home";
    return unless -e "$ENV{HOME}/.duply/$profile/conf";

    # Offer to force a full backup if it has been five days since the
    # last.  When running locmaint I often have a good connection and
    # the time for that.  If I run locmaint often enough, the duply
    # cronjob can unconditionally do an incremental backup (which is
    # good for roaming between WiFi networks) but the backup chain
    # isn't in danger of growing too long
    my ($last_full) = grep /^Last full backup date: /m, `duply $profile status`;
    $last_full =~ s/^Last full backup date: //;

    my $full = ParseDate($last_full) lt ParseDate("5 days ago");

    # user can override and force incremental if time or bandwidth is
    # lacking
    $full = prompt_yn("Run full duply backup?  (requires time & bandwidth)")
      if $full;

    system "duply $profile " . ($full ? "full+purgeFull --force" : "incr");
}

sub do_sysmaint {
    return unless $can_root;

    # could also check uptime here, as old sysmaint did when run on athena

    # Make a guess as to whether we're on stable, testing or sid.
    # lsb_release(1) is an alternative to this, but that just performs
    # guesswork too, and it's not Essential, so we might as well do it
    # ourselves.
    #
    # This assumes that on a testing system, if we have a sid apt
    # source configured, it's in a file in /etc/apt/sources.list.d,
    # not in the file /etc/apt/sources.list
    #
    # Possibly /usr/lib/os-release is more portable.
    my $suite;
    open my $fh, '<', "/etc/debian_version"
      or die "failed to open /etc/debian_version for reading";
    chomp(my $debian_version = <$fh>);
    if (looks_like_number($debian_version)) {
        $suite = STABLE;
    } else {
        open my $fh, '<', "/etc/apt/sources.list"
          or die "failed to open /etc/apt/sources.list for reading";
        my $sources = do { local $/; <$fh> };
        if (grep / (sid|unstable) /, $sources) {
            $suite = UNSTABLE;
        } else {
            $suite = TESTING;
        }
    }

    chomp(my $kernel_release = `uname -r`);
    my $kernel_pkg_name = "linux-image-$kernel_release";

    my %purgeable;
    my @rc_packages;
    for (`dpkg -l`) {
        /^([a-zA-Z ][a-zA-Z ][a-zA-Z ])\s(\S+)\s/ or next;
        my ($stat, $pkg) = ($1, $2);
        if ($stat eq "rc ") {
            $purgeable{$pkg}{rc} = 1;
            # @rc_packages will be used before %purgeable is modified,
            # so we can its entries now.  @build_deps_packages and
            # @obsolete_packages will need be initialised only after
            # we've possibly removed some entries from %purgeable
            push @rc_packages, $pkg;
        }
        $purgeable{$pkg}{build_deps} = 1 if $pkg =~ /-build-deps\z/;
    }
    $purgeable{$_}{obsolete} = 1
      for grep !/\A$kernel_pkg_name\z/,
      map { /^..A? (\S+)\s/; $1 } `aptitude search '?obsolete'`;

    show_user
      ("df -h", "Clean up some files if host does not have enough disc space");
    script_status("updating apt indices");
    system as_root("apt-get update");
    die "apt-get update failed" unless $? == 0;
    unless (@rc_packages == 0) {
        say_bold("Conf-files packages:");
        print "  rc $_\n" for @rc_packages;
        if (prompt_yn("Purge these?")) {
            system as_root("apt-get -y purge @rc_packages");
            delete @purgeable{@rc_packages};
        }
    }
    my @build_deps_packages = grep { $purgeable{$_}{bd} } keys %purgeable;
    unless (@build_deps_packages == 0) {
        say_bold("mk-build-deps(1) packages:");
        print "  $_\n" for @build_deps_packages;
        if (prompt_yn("Purge these?")) {
            system as_root("apt-get -y purge @build_deps_packages");
            delete @purgeable{@build_deps_packages};
        }
    }
    my @obsolete_packages
      = grep { $purgeable{$_}{obsolete} } keys %purgeable;
    # packages go in and out of testing frequently, so we probably
    # don't want to remove them
    unless (@obsolete_packages == 0 || $suite eq TESTING) {
        say_bold("Packages not available from any mirrors:");
        print "  $_\n" for @obsolete_packages;
        system as_root("apt-get -y purge @obsolete_packages")
          if prompt_yn("Purge these?");
    }
    # run these as one shell command to avoid having to type sudo
    # password repeatedly.  The first apt-get call is equivalent to
    # `apt upgrade` (at the time of writing) and has the advantage
    # over plain `apt-get upgrade` that new Recommends won't be
    # missed, which is possible with plain `apt-get upgrade`.
    # (Arguably plain `apt-get upgrade` should never be used and its
    # semantics were a poor design choice.)
    interactive_ensure_subroutine_success(
      sub {system_pty_capture(as_root(
         "bash -c \""
           . "apt-get --with-new-pkgs upgrade"
           . " && apt-get dist-upgrade"
           . " && apt-get -y autoremove"
           . " && apt-get autoclean"
           . "\""))});

    chomp(my $mailq = `which mailq`);
    if (-x $mailq) {
        chomp(my $owner = `dpkg-query -S $mailq`);
        $owner =~ s/: $mailq\z//;
        # this check is only for systems running postfix
        interactive_ensure_subroutine(
            sub { system_pty_capture("mailq") },
            sub {
                my $result = shift;
                chomp($result->{output});
                if ($result->{output} =~ /Mail queue is empty/) {
                    return 1;
                } else {
                    say_bold("uh oh, expected an empty mail queue");
                    return 0;
                }
            }) if $owner eq 'postfix';
    }

    my %obsolete_conffiles;
    my $curr_pkg;
    for (`dpkg-query --show --showformat='\${Package}\\n\${Conffiles}\\n'`) {
        chomp;
        next unless /\S/;
        if (/^\S/) {
            $curr_pkg = $_;
        } else {
            my @fields = split ' ';
            push @{$obsolete_conffiles{$curr_pkg}}, $fields[0]
              if $fields[$#fields] eq "obsolete";
        }
    }
    unless (keys %obsolete_conffiles == 0) {
        my @all_obsolete_conffiles;
        say_bold("Obsolete conffiles:");
        foreach my $pkg (keys %obsolete_conffiles) {
            foreach my $file (@{$obsolete_conffiles{$pkg}}) {
                print "  $pkg\t$file\n";
                push @all_obsolete_conffiles, $file;
            }
        }
        if (prompt_yn
            ("Fix by deleting each conffile and reinstalling its package (is not the right fix if conffile has moved between packages)?")) {
            system as_root("rm @all_obsolete_conffiles");
            system as_root("apt-get install -y --reinstall "
                           . join(' ', keys %obsolete_conffiles));
        }
    }

    if (($suite ne STABLE || -e "/var/run/reboot-required")
        && prompt_yn("Should reboot; do it now?")) {
        exec as_root("reboot");
    }
}

=head2 empty_dir_or_list($dir)

Check whether C<$dir> contains any hidden or unhidden files, returning
a true value if it does not, a false value if it does.  If it does,
print them.

=cut

sub empty_dir_or_list {
    my ($dir) = @_;

    opendir(my $dirh, $dir);
    my @files = grep { $_ ne '.' && $_ ne '..' } readdir $dirh;

    if (@files == 0) {
        return 1;
    } else {
        $dir =~ s/$ENV{HOME}/~/;
        say_bold("Listing $dir:\n");
        print "  $_\n" for @files;
        return 0;
    }
}

=head2 loose_src_files()

Check whether there are loose plain files outside of repos in ~/src,
returning a true value if there are, a false value if not.  If there
are, print them.

=cut

sub loose_src_files {
    my @loose_src_files;
    find({wanted => sub {
              push @loose_src_files, $File::Find::name
                unless -d
                # permit orig.tars with associated source trees
                || ((-f || -l)
                    && /([^_]+)_([^_]+)\.orig(?:\.gbp)?\.tar/
                    && (-d $1 || -d "$1-$2"))
          }, preprocess => sub {
              # don't look inside any repos
              return grep { not Local::Homedir::is_repo($_) } @_
          }}, "$ENV{HOME}/src");
    if (@loose_src_files == 0) {
        return 0;
    } else {
        say_bold("The following files in ~/src should be cleaned up:");
        print "  $_\n" for @loose_src_files;
        return 1;
    }
}

=head backup_repo($uri, $dest)

Back up git repo at C<$uri> to destination directory C<$dest>,
appending a '.git' to the latter if necessary.

Handle annexes listed in C<@remote_annexes> specially.

Requires Git::Wrapper to be available.  Code that calls
C<backup_repo()> should ensure it's available.

=cut

sub backup_repo {
    my ($uri, $dest) = @_;

    my ($paired_annex, $lazy_paired_annex)
      = map { (catfile($ENV{HOME}, $_->{homedir}), $_->{lazy} // 0) }
      grep { $_->{origin} eq $uri } @remote_annexes;
    $dest = "$dest.git" unless $dest =~ /\.git\z/;

    # when we are backing up a paired annex, we need to be on a
    # removable drive under /media, because that's going to be the
    # annex description
    my $desc;
    if (defined $paired_annex) {
        $dest =~ m|^/media/[^/]+/([^/]+)/|;
        die "failed to determine drive label for $dest" unless defined $1;
        $desc = $1;
    }

    # report status
    if (defined $paired_annex) {
        script_status("backing up $uri to $dest as annex");
    } else {
        script_status("backing up $uri to $dest");
    }

    my $clone_needed;
    if (-e $dest && !-d $dest) {
        die "$dest exists but is not a directory";
    } elsif (-d $dest) {
        opendir my $dirh, $dest or die "failed to opendir $dest";
        readdir $dirh;
        readdir $dirh;
        # if we fail to read a third entry, the dir only had . and
        # .. in it, so we need to clone
        $clone_needed = ! readdir $dirh;
    } else {
        $clone_needed = 1;
    }
    return if $clone_needed and defined $paired_annex and $lazy_paired_annex;
    if ($clone_needed) {
        make_path($dest) unless -d $dest;
        # bare repos don't get a reflog by default
        system "git -C $dest -c core.logAllRefUpdates=true clone "
          . (defined $paired_annex ? "--bare" : "--mirror") . " $uri .";
    }
    my $git = Git::Wrapper->new($dest);

    # Protect our backup from being reaped by git-gc.
    #
    # Enable the reflog, since it is off by default in bare repos.
    # Since we fetch with --no-prune, no reflogs will ever get
    # deleted, so we have one for every branch that ever existed in
    # the remote we're backing up (that existed at a time we ran this
    # script, at least)
    $git->config(qw(core.logAllRefUpdates true));
    # Never remove reflog entries
    $git->config(qw(gc.reflogExpire never));
    # git-gc will never remove dangling commits mentioned in any
    # reflog *unless* they are unreachable in the branch the
    # reflog logs and are older than this config variable
    $git->config(qw(gc.reflogExpireUnreachable never));
    # avoid backing up broken commits
    $git->config(qw(fetch.fsckObjects true));

    if (defined $paired_annex) {
        if ($clone_needed) {
            $git->annex("init", $desc);
            # set these content settings now, but the user might want to
            # change for this particular backup drive
            $git->config(qw(annex.diskreserve 2GB));
            $git->annex(qw(wanted . standard));
            $git->annex(qw(group . incrementalbackup));
        }
        if (-d catfile($paired_annex, ".git")
              && -d catfile($paired_annex, ".git", "annex")) {
            my $pair = Git::Wrapper->new($paired_annex);
            my @remotes = $pair->remote();
            $pair->remote("add", $desc, $dest)
              unless (grep /^$desc$/, @remotes);
            # bypass Git::Wrapper so that output is printed
            interactive_ensure_subroutine_success(
                sub {
                    system_pty_capture(
                        "git -C $paired_annex annex sync --content $desc");
                });
            interactive_ensure_subroutine_success(
                sub {
                    system_pty_capture(
                        "git -C $paired_annex annex sync --no-content origin");
                }) if grep /^origin$/, @remotes;
        } else {
            say_bold("$paired_annex doesn't look like an annex"
                     . " on this machine, so not updating $dest");
            get_ack();
        }
    } elsif (!$clone_needed
             # additional check to avoid accidental ref clobbering
             and !-d catfile($dest, ".git", "annex")) {
        my ($origin) = $git->config(qw(remote.origin.url));

        die "$dest has origin remote URI $origin but we expected $uri"
          unless ($origin eq $uri)
          # accommodate repos created by coldbkup part of sysmaint --
          # these don't use the athena:/athenap:/athenag: aliases
          || ("$origin $uri"
              =~ m|git\@spwhitton\.name:(.+)(?:\.git)? athena:\1|)
          || ("$origin $uri"
              =~ m|git\@spwhitton\.name:priv/(.+)(?:\.git)? athenap:\1|)
          || ("$origin $uri"
            =~ m|gcrypt::rsync://athena:/srv/gcrypt/(.+) athenag:\1|);

        # bypass Git::Wrapper so that fetch output is shown to the user
        interactive_ensure_subroutine_success(
            sub {
                system_pty_capture(
"git -C $dest fetch origin +refs/heads/*:refs/heads/* --tags --no-prune"
                );
            });
    }
}