#!/usr/bin/perl -w
# Version Tue, 14 Jan 2020 23:44:58 GMT from http://www.pedantic.org/src/wiki
use strict;
use CGI;

#####
##### Configuration settings
#####

# Where wiki pages are stored:
my $datadir=$ENV{DOCUMENT_ROOT};

# Maximum page size (or set to 0 for unlimited page size):
my $maxpagesize=250000;

# If you have the UNIX 'diff' utility, this setting will let you use it:
my $diffcommand="diff -u";

# MIME types for allowable image formats:
my %imagetypes=(qw(
	gif	image/gif
	jpg	image/jpeg
	png	image/png
));

# MIME types for allowable non-image blob formats:
my %nonimageblobtypes=(qw(
	pdf	application/pdf
));

my %blobtypes=(%imagetypes,%nonimageblobtypes);

#####
##### Special pages (special pages don't have subpages or versions)
#####

my %specialpages=(
	"ListOfPages" => \&listofpages,
	"ListOfWords" => \&listofwords,
	"RecentChanges" => \&recentchanges,
	"MySelf" => \&showself,
);

sub listofpages() {
	my $querystring=$ENV{QUERY_STRING};
	my @pages;
	&printheader("ListOfPages",0,0,"","");
	print "<isindex />\n";
	if($querystring) {
		@pages=grep {
			open(PAGE,"<$datadir/$_") or die "open: $!";
			grep /\Q$querystring\E/i,<PAGE>;
		} sort grep !/\./,&pagelist(0,0);
		close(PAGE);
	} else {
		@pages=sort &pagelist(1,0);
	}
	print map {"<a href=\"$_\">$_</a><br />\n"} @pages;
	&printfooter("ListOfPages",0,0,"","");
}

sub listofwords() {
	my %words=();
	my ($page,$word);
	&printheader("ListOfWords",0,0,"","");
	foreach $page (&pagelist(1,0)) {
		foreach $word (split /(?<!^)(?=[A-Z]|\.[a-z]+)/,$page) {
			$words{$word}=[] unless($words{$word});
			push @{$words{$word}},$page;
		}
	}
	print "<dl>\n";
	foreach $word (sort keys %words) {
		print "<dt>$word</dt>\n<dd>";
		print join(",\n\t",map {"<a href=\"$_\">$_</a>"} sort @{$words{$word}});
		print "</dd>\n";
	}
	print "</dl>\n";
	&printfooter("ListOfWords",0,0,"","");
}

sub recentchanges() {
	my $showip=0;
	my $maxentries=250;
	my @recent=();
	if(open(RECENT,"<$datadir/RecentChanges")) {
		my $maxgoodslice=$maxentries*250; # Entries probably won't be > 250 bytes
		if($maxgoodslice < -s RECENT) {
			seek(RECENT,-$maxgoodslice,2);
			@recent=<RECENT>;
			shift @recent; # The first one might be malformed
		} else {
			@recent=<RECENT>;
		}
		close(RECENT);
	}
	my $modtime=&modtime("RecentChanges");
	&printheader("RecentChanges",0,$modtime,"","");
	print "<table border=\"1\">\n";
	print "<tr><th>Time</th>";
	print "<th>IP</th>" if($showip);
	print "<th>Action</th><th>Page</th><th>Version</th></tr>\n";
	@recent=@recent[(@recent-$maxentries)..$#recent] if(@recent>$maxentries);
	while(@recent) {
		chomp $recent[$#recent];
		my @fields=split /\t/,pop @recent;
		print "<tr><td>".&timestamp2iso($fields[0])."</td>";
		print "<td>$fields[1]</td>" if($showip);
		print "<td>$fields[2]</td><td><a href=\"$fields[3]\">$fields[3]</a></td><td><a href=\"$fields[3]-$fields[4]\">$fields[4]</a></td></tr>\n";
	}
	print "</table>\n";
	&printfooter("RecentChanges",0,$modtime,"","");
}

sub showself() {
	my $me=$ENV{SCRIPT_FILENAME};
	notfound("") unless($me);
	notfound("") unless(open(SELF,"<$me"));
	my @stat=stat SELF;
	print "Content-type: text/plain\n";
	print "Last-Modified: ".&prettytime($stat[9])."\n" if(@stat);
	print "\n",scalar(<SELF>);
	print "# Version ".prettytime($stat[9])." from ".&requesturl()."\n" if(@stat);
	print <SELF>;
	close(SELF);
}

#####
##### Subpages
#####

my %subpages=(
	"edit" => \&editpage,
	"versions" => \&pageversions,
	"revert" => \&revertpage,
	"blob" => \&showblob,
	"show" => \&showblobpage,
	"upload" => \&uploadblob,
);
$subpages{diff}=\&diffpage if($diffcommand);

sub diffpage($$) {
	my ($page,$version)=@_;
	my $text;
	$version=&getpageversion($page,0) unless($version);
	&nopermission("That version of the page doesn't exist.") unless(-f "$datadir/$page-$version");
	&nopermission("You cannot diff blobs") if(&blobtype($page));
	&printheader("$page: $version vs. Current",0,"","","");
	print "<pre>";
	$|=1;
	my $safedatadir=$datadir;
	$safedatadir =~ s/'/'"'"'/g;
	open(DIFF,"cd '$datadir';$diffcommand $page-$version $page|") or die "popen: $!";
	while(defined($text=<DIFF>)) {
		print &htmlquote($text);
	}
	close(DIFF);
	print "</pre>\n";
	&printfooter("$page: $version vs. Current",0,"","","");
}

sub editpage($$) {
	my ($page,$version)=@_;
	&nopermission("You are not allowed to edit a particular version of a page.") if($version);
	&nopermission("You cannot edit blobs") if(&blobtype($page));
	my $curversion=&getpageversion($page,1);
	my $cgi=new CGI;
	my $text=$cgi->param("text");
	if($text) {
		if($text =~ /<a href=|<img src=/is) {
			&errorinedit("HTML is not allowed in wiki pages");
			return;
		}
		my $oldcurversion=($cgi->param("curversion") or 0);
		&conflictingupdate($page,"$page=edit","text",$text) if($curversion ne $oldcurversion);
		my $newversion=&newpageversion($page,$text,1);
		&setpageversion($page,$newversion);
	}
	my $modtime=&modtime($page);
	my $action=$modtime?"Edit":"Create";
	&printheader("$action $page",0,$modtime,"","");
	print <<"EOD";
<form method="post" action="$page=edit">
<input type="hidden" name="curversion" value="$curversion" />
<textarea name="text" wrap="yes" cols="60" rows="15">
EOD
	if(open(PAGE,"<$datadir/$page")) {
		while(defined($text=<PAGE>)) {
			print &htmlquote($text);
		}
		close(PAGE);
	}
	print <<"EOD";
</textarea><br />
<input type="submit" value="Submit Changes" />
<input type="reset" value="Reset" />
</form>
EOD
	if($modtime) {
		my $subpage=&blobtype($page)?"=show":"";
		print "<p><a href=\"$page$subpage\">See the current version</a>.</p>\n";
	}
	&printfooter("$action $page",0,$modtime,"","");
}

sub pageversions($) {
	my ($page)=@_;
	my $subpage=&blobtype($page)?"=show":"";
	my $currentversion=&getpageversion($page,0);
	&printheader("Versions of $page",0,0,"","");
	foreach my $version (sort {$b<=>$a} grep s/^$page-//s,pagelist(0,1)) {
		print "<a href=\"$page-$version$subpage\">$version</a>";
		print " (current version)" if($version eq $currentversion);
		print "<br />\n";
	}
	&printfooter("Versions of $page",0,0,"","");
}

sub revertpage($$) {
	my ($page,$version)=@_;
	&notfound("") unless($version);
	my $cgi=new CGI;
	my $oldcurversion=($cgi->param("curversion") or 0);
	my $curversion=&getpageversion($page,0);
	&conflictingupdate($page,"$page-$version=revert","","") if($oldcurversion ne $curversion);
	&nopermission("You cannot revert to the current version of the page.") if($version eq $curversion);
	&setpageversion($page,$version);
	&printheader("Revert Page",0,0,"","");
	my $subpage=&blobtype($page)?"=show":"";
	print "<p>You have reverted to the <a href=\"$page-$version$subpage\">$version</a> version of <a href=\"$page\">$page</a>.</p>\n";
	&printfooter("Revert Page",0,0,"","");
}

sub showblob($$) {
	my ($page,$version)=@_;
	my $file=$page;
	$file.="-$version" if($version);
	my $type=&blobtype($page);
	&nopermission("This is not a blob page") unless($type);
	my $modtime=&modtime($file);
	&nopermission("You cannot view a non-blob as an blob") unless($blobtypes{$type});
	&notfound($page) unless(open(PAGE,"<$datadir/$file"));
	print "Content-type: $blobtypes{$type}\n";
	print "Last-Modified: $modtime\n";
	print "\n";
	print <PAGE>;
	close(PAGE);
}

sub showblobpage($$) {
	my ($page,$version)=@_;
	my $file=$page;
	$file.="-$version" if($version);
	&notfound($page) unless(open(PAGE,"<$datadir/$file"));
	my $modtime=&modtime($file);
	my $curversion=&getpageversion($page);
	&printheader($page,(not $version),$modtime,$version,$curversion);
	if($imagetypes{&blobtype($page)}) {
		print "<a href=\"$file\"><img src=\"$file\" /></a>";
	} else {
		print "<a href=\"$file\">View this file</a>";
	}
	close(PAGE);
	&printfooter($page,(not $version),$modtime,$version,$curversion);
}

sub uploadblob($) {
	my ($page,$version)=@_;
	&nopermission("You are not allowed to upload a particular version of a page.") if($version);
	my $type=&blobtype($page);
	&notfound("") unless($type);
	my $curversion=&getpageversion($page,1);
	my $cgi=new CGI;
	my $blob=$cgi->param("blob");
	if($blob and $cgi->uploadInfo($blob)) {
		my %info=%{$cgi->uploadInfo($blob)};
		my $mimetype=($info{"Content-Type"} or "");
		$mimetype =~ s#^(?:application|text)/(?:x-)pdf$#application/pdf#s;
		&nopermission("You cannot upload an file of type \"$mimetype\" as $page") unless($blobtypes{$type} eq lc $mimetype);
		my $oldcurversion=($cgi->param("curversion") or 0);
		&conflictingupdate($page,"$page=upload","","") if($curversion ne $oldcurversion);
		my $data;
		($/,$data)=($/,(undef $/,<$blob>)[1]);
		my $newversion=&newpageversion($page,$data,0);
		&setpageversion($page,$newversion);
		&printheader("$page Uploaded",0,"","","");
		my $html=&wiki2html("You have successfully uploaded $page");
		if(&blobtype($page)) {
			$html =~ s#( href="[^"<>]+)#$1=show#gs;
		}
		print $html;
		&printfooter("$page Uploaded",0,"","","");
	} else {
		&printheader("Upload $page",0,"","","");
		print <<"EOD";
<form method="post" action="$page=upload" enctype="multipart/form-data">
<input type="hidden" name="curversion" value="$curversion" />
<input type="file" name="blob" accept="$blobtypes{$type}" /><br />
<input type="submit" value="Upload File" />
</form>
EOD
		print "<p>Files are limited to $maxpagesize bytes.</p>\n" if($maxpagesize);
		&printfooter("Upload $page",0,"","","");
	}
}

#####
##### Utility subroutines
#####

my $mostrecentchangelogentry="";
sub addchangelogentry($$$) {
	my ($action,$page,$version)=@_;
	my $remoteip=$ENV{REMOTE_ADDR};
	$remoteip="127.0.0.1" unless(defined $remoteip);
	my $timestamp=&secs2timestamp(time());
	if($action eq "revert" and ($mostrecentchangelogentry eq "$timestamp\t$remoteip\tcreate\t$page\t$version\n" or $mostrecentchangelogentry eq "$timestamp\t$remoteip\tupdate\t$page\t$version\n")) {
		# We do nothing, because we just logged a create/update for this page
	} else {
		open(RECENT,">>$datadir/RecentChanges") or &nopermission("You are not allowed to modify this wiki.");
		print RECENT "$timestamp\t$remoteip\t$action\t$page\t$version\n";
		close(RECENT);
	}
	$mostrecentchangelogentry="$timestamp\t$remoteip\t$action\t$page\t$version\n";
}

sub conflictingupdate($$$$) {
	my ($page,$submiturl,$name,$value)=@_;
	&printheader("$page: Conflicting Modifications Made",0,"","","");
	print <<"EOD";
<p>The page you were trying to change was modified while you were changing it.
If you are sure you wish to override those changes and use the version you just
submitted, you can do so by submitting this page.</p>
<form method="post" action="$submiturl">
<input type="submit" value="Continue Anyway" />
EOD
	my $curversion=getpageversion($page);
	print "<input type=\"hidden\" name=\"curversion\" value=\"$curversion\" />\n";
	print "<input type=\"hidden\" name=\"$name\" value=\"".&htmlquote($value)."\" />\n" if($name);
	print "</form>\n";
	&printfooter("$page: Conflicting Modifications Made",0,"","","");
	exit 0;
}

sub errorinedit($) {
	my ($reason)=@_;

	print "Status: 406\n";
	printheader("Error in Edit",0,0,"","");
	print htmlquote($reason);
	printfooter("Error in Edit",0,0,"","");
}

sub getpageversion($$) {
	my ($page,$allowmissingpage)=@_;
	my $link=readlink("$datadir/$page");
	$link="$page-0" if($allowmissingpage and not $link);
	notfound("") unless($link);
	die unless($link =~ s#^$page-##s);
	return $link;
}

sub htmlquote($) {
	my ($str)=@_;
	$str.=""; # Make sure we aren't dealing with a read-only string
	$str =~ s/&/&amp;/gs;
	$str =~ s/</&lt;/gs;
	$str =~ s/>/&gt;/gs;
	$str =~ s/"/&quot;/gs;
	return $str;
}

sub blobtype($) {
	my ($str)=@_;
	my $type="";
	$type=$1 if($str =~ /^(?:[A-Z][a-z]+){2,}\.([a-z]+)$/s);
	$type="jpg" if("jpeg" eq $type);
	$type="" unless($blobtypes{$type});
	return $type;
}

sub iswikiword($) {
	my ($str)=@_;
	my $blobs=join("|",keys %blobtypes);
	return 1 if($str =~ /^(?:[A-Z][a-z]+){2,}(?:\.(?:$blobs))?$/s);
	return 0;
}

sub modtime($) {
	my ($page)=@_;
	my @stat=lstat "$datadir/$page";
	return "" unless(@stat);
	return &prettytime($stat[9]);
}

sub newpageversion($$) {
	my ($page,$data,$istext)=@_;
	if($istext) {
		$data =~ s#\r\n?#\n#gs;
		$data =~ s#[ \t]+\n#\n#gs;
		$data =~ s#^\s+##s;
		$data =~ s#\s+$##s;
	}
	&nopermission("You are not allowed to post ".($istext?"pages":"files")." greater than $maxpagesize bytes.") if($maxpagesize and $maxpagesize<length($data));
	my $uniquesuffix=time()."-$$";
	&nopermission("You do not have permission to edit that ".($istext?"page":"file").".") unless(open(PAGE,">$datadir/-$page-$uniquesuffix"));
	print PAGE $data;
	close(PAGE);
	my $modtime=(stat("$datadir/-$page-$uniquesuffix"))[9];
	my $timestamp=&secs2timestamp($modtime);
	unless(rename("$datadir/-$page-$uniquesuffix","$datadir/$page-$timestamp")) {
		&nopermission("That ".($istext?"page":"file")." was just updated by someone else.");
	}
	&addchangelogentry(modtime($page)?"update":"create",$page,$timestamp);
	return $timestamp;
}

sub nopermission($) {
	my ($message)=@_;
	print <<"EOD";
Status: 403 No Permission
Content-type: text/html

<html><body><p>$message</p></body></html>
EOD
	exit 0;
}

sub notfound($) {
	my ($offertocreatepage)=@_;
	print <<"EOD";
Status: 404 File Not Found
Content-type: text/html

EOD
	print "<html><body><p>The requested page was not found.";
	if($offertocreatepage) {
		print " Would you like to <a href=\"$offertocreatepage=";
		print &blobtype($offertocreatepage)?"upload\">upload":"edit\">create";
		print " one</a>?";
	}
	print "</p></body></html>";
	exit 0;
}

sub pagelist($$) {
	my ($includespecialpages,$includeversions)=@_;
	my %pages=();
	my $page;
	map {$pages{$_}=1} keys %specialpages if($includespecialpages);
	opendir(DATADIR,$datadir) or die "opendir: $!";
	while($page=readdir(DATADIR)) {
		next if($page =~ /^\./s);
		unless($includeversions) {
			next if($page =~ /-/);
		}
		$pages{$page}=1;
	}
	closedir(DATADIR);
	return keys %pages;
}

sub permredirect($) {
	my ($url)=@_;
	print <<"EOD";
Status: 301 Moved Permanently
Location: $url
Content-type: text/html

<html><body><p>Please go to <a href="$url">$url</a>.</p></body></html>
EOD
	exit 0;
}

sub prettytime($) {
	my ($time)=@_;
	my @time=gmtime($time);
	$time[6]=(qw(Sun Mon Tue Wed Thu Fri Sat Sun))[$time[6]];
	$time[4]=(qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$time[4]];
	$time[5]+=1900;
	return sprintf "%s, %d %s %04d %02d:%02d:%02d GMT",$time[6],$time[3],$time[4],$time[5],$time[2],$time[1],$time[0];
}

sub printfooter($$$$$) {
	my ($title,$editable,$lastmodified,$revertversion,$curversion)=@_;
	my $isblob=&blobtype($title);
	my @stuff=();
	push @stuff,"Last modified: $lastmodified" if($lastmodified);
	if($editable) {
		push @stuff,"<a href=\"$title=".($isblob?"upload\">Upload":"edit\">Edit")." this page</a>, <a href=\"$title=versions\">versions of this page</a>";
	} elsif($revertversion and $diffcommand and not $isblob) {
		push @stuff,"<a href=\"$title-$revertversion=diff\">Diff from this version to the current version</a>";
	}
	push @stuff,"<a href=\"ListOfPages?$title\">Search for references to this page</a>" if(iswikiword($title));
	if($revertversion) {
		push @stuff,"<form method=\"post\" action=\"$title-$revertversion=revert\">";
		$stuff[$#stuff].="<input type=\"hidden\" name=\"curversion\" value=\"$curversion\" />" if($curversion);
		$stuff[$#stuff].="<input type=\"submit\" value=\"Revert to this version of the page\" /></form>";
	}
	if(@stuff) {
		print "<hr />\n<p>".join("<br />\n",@stuff)."</p>\n";
	}
	print "</body></html>";
}

sub printheader($$$$$) {
	my ($title,$editable,$lastmodified,$revertversion,$curversion)=@_;
	$title=&htmlquote($title);
	print "Content-type: text/html\n";
	print "Last-Modified: $lastmodified\n" if($lastmodified);
	print <<"EOD";

<html><head><title>$title</title></head><body>
<h1>$title</h1>
EOD
}

sub requesturl() {
	my $servername=($ENV{SERVER_NAME} or "localhost");
	my $requesturi=($ENV{REQUEST_URI} or "/MySelf");
	return "http://$servername$requesturi";
}

sub secs2timestamp($) {
	my ($secs)=@_;
	my @time=gmtime($secs);
	return sprintf "%04d%02d%02d%02d%02d%02d",1900+$time[5],1+$time[4],$time[3],$time[2],$time[1],$time[0];
}

sub setpageversion($$) {
	my ($page,$newversion)=@_;
	&nopermission("That version of the page doesn't exist.") unless(-f "$datadir/$page-$newversion");
	my $r1=unlink("$datadir/$page");
	my $r2=symlink("$page-$newversion","$datadir/$page");
	&nopermission("You are not allowed to modify that page.") unless($r2 or $r1);
	die "symlink: $!" if($r1 and not $r2);
	&addchangelogentry("revert",$page,$newversion);
}

sub timestamp2iso($) {
	my ($timestamp)=@_;
	die $timestamp unless($timestamp =~ /^(....)(..)(..)(..)(..)(..)$/s);
	return "$1-$2-$3T$4:$5:${6}Z";
}

sub wiki2html($) {
	my ($page)=@_;
	my %pages=map {($_,1)} &pagelist(1,0);
	$page=&htmlquote($page);
	$page =~ s#^\s+##s;
	$page =~ s#\s+$##s;
	my $i=0;
	my %change=();
	while($page =~ s#&lt;pre&gt;(.*?)&lt;/pre&gt;#<$i>#s) {
		$change{$i++}="<pre>$1</pre>";
	}
	my $hostnameregex='(?:(?:[0-9A-Za-z][0-9A-Za-z-]*\\.)+[A-Za-z][0-9A-Za-z-]*\\.?)';
	while($page =~ s#\b([a-z]+://$hostnameregex/(?:[!\#-%'*-;=?-z|~]|&amp;)*)#<$i>#) {
		$change{$i++}="<a href=\"$1\">$1</a>";
	}
	while($page =~ s#\b([0-9A-Za-z_+-]+\@$hostnameregex)\b#<$i>#) {
		$change{$i++}="<a href=\"mailto:$1\">$1</a>";
	}
	my $imagetyperegexp="(?:".join("|",keys %imagetypes).")";
	while($page =~ s#\b((?:[A-Z][a-z]+){2,}\.$imagetyperegexp)\b#<$i>#) {
		$change{$i++}=$pages{$1}?"<a href=\"$1=show\"><img src=\"$1\" /></a>":$1."[<a href=\"$1=upload\">?</a>]";
	}
	my $nonimagetyperegexp="(?:".join("|",keys %nonimageblobtypes).")";
	while($page =~ s#\b((?:[A-Z][a-z]+){2,}\.$nonimagetyperegexp)\b#<$i>#) {
		$change{$i++}=$pages{$1}?"<a href=\"$1=show\">$1</a>":$1."[<a href=\"$1=upload\">?</a>]";
	}
	while($page =~ s#\b((?:[A-Z][a-z]+){2,})\b#<$i>#) {
		$change{$i++}=$pages{$1}?"<a href=\"$1\">$1</a>":$1."[<a href=\"$1=edit\">?</a>]";
	}
	$page =~ s#(^|\n)(=[^\n]+)\n#$1$1$2\n\n#gs;
	$page =~ s#\n(\n*)#$1?"</p>\n<p>":"<br />\n"#egs;
	$page="<p>$page</p>\n";
	$page =~ s#<p>(={1,5})([^\n]+)</p>#"<h".(1+length($1)).">$2</h".(1+length($1)).">"#egs;
	$page =~ s#<p>-+</p>#<hr />#gs;
	$page =~ s#&lt;(em|strong)&gt;([^\n<>]+?)&lt;/\1&gt;#<$1>$2</$1>#gs;
	$page =~ s#&amp;(amp|gt|lt|quot);#&$1;#gs;
	$page =~ s#<(\d+)>#$change{$1}#gs;
	return $page;
}

#####
##### Basic page display
#####

sub showpage($$) {
	my ($page,$version)=@_;
	if(&blobtype($page)) {
		return &showblob($page);
	}
	my $file=$page;
	my $data;
	$file.="-$version" if($version);
	&notfound($page) unless(open(PAGE,"<$datadir/$file"));
	my $modtime=&modtime($file);
	my $curversion=&getpageversion($page);
	&printheader($page,(not $version),$modtime,$version,$curversion);
	($/,$data)=($/,(undef $/,<PAGE>)[1]);
	print &wiki2html($data);
	close(PAGE);
	&printfooter($page,(not $version),$modtime,$version,$curversion);
}

#####
##### Main program
#####

my $pathinfo=$ENV{PATH_INFO};
unless($pathinfo and $pathinfo =~ s#^/##s) {
	my $scriptname=$ENV{SCRIPT_NAME};
	&notfound("") unless($scriptname);
	$scriptname =~ s#.*/##s;
	&permredirect("$scriptname/");
}
&permredirect("MainPage") unless(length $pathinfo);
&notfound("") unless($pathinfo =~ /^((?:[A-Z][a-z]+){2,}(?:\.[a-z]+)?)(?:-([0-9]{14}))?(?:=([a-z]+))?$/s);
my ($page,$version,$action)=($1,$2,$3);
if($specialpages{$page}) {
	&notfound("") if($action or $version);
	&{$specialpages{$page}}();
} elsif($action) {
	&notfound("") unless($subpages{$action});
	&{$subpages{$action}}($page,$version);
} elsif($version) {
	&showpage($page,$version);
} else {
	&showpage($page,0);
}
0;

#####
##### To do
#####

# text convention for (nested) lists
# preformatted text should still check for WikiWords