This lets us clean up disk space when repos are removed
on the remote side.
---
Documentation/public-inbox-clone.pod | 9 +++++++++
lib/PublicInbox/LeiMirror.pm | 30 +++++++++++++++++++++-------
script/public-inbox-clone | 2 +-
t/clone-coderepo.t | 21 +++++++++++++++++++
4 files changed, 54 insertions(+), 8 deletions(-)
diff --git a/Documentation/public-inbox-clone.pod
b/Documentation/public-inbox-clone.pod
index 50a290df..152fed73 100644
--- a/Documentation/public-inbox-clone.pod
+++ b/Documentation/public-inbox-clone.pod
@@ -176,6 +176,15 @@ calls on incremental clones.
This is a new option in public-inbox 2.0+
+=item --purge
+
+Deletes entire repos which no longer exist in the remote manifest,
+or are filtered out by C<--include=> or C<--exclude=>.
+
+This is only useful when using C<--manifest>
+
+This is a new option in public-inbox 2.0+
+
=item --exit-code
Exit with C<127> if no updates are done when relying on a manifest.
diff --git a/lib/PublicInbox/LeiMirror.pm b/lib/PublicInbox/LeiMirror.pm
index 8b7e48ab..abb68f70 100644
--- a/lib/PublicInbox/LeiMirror.pm
+++ b/lib/PublicInbox/LeiMirror.pm
@@ -1094,7 +1094,9 @@ sub dump_project_list ($$) {
my %new;
open my $dh, '<', '.' or die "open(.): $!";
- chdir($self->{dst}) or die "chdir($self->{dst}): $!";
+ if (!$self->{dry_run} || -d $self->{dst}) {
+ chdir($self->{dst}) or die "chdir($self->{dst}): $!";
+ }
my @local = grep { -e $_ ? ($new{$_} = undef) : 1 } split(/\n/s, $old);
chdir($dh) or die "chdir(restore): $!";
@@ -1104,10 +1106,22 @@ sub dump_project_list ($$) {
my %lnk = map { substr($_, 1) => undef } @{$self->{-new_symlinks}};
@remote = grep { !exists($lnk{$_}) } @remote;
- warn <<EOM if @remote;
+ if (@remote) {
+ warn <<EOM;
The following local repositories are ignored/gone from $self->{src}:
EOM
- warn "\t", $_, "\n" for @remote;
+ warn "\t", $_, "\n" for @remote;
+
+ if ($self->{lei}->{opt}->{purge} && !$self->{dry_run}) {
+ my $o = {};
+ $o->{verbose} = 1 if $self->{lei}->{opt}->{verbose};
+ my $dst = $self->{dst};
+ File::Path::remove_tree(map { "$dst/$_" } @remote, $o);
+ my %rm = map { $_ => undef } @remote;
+ @list = grep { !exists($rm{$_}) } @list;
+ $self->{lei}->qerr('# purged ');
+ }
+ }
if (defined($f) && @local) {
warn <<EOM;
The following repos in $f no longer exist on the filesystem:
@@ -1115,7 +1129,7 @@ EOM
warn "\t", $_, "\n" for @local;
}
$self->{chg}->{nr_chg} += scalar(@remote) + scalar(@local);
- $f // return;
+ return if !defined($f) || $self->{dry_run};
my (undef, $dn, $bn) = File::Spec->splitpath($f);
my $new = join("\n", @list, '');
atomic_write($dn, $bn, $new) if $new ne $old;
@@ -1222,7 +1236,7 @@ EOM
}
delete local $lei->{opt}->{epoch} if defined($v2);
clone_all($self, $m);
- return if $self->{dry_run} || !keep_going($self);
+ return if !keep_going($self);
# set by clone_v2_prep/-I/--exclude
my $mis = delete $self->{chg}->{fp_mismatch};
@@ -1239,13 +1253,15 @@ EOM
W: The above fingerprints may never match without --prune
EOM
}
- dump_manifest($m => $ft) if delete($self->{chg}->{manifest}) || $mis;
+ if ((delete($self->{chg}->{manifest}) || $mis) && !$self->{dry_run}) {
+ dump_manifest($m => $ft);
+ }
my $bad = delete $self->{chg}->{badlink};
warn(<<EOM, map { ("\t", $_, "\n") } @$bad) if $bad;
W: The following exist and have not been converted to symlinks
EOM
dump_project_list($self, $m);
- ft_rename($ft, $manifest, 0666);
+ ft_rename($ft, $manifest, 0666) if !$self->{dry_run};
!$self->{chg}->{nr_chg} && $lei->{opt}->{'exit-code'} and
$lei->child_error(127 << 8);
}
diff --git a/script/public-inbox-clone b/script/public-inbox-clone
index 5b365df7..c3e64485 100755
--- a/script/public-inbox-clone
+++ b/script/public-inbox-clone
@@ -32,7 +32,7 @@ EOF
GetOptions($opt, qw(help|h quiet|q verbose|v+ C=s@ c=s@ include|I=s@ exclude=s@
inbox-config=s inbox-version=i objstore=s manifest=s
remote-manifest=s project-list|projectslist=s post-update-hook=s@
- prune|p keep-going|k exit-code
+ prune|p keep-going|k exit-code purge
dry-run|n jobs|j=i no-torsocks torsocks=s epoch=s)) or die $help;
if ($opt->{help}) { print $help; exit };
require PublicInbox::Admin; # loads Config
diff --git a/t/clone-coderepo.t b/t/clone-coderepo.t
index 3a5997c9..e117293e 100644
--- a/t/clone-coderepo.t
+++ b/t/clone-coderepo.t
@@ -131,6 +131,27 @@ is(PublicInbox::Git::try_cat($dst_pl), "a.git\nb.git\n",
like($err, qr/no longer exist.*\bgone\.git\b/s, 'gone.git noted');
}
+{ # --purge
+ open my $fh, '>>', $dst_pl or xbail $!;
+ print $fh "gone-rdonly.git\n" or xbail $!;
+ close $fh or xbail $!;
+ my $ro = "$tmpdir/dst/gone-rdonly.git";
+ PublicInbox::Import::init_bare($ro);
+ ok(-d $ro, 'gone-rdonly.git created');
+ my @st = stat($ro) or xbail "stat($ro): $!";
+ chmod($st[2] & 0555, $ro) or xbail "chmod($ro): $!";
+
+ utime($t0, $t0, $dst_mf) or xbail "utime: $!";
+ my $rdr = { 2 => \(my $err = '') };
+ my $xcmd = [ @$cmd, '--purge' ];
+ ok(run_script($xcmd, undef, $rdr), 'clone again for expired gone.git');
+ is(PublicInbox::Git::try_cat($dst_pl), "a.git\nb.git\n",
+ 'project list cleaned');
+ like($err, qr!ignored/gone.*?\bgone-rdonly\.git\b!s,
+ 'gone-rdonly.git noted');
+ ok(!-d $ro, 'gone-rdonly.git dir gone from --purge');
+}
+
my $test_puh = sub {
my (@clone_arg) = @_;
my $x = [qw(-clone --inbox-config=never --manifest= --project-list=
