#!/usr/bin/perl -Tw
# -*- perl -*-
# $Id: BoreWiki.cgi 1333 2007-04-09 10:57:15Z too $
#
# Author: Tomi Ollila  --  too ät iki piste fi
#
# Created: Thu Apr 27 10:40:22 EEST 2006 too
# Last Modified: Mon Apr 09 13:35:01 EEST 2007 too
#
# Licensed under GPL v2 (until v3 is ready and if good enough).

use 5.8.0;
use strict;
use Fcntl;
use Digest::MD5 qw(md5_hex);
# cgi support self-implemented (for fun).

#use Data::Dumper; # for testing.

# Begin shared variables (keep syntax sh-compatible, when lines catenated...)
my $version = '0.981';
my $bwdotdir = "/var/tmp/.borewiki";
my $cnf_passwd = "$bwdotdir/passwd.conf";
my $cnf_cookies = "$bwdotdir/cookies.conf";
my $logfile = "$bwdotdir/log";
my $savelogfile = "$bwdotdir/savelog";
my $errfile = "$bwdotdir/stderr";
my $tmpdir = "$bwdotdir/tmp";
# End shared variables

my $https_required_with_port = 0;

my $prestdir = "prest-0.003016";

# Tune this implementation if required.
sub randombytes($)
{
    openI('/dev/urandom');
    my $x;
    read(I, $x, $_[0], 0);
    close I;
    return $x;
}

my $request_method = $ENV{'REQUEST_METHOD'};
if (defined $request_method) { open STDERR, '>>', $errfile; }
my $https = $ENV{'HTTPS'};

$\ = "\n";

my $cookie_expiretime_in_hours = 5;
my $pagecss  = 'borewiki.css';

$ENV{'PATH'} = '/bin:/usr/bin';

die "Opening log file $logfile failed: $!\n" unless open LOG, '>>', $logfile;
#select((select(LOG), $| = 1)[0]);

use subs qw(log);
sub log(@)
{
    local $" = ' ';
    my $t = localtime; # Does not show TZ.
    syswrite LOG, "$t [$$]: @_\n";
}

sub stderr(@)
{
    local $" = ' ';
    my $t = localtime; # Does not show TZ.
    syswrite STDERR, "$t [$$]: @_\n";
}

log "BoreWiki connection from $ENV{'REMOTE_ADDR'}:$ENV{'REMOTE_PORT'}";

sub nl() { "\n"; }

sub ilog($) { log('I:', $_[0]); }
sub _info(@)
{
    ilog(shift @_); header(shift @_);
    local $" = nl;  print "@_";  _tailer();
}

sub nlog($) { log('N:', $_[0]); }
sub _notice(@)
{
    nlog(shift @_); header(shift @_);
    local $" = nl;  print "@_";  _tailer();
}

sub elog($) { log('E:', $_[0]); }
sub _error(@)
{
    elog(shift @_); header(shift @_);
    local $" = nl;  print "@_";  _tailer();
}

sub _internal_error($)
{
    local $" = nl;
    log("Internal Error: $_[0]");
    header('Internal Error');
    print 'Error in BoreWiki operation. See log for more information.';
    _tailer();
}

sub makeurlprefix($$)
{
    if (defined $_[1]) {
	if ($_[0] != 443) { return "https://$ENV{'HTTP_HOST'}:$_[0]" }
	else		  { return "https://$ENV{'HTTP_HOST'}"; }
    } else {
	if ($_[0] != 80) { return "http://$ENV{'HTTP_HOST'}:$_[0]"; }
	else		 { return "http://$ENV{'HTTP_HOST'}"; }
    }
}

if (! defined $https && $https_required_with_port)
{
    _error('HTTP POST when HTTPS required',
	   'HTTPS Required',
	   'HTTP POST request was made when HTTPS protocol was required.')
      if $request_method != 'GET';

    my $urlprefix = makeurlprefix($https_required_with_port, 1);

    log('prefix+location', $urlprefix, $ENV{'REQUEST_URI'});

    print "Location: " . $urlprefix . $ENV{'REQUEST_URI'};
    print ;
    exit 0;
}


sub h1($) { '<h1>' . $_[0] . '</h1>'; }
sub h3($) { '<h3>' . $_[0] . '</h3>'; }
sub h4($) { '<h3>' . $_[0] . '</h4>'; }
sub form(@) { qq(<form method="$_[0]">); }  sub form0 { '</form>'; }

sub p () { '<p>'; }  sub p0 () { '</p>'; }  sub p7 () { '<p />'; }
sub pre () { '<pre>'; }  sub pre0 () { '</pre>'; }

sub table () { '<table>'; }  sub table0 () { '</table>'; }
#use subs qw(tr);
sub tr_ () { '<tr>'; }  sub tr0 () { '</tr>'; }

sub td($) { '<td>' . $_[0] . '</td>'; }

sub b($) { '<b>' . $_[0] . '</b>'; }
sub i($) { '<i>' . $_[0] . '</i>'; }

sub br7() { '<br />'; }
sub hr7() { '<hr />'; }

sub hidden($$) { qq(<input type="hidden" name="$_[0]" value="$_[1]" />); }
sub submit($$) {
    qq(<input type="submit" value="$_[0]" accesskey="$_[1]" />); }

# XXX wrap="..." is not really xhtml (especially not strict...)
sub textarea($$) {
    qq(<textarea wrap="off" name="$_[0]" id="$_[0]" rows="$_[1]" style="width:99%">); }
sub textarea0() { '</textarea>'; }


sub openI($)
{
    _internal_error("Opening file $_[0] for reading failed: $!")
      unless ( open(I, '<', $_[0]) );
}

sub openO($)
{
    stderr('openO:', $_[0]);
    _internal_error("Opening file $_[0] for writing failed: $!")
      unless ( open(O, '>', $_[0]) );
}

sub start_proc(@)
{
    my $pid = fork;

    _internal_error("fork() failed: $!") unless defined $pid;
    return $pid if $pid;

    # child -- close-on exec flag (see $^F on perlvar) is in action.
    my $listref = shift @_;
    stderr('exec:', @_);
    if (defined $listref) {
	while (1) {
	    my $new = shift @{$listref};
	    my $old = shift @{$listref};
	    last unless defined $old;

	    open($new, "<& $old");
	}}
    exec { $_[0] } @_;
    exit 1;
}

sub run_proc(@) { waitpid(start_proc(@_), 0); return $?; }

my $copenpid;
sub copenI(@)
{
    stderr('copenI:', @_);
    _internal_error("Creating pipe: $!") unless pipe(I, WH);
    $copenpid = start_proc([*STDOUT, *WH], @_);
    close WH;
}
sub ccloseI()
{
    close I;
    waitpid($copenpid, 0);
}

sub getpasswd($)
{
    if (-f $cnf_passwd) {
	openI($cnf_passwd);
	while (<I>) {
	    chomp;
# line format:  passwd: <pwuser> <user> <salt> <passwd> path [path...]
	    if (s/^passwd:\s+(\S+)\s+//) {
		if ($1 eq $_[0]) {
		    my @a = split(/\s+/);
		    close I, return @a if (@a >= 4);
		}}}
	close I;
    }
    return undef;
}


my $username;
my @useraccess;
sub findcookie($)
{
    if (-f $cnf_cookies) {
	my $now = time;
	openI($cnf_cookies);
	while (<I>) {
	    chomp;
	    # line format:  cookie: <cookie> <time> <username> path...
	    if (s/^cookie:\s+(\S+)\s+(\S+)\s+(\S+)\s+//) {
		next unless $1 eq $_[0];
		nlog("Expired cookie for user $3"), next if $2 < $now;
		$username = $3;
		@useraccess = split(/\s+/);
		close I;
		return 1;
	    }}
	close I;
	return 0;
    }
}

sub updatecookies(@)
{
    for (my $i = 0; 1; $i++) {
	last if sysopen(O, "$cnf_cookies.new", O_WRONLY|O_CREAT|O_EXCL);
	_internal_error("sysopen $cnf_cookies.new failed: $!\n") if $i > 7;
	sleep 1;
    }
    if (-f $cnf_cookies) {
	my $now = time;
	openI($cnf_cookies);
	while (<I>) {
	    chomp;
	    # line format:  cookie: <cookie> <time> <username> path...
	    if (/^cookie:\s+\S+\s+(\S+)\s+/) {
		next if $1 < $now;
		print O $_;
	    }}
	close I;
    }
    print O "cookie: @_";
    rename "$cnf_cookies.new", $cnf_cookies;
}


sub prest_copenI($$$)
{
    copenI('perl', '-CSD', "-I$prestdir/lib", "$prestdir/script/prest",
	   '-D', "file_insertion_enabled=0",
	   '-D', "source_url=$_[1]", '-W', "stylesheet=$_[2]", $_[0]);
}


my $script_name = $ENV{'SCRIPT_NAME'};

my $headeradded = 0;
my $set_cookie;
sub first()
{
    $headeradded = 1; # XXX ...
    print "Cache-control: max-age=10\r";
    print "Content-Type: text/html; charset=UTF-8\r";
    print "Set-Cookie: /$script_name=$set_cookie; path=$script_name\r"
      if defined $set_cookie;
    print "\r";
}

sub header($)
{
    return if $headeradded; # ... XXX
    first();
    print <<"EOF";
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
		      "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head>
  <link rel="Stylesheet" href="$pagecss" type="text/css" media="screen" />
  <title>$_[0]</title>
</head><body>
EOF
}

sub _tailer()
{
    #print hr7;
    print '</body></html>';
    exit 0;
}


my @srlines;
sub nextline ()
{
    local $/ = '%0A';

    return shift @srlines if (@srlines);
    $_ = <STDIN>; #stderr("/// $_ <br />");
    return 0 unless defined ($_);
    s/^\s*&//;
    return $_ unless /&/;
    @srlines = split(/&/, $_);
    return shift @srlines;
}

my $srlast = 'none';
my $tabs = 0;
sub readposted ()
{
    $_ = nextline();
    return ('', '') unless $_;
    ($srlast, $_) = split(/=/, $_, 2) if /=/;
    s/%0[DA]//g;
    s/\+/ /g;
    s/%([A-Fa-f0-9]{2})/pack('C',hex($1))/ge; # from cgi-lib.pl
    s/\s+$//; # remove trailing whitespace (2006-06-10 too)
    $tabs = 1 if s/\t/ /g; # convert tab(s) to space(s) (2006-09.22 too)
    return ($srlast, $_)
}

#foreach (<STDIN>) { s/&/&amp;/; print "line: $_ <br />"; } print "<hr />;

sub askpw($)
{
    my $e = $_[0] x 3;
    header("$e Authentication Required $e");
    print h3('Using this page requires authentication:');
    print form('post');
    print hidden('action', 'passwd');
    print table, tr_, td('User:');
    print td('<input type="text" size="10" name="user" value="" accesskey="u" />');
    print td('Password:');
    print td('<input type="password" name="passwd" value="" accesskey="u" />');
    print td(submit('submit', 's'));
    print tr0, table0, form0, p0;
    print 'If you just authenticated and came back here ',
      b('reload/refresh'), ' this page.';
    #print b('Reload'),
    #  ' this page when coming back after successful authentication.';
    _tailer();
}

sub needauth($)
{
    my $http_cookie = $ENV{'HTTP_COOKIE'};
    askpw($_[0]) unless defined($http_cookie);
    if ($http_cookie =~ m|/$script_name=(\w+)|) {
	return if findcookie(my $a = $1);
    }
    askpw($_[0]);
}

sub readheadrev($)
{
    my $rev = 0;
    copenI('rlog', '-hb', $_[0]);
    while (<I>) {
	$rev = $1 if /^head: 1\.(\d+)/;
    }
    ccloseI();
    _internal_error("Reading revision number from $_[0] failed") unless $rev;
    return $rev;
}

sub pathaccess($)
{
    my $cpath = '/' . $_[0];
    foreach my $p (@useraccess) {
	if (substr($cpath, 0, length $p) eq $p) {
	    nlog("pathaccess: access ok: $cpath matches $p");
	    return $p;
	}}
    return undef;
}


sub chkpageaccess($)
{
    # arg: pi
    $_ = $_[0];

    nlog("chkpageaccess: $username, $_[0]");

    y|[0-9A-Za-z]_/.-||d, _error("Path '$_[0]' has unsupported characters: $_",
				 'Unsupported characters',
				 "Page path has unsupported characters: $_")
      if y|[0-9A-Za-z]_/.-||c;

    _error("Path '$_[0]' has './' ...", 'Unsupported path components',
	   q(Page path has unsupported components, like './') ) if /\.\//;

    m|^/*(.*?)([^/]+)/*$|;

    _internal_error("Directory $1 does not exist") if (length $1 && ! -d $1);

    return ($1, $2) if (pathaccess($1));

    _notice("Access denied: $_[0], $username, @useraccess",
	    'Access denied',
	    'You do not have permissions to edit this page.');
}

# ------------------------------

if ($request_method eq 'GET') {
    my $pi = $ARGV[0];
    if (! $pi && $ENV{'QUERY_STRING'}) {
	_error("Illegal Query String: $ENV{'QUERY_STRING'}",
	       'Illegal Query String',
	       'Illegal Query String.');
    }

    needauth('+');

    $pi = 'index' unless $pi;

    my ($path, $page) = chkpageaccess($pi); $pi = $path . $page;

    if (-f "$pi.html" && ! -f "$pi.bw.rst,v") {
	_notice("Page $pi.html not managed by BoreWiki", 'Page not managed',
		"Page $pi.html not managed by BoreWiki.");
    }

    ilog("Edit on page '$pi'.");

    my $prefix = sprintf("%07d-%s",
			 (time + 86400) % 1e7, unpack("H8", randombytes(4)));
    my $rev;
    if (-s "$pi.bw.rst,v")  {
	$rev = readheadrev("$pi.bw.rst");
    }
    else { $rev = 0; }

    header("Editing page '$pi'");
    print h3("Editing page '$pi' on revision $rev.");

    print p, form('post');
    print hidden('action', 'preview');
    print hidden('page', $pi);
    print hidden('prefix', $prefix);
    print hidden('revision', $rev);

    print textarea('text', 20);

    if ($rev) {
	copenI('co', "-p1.$rev", "$pi.bw.rst");
	$\ = '';
	while (<I>) { s/</&lt;/g; print $_; }
	$\ = "\n";
	ccloseI();
    }
    else {
	print "New page '$pi'. Please add content.";
    }

    print textarea0, br7;
    print submit('preview', 'p');
    print form0, p0, br7;
    print 'If you came back here after you <b>save</b>d the content';
    print 'edited, please <b>reload/refresh</b> this before re-editing.', br7;
    print 'Doing that the <b>content</b> and <b>synchronization</b>';
    print 'information of this page will be <b>reloaded</b>.';
    _tailer();
    exit 0;
}

# else $ENV{'REQUEST_METHOD'} eq 'POST')
# --------------------------------------

sub login_incorrect($)
{
    _notice("Login incorrect: $_[0]", 'Login incorrect',
	    h3('Login incorrect'));
}

sub handlepasswd()
{
    my ($user, $passwd);
    while (1)
    {
	my $line; ($srlast, $line) = readposted();
	last unless $srlast;
	if    ($srlast eq 'user')   { $user = $line; }
	elsif ($srlast eq 'passwd') { $passwd = $line; }
    }
    _internal_error('handlepasswd: User not defined') unless defined $user;
    _internal_error('handlepasswd: Passwd not defined') unless defined $passwd;

    my ($username, $salt, $hash, @access) = getpasswd($user);
    login_incorrect("User '$user' does not exist") unless defined $username;
    my $x = md5_hex($salt . $passwd . $salt);
    login_incorrect("User '$user' password mismatch") unless $x eq $hash;
    my $cookie = unpack("H16", randombytes(8));
    my $expiretime = time + $cookie_expiretime_in_hours * 3600;
    updatecookies($cookie, $expiretime, $username, @access);
    $set_cookie = $cookie;
    _info("Authentication for $user ($username) successful. Cookie $cookie",
	  'Authentication successful',
	  h3('Authentication successful.'),
	  'Please go <b>back</b> one page and then <b>reload/refresh</b> that page.');
}

sub makedummyforpage($$)
{
    local *O;
    local $\ = "\n";
    local $, = ' ';
    my $pi = $_[0] . $_[1];

    log('Creating "dummy" page', $pi);

    openO($pi . '.bw.rst,v'); close O;
    openO($pi . '.html');
    print O '<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">';
    print O '<html><head><title>New Page</title></head><body>';
    print O h3('New Page');
    print O 'Please load', b("$_[1].htm"), 'to edit this page.';
    print O '</body></html>';
    close O;
    writeredirfile($_[0], $_[1]);
}

sub addummies($)
{
    my $path = $_[0];
    M: while (/<a .*?href="([\w\.\/-]+?)"/g) {
	  local *_; $_ = $1;
	  #next M if y|[0-9A-Za-z]_/.-||c; # re above handles this.
	  next M unless /\.html$/;
	  $_ = $path . $_;
	  while (m|\.\./|) {
	      next M if m|^\.\./|;
	      s|[^/]+/\.\./||g;
	  }
	  next M if m|\.\./|;
	  next M if -f $_;
	  m|^(.*?)([^/]+)\.html$|;
	  next M if (length $1 && ! -d $1);
	  makedummyforpage(my $a1 = $1, my $a2 = $2) if (pathaccess($1));
      }
}

sub addbasetag($)
{
    my $script_dir = $ENV{'SCRIPT_NAME'};
    $script_dir =~ s|/[^/]+$||;

    my $base = makeurlprefix($ENV{'SERVER_PORT'},$https) . "$script_dir/$_[0]";

    print qq(<base href="$base" />), nl;
}

sub pppresthtml(@)
{
    #log("xxx @_ -- $#_ --");
    # args: [ rev path ]

    while (<I>) {
	print $_;
	last if /<div class="footer">/;
	last if /<\/body>/;
	addummies($_[1]) if defined $_[1];
    }

    if (/<\/body>/) {
	print '<div>', nl;
    }
    else { while (<I>) {
	print br7, nl if /Generated by prest/;
	last if /<\/div>/;
	print $_;
    }}

    print br7, nl, 'Revision ', b($_[0]), ' modified by ', b($username), '.', nl;
    print 'Page managed by ', b("BoreWiki $version"), '.', nl;
    print '</div>', nl;
}

sub handlepreview()
{
    my (@lines, $srlast, $line, $pi, $prefix, $rev);

    needauth('-');

    while (1) {
	($srlast, $line) = readposted();
	last unless $srlast;
	last if ($srlast eq 'text');
	if    ($srlast eq 'page') { $pi = $line; }
	elsif ($srlast eq 'prefix') { $prefix = $line; }
	elsif ($srlast eq 'revision') { $rev = $line; }
    }
    _internal_error('Handlepreview: page missing') unless defined $pi;
    my ($path, $page) = chkpageaccess($pi);
    _internal_error('Handlepreview: prefix missing') unless defined $prefix;
    _internal_error('Handlepreview: prefix $prefix has illegal format')
      unless $prefix =~ /^([0-9]{7}-[0-9a-f]{8})$/;
    $prefix = $1; # untaint
    _internal_error('Handlepreview: revision missing') unless defined $rev;
    _internal_error("Handlesave: revision $rev has incorrect format")
      unless $rev =~ /^(\d+)$/;
    $rev = $1; # untaint.

    ilog("Preview on page '$pi'.");

    my $rstnewfile = "$tmpdir/$prefix-$page.bw.new";

    openO($rstnewfile);
    while (1) {
	last unless $srlast;
	if ($srlast eq 'text') { print O $line; }
	else { log("Unknown content: $srlast = $line"); } # FIXME: DOS attack?
	($srlast, $line) = readposted();
    }
    close O;

    open(STDIN, '<', $rstnewfile); # closed at program exit.
    prest_copenI('-', '-', $pagecss);
    # FIXME above error checking if not good enough.

    first(); # header will be provided by prest.

    $\ = '';
    while (<I>) {
	print $_;
	last if /<link.*stylesheet/;
    }

    print '<style type="text/css"> <!--', nl;
    print '  body { background-image: url(borewiki-draft.png); }', nl;
    print '--></style>', nl;

    addbasetag($path) if length $path;

    while (<I>) {
	print $_;
	last if /<body>/;
    }
    print h3("This is preview page of $pi edited on revision $rev."), nl;
    print 'If you are satisfied with this page, click ', b('[save]'), ' ';
    print 'at the end of this page.', br7, nl;
    print 'If not, go ', b('back'), ' one page and re-edit the content.',
      nl, hr7, nl;
    if ($tabs) {
	print h4("TAB characters converted!"), nl;
	print 'There were TAB characters in input, which all were', nl;
	print 'converted to spaces (1 tab - 1 space).', br7, nl;
	print 'If you see "errors" in resulting page and think', nl;
	print 'it is due to this tab-to-space conversion, it is best', nl;
	print 'to save this page and then reload source page to fix it.',
	  nl, hr7, nl;
    }
    print hr7, nl;

    pppresthtml($rev + 1 . '?');
    ccloseI();
    $\ = "\n";

    print p, form('post');
    print hidden('action', 'save');
    print hidden('page', $pi);
    print hidden('prefix', $prefix);
    print hidden('revision', $rev);
    print table, tr_, td('log message:');
    print td('<input type="text" size="80%" name="msg" value="" accesskey="m" />'), tr0;
    print tr_, td(''), td(submit('save', 's')), tr0, table0;
    print form0, p0, br7;
    print 'This preview page does not have valid link for';
    print '<u>View document source</u>.<br />Also, the new page creation';
    print 'feature is activated when this page is saved<br />i.e. some pages';
    print 'this preview page may reference but does not exist yet', br7;
    print 'will be created when this page is saved.';
    _tailer();
}

sub writeredirfile($$)
{
    #args: $path, $page

    $_ = $_[0];
    s|.*?/|../|g;
    $_ = $_ . 'BoreWiki.cgi?' . $_[0] . $_[1];

    openO($_[0] . $_[1] . '.htm');

    print O <<EOF;
<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
<html><head>
<META HTTP-EQUIV="refresh" CONTENT="1; URL=$_">
<title>Redirection</title>
<script language="JavaScript"> <!--
  function replace(url) { location = url };
//--></script>

<script language="JavaScript1.1"> <!--
  function replace(url) { location.replace(url); }
//--></script>

</head><body>

<script> <!--
  replace("$_");
//--></script>

<h1>Redirection</h1>

If you are not automatically redirected to the actual page, please
click <a href="$_">here.</a>
</body></html>
EOF
  close O;
}

my $cofile_del_at_exit;
END { unlink $cofile_del_at_exit if defined $cofile_del_at_exit; }

sub cleantmps($)
{
    # argh, simple unlink <$_[0]*>; considered tainted ?
    foreach (<$tmpdir/$_[0]*>) { /(.*)/; unlink $1; }

    # delete too old page files edited but not saved.
    foreach (<$tmpdir/[0-9][0-9][0-9][0-9][0-9][0-9][0-9]-*>) {
	m|/(\d+)-([^/]*)$|;
	if ( ((time % 1e7) - $1) % 1e7 < (1e7 / 2) ) {
	    log("Deleting old edited but not saved page file $1-$2.");
	    unlink "$tmpdir/$1-$2";
	}}
}

sub handlesave()
{
    my ($srlast, $line, $pi, $prefix, $rev, $msg);

    needauth('-');

    while (1) {
	($srlast, $line) = readposted();
	last unless $srlast;
	if    ($srlast eq 'page') { $pi = $line; }
	elsif ($srlast eq 'prefix') { $prefix = $line; }
	elsif ($srlast eq 'revision') { $rev = $line; }
	elsif ($srlast eq 'msg') { $msg = $line; }
    }

    # FIXME: function check these...
    _internal_error('Handlesave: page missing') unless defined $pi;
    my ($path, $page) = chkpageaccess($pi);
    _internal_error('Handlesave: prefix missing') unless defined $prefix;
    _internal_error("Handlesave: prefix $prefix has illegal format")
      unless $prefix =~ /^([0-9]{7}-[0-9a-f]{8})$/;
    $prefix = $1; # untaint.
    _internal_error('Handlesave: revision missing') unless defined $rev;
    _internal_error("Handlesave: revision $rev has incorrect format")
      unless $rev =~ /^(\d+)$/;
    $rev = $1; # untaint.

    my $rstnewfile = "$tmpdir/$prefix-$page.bw.new";
    my $rstoldfile = "$tmpdir/$prefix-$page.bw.old";
    my $rstfile = $path . "$page.bw.rst";

    _error("Save: Edit page $rstnewfile missing", 'Edit page missing',
	   "Edit page for $page have been lost for some reason",
	   'Please go back 2 pages and re-preview your page if that helps.')
      unless -f $rstnewfile;

    openO($rstoldfile);
    if ($rev != 0) {
	run_proc([ *STDOUT, *O ], 'co', "-p1.$rev", $rstfile);
	# FIXME: check return value of above command.
    }
    else {
	my $rfv = "$rstfile,v";
	_internal_error("Handlesave: $rfv exists when revision 0") if -s $rfv;
	unlink $rfv;
	run_proc(undef, 'rcs', '-i', $rstfile); # FIXME: check return value
    }
    close O;

    open NULL, '+<', '/dev/null';
    for (my $i = 0; 1; $i++) {
	last unless (run_proc([ *STDIN, *NULL ], 'co', '-l', $rstfile));
	if ($i >= 3) {
	    _notice(q(Page ') . $path . $page . q(' lock timeout),
		    'Page lock timeout',
		    "Could not lock page '$page' for update.", br7,
		    'Please click <b>back</b> and try again in a moment.');
	}
	sleep 1;
    }
    $cofile_del_at_exit = $rstfile;

    ilog(q(Save on page ') . $path . $page . q('));
    header('Page save'); # FIXME: move later.

    print h3('Saving in progress...');

    my $merged = 0;
    if (run_proc([ *STDOUT, *NULL ],
		 'cmp', $rstoldfile, $rstfile) == 0) {

	#print "Page not changed during edition. Saving without merge.", br7;
	run_proc(undef, 'cp', $rstnewfile, $rstfile);
	# FIXME: check return value...
    }
    else {
	print "Page changed during edition. Merging content.", br7;
	$merged = 1;
	my $rv = run_proc(undef, 'merge', $rstfile, $rstoldfile, $rstnewfile);
	if ($rv == 0) {
	    print "No conflicts during merge. Page update clean.", br7;
	}
	elsif ($rv == 256) {
	    print 'Conflicts during merge. Content may be messed up.', br7;
	}
	else {
	    _internal_error("FIXME: merge problem: rv = $rv (see stderr log)");
	}}

    if ($msg =~ /^\s*$/) {
	$msg = $username;
    }
    else { $msg = $username . ": $msg"; }

    cleantmps($prefix);

    open(STDIN, '<', $rstfile); # closed at program exit.

    undef $cofile_del_at_exit;
    $msg =~ /(.*)/; $msg = $1; # untaint as msg used safely.
    unlink $path . "$page.rst";
    link $rstfile, $path . "$page.rst";
    run_proc(undef, 'ci', "-m$msg", $rstfile);
    # FIXME: check return value of above command.
    # Note: it is possible, though highly unlikely that concurrency problems arise...
    my $newrev = readheadrev($rstfile);
    if ($newrev == $rev) {
	print h1("No changes made on page $page");
	print h3("Current revision is " . $rev);
    } else {
	openO($path . "$page.html");
	$_ = $path; s|.*?/|../|g;
	prest_copenI('-', "$page.rst", $_ . $pagecss);
	$\ = '';
	select O;
	pppresthtml($newrev, $path);
	$\ = "\n";
	print '</body></html>';
	select STDOUT;
	ccloseI();
	close O;
	writeredirfile($path, $page);

	print h1("Page '$page' saved");
	print h3("New revision is " . $newrev);

	close LOG;
	unless (open LOG, '>>', $savelogfile) {
	    warn "Opening log file $savelogfile failed: $!\n";
	    *LOG = *STDERR
	}
	log($path . $page, $rev, '->', $newrev, $msg);
        close LOG;
    }
    print 'Go ', b('back'), ' three (3) pages to get back to original page';
    print 'and <b>reload/refresh</b> it to load just-edited content.', br7;
    if ($merged) {
	print br7;
	print 'Content merge was required, either by concurrent edits';
	print 'or you accidentally re-edited page after save without reload.';
	print br7;
	print 'Now you need to carefully examine if there is any problems';
	print 'in created page.', br7;
	print 'Instead of going back three (3) pages as';
	print 'suggested above you can also go back only two (2) pages', br7;
	print 'to the edit page and after <b>reload/refresh</b> fix directly';
	print 'any problems you may encounter.';
    }

    #print b($rstnewfile), " $page, $prefix, $rev, $msg";

    _tailer();
}


while (1)
{
    my $line; ($srlast, $line) = readposted();
    last unless $srlast;
    #log("$srlast = $line");
    if ($srlast eq 'action') {
	handlesave() if ($line eq 'save');
	handlepreview() if ($line eq 'preview');
	handlepasswd() if ($line eq 'passwd');
	_internal_error("Unknown action: $line");
	exit 0
    }
}