t/admin.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 strict;
   5 use v5.10.1;
   6 use PublicInbox::TestCommon;
   7 use PublicInbox::Import;
   8 use_ok 'PublicInbox::Admin';
   9 use autodie;
  10 my $v1 = create_inbox 'v1', -no_gc => 1, sub {};
  11 my ($tmpdir, $for_destroy) = tmpdir();
  12 my $git_dir = $v1->{inboxdir};
  13 my ($res, $err, $v);
  14 my $v2ibx;
  15 SKIP: {
  16         require_mods(qw(DBD::SQLite), 5);
  17         require_git(2.6, 5);
  18         $v2ibx = create_inbox 'v2', indexlevel => 'basic', version => 2,
  19                                 -no_gc => 1, sub {
  20                 my ($v2w, $ibx) = @_;
  21                 $v2w->idx_init;
  22                 $v2w->importer;
  23         };
  24 };
  25
  26 *resolve_inboxdir = \&PublicInbox::Admin::resolve_inboxdir;
  27 *resolve_git_dir = \&PublicInbox::Admin::resolve_git_dir;
  28
  29 {
  30         symlink $git_dir, my $sym = "$tmpdir/v1-symlink.git";
  31         for my $d ('') { # TODO: should work inside $sym/objects
  32                 local $ENV{PWD} = $sym.$d;
  33                 chdir $sym.$d;
  34                 is resolve_git_dir('.'), $sym,
  35                         "symlink preserved from {SYMLINKDIR}.git$d";
  36         }
  37 }
  38
  39 # v1
  40 is(resolve_inboxdir($git_dir), $git_dir, 'top-level GIT_DIR resolved');
  41 is(resolve_inboxdir("$git_dir/objects"), $git_dir, 'GIT_DIR/objects resolved');
  42
  43 ok(chdir($git_dir), 'chdir GIT_DIR works');
  44 is(resolve_inboxdir(), $git_dir, 'resolve_inboxdir works in GIT_DIR');
  45
  46 ok(chdir("$git_dir/objects"), 'chdir GIT_DIR/objects works');
  47 is(resolve_inboxdir(), $git_dir, 'resolve_inboxdir works in GIT_DIR');
  48 $res = resolve_inboxdir(undef, \$v);
  49 is($v, 1, 'version 1 detected');
  50 is($res, $git_dir, 'detects directory along with version');
  51
  52 # $tmpdir could be inside a git working, directory, so we test '/'
  53 SKIP: {
  54         my $no_vcs_dir = '/';
  55         # do people version-control "/"?
  56         skip "$no_vcs_dir is version controlled by git", 4 if -d '/.git';
  57         open my $null, '>', '/dev/null' or die "open /dev/null: $!";
  58         open my $olderr, '>&', \*STDERR or die "dup stderr: $!";
  59
  60         ok(chdir($no_vcs_dir), 'chdir to a non-inbox');
  61         open STDERR, '>&', $null or die "redirect stderr to /dev/null: $!";
  62         $res = eval { resolve_inboxdir() };
  63         open STDERR, '>&', $olderr or die "restore stderr: $!";
  64         is($res, undef, 'fails inside non-version-controlled dir');
  65
  66         ok(chdir($tmpdir), 'back to test-specific $tmpdir');
  67         open STDERR, '>&', $null or die "redirect stderr to /dev/null: $!";
  68         $res = eval { resolve_inboxdir($no_vcs_dir) };
  69         $err = $@;
  70         open STDERR, '>&', $olderr or die "restore stderr: $!";
  71         is($res, undef, 'fails on non-version-controlled dir');
  72         ok($err, '$@ set on failure');
  73 }
  74
  75 # v2
  76 if ($v2ibx) {
  77         my $v2_dir = $v2ibx->{inboxdir};
  78         is(resolve_inboxdir($v2_dir), $v2_dir,
  79                 'resolve_inboxdir works on v2_dir');
  80         chdir($v2_dir) or BAIL_OUT "chdir v2_dir: $!";
  81         is(resolve_inboxdir(), $v2_dir, 'resolve_inboxdir works inside v2_dir');
  82         $res = resolve_inboxdir(undef, \$v);
  83         is($v, 2, 'version 2 detected');
  84         is($res, $v2_dir, 'detects directory along with version');
  85
  86         # TODO: should work from inside Xapian dirs, and git dirs, here...
  87         my $objdir = "$v2_dir/git/0.git/objects";
  88         is($v2_dir, resolve_inboxdir($objdir, \$v), 'at $objdir');
  89         is($v, 2, 'version 2 detected at $objdir');
  90         chdir($objdir) or BAIL_OUT "chdir objdir: $!";
  91         is(resolve_inboxdir(undef, \$v), $v2_dir, 'inside $objdir');
  92         is($v, 2, 'version 2 detected inside $objdir');
  93 }
  94
  95 chdir '/' or BAIL_OUT "chdir: $!";
  96
  97 my @pairs = (
  98         '1g' => 1024 ** 3,
  99         666 => 666,
 100         '1500K' => 1500 * 1024,
 101         '15m' => 15 * (1024 ** 2),
 102 );
 103
 104 while (@pairs) {
 105         my ($in, $out) = splice(@pairs, 0, 2);
 106         my $orig = $in;
 107         ok(PublicInbox::Admin::parse_unsigned(\$in), "parse_unsigned $orig");
 108         is($in, $out, "got $orig => ($in == $out)");
 109 }
 110
 111 for my $v ('', 'bogus', '1p', '1gig') {
 112         ok(!PublicInbox::Admin::parse_unsigned(\$v),
 113                 "parse_unsigned rejects $v");
 114 }
 115
 116 done_testing();