Remove Emacs reminder

Running perl t/crypto.t only rarely works. Most of the time the token
cannot be decrypted.

Makefile

@@ -21,7 +21,7 @@ clean:
 	rm -rf build
 
 build/wiki.pl: wiki.pl
-	perl -lne "s/(\\\$$q->a\({-href=>'http:\/\/www.oddmuse.org\/'}, 'Oddmuse'\))/\\\$$q->a({-href=>'http:\/\/git.savannah.gnu.org\/cgit\/oddmuse.git\/tag\/?id=$(VERSION_NO)'}, 'wiki.pl') . ' ($(VERSION_NO)), see ' . \$$1/; print" < $< > $@
+	perl build.pl $< $@ $(VERSION_NO)
 
 build/%-utf8.pl: modules/translations/%-utf8.pl
 	perl -lne "s/(AddModuleDescription\('[^']+', '[^']+')\)/\$$1, 'translations\/', '$(VERSION_NO)')/; print" < $< > $@

build.pl

@@ -0,0 +1,36 @@
+# Copyright (C) 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 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.
+#
+# You should have received a copy of the GNU General Public License along with
+# this program. If not, see <http://www.gnu.org/licenses/>.
+
+# This script processes wiki.pl, replacing the link to www.oddmuse.org with a
+# link to the current version. It also changes the default of the random
+# Challenge Token so that everybody gets a different one.
+
+use Crypt::Random qw( makerandom );
+
+my ($old_file, $new_file, $version) = @ARGV;
+
+undef $/;
+open(my $in, '<:utf8', $old_file) or die "Cannot read $old_file: $!";
+$_ = <$in>;
+close($in);
+
+s!(\$q->a\({-href=>'http://www.oddmuse.org/'}, 'Oddmuse'\))!\$q->a\({-href=>'http://git.savannah.gnu.org/cgit/oddmuse.git/tag/?id=$version'}, 'wiki.pl'\) . ' ($version), see ' . $1!;
+
+my $r = join('', map { sprintf('\x%x', makerandom( Size => 8, Uniform => 1, Strength => 1 )) } 1..16);
+
+s!our \$TokenKey //= '(.*?)'!our \$TokenKey //= '$r'!;
+
+open(my $out, '>:utf8', $new_file) or die "Cannot write $new_file: $!";
+print $out $_;
+close($out);

t/crypto.t

@@ -0,0 +1,25 @@
+# Copyright (C) 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 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.
+#
+# 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 => 3;
+
+$page = get_page('title=Test text="Editing a page"');
+test_page_negative($page, "Editing a page");
+test_page($page, "Token is missing");
+test_page(update_page("Test", "Editing a page using update_page"),
+          "Editing a page using update_page");
+print $redirect;

t/test.pl

@@ -13,7 +13,9 @@
 # this program. If not, see <http://www.gnu.org/licenses/>.
 
 package OddMuse;
-use lib '.';
+use Crypt::CBC;
+use Crypt::Cipher::AES;
+use MIME::Base64;
 use XML::LibXML;
 use utf8;
 use vars qw($raw);
@@ -90,8 +92,9 @@ sub update_page {
   $text = url_encode($text);
   $summary = url_encode($summary);
   $minor = $minor ? 'on' : 'off';
+  my $token = GetChallengeToken('edit', $id);
   my $rest = join(' ', @rest);
-  $redirect = capture("perl wiki.pl 'Save=1' 'title=$page' 'summary=$summary' 'recent_edit=$minor' 'text=$text' 'pwd=$pwd' $rest");
+  $redirect = capture("perl wiki.pl 'Save=1' 'title=$page' 'summary=$summary' 'recent_edit=$minor' 'text=$text' 'token=$token' 'pwd=$pwd' $rest");
   $output = capture("perl wiki.pl action=browse id=$page $rest");
   if ($redirect =~ /^Status: 302 /) {
     # just in case a new page got created or NearMap or InterMap

test.pl

@@ -0,0 +1,18 @@
+use Crypt::CBC;
+use Crypt::Cipher::AES;
+use MIME::Base64;
+ 
+my $key = 'my secret key'; # length has to be valid key size for this cipher
+my $cipher = Crypt::CBC->new( -cipher=>'Cipher::AES', -key=>$key );
+my $ciphertext = $cipher->encrypt("secret data");
+my $code = encode_base64($ciphertext);
+chomp $code;
+print "$code\n";
+
+my $cipher2 = Crypt::CBC->new( -cipher=>'Cipher::AES', -key=>$key );
+my $plaintext = $cipher2->decrypt(decode_base64($code));
+print $plaintext . "\n";
+
+use Crypt::Random qw( makerandom );
+my $r = join('', map { sprintf("\\x%x", makerandom( Size => 8, Uniform => 1, Strength => 1 )) } 1..16);
+printf "$r\n";

wiki.pl

@@ -35,6 +35,9 @@ use utf8; # in case anybody ever addes UTF8 characters to the source
 use CGI qw/-utf8/;
 use CGI::Carp qw(fatalsToBrowser);
 use File::Glob ':glob';
+use Crypt::CBC;
+use Crypt::Cipher::AES;
+use MIME::Base64;
 local $| = 1; # Do not buffer output (localized for mod_perl)
 
 # Options:
@@ -91,7 +94,8 @@ our $AdminPass //= '';              # Whitespace separated passwords.
 our $EditPass  //= '';              # Whitespace separated passwords.
 our $PassHashFunction //= '';       # Name of the function to create hashes
 our $PassSalt  //= '';              # Salt will be added to any password before hashing
-
+# Key to encrypt challenge token. Use make prepare to create a new one.
+our $TokenKey //= '\x40\x77\x79\xfc\xd9\x33\x21\xf0\x6e\xf7\xa1\x86\xbe\xc6\x5f\xed';
 our $BannedHosts = 'BannedHosts';   # Page for banned hosts
 our $BannedCanRead = 1;             # 1 = banned cannot edit, 0 = banned cannot read
 our $BannedContent = 'BannedContent'; # Page for banned content (usually for link-ban)
@@ -1326,6 +1330,7 @@ sub DoBrowseRequest {
     SetParam('action', 'search'); # make sure this gets a NOINDEX
     DoSearch();
   } elsif (GetParam('title', '') and not GetParam('Cancel', '')) {
+    SetParam('action', 'edit'); # make sure this gets a NOINDEX
     DoPost(GetParam('title', ''));
   } else {
     BrowseResolvedPage($id || $HomePage);  # default action!
@@ -2483,12 +2488,34 @@ sub GetCommentForm {
   return '';
 }
 
+sub GetChallengeToken {
+  my ($action, $id) = @_;
+  my $token = join($FS, $Now, GetParam('username'), $q->remote_addr(), $action, $id);
+  my $cipher = Crypt::CBC->new( -cipher=>'Cipher::AES', -key=>$TokenKey );
+  my $ciphertext = $cipher->encrypt($token);
+  return encode_base64($ciphertext);
+}
+
+sub CheckToken {
+  my $code = UnquoteHtml(GetParam('token'));
+  ReportError(T('Token is missing.'), '403 FORBIDDEN') unless $code;
+  my $cipher = Crypt::CBC->new( -cipher=>'Cipher::AES', -key=>$TokenKey );
+  my ($ts, $name, $ip, $action, $id) = split(/$FS/, $cipher->decrypt(decode_base64($code)));
+  # FIXME add retry functionality
+  ReportError(T('Token mismatch on time.'), '403 FORBIDDEN', '', "$ts >= $Now - 60 * 60") unless $ts >= $Now - 60 * 60; # 1h
+  ReportError(T('Token mismatch on IP number.'), '403 FORBIDDEN', '', $q->remote_addr . "eq $ip") unless $q->remote_addr eq $ip;
+  ReportError(T('Token mismatch on action.'), '403 FORBIDDEN', '', GetParam('action') . "eq $action") unless GetParam('action') eq $action;
+  ReportError(T('Token mismatch on id.'), '403 FORBIDDEN') unless GetParam('id', GetParam('title')) eq $id;
+}
+
 sub GetFormStart {
-  my ($ignore, $method, $class) = @_;
+  my ($ignore, $method, $class, $action, $id) = @_;
   $method ||= 'post';
   $class  ||= 'form';
-  return $q->start_multipart_form(-method=>$method, -action=>$FullUrl,
-				  -accept_charset=>'utf-8', -class=>$class);
+  my $html = $q->start_multipart_form(-method=>$method, -action=>$FullUrl,
+                                      -accept_charset=>'utf-8', -class=>$class);
+  $html .= GetHiddenValue('token', GetChallengeToken($action, $id)) if $action;
+  return $html;
 }
 
 sub GetSearchForm {
@@ -3055,9 +3082,9 @@ sub DoEdit {
 }
 
 sub GetEditForm {
-  my ($page_name, $upload, $oldText, $revision) = @_;
-  my $html = GetFormStart(undef, undef, $upload ? 'edit upload' : 'edit text') # protected by questionasker
-    .$q->p(GetHiddenValue("title", $page_name),
+  my ($id, $upload, $oldText, $revision) = @_;
+  my $html = GetFormStart(undef, undef, $upload ? 'edit upload' : 'edit text', 'edit', $id) # protected by questionasker
+    .$q->p(GetHiddenValue("title", $id),
 	   ($revision ? GetHiddenValue('revision', $revision) : ''),
            GetHiddenValue('oldtime', GetParam('oldtime', $Page{ts})), # prefer parameter over actual timestamp
 	   ($upload ? GetUpload() : GetTextArea('text', $oldText)));
@@ -3075,9 +3102,9 @@ sub GetEditForm {
            ($upload ? '' : ' ' . $q->submit(-name=>'Preview', -accesskey=>T('p'), -value=>T('Preview'))).
            ' '.$q->submit(-name=>'Cancel', -value=>T('Cancel')));
   if ($upload) {
-    $html .= $q->p(ScriptLink('action=edit;upload=0;id=' . UrlEncode($page_name), T('Replace this file with text'),   'upload'));
+    $html .= $q->p(ScriptLink('action=edit;upload=0;id=' . UrlEncode($id), T('Replace this file with text'),   'upload'));
   } elsif ($UploadAllowed or UserIsAdmin()) {
-    $html .= $q->p(ScriptLink('action=edit;upload=1;id=' . UrlEncode($page_name), T('Replace this text with a file'), 'upload'));
+    $html .= $q->p(ScriptLink('action=edit;upload=1;id=' . UrlEncode($id), T('Replace this text with a file'), 'upload'));
   }
   $html .= $q->end_form();
   return $html;
@@ -3104,9 +3131,8 @@ sub DoDownload {
       ReportError(Ts('Files of type %s are not allowed.', $type), '415 UNSUPPORTED MEDIA TYPE');
     }
     print GetHttpHeader($type, $Page{ts}, undef, $encoding);
-    require MIME::Base64;
     binmode(STDOUT, ":pop:raw"); # need to pop utf8 for Windows users!?
-    print MIME::Base64::decode($data);
+    print decode_base64($data);
   } else {
     print GetHttpHeader('text/plain', $Page{ts});
     print $text;
@@ -3569,6 +3595,7 @@ sub Replace {
 sub DoPost {
   my $id = FreeToNormal(shift);
   UserCanEditOrDie($id);
+  CheckToken();
   # Lock before getting old page to prevent races
   RequestLockOrError();		# fatal
   OpenPage($id);
@@ -3597,7 +3624,7 @@ sub DoPost {
     local $/ = undef;		# Read complete files
     my $content = <$file>; # Apparently we cannot count on <$file> to always work within the eval!?
     my $encoding = substr($content, 0, 2) eq "\x1f\x8b" ? 'gzip' : '';
-    eval { require MIME::Base64; $_ = MIME::Base64::encode($content) };
+    $_ = encode_base64($content);
     $string = "#FILE $type $encoding\n" . $_;
   } else {			# ordinary text edit
     $string = AddComment($old, $comment) if $comment;