t/02-operation.t

   1 use Getopt::Long;
   2 use Test::More;
   3 use strict;
   4 my $tests;
   5 BEGIN { $tests = 0 }
   6 use lib "lib";
   7
   8 my %Opt;
   9 GetOptions(
  10            "verbose!",
  11           ) or die;
  12 $Opt{verbose} ||= $ENV{PERL_RERSYNCRECENT_TEST_VERBOSE};
  13
  14 my $HAVE;
  15 BEGIN {
  16     # neither LibMagic nor MMagic tell them apart
  17     for my $package (
  18                      # "File::LibMagic",
  19                      "File::MMagic",
  20                     ) {
  21         $HAVE->{$package} = eval qq{ require $package; };
  22     }
  23 }
  24
  25 use Dumpvalue;
  26 use File::Basename qw(dirname);
  27 use File::Copy qw(cp);
  28 use File::Path qw(mkpath rmtree);
  29 use File::Rsync::Mirror::Recent;
  30 use File::Rsync::Mirror::Recentfile;
  31 use List::MoreUtils qw(uniq);
  32 use Storable;
  33 use Time::HiRes qw(time sleep);
  34 use YAML::Syck;
  35
  36 my $root_from = "t/ta";
  37 my $root_to = "t/tb";
  38 my $statusfile = "t/recent-rmirror-state.yml";
  39 rmtree [$root_from, $root_to];
  40
  41 {
  42     my @serializers;
  43     BEGIN {
  44         @serializers = (
  45                         ".yaml",
  46                         ".json",
  47                         ".sto",
  48                         ".dd",
  49                        );
  50         $tests += @serializers;
  51         if ($HAVE->{"File::LibMagic"}||$HAVE->{"File::MMagic"}) {
  52             $tests += @serializers;
  53         }
  54     }
  55     mkpath $root_from;
  56     my $ttt = "$root_from/ttt";
  57     open my $fh, ">", $ttt or die "Could not open: $!";
  58     print $fh time;
  59     close $fh or die "Could not close: $!";
  60     my $fm;
  61     if ($HAVE->{"File::LibMagic"}) {
  62         $fm = File::LibMagic->new();
  63     } elsif ($HAVE->{"File::MMagic"}) {
  64         $fm = File::MMagic->new();
  65     }
  66     for my $s (@serializers) {
  67         my $rf = File::Rsync::Mirror::Recentfile->new
  68             (
  69              filenameroot   => "RECENT",
  70              interval       => q(1m),
  71              localroot      => $root_from,
  72              serializer_suffix => $s,
  73             );
  74         $rf->update($ttt,"new");
  75         if ($fm) {
  76             my $magic = $fm->checktype_filename("$root_from/RECENT-1m$s");
  77             ok($magic, sprintf
  78                ("Got a magic[%s] for s[%s]: [%s]",
  79                 ref $fm,
  80                 $s,
  81                 $magic,
  82                ));
  83         }
  84         my $content = do {open my $fh, "$root_from/RECENT-1m$s";local $/;<$fh>};
  85         $content = Dumpvalue->new()->stringify($content);
  86         my $want_length = 42; # or maybe 3 more
  87         substr($content,$want_length) = "..." if length $content > 3+$want_length;
  88         ok($content, "Got a substr for s[$s]: [$content]");
  89     }
  90 }
  91
  92 rmtree [$root_from, $root_to];
  93
  94 {
  95     # very small tree, aggregate it
  96     my @intervals;
  97     BEGIN {
  98         $tests += 30;
  99         @intervals = qw( 2s 4s 8s 16s 32s Z );
 100     }
 101     ok(1, "starting smalltree block");
 102     is 6, scalar @intervals, "array has 6 elements: @intervals";
 103     for my $pass (0,1) {
 104         my $rf0 = File::Rsync::Mirror::Recentfile->new
 105             (
 106              aggregator     => [@intervals[1..$#intervals]],
 107              interval       => $intervals[0],
 108              localroot      => $root_from,
 109              rsync_options  => {
 110                                 compress          => 0,
 111                                 links             => 1,
 112                                 times             => 1,
 113                                 checksum          => 0,
 114                                },
 115             );
 116         my $timestampfutured = 0;
 117         for my $iv (@intervals) {
 118             for my $i (0..3) {
 119                 my $file = sprintf
 120                     (
 121                      "%s/A%s-%02d",
 122                      $root_from,
 123                      $iv,
 124                      $i,
 125                     );
 126                 mkpath dirname $file;
 127                 open my $fh, ">", $file or die "Could not open '$file': $!";
 128                 print $fh time, ":", $file, "\n";
 129                 close $fh or die "Could not close '$file': $!";
 130                 $rf0->update($file,"new");
 131                 if ($pass==1 && !$timestampfutured) {
 132                     $DB::single++;
 133                     my $recent_events = $rf0->recent_events;
 134                     $recent_events->[0]{epoch} += 987654321;
 135                     $rf0->write_recent($recent_events);
 136                     $timestampfutured++;
 137                 }
 138             }
 139         }
 140         my $recent_events = $rf0->recent_events;
 141         # faking internals as if the contents were wide-spread in time
 142         for my $evi (0..$#$recent_events) {
 143             my $ev = $recent_events->[$evi];
 144             $ev->{epoch} -= 2**($evi*.25);
 145         }
 146         $rf0->write_recent($recent_events);
 147         $rf0->aggregate;
 148         my $filesize_threshold = 1750; # XXX may be system dependent
 149         my %size_before;
 150         for my $iv (@intervals) {
 151             my $rf = "$root_from/RECENT-$iv.yaml";
 152             my $filesize = -s $rf;
 153             $size_before{$iv} = $filesize;
 154             # now they have $filesize_threshold+ bytes because they were merged for the
 155             # first time ever and could not be truncated for this reason.
 156             ok( $filesize > $filesize_threshold, "file $iv (before merging) has good size[$filesize]");
 157             utime 0, 0, $rf; # so that the next aggregate isn't skipped
 158         }
 159         open my $fh, ">", "$root_from/finissage" or die "Could not open: $!";
 160         print $fh "fin";
 161         close $fh or die "Could not close: $!";
 162         $rf0->update("$root_from/finissage","new");
 163         $rf0 = File::Rsync::Mirror::Recentfile->new_from_file("$root_from/RECENT-2s.yaml");
 164         $rf0->aggregate;
 165         for my $iv (@intervals) {
 166             my $filesize = -s "$root_from/RECENT-$iv.yaml";
 167             # now they have <$filesize_threshold bytes because the second aggregate could
 168             # truncate them
 169             ok($iv eq "Z" || $filesize<$size_before{$iv}, "file $iv (after merging) has good size[$filesize]");
 170         }
 171         my $dagg1 = $rf0->_debug_aggregate;
 172         Time::HiRes::sleep 1.2;
 173         $rf0->aggregate; # should not change the file
 174         my $dagg2 = $rf0->_debug_aggregate;
 175         is $dagg2->[0]{mtime}, $dagg1->[0]{mtime}, "no change by gratuitous aggregate";
 176         {
 177             my $recc = File::Rsync::Mirror::Recent->new
 178                 (
 179                  local => "$root_from/RECENT-2s.yaml",
 180                 );
 181             ok $recc->overview, "overview created";
 182             # diag $recc->overview;
 183         }
 184         rmtree [$root_from, $root_to];
 185     }
 186 }
 187
 188 rmtree [$root_from, $root_to];
 189
 190 {
 191     # replay a short history, run aggregate on it, add files, aggregate again
 192     BEGIN { $tests += 208 }
 193     ok(1, "starting short history block");
 194     my $rf = File::Rsync::Mirror::Recentfile->new_from_file("t/RECENT-6h.yaml");
 195     my $recent_events = $rf->recent_events;
 196     my $recent_events_cnt = scalar @$recent_events;
 197     is (
 198         92,
 199         $recent_events_cnt,
 200         "found $recent_events_cnt events",
 201        );
 202     $rf->interval("5s");
 203     $rf->localroot($root_from);
 204     $rf->comment("produced during the test 02-operation.t");
 205     $rf->aggregator([qw(10s 30s 1m 1h Z)]);
 206     $rf->verbose(0);
 207     my $start = Time::HiRes::time;
 208     for my $e (@$recent_events) {
 209         for my $pass (0,1) {
 210             my $file = sprintf
 211                 (
 212                  "%s/%s",
 213                  $pass==0 ? $root_from : $root_to,
 214                  $e->{path},
 215                 );
 216             mkpath dirname $file;
 217             open my $fh, ">", $file or die "Could not open '$file': $!";
 218             print $fh time, ":", $file, "\n";
 219             close $fh or die "Could not close '$file': $!";
 220             if ($pass==0) {
 221                 $rf->update($file,$e->{type});
 222             }
 223         }
 224     }
 225     $rf->aggregate;
 226     my $took = Time::HiRes::time - $start;
 227     ok $took > 0, "creating the tree and aggregate took $took seconds";
 228     my $dagg1 = $rf->_debug_aggregate;
 229     for my $i (1..5) {
 230         my $file_from = "$root_from/anotherfilefromtesting$i";
 231         open my $fh, ">", $file_from or die "Could not open: $!";
 232         print $fh time, ":", $file_from;
 233         close $fh or die "Could not close: $!";
 234         $rf->update($file_from,"new");
 235     }
 236     $rf->aggregate;
 237     my $dagg2 = $rf->_debug_aggregate;
 238     undef $rf;
 239     ok($dagg1->[0]{size} < $dagg2->[0]{size}, "The second 5s file size larger: $dagg1->[0]{size} < $dagg2->[0]{size}");
 240     ok($dagg1->[1]{mtime} <= $dagg2->[1]{mtime}, "The second 30s file timestamp larger: $dagg1->[1]{mtime} <= $dagg2->[1]{mtime}");
 241     is $dagg1->[2]{size}, $dagg2->[2]{size}, "The 1m file size unchanged";
 242     is $dagg1->[3]{mtime}, $dagg2->[3]{mtime}, "The 1h file timestamp unchanged";
 243     ok -l "t/ta/RECENT.recent", "found the symlink";
 244     my $have_slept = my $have_worked = 0;
 245     $start = Time::HiRes::time;
 246     my $debug = +[];
 247     for my $i (0..99) {
 248         my $file = sprintf
 249             (
 250              "%s/secscnt%03d",
 251              $root_from,
 252              ($i<25) ? ($i%12) : $i,
 253             );
 254         open my $fh, ">", $file or die "Could not open '$file': $!";
 255         print $fh time, ":", $file, "\n";
 256         close $fh or die "Could not close '$file': $!";
 257         my $another_rf = File::Rsync::Mirror::Recentfile->new
 258             (
 259              interval => "5s",
 260              localroot => $root_from,
 261              aggregator => [qw(10s 30s 1m 1h Z)],
 262             );
 263         $another_rf->update($file,"new");
 264         my $should_have = 97 + (($i<25) ? ($i < 12 ? ($i+1) : 12) : ($i-12));
 265         my($news,$filtered_news);
 266         if ($i < 50) {
 267             $another_rf->aggregate;
 268         }
 269         {
 270             my $recc = File::Rsync::Mirror::Recent->new
 271                 (
 272                  local => "$root_from/RECENT-5s.yaml",
 273                 );
 274             $news = $recc->news ();
 275             $filtered_news = [ uniq map { $_->{path} } @$news ];
 276         }
 277         is scalar @$filtered_news, $should_have, "should_have[$should_have]" or die;
 278         $debug->[$i] = $news;
 279         my $rf2 = File::Rsync::Mirror::Recentfile->new_from_file("$root_from/RECENT-5s.yaml");
 280         my $rece = $rf2->recent_events;
 281         my $rececnt = @$rece;
 282         my $span = $rece->[0]{epoch} - $rece->[-1]{epoch};
 283         $have_worked = Time::HiRes::time - $start - $have_slept;
 284         ok($rececnt > 0
 285            && ($i<50 ? $span <= 5 # we have run aggregate, so it guaranteed(*)
 286                : $i < 90 ? 1      # we have not yet spent 5 seconds, so cannot predict
 287                : $span > 5        # we have certainly written enough files now, must happen
 288               ),
 289            sprintf
 290            ("i[%s]cnt[%s]span[%s]worked[%6.4f]",
 291             $i,
 292             $rececnt,
 293             $span,
 294             $have_worked,
 295            ));
 296         $have_slept += Time::HiRes::sleep 0.2;
 297     }
 298     # (*) "<=" instead of "<" because of rounding errors
 299 }
 300
 301 {
 302     # running mirror
 303     BEGIN { $tests += 2 }
 304     my $rf = File::Rsync::Mirror::Recentfile->new
 305         (
 306          filenameroot   => "RECENT",
 307          interval       => q(30s),
 308          localroot      => $root_to,
 309          max_rsync_errors  => 0,
 310          remote_dir     => $root_from,
 311          # verbose        => 1,
 312          rsync_options  => {
 313                             compress          => 0,
 314                             links             => 1,
 315                             times             => 1,
 316                             # not available in rsync 3.0.3: 'omit-dir-times'  => 1,
 317                             checksum          => 0,
 318                            },
 319         );
 320     my $somefile_epoch;
 321     for my $pass (0,1) {
 322         my $success;
 323         if (0 == $pass) {
 324             $success = $rf->mirror;
 325             my $re = $rf->recent_events;
 326             $somefile_epoch = $re->[24]{epoch};
 327         } elsif (1 == $pass) {
 328             $success = $rf->mirror(after => $somefile_epoch);
 329         }
 330         ok($success, "mirrored pass[$pass] without dying");
 331     }
 332     {
 333         my $recc = File::Rsync::Mirror::Recent->new
 334             (  # ($root_from, $root_to)
 335              local => "$root_from/RECENT-5s.yaml",
 336             );
 337         diag "\n";
 338         diag $recc->overview;
 339     }
 340     {
 341         my $recc = File::Rsync::Mirror::Recent->new
 342             (
 343              # ignore_link_stat_errors => 1,
 344              localroot => $root_to,
 345              remote => "$root_from/RECENT-5s.yaml",
 346              # verbose => 1,
 347              rsync_options => {
 348                                links => 1,
 349                                times => 1,
 350                                compress => 1,
 351                                checksum => 1,
 352                               },
 353             );
 354         $recc->rmirror;
 355     }
 356     {
 357         my $recc = File::Rsync::Mirror::Recent->new
 358             (  # ($root_from, $root_to)
 359              local => "$root_from/RECENT-5s.yaml",
 360             );
 361         diag "\n";
 362         diag $recc->overview;
 363     }
 364     {
 365         my $recc = File::Rsync::Mirror::Recent->new
 366             (
 367              # ignore_link_stat_errors => 1,
 368              localroot => $root_to,
 369              remote => "$root_from/RECENT.recent",
 370              verbose => $Opt{verbose},
 371              rsync_options => {
 372                                links => 1,
 373                                times => 1,
 374                                compress => 1,
 375                                checksum => 1,
 376                               },
 377              _runstatusfile => $statusfile,
 378             );
 379         $recc->rmirror;
 380         my $rf2 = File::Rsync::Mirror::Recentfile->new_from_file("$root_from/RECENT-5s.yaml");
 381         my $file = "$root_from/about-re-mirroring.txt";
 382         open my $fh, ">", $file or die "Could not open '$file': $!";
 383         print $fh time;
 384         close $fh or die "Could not close '$file': $!";
 385         $rf2->update($file, "new");
 386         $recc->rmirror;
 387     }
 388 }
 389
 390 rmtree [$root_from, $root_to, $statusfile] unless $Opt{verbose};
 391
 392 BEGIN { plan tests => $tests }
 393
 394 # Local Variables:
 395 # mode: cperl
 396 # cperl-indent-level: 4
 397 # End: