add empty-annexes-from

1 files changed, 84 insertions, 0 deletions

diff --git a/scripts/git/empty-annexes-from b/scripts/git/empty-annexes-from
new file mode 100755
index 00000000..d4eba167
--- /dev/null
+++ b/scripts/git/empty-annexes-from
@@ -0,0 +1,84 @@
+#!/usr/bin/env perl
+use 5.036;
+
+# This is for emptying a machine that's about to be reinstalled, scrapped etc.
+# Assume HOME is the same there as here, and that it uses my ~/.mrconfig.
+# We then process only annexes checked out both here and there.
+# Before running this, mount a backup drive, s.t. git-annex is more likely to
+# be happy about the number of copies that will remain after moving to here.
+
+use Git::Annex;
+use experimental "try";
+
+our @leave_used = qw(lib/priv);
+
+@ARGV == 1 or die "Exactly one argument required\n";
+my $remote = $ARGV[0];
+$remote =~ /\A[a-z]+\z/ or die "Remote name $remote not a short hostname?\n";
+chdir;
+my @annexes;
+for (`mr ls`) {
+    chomp;
+    /^mr list: (?=\/)/ and -d $' or next;
+    `git -C $' annex status 2>/dev/null`;
+    $? and next;
+    `ssh $remote git -C $' annex status 2>/dev/null`;
+    $? or push @annexes, Git::Annex->new($');
+}
+
+my @not_done;
+
+foreach my $annex (@annexes) {
+    my $tl = $annex->toplevel;
+    say "Processing $tl";
+    (my $rel = $tl) =~ s#\A\Q$ENV{HOME}\E/##;
+    try {
+	my ($url) = $annex->git->remote("get-url", $remote);
+	$url =~ /\A$remote:\Q$rel\E\z/
+	  or die "$tl $remote remote URL form not recognised\n";
+    } catch ($e) {
+	$e =~ /No such remote/
+	  ? $annex->git->remote("add", $remote, "$remote:$rel")
+	  : die $e
+    }
+
+    $annex->annex->sync(qw(--no-content origin), $remote);
+    $annex->annex->untrust($remote);
+
+    chdir $tl;
+    if (grep $_ eq $rel, @leave_used) {
+	$annex->annex->unused({
+	    used_refspec =>
+"+refs/remotes/$remote/master:+refs/remotes/$remote/synced/master",
+	    from => $remote
+	});
+	system(qw(git annex move --unused --numcopies=1), "--from=$remote")
+	  == 0
+	  or die "'git annex move --unused' for $rel exited non-zero\n";
+	push @not_done, $rel;
+	$annex->annex->sync(qw(--no-content origin), $remote);
+    } else {
+	$annex->annex->wanted($remote, "standard");
+	$annex->annex->required($remote, "standard");
+	$annex->annex->ungroup($remote, $_)
+	  for split " ", ($annex->annex->group($remote))[0];
+	$annex->annex->group($remote, "unwanted");
+	system qw(git annex move --all), "--from=$remote";
+
+	my @objects = `ssh $remote find $tl/.git/annex/objects`;
+	if (    @objects == 1
+	    and $? == 0
+	    and system("ssh $remote git -C $tl annex uninit") == 0) {
+	    $annex->annex->dead($remote);
+	    $annex->annex->sync("origin");
+	} else {
+	    push @not_done, $rel;
+	    $annex->annex->sync("origin", $remote);
+	}
+    }
+
+    $annex->git->remote("rm", $remote);
+}
+
+$" = ", ";
+warn "Annexes that remain on $remote: @not_done\n" if @not_done;