lock-expiration.t: test fake time

Fake time requires changes to wiki.pl. We created a test-wiki.pl with a
preamble that changes how the time and sleep builtins work. This is used
in lock-expiration.t as a proof of concept.

t/lock-expiration.t

@@ -1,24 +1,20 @@
-# Copyright (C) 2007  Alex Schroeder <alex@emacswiki.org>
+# Copyright (C) 2007–2015  Alex Schroeder <alex@gnu.org>
 #
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
+# This program is free software; you can redistribute it and/or modify it under
+# the terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 3 of the License, or (at your option) any later
+# version.
 #
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
+# This program is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
 #
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the
-#    Free Software Foundation, Inc.
-#    59 Temple Place, Suite 330
-#    Boston, MA 02111-1307 USA
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
 
 require 't/test.pl';
 package OddMuse;
-use Test::More tests => 17;
+use Test::More tests => 19;
 
 AppendStringToFile($ConfigFile, "\$SurgeProtection = 1;\n");
 $localhost = 'confusibombus';
@@ -27,25 +23,44 @@ my $lock = $LockDir . 'visitors';
 ok(! -d $lock, 'visitors lock does not exist yet');
 ok(! -f $VisitorFile, 'visitors log does not exist yet');
 
-# Don't loop forever trying to remove a lock older than
-# $LockExpiration that cannot be removed (eg. if the script user was
-# changed, so that the old lockfile cannot be removed by the new
-# user). Locks are directories; we simulate a lock that cannot be
-# removed by creating a file with the same name instead.
+# Don't loop forever trying to remove a lock older than $LockExpiration that
+# cannot be removed (eg. if the script user was changed, so that the old
+# lockfile cannot be removed by the new user). Locks are directories; we
+# simulate a lock that cannot be removed by creating a file with the same name
+# instead. At the same time, test fake-time!
 mkdir($TempDir);
 ok(open(F, '>', $lock), "create bogus ${LockDir}visitors");
 my $ts = time - 120;
 utime($ts, $ts, $lock); # change mtime of the lockfile
+
+# Getting a time will now time out because no visitor lock can ge aquired.
 $ts = time;
 get_page('fail-to-get-lock');
+
+# Since we're using fake-time, let's make sure that no real time passed.
 my $waiting = time - $ts;
-ok($waiting >= 16, "waited $waiting seconds (min. 16)");
+ok($waiting <= 1, "waited $waiting real seconds (max. 1)");
+
+# Fake time is available in the timestamp file.
+my $fakets = (stat("$DataDir/ts"))[9];
+$waiting = $fakets - $ts;
+ok($waiting >= 16, "waited $waiting fake seconds (min. 16)");
+
+# Remove the fake visitors lock and redo this. Reset the fake timestamp on the
+# file. Get a file. This should take no real time and no fake time (as there was
+# no sleeping involved).
 unlink($LockDir . 'visitors');
 $ts = time;
+utime($ts, $ts, "$DataDir/ts");
 test_page(get_page('get-lock'), 'get-lock');
-my $waiting = time - $ts;
+$waiting = time - $ts;
 ok($waiting <= 2, "waited $waiting seconds (max. 2)");
 
+# Make sure no fake time elapsed!
+$fakets = (stat("$DataDir/ts"))[9];
+$waiting = $fakets - time;
+ok($waiting <= 2, "waited $waiting fake seconds (max. 2)");
+
 # The main lock works as intended.
 RequestLockOrError();
 update_page('cannot', 'create');
@@ -67,7 +82,7 @@ test_page($redirect, 'Status: 503 SERVICE UNAVAILABLE',
 ok(-d $LockDir . 'visitors', 'visitors lock remained');
 ok($ts == (stat($VisitorFile))[10], 'visitors log was not modified');
 
-AppendStringToFile($ConfigFile, "\$LockExpiration = 3;\n");
+AppendStringToFile($ConfigFile, "\$LockExpiration = -1;\n");
 test_page(update_page('Test', 'page updated'), 'page updated');
 ok(! -d $LockDir . 'visitors', 'visitors lock expired');
 ok($ts != (stat($VisitorFile))[10], 'visitors log was modified');

t/test.pl

@@ -74,12 +74,12 @@ sub url_encode {
 sub capture {
   my $command = shift;
   if ($raw) {
-    open (CL, '-|', $command) or die "Can't run $command: $!";
+    open ($fh, '-|', $command) or die "Can't run $command: $!";
   } else {
-    open (CL, '-|:encoding(utf-8)', $command) or die "Can't run $command: $!";
+    open ($fh, '-|:encoding(utf-8)', $command) or die "Can't run $command: $!";
   }
-  my $result = <CL>;
-  close CL;
+  my $result = <$fh>;
+  close $fh;
   return $result;
 }
 
@@ -91,8 +91,8 @@ sub update_page {
   $summary = url_encode($summary);
   $minor = $minor ? 'on' : 'off';
   my $rest = join(' ', @rest);
-  $redirect = capture("perl wiki.pl 'Save=1' 'title=$page' 'summary=$summary' 'recent_edit=$minor' 'text=$text' 'pwd=$pwd' $rest");
-  $output = capture("perl wiki.pl action=browse id=$page $rest");
+  $redirect = capture("perl $DataDir/test-wiki.pl 'Save=1' 'title=$page' 'summary=$summary' 'recent_edit=$minor' 'text=$text' 'pwd=$pwd' $rest");
+  $output = capture("perl $DataDir/test-wiki.pl action=browse id=$page $rest");
   if ($redirect =~ /^Status: 302 /) {
     # just in case a new page got created or NearMap or InterMap
     $IndexHash{$id} = 1;
@@ -103,7 +103,7 @@ sub update_page {
 }
 
 sub get_page {
-  return capture("perl wiki.pl @_");
+  return capture("perl $DataDir/test-wiki.pl @_");
 }
 
 sub name {
@@ -312,12 +312,12 @@ sub remove_module {
 }
 
 sub write_config_file {
-  open(F, '>:encoding(utf-8)', "$DataDir/config");
-  print F "\$AdminPass = 'foo';\n";
+  open($fh, '>:encoding(utf-8)', "$DataDir/config");
+  print $fh "\$AdminPass = 'foo';\n";
   # this used to be the default in earlier CGI.pm versions
-  print F "\$ScriptName = 'http://localhost/wiki.pl';\n";
-  print F "\$SurgeProtection = 0;\n";
-  close(F);
+  print $fh "\$ScriptName = 'http://localhost/wiki.pl';\n";
+  print $fh "\$SurgeProtection = 0;\n";
+  close($fh);
   $ScriptName = 'http://localhost/test.pl'; # different!
   $IndexInit = 0;
   %IndexHash = ();
@@ -329,6 +329,31 @@ sub write_config_file {
   %NearSearch = ();
 }
 
+sub write_modified_wiki {
+  my $preamble = <<EOT;
+
+BEGIN {
+  my \$delta = 0;
+
+  *CORE::GLOBAL::sleep = sub {
+    \$delta += shift;
+    my \$ts = time + \$delta;
+    utime(\$ts, \$ts, "$DataDir/ts")
+  };
+
+  sub newtime {
+    return time + \$delta;
+  };
+
+  *CORE::GLOBAL::time = \&newtime;
+}
+
+EOT
+     
+  WriteStringToFile("$DataDir/test-wiki.pl", $preamble . ReadFileOrDie('wiki.pl'));
+  WriteStringToFile("$DataDir/ts", '');
+}
+
 sub clear_pages {
   if (-f "/bin/rm") {
     system('/bin/rm', '-rf', $DataDir);
@@ -346,6 +371,7 @@ sub clear_pages {
     add_module('mac.pl');
   }
   write_config_file();
+  write_modified_wiki();
 }
 
 1;