t/clone-coderepo.t

   1 #!perl -w
   2 # Copyright (C) all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use v5.12;
   5 use PublicInbox::TestCommon;
   6 use PublicInbox::Import;
   7 use File::Temp;
   8 use File::Path qw(remove_tree);
   9 use PublicInbox::SHA qw(sha1_hex);
  10 use PublicInbox::IO;
  11 require_mods(qw(json Plack::Builder HTTP::Date HTTP::Status));
  12 require_git_http_backend;
  13 require_git '1.8.5';
  14 require_cmd 'curl';
  15 require_ok 'PublicInbox::LeiMirror';
  16 my ($tmpdir, $for_destroy) = tmpdir();
  17 my $pa = "$tmpdir/src/a.git";
  18 my $pb = "$tmpdir/src/b.git";
  19 PublicInbox::Import::init_bare($pa);
  20 my ($stdout, $stderr) = ("$tmpdir/out.log", "$tmpdir/err.log");
  21 my $pi_config = "$tmpdir/pi_config";
  22 my $td;
  23 my $tcp = tcp_server();
  24 my $url = 'http://'.tcp_host_port($tcp).'/';
  25 my $set_manifest = sub {
  26         my ($m, $f) = @_;
  27         $f //= "$tmpdir/src/manifest.js.gz";
  28         my $ft = File::Temp->new(TMPDIR => $tmpdir, UNLINK => 0);
  29         PublicInbox::LeiMirror::dump_manifest($m, $ft);
  30         PublicInbox::LeiMirror::ft_rename($ft, $f, 0666);
  31 };
  32 my $read_manifest = sub {
  33         my ($f) = @_;
  34         open my $fh, '<', $f or xbail "open($f): $!";
  35         PublicInbox::LeiMirror::decode_manifest($fh, $f, $f);
  36 };
  37
  38 my $t0 = time - 1;
  39 my $m; # manifest hashref
  40
  41 {
  42         my $fi_data = PublicInbox::IO::try_cat './t/git.fast-import-data';
  43         my $db = PublicInbox::Import::default_branch;
  44         $fi_data =~ s!\brefs/heads/master\b!$db!gs;
  45         my $rdr = { 0 => \$fi_data };
  46         my @git = ('git', "--git-dir=$pa");
  47         xsys_e([@git, qw(fast-import --quiet)], undef, $rdr);
  48         xsys_e([qw(/bin/cp -Rp a.git b.git)], undef, { -C => "$tmpdir/src" });
  49         open my $fh, '>', $pi_config or xbail "open($pi_config): $!";
  50         print $fh <<EOM or xbail "print: $!";
  51 [publicinbox]
  52         cgitrc = $tmpdir/cgitrc
  53         cgit = fallback
  54 EOM
  55         close $fh or xbail "close: $!";
  56
  57         my $f = "$tmpdir/cgitrc";
  58         open $fh, '>', $f or xbail "open($f): $!";
  59         print $fh <<EOM or xbail "print: $!";
  60 project-list=$tmpdir/src/projects.list
  61 scan-path=$tmpdir/src
  62 EOM
  63         close $fh or xbail "close($f): $!";
  64
  65         my $cmd = [ '-httpd', '-W0', "--stdout=$stdout", "--stderr=$stderr",
  66                 File::Spec->rel2abs('t/clone-coderepo.psgi') ];
  67         my $env = { TEST_DOCROOT => "$tmpdir/src", PI_CONFIG => $pi_config };
  68         $td = start_script($cmd, $env, { 3 => $tcp });
  69         my $fp = sha1_hex(my $refs = xqx([@git, 'show-ref']));
  70         my $alice = "\x{100}lice";
  71         $m = {
  72                 '/a.git' => {
  73                         fingerprint => $fp,
  74                         modified => 1,
  75                         owner => $alice,
  76                         description => "${alice}'s repo",
  77                 },
  78                 '/b.git' => {
  79                         fingerprint => $fp,
  80                         modified => 1,
  81                         owner => 'Bob',
  82                 },
  83         };
  84         $set_manifest->($m);
  85         $f = "$tmpdir/src/projects.list";
  86         open $fh, '>', $f, or xbail "open($f): $!";
  87         print $fh <<EOM or xbail "print($f): $!";
  88 a.git
  89 b.git
  90 EOM
  91         close $fh or xbail "close($f): $!";
  92 }
  93
  94 my $cmd = [qw(-clone --inbox-config=never --manifest= --project-list=
  95         --objstore= -p -q), $url, "$tmpdir/dst", '--exit-code'];
  96 ok(run_script($cmd), 'clone');
  97 is(xqx([qw(git config gitweb.owner)], { GIT_DIR => "$tmpdir/dst/a.git" }),
  98         "\xc4\x80lice\n", 'a.git gitweb.owner set');
  99 is(xqx([qw(git config gitweb.owner)], { GIT_DIR => "$tmpdir/dst/b.git" }),
 100         "Bob\n", 'b.git gitweb.owner set');
 101 my $desc = PublicInbox::IO::try_cat("$tmpdir/dst/a.git/description");
 102 is($desc, "\xc4\x80lice's repo\n", 'description set');
 103
 104 my $dst_pl = "$tmpdir/dst/projects.list";
 105 my $dst_mf = "$tmpdir/dst/manifest.js.gz";
 106 ok(!-d "$tmpdir/dst/objstore", 'no objstore created w/o forkgroups');
 107 my $r = $read_manifest->($dst_mf);
 108 is_deeply($r, $m, 'manifest matches');
 109
 110 is(PublicInbox::IO::try_cat($dst_pl), "a.git\nb.git\n",
 111         'wrote projects.list');
 112
 113 { # check symlinks
 114         $m->{'/a.git'}->{symlinks} = [ '/old/a.git' ];
 115         $set_manifest->($m);
 116         utime($t0, $t0, $dst_mf) or xbail "utime: $!";
 117         ok(run_script($cmd), 'clone again +symlinks');
 118         ok(-l "$tmpdir/dst/old/a.git", 'symlink created');
 119         is(PublicInbox::IO::try_cat($dst_pl), "a.git\nb.git\n",
 120                 'projects.list does not include symlink by default');
 121
 122         $r = $read_manifest->($dst_mf);
 123         is_deeply($r, $m, 'updated manifest matches');
 124 }
 125 { # cleanup old projects from projects.list
 126         open my $fh, '>>', $dst_pl or xbail $!;
 127         print $fh "gone.git\n" or xbail $!;
 128         close $fh or xbail $!;
 129
 130         utime($t0, $t0, $dst_mf) or xbail "utime: $!";
 131         my $rdr = { 2 => \(my $err = '') };
 132         ok(run_script($cmd, undef, $rdr), 'clone again for expired gone.git');
 133         is(PublicInbox::IO::try_cat($dst_pl), "a.git\nb.git\n",
 134                 'project list cleaned');
 135         like($err, qr/no longer exist.*\bgone\.git\b/s, 'gone.git noted');
 136 }
 137
 138 { # --purge
 139         open my $fh, '>>', $dst_pl or xbail $!;
 140         print $fh "gone-rdonly.git\n" or xbail $!;
 141         close $fh or xbail $!;
 142         my $ro = "$tmpdir/dst/gone-rdonly.git";
 143         PublicInbox::Import::init_bare($ro);
 144         ok(-d $ro, 'gone-rdonly.git created');
 145         my @st = stat($ro) or xbail "stat($ro): $!";
 146         chmod($st[2] & 0555, $ro) or xbail "chmod($ro): $!";
 147
 148         utime($t0, $t0, $dst_mf) or xbail "utime: $!";
 149         my $rdr = { 2 => \(my $err = '') };
 150         my $xcmd = [ @$cmd, '--purge' ];
 151         ok(run_script($xcmd, undef, $rdr), 'clone again for expired gone.git');
 152         is(PublicInbox::IO::try_cat($dst_pl), "a.git\nb.git\n",
 153                 'project list cleaned');
 154         like($err, qr!ignored/gone.*?\bgone-rdonly\.git\b!s,
 155                 'gone-rdonly.git noted');
 156         ok(!-d $ro, 'gone-rdonly.git dir gone from --purge');
 157 }
 158
 159 my $test_puh = sub {
 160         my (@clone_arg) = @_;
 161         my $x = [qw(-clone --inbox-config=never --manifest= --project-list=
 162                 -q -p), $url, "$tmpdir/dst", @clone_arg,
 163                 '--post-update-hook=./t/clone-coderepo-puh1.sh',
 164                 '--post-update-hook=./t/clone-coderepo-puh2.sh' ];
 165         my $log = "$tmpdir/puh.log";
 166         my $env = { CLONE_CODEREPO_TEST_OUT => $log };
 167         remove_tree("$tmpdir/dst");
 168         ok(run_script($x, $env), "fresh clone @clone_arg w/ post-update-hook");
 169         ok(-e $log, "hooks run on fresh clone @clone_arg");
 170         open my $lh, '<', $log or xbail "open $log: $!";
 171         chomp(my @l = readline($lh));
 172         is(scalar(@l), 4, "4 lines written by hooks on @clone_arg");
 173         for my $r (qw(a b)) {
 174                 is_xdeeply(['uno', 'dos'],
 175                         [ (map { s/ .+//; $_ } grep(m!/$r\.git\z!, @l)) ],
 176                         "$r.git hooks ran in order") or diag explain(\@l);
 177         }
 178         unlink($log) or xbail "unlink: $!";
 179         ok(run_script($x, $env), "no-op clone @clone_arg w/ post-update-hook");
 180         ok(!-e $log, "hooks not run on no-op @clone_arg");
 181
 182         push @$x, '--exit-code';
 183         ok(!run_script($x, $env), 'no-op clone w/ --exit-code fails');
 184         is($? >> 8, 127, '--exit-code gave 127');
 185 };
 186 $test_puh->();
 187 ok(!-e "$tmpdir/dst/objstore", 'no objstore, yet');
 188
 189 my $fgrp = 'fgrp';
 190 $m->{'/a.git'}->{forkgroup} = $m->{'/b.git'}->{forkgroup} = $fgrp;
 191 $set_manifest->($m);
 192 $test_puh->('--objstore=');
 193 ok(-e "$tmpdir/dst/objstore", 'objstore created');
 194
 195 # ensure new repos can be detected
 196 {
 197         xsys_e([qw(/bin/cp -Rp a.git c.git)], undef, { -C => "$tmpdir/src" });
 198         open my $fh, '>>', "$tmpdir/src/projects.list" or xbail "open $!";
 199         say $fh 'c.git' or xbail "say $!";
 200         close $fh or xbail "close $!";
 201         xsys_e([qw(git clone -q), "${url}c.git", "$tmpdir/dst/c.git"]);
 202         SKIP: {
 203                 require_mods(qw(Plack::Test::ExternalServer LWP::UserAgent), 1);
 204                 use_ok($_) for qw(HTTP::Request::Common);
 205                 chop(my $uri = $url) eq '/' or xbail "BUG: no /";
 206                 local $ENV{PLACK_TEST_EXTERNALSERVER_URI} = $uri;
 207                 my %opt = (ua => LWP::UserAgent->new);
 208                 $opt{ua}->max_redirect(0);
 209                 $opt{client} = sub {
 210                         my ($cb) = @_;
 211                         my $res = $cb->(GET('/c.git/'));
 212                         is($res->code, 200, 'got 200 response for /');
 213                         $res = $cb->(GET('/c.git/tree/'));
 214                         is($res->code, 200, 'got 200 response for /tree');
 215                 };
 216                 Plack::Test::ExternalServer::test_psgi(%opt);
 217         }
 218 }
 219
 220 done_testing;