#!/usr/bin/perl
# -*-mode: perl; coding: utf-8;-*-


# utf8 -  source code is UTF-8
use utf8;

# Copyright (c) 2014,2016,2019 Kari Hurtta
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

use strict;
use warnings;
use feature "switch";
use Fcntl qw(:DEFAULT :seek);
use File::stat qw();
use Encode;
use POSIX;

sub process($$$$);

my %allowed_domain;
my $cache;
my $exitval = 0;

my $prog = $0;
my $dir = "./";
my $name = $prog;

if ($prog =~ /^(.*\/)([^\/]+)/) {
    $dir = $1;
    $name = $2;
}

my $cgi;
my $cs;
my $filecs;

$cgi = 1 if ($prog =~ /\.cgi$/ &&
	     defined $ENV{"GATEWAY_INTERFACE"} &&
	     $ENV{"GATEWAY_INTERFACE"} =~ /^CGI/);

my @results;


my $loghandle;
my @errors;

sub logerr(@) {

    if (defined $loghandle) {
	print $loghandle @_;
    } else {
	push(@errors, \@_);
    }
}

sub seterrfile(*) {
    if (defined $loghandle) {
	$loghandle->flush;
    }

    $loghandle = $_[0];

    foreach my $e ( @errors ) {
	print $loghandle @{ $e };	
    }
    @errors = ();

    $SIG{__WARN__} = sub {
	print $loghandle @_;
    };

    $SIG{__DIE__} = sub {
	print $loghandle @_;
    };
}

sub last_mtime(@) {
    my $result;
    
    for my $st ( @_ ) {
	$result = $st->mtime if (ref $st && 
				 (!defined $result || $st->mtime > $result));
    }

    return $result;
}

my $navigation;

for my $a ( @ARGV ) {

    if ($a =~ /^\-/) {
	if ($a =~ /^\--allowed-domain:(\S+)$/) {
	    $allowed_domain{lc($1)} = 1;
	} elsif ($a =~ /^\--cache$/) {
	    $cache = 1;
	} elsif ($a =~ /^\--cgi$/) {
	    $cgi = 1;
	} elsif ($a =~ /^\--navigation=(.+)$/) {
	    $navigation = $1;
	} elsif ($a =~ /^\--cs=(.+)$/) {
	    my $b = find_encoding($1);

	    if (!ref $b) {
		logerr "$0: option --cs=$1 ignored\n";
		$exitval = 1;
	    } else {
		$cs = $b->mime_name;
		
		binmode STDIN, ":encoding($cs)";
		binmode STDOUT,":encoding($cs)";
		binmode STDERR,":encoding($cs)";
	    }

	} elsif ($a =~ /^\--filecs=(.)$/) {
	    my $b = find_encoding($1);

	    if (!ref $b) {
		logerr "$0: option --filecs=$1 ignored\n";
		$exitval = 1;
	    } else {
		$filecs = $b->mime_name;
	    }

	} else {
	    logerr "$0: option $a ignored\n";
	}

    } elsif (my $st = File::stat::stat($a) ) {
	my $b = process($a,
			$filecs // $cs,
			$cs // $filecs,
			$st);

	if (defined $b) {
	    push(@results,$b);
	} else {
	    $exitval ||= 2;
	}

	
    } else {
	logerr "$0: $a ignored: $!\n";
	$exitval ||= 2;
    }
} 

sub HTMLtag($@);

sub cachename($$) {
    my ($file,$cachecs) = @_;

    my $XX = "$file.html";
    $XX = "$file.$cachecs.html" if defined $cachecs;

    return $XX;
}


my $buffer;    
my @response_vary;
my $content_location;
my $content_type = "text/html";
my $last_modified;
my $if_modified_since;
my $have_body = 1;

if ($cgi) {
    my $target = $ENV{"PATH_INFO"};
    my $method = $ENV{"REQUEST_METHOD"};
    my $script = $ENV{"SCRIPT_NAME"} // $0;
    my $pr     = $ENV{"SERVER_PROTOCOL"};
    my $host   = $ENV{"SERVER_NAME"};
    my $port   = $ENV{"SERVER_PORT"};
    my $https  = $ENV{"HTTPS"};
    
    my $site;

    $if_modified_since = $ENV{"HTTP_IF_MODIFIED_SINCE"};

    if (defined $pr && defined $host && defined $port &&
	$pr =~ /^HTTP/) {

	my $def    = 80;
	my $scheme = "http";

	if (defined $https && $https eq "on") {
	    $def = 443;
	    $scheme = "https";
	}

	$site  = "$scheme://$host";
	$site .= ":$port" if $port != $def;
    }

    my $charset = $ENV{"HTTP_ACCEPT_CHARSET"};
    push(@response_vary,"Accept-Charset");

    my $gendir;

    if (defined $charset) {
	my @a = split(/\s*,\s*/,$charset);
	my $found;
	my $foundlev = 0;
	
	for my $c (@a) {
	    my $q = 1;
	    my $c1 = $c;
	    
	    if ($c =~ /^(\S+);q=(\S+)$/) {
		$c1 = $1;
		$q = $2;
	    }
	    
	    next if $c1 eq '*';

	    my $b = find_encoding($c1);
	    if (ref $b) { 
		if ($q > $foundlev) {
		    $found = $b->mime_name;
		    $foundlev = $q;
		}
	    } else {
		logerr 
		    "$0: option Accept-Charset value $c1 (on $charset) unparseable\n";
	    }
	}

	if ($found) {
	    $cs = $found;
		
	    binmode STDIN, ":encoding($cs)";
	    binmode STDOUT,":encoding($cs)";
	    binmode STDERR,":encoding($cs)";
	}
    } 

    my $settings = "$dir.$name.settings";
    my $settings_st;
    my $logfile  = "$dir.$name.log";
    my $logcs;
    my $loghd;

    my %allow;
    my %relative;
    my $list_source;
    my $settings_hd;
    
    if (open($settings_hd,'<',$settings)) { 
	$settings_st = File::stat::stat($settings_hd);
	if (!defined $settings_st) {
	    logerr "$0: $settings: $!\n";
	}

	while(<$settings_hd>) {
	    chomp;

	    if (/^cs: (\S+)$/) {
		my $b = find_encoding($1);
		
		if (!ref $b) {
		    logerr "$0: $settings:$.: $_ ignored\n";
		    $exitval = 1;
		} else {
		    $logcs = $b->mime_name;	

		    binmode $settings_hd,":encoding($logcs)";
		}

	    } elsif (/^logfile: (\S+)$/) {
		my $x = $1;

		$x = "$dir$1" if $x !~ /^\//;

		if (! sysopen($loghd,$x,O_RDWR|O_CREAT|O_APPEND|O_NOFOLLOW,)) {
		    logerr "$0: $settings:$.: $x: $!\n";
		    $exitval = 1;
		} else {
		    $logfile = $x;
		}
	       
	    } elsif (/^allowed-domain: (\S+)$/) {	    
		$allowed_domain{lc($1)} = 1;
	    } elsif (/^cache$/) {	    
		$cache = 1;
	    } elsif (/^list-source$/) {	    
		$list_source = 1;
	    } elsif (/^directory: +(.+)$/) {	    
		$gendir = $1;
	    } elsif (/^navigation: +(.+)$/) {
		$navigation = $1;
	    } elsif (/^filecs: (\S+)$/) {	    
		my $b = find_encoding($1);
		
		if (!ref $b) {
		    logerr "$0: $settings:$.: $_ ignored\n";
		    $exitval = 1;
		} else {
		    $filecs = $b->mime_name;
		}
	    } elsif (/^allow: (\S+)\s+(\S+)$/) {	    
		my $x = $1;
		my $f = $2;

		$x = "/$x" if $x !~ /^\//;
		if ($f !~ /^\//) {
		    $relative { $x } = $f;
		    $f = "$dir$f"; 
		}
		if (! -f $f) {
		    logerr "$0: $settings:$.: $f not found\n";  
		} else {
		    $allow{ $x } = $f;
		}

	    } else {
		logerr "$0: $settings:$.: $_ ignored\n";
		$exitval = 1;
	    }
	}

	close($settings_hd);

	$cs = $logcs if !defined $cs;
	
    } else {
	logerr "$0: $settings: $!\n";
    }

    if (!defined $cs) {
	$cs="UTF-8";

	binmode STDIN, ":encoding($cs)";
	binmode STDOUT,":encoding($cs)";
	binmode STDERR,":encoding($cs)";	
    }

    if (!defined $loghd) {
	if (! sysopen($loghd,$logfile,O_RDWR|O_CREAT|O_APPEND|O_NOFOLLOW,)) {
	    logerr "$0: $logfile: $!\n";
	}
    }

    if (defined $loghd) {
	seek($loghd, 0, SEEK_SET) or logerr "$0: $logfile: $!\n";

	my $first = <$loghd>;

	if (!defined $first) {

	    if (defined $logcs) {
		print $loghd "cs: $logcs\n";
	    }
	} elsif ($first =~ /^cs: (\S+)$/) {	  
	    my $b = find_encoding($1);
		
	    if (!ref $b) {
		logerr "$0: $logfile:$:.: charset $1 ignored\n";
	    } else {
		$logcs = $b->mime_name;	
	    }
	}

	seek($loghd, 0, SEEK_END) or logerr "$0: $logfile: $!\n";

	if (defined $logcs) {
	    binmode $loghd,":encoding($logcs)";
	}
	seterrfile($loghd);
	
    } else {
	seterrfile(\*STDERR);
    }

    given ($method) {
	when ("HEAD") {
	    $have_body = 0;
	}

	when ("GET") {
	    # OK
	}

	default {
	    $exitval ||= 3;    # unsupported method
	}
    }

    my $source_st = File::stat::stat($0);
    if (!defined $source_st) {
	logerr "$0: $!\n";
    }

    if (defined $target) {
	my $file = $allow{ $target };

	if (defined $file) {

	    my $st = File::stat::stat($file);
	    if (!defined $st) {
		logerr "$0: $file not found: $!\n";
		goto notfound;
	    }

	    if ($cache) {
	    
		if (defined $relative{ $target } &&
		    defined $site) {
		    my $A = cachename($relative{ $target },$cs);
		    $content_location = "$site/$A" 
		}
		    
		my $XX = cachename($file,$cs);

		my $cachehd;

		if (!open($cachehd,"<:encoding($cs)",$XX)) {
		    goto nocache;
		}

		my $other_mtime = 
		    last_mtime($st,$source_st,
			       $settings_st);

		my $st2 = File::stat::stat($cachehd);
		if ($other_mtime > $st2->mtime ||
		    $st->mode  != $st2->mode) {
		    close($cachehd);

		    goto nocache;
		}
		$last_modified = last_mtime($st2,$source_st,
					    $settings_st);
					

		while(<$cachehd>) {
		    $buffer .= $_;
		}

		close($cachehd);
	    } else {

	      nocache:
		
		my $b = process($file,
				$filecs // $cs,
				$cs,$st);
				
		if (defined $b) {
		    push(@results,$b);
		} else {
		  notfound:
		    $exitval ||= 2;
		    
		    my @body;
		    
		    push(@body, HTMLtag('h2',{ '*nl' => 1 },$script,$target, " not found"));
		    push(@body, HTMLtag('p', { '*nl' => 1 },
					"File ", $file, " not found." ));
		    
		    push(@results, {
			file => $target,
			body => \@body });
		    
		}
	    }

	} elsif (defined $gendir && $target =~ m/\/$/) {
	    
	    my %item;
	    my $found;
	    for my $i (sort keys %allow)  {

		if ($i =~ m/^\Q$target\E([^\/]+)$/) {
		    $item{ $1 } = $i;
		    $found = 1;
		} elsif ($i =~ m/^(\Q$target\E([^\/]+\/))/) {
		    $item{ $2 } = $1;
		    $found = 1;
		}
	    }

	    $exitval ||= 2 if (! $found);

	    my @body;	    
	    my $z = $gendir;
	    $z =~ s/%/$script$target/;

	    push(@body, HTMLtag('h2',{ '*nl' => 1 },$z));
				

	    my @li;
	    for my $a ( sort keys %item ) {
		push (@li,HTMLtag('li', { '*nl'    => 1 },
				  HTMLtag('a', { href => "$script" . $item{ $a }},
					  $a)));
	    }
	    push(@body,HTMLtag('ul',{ '*nl'    => 1 },@li));
	    
	    push(@results, {
		file => "$script$target",
		body => \@body });
	    
	} else {
	    $exitval ||= 2;

	    my @body;

	    push(@body, HTMLtag('h2',{ '*nl' => 1 },$script,$target, " not found"));
	    push(@body, HTMLtag('p', { '*nl' => 1 },
				"Target ", $script,$target, " is not allowed." ));

	    push(@results, {
		file => "$script$target",
		body => \@body });
	}
	
    } elsif ($list_source) {
	$cs = "utf-8";
	@response_vary = ();
	$last_modified = $source_st->mtime if ref $source_st;

	if (open(SOURCE,"<::encoding($cs)",$0)) {
	    
	    while(<SOURCE>) {
		$buffer .= $_;
	    }
	    close(SOURCE);
	    $content_type = "text/plain; format=fixed";
	} else {
	    logerr "$0: $!\n";
	    $exitval ||= 2;
	}

    }

} else {
    seterrfile(\*STDERR);
}


sub serialize_html ($) {
    my ($html) = @_;
    
    return undef if !defined $html;

    my @stack;
	
    my $result = '';

    my $this = {
	item => $html,
    };

  LOOP:
    while (defined $this) {
	my $walk = $this->{'item'};
	my $br   = $this->{'br'};
	my $t = ref $walk;
	

	if ($t) {
	    given ($t) {		

		when ("SCALAR") {
		    my $a = ${$walk};
		    $a =~ s/\&/\&amp;/g;
		    $a =~ s/\>/\&gt;/g;
		    $a =~ s/\</\&lt;/g;

		    if ($br) {
			$a =~ s/\n/<br>\n/g;	
		    }

		    $result .= $a;
		}

		when ("ARRAY") {
		    my $index =  0;
		    $index = $this->{'index'} if defined $this->{'index'};

		    if ($index <= $#{$walk}) {

			my $inner = $walk->[$index];
			$this->{'index'} = $index + 1;
			
			push(@stack,$this);

			$this = {
			    item => $inner,
			    br   => $br
			};
			next LOOP;
		    }		   
		}

		when ("HASH") {
		    my $isend = 0;
		    $isend = $this->{'isend'} if defined $this->{'isend'};
		    
		    my $tag  = $walk->{'*tag'};

		    $br = $walk->{'*br'} if defined $walk->{'*br'};

		    if (!$isend) {
			my $body = $walk->{'*body'};

			if (defined $tag) {
			    $result .= "<$tag";

			    for my $t (keys %{ $walk }) {
				next if $t =~ /^\*/;

				$result .= " $t";
				my $val = $walk->{$t};

				if (defined $val) {
				    if ($val =~ /^[a-z0-9A-Z]$/) {
					$result .= "=$val";
				    } else {
					$val =~ s/\&/\&amp;/g;
					$val =~ s/\"/\&quot;/g;

					$result .= '="' . $val . '"';
				    }				    
				}				
			    }
			
			    $result .= ">";
			}

			$isend = 1 if !$walk->{'*noend'};

			if (defined $body) {
			    if ($isend || $walk->{'*nl'}) {
				$this->{'isend'} = 1;
			    
				push(@stack,$this);
			    }
			    $this = {
				item => $body,
				br   => $br
			    };
			    next LOOP;
			} elsif (!$isend) {
			    $result .= "\n" if ($walk->{'*nl'});
			}		       
		    }

		    if ($isend) {
			if (defined $tag && !$walk->{'*noend'}) {
			    $result .= "</$tag>";
			}
			
			$result .= "\n" if ($walk->{'*nl'});

		    }

		    if (!defined $tag) {
			my $entity  = $walk->{'*entity'};

			$result .= '&' . $entity . ';';
		    }
		}
	
		when ("CODE") {
		    my $res= &$walk;
		    
		    if (defined $res) {
			$this = {
			    item => $res,
			    br   => $br
			};
			next LOOP;
		    }
		}

		default { logerr "$0: bad type $t\n" }
	    }

	} else {

	    my $a = $walk;
	    $a =~ s/\&/\&amp;/g;
	    $a =~ s/\>/\&gt;/g;
	    $a =~ s/\</\&lt;/g;

	    if ($br) {
		$a =~ s/\n/<br>\n/g;	
	    }

	    $result .= $a;
	}

	$this = pop @stack;
    }

    return $result;
}

sub HTMLsingletag($;$) {
    my $hash = {
	'*tag'   => $_[0],
	'*noend' => 1
    };

    if ($#_ > 0 && 'HASH' eq ref $_[1]) {
	for my $t ( keys %{$_[1]} ) {
	    $hash -> { $t } = $_[1]->{ $t };
	}
    }

    return $hash;
}

sub HTMLtag($@) {
    
    my $hash = {
	'*tag' => $_[0]
    };

    given ($_[0]) {
	when (/^pre$/i) { $hash -> { '*br' } = 0; }
    }

    if ($#_ > 0) {
	my $start = 1;

	if ('HASH' eq ref $_[1]) {

	    if (defined $_[1]->{ '*tag' } ||
		defined $_[1]->{ '*body' }) {
		goto NOPARAM;
	    }


	    $start = 2;
	    
	    for my $t ( keys %{$_[1]} ) {
		$hash -> { $t } = $_[1]->{ $t };
	    }
	}

      NOPARAM:

	if ($#_== $start) {
	    $hash -> { '*body' } = $_[ $start ];
	} elsif ($#_ > $start) {
	    my @body = @_[ $start .. $#_ ];
	    $hash -> { '*body' } = \@body;
	} 
    } 

    return $hash;
}

sub HTMLentity($) {
    my $hash = {
	'*entity' => $_[0]
    };

    return $hash;
}

sub convert_mailto($) {
    
    if ($_[0] =~ /^([^<>]+)\<(\S+)\@(\S+)\>([^<>]*)$/) {

	if ($allowed_domain{lc($3)}) {

	    return [ "$1<", HTMLtag('a',
				    { href => "mailto:$2%40$3" },
				    $2, HTMLentity("#64"), $3), ">$4" ];
	} else {
	    return [ "$1<$2", HTMLentity("#64"), "$3>$4" ];
	}
    } 
    
    return $_[0];
}


sub eat_paragraph(\@\$) {
    my ($array,$walk_p) = @_;

    my $walk = ${$walk_p};

    $walk++ if ($#{$array} > $walk && $array->[$walk] =~ /^\s*$/);

    my @got = ();

    while ($#{$array} >= $walk && $array->[$walk] =~ /^\S/) {
	push(@got,convert_mailto($array->[$walk]));
	$walk++;
    }
    
    if ($#{$array} >= $walk && $array->[$walk] =~ /^\s*$/) {
	$walk++;
    } elsif ($walk < $#{$array}) {
	return undef;
    }

    return undef if ! @got;

    ${$walk_p} = $walk;
    
    $got[$#got] =~ s/\n$//;

    return HTMLtag('p',{ '*br' => 1, '*nl' => 1 }, @got);
}

sub eat_pre(\@\$$) {
    my ($array,$walk_p,$needpre) = @_;

    my $walk = ${$walk_p};

    $walk++ if ($#{$array} > $walk && $array->[$walk] =~ /^\s*$/);

    my @got = ();

    while ($#{$array} >= $walk && $array->[$walk] !~ /^\s*$/) {
	$needpre++ if $array->[$walk] =~ /^\s+/;

	push(@got,convert_mailto($array->[$walk]));
	$walk++;
    }

    return undef if ! $needpre;

    if ($#{$array} >= $walk && $array->[$walk] =~ /^\s*$/) {
	$walk++;
    } elsif ($walk < $#{$array}) {
	return undef;
    }

    return undef if ! @got;
    
    ${$walk_p} = $walk;
    
    $got[$#got] =~ s/\n$//;

    return HTMLtag('pre',{ '*nl' => 1 },@got);
}

my $baseid;

use Digest::MD5 qw(md5_base64);

my %used_links;


sub eat_separator(\@\$\@\$\$) {
    my ($array,$walk_p,$links_p,$links_pp,$base_p) = @_;

    my $walk = ${$walk_p};

    $walk++ if ($#{$array} > $walk && $array->[$walk] =~ /^\s*$/);

    my @got = ();
    if ($#{$array} >= $walk && 
	$array->[$walk] =~ /^=======================================+\s*$/) {

	push(@got,HTMLsingletag('hr',{ '*nl' => 1 }));
	$walk++;
    } else {
	return undef;
    }

    my $text;
    if ($#{$array} >= $walk && $array->[$walk] =~ /^\*\s+(\S.*)\s*$/)  {
	$text = $1;

	$walk++;
    }

    if ($#{$array} >= $walk && $array->[$walk] =~ /^\s*$/) {
	$walk++;
    } elsif ($walk < $#{$array}) {
	return undef;
    }

    my $c;
    if (defined $baseid) {
	my @inner;
	
	$c = $#{$links_p} +1;
	$$links_pp = \@inner;
	
	$links_p->[$c] = {
	    inner => \@inner
	};	

	$$base_p = "$baseid$c" . '_';
    }
   
    if (defined $text) {
	my $Z = { '*nl' => 1 };

	if (defined $baseid) {
	    my $id = "$baseid$c";
	
	    my $hash = md5_base64($text);
	    if (! $used_links{$hash}) {
		$used_links{$hash} = $c;
		$id = $hash;
	    }

	    $Z->{'id'} = $id;       
	    $links_p->[$c]->{'id'}    = $id;
	    $links_p->[$c]->{'title'} = $text;
	};

	push(@got,HTMLtag('h2',$Z,$text));
    }

    ${$walk_p} = $walk;

    return $got[0] if $#got == 0;
    return [@got];
}

sub eat_title(\@\$\@$) {
    my ($array,$walk_p,$links_p,$base) = @_;
    
    my $walk = ${$walk_p};
    
    my $len;
    my $text;

    $walk++ if ($#{$array} > $walk && $array->[$walk] =~ /^\s*$/);

    if ($#{$array} >= $walk &&
	$array->[$walk] =~ /^(\p{IsAlnum}.*)\s*$/)  {
	$text = $1;
	
	$len = length($text);

	$walk++;
    } else {
	return undef;
    }
    
    if ($#{$array} >= $walk && 
	$array->[$walk] =~ /^(------+)\s*$/ &&	
	length($1) > $len -5 &&
	length($1) < $len +5) {
	$walk++;
    } else {
	return undef;
    }	
    
    my $Z = { '*nl' => 1,
	      style => "text-decoration:underline" };
    
    if (defined $base) {
	my $c = $#{$links_p} +1;
	my $id = "$base$c";
	
	my $hash = md5_base64($text);
	if (! $used_links{$hash}) {
	    $used_links{$hash} = $c;
	    $id = $hash;
	}


	$Z->{'id'} = $id;
	
	$links_p->[$c] = {
	    id    => $id,
	    title => $text
	};
	
    }
            
    ${$walk_p} = $walk;
    return HTMLtag('h3',$Z,
		   $text);    
}

sub eat_cvs(\@\$) {
    my ($array,$walk_p) = @_;

    my $walk = ${$walk_p};

    $walk++ if ($#{$array} > $walk && $array->[$walk] =~ /^\s*$/);

    my @got = ();
    while ($#{$array} >= $walk && 
	   $array->[$walk] =~/^\$.+:.*\$\s*$/) {
	push(@got, $array->[$walk]);
	$walk++;
    }

    if ($#{$array} >= $walk && $array->[$walk] =~ /^\s*$/) {
	$walk++;
    } elsif ($walk < $#{$array}) {
	return undef;
    }

    return undef if ! @got;

    ${$walk_p} = $walk;
    $got[$#got] =~ s/\n$//;

    return HTMLtag('p',{  '*br' => 1,
			  '*nl' => 1,
			  style => "font-size:small" },
		   @got);
}

sub process($$$$) {
    my ($file,$filecs,$cachecs,$st) = @_;
   
    my $fh;
    if (! open($fh,'<', $file)) {
	logerr "$0: $file: $!\n";
	return;
    }
    binmode ($fh,":encoding($filecs)") if (defined $filecs);

    my @input = <$fh>;
    my @body;

    my $disable = 0;

    my @links;
    my $titlelinks = \@links;
    my $add_navigation;
    my $baseX;

    if (defined $navigation) {
	
	if (!defined $baseid) {
	    $baseid = "A";
	} else {
	    $baseid++;
	}
	$baseX = $baseid;

	$add_navigation = sub {
	    my @list;

	    return undef if ! @links;

	    push(@list,HTMLtag('h3', { '*nl' => 1 }, $navigation));
	    
	    my @items;
	    
	    for my $z ( @links ) {
		my @inner;
		
		if (defined $z -> {'id'} && defined $z -> {'title'}) {
		    push(@inner,HTMLtag('a', { href => 
						   '#' . $z -> {'id'}},
					$z -> {'title'}));
		} else {
		    push(@inner,HTMLtag('span'));
		}
		
		if (ref $z -> {'inner'}) {
		    my @items2;
		    
		    for my $z1 ( @{ $z -> {'inner'}} ) {
			
			push(@items2, HTMLtag('li', { '*nl'    => 1 },
					      HTMLtag('a', 
						      { href => 
							    '#' . 
							    $z1 -> {'id'}},
						      $z1 -> {'title'} )));
			
		    }
		    push(@inner,HTMLtag('ul',{ '*nl'    => 1 }, @items2));   
		} 
	    	    
		push(@items, HTMLtag('li', { '*nl'    => 1 },
				     @inner));
	    }

	    push(@list,HTMLtag('ul',@items));
	    return HTMLtag('nav', { '*nl'    => 1 },@list);
	};
    }


    for (my $walk = 0; $walk <= $#input; ) {
	my $x = eat_separator(@input,$walk,@links, $titlelinks,$baseX);
	if (defined $x) {
	    $disable = 1; 
	    
	    if (defined $add_navigation) {
		push(@body,$add_navigation);
		undef $add_navigation;
	    }
	}
	$x = eat_cvs(@input,$walk) if !defined $x; 
	if (!defined $x) {
	    $x = eat_title(@input,$walk,@{ $titlelinks },$baseX); 

	    if (defined $x) {
		$disable = 1; 
	    
		if (defined $add_navigation) {
		    push(@body,$add_navigation);
		    undef $add_navigation;
		}
	    }

	};
	$x = eat_paragraph(@input,$walk) if !defined $x && !$disable;
	$x = eat_pre(@input,$walk,$disable) if !defined $x; 

	$x = convert_mailto($input[$walk++]) if !defined $x; 

	push(@body,$x)  if (defined $x);
    }

    if (defined $add_navigation) {
	push(@body,$add_navigation);
	undef $add_navigation;
    }

    close($fh);

    my $cachefile;
    if ($cache) {
	my $tmp = sprintf "%s.%d.%d.%s.html",$file,$st->dev,$st->ino,$cachecs // "X";

	if (! sysopen(CACHE,$tmp, 
		      O_RDWR|O_CREAT|O_TRUNC|O_NOFOLLOW,
		      $st->mode
	    )) {
	    logerr "$0: $tmp: $!\n";
	    return;
	}

	my @a;

	if (defined $cachecs) {
	    binmode CACHE,":encoding($cachecs)";

	    push(@a, HTMLsingletag('meta',{ '*nl'   => 1,
					    charset => $cachecs }));
	}


	my $html =  HTMLtag('html',{ '*nl' => 1 },
			    HTMLtag('head',{ '*nl' => 1 }, @a,HTMLtag('title',$file)),
			HTMLtag('body',@body));
	my $buffer = 
	    "<!DOCTYPE html>\n" .
	    serialize_html($html);
	print CACHE $buffer;

	if (close(CACHE)) {
	    my $XX = cachename($file,$cachecs);

	    if (!rename($tmp,$XX)) {
		logerr "$0: $XX: $!\n";
		goto failcache;
	    } 
	    $cachefile = $XX;

	} else {
	    logerr "$0: $tmp: $!\n";
	  failcache:
	    if (!unlink($tmp)) {
		logerr "$0: $tmp: $!\n";
	    }
	}
    }

    return {
	body      => \@body, 
	cachefile => $cachefile,
	file      => $file
    };
}

my @headcs;
if (defined $cs) {
    push(@headcs, HTMLsingletag('meta',{ '*nl'   => 1,
					 charset => $cs }));
}

if (0 == $#results && ref $results[0]) {
    my $html =  HTMLtag('html',{ '*nl' => 1 },
			HTMLtag('head',{ '*nl' => 1 }, 
				@headcs,
				HTMLtag('title',
					$results[0]->{'file'})),
			HTMLtag('body',@{$results[0]->{'body'}}));
    $last_modified = time;

    $buffer = 
	"<!DOCTYPE html>\n" .
	serialize_html($html);

} elsif (0 < $#results) {
    my @join;
    my @names;

    foreach my $x (@results) {
	next if !ref $x;

	push(@join,HTMLtag('div',{ '*nl' => 1 },
			   HTMLtag('h1',{ '*nl' => 1 },$x->{'file'}),
			   @{ $x->{'body'} }));				   
	push(@names,$x->{'file'});

	if ($#names < $#results) {
	    push(@join,HTMLsingletag('hr',{ '*nl' => 1 }));
	}
    }

    $last_modified = time;
    my $html =  HTMLtag('html',{ '*nl' => 1 },
			HTMLtag('head',{ '*nl' => 1 }, 
				@headcs,
				HTMLtag('title',join(', ',@names))),
			HTMLtag('body',@join));

    $buffer = 
	"<!DOCTYPE html>\n" .
	serialize_html($html);
}

if ($cgi) {
    my $status;
    
    given($exitval) {
	when (0) {
	    if (defined $buffer) {
		$status = "200 OK";
	    } else {
		$status = "404 Not found";
	    }
	}
	when(2) {
	    $status = "404 Not found";
	}
	when(3) {
	    $status = "405 Method Not Allowed";
	}
	default {
	    $status = "500 Exit status $exitval";
	}
    }

    my $cl  = 0;
    my $raw = "";

    if (defined $buffer) {
	$raw = encode($cs,$buffer,Encode::FB_HTMLCREF);
	$cl  = length($raw);
    }

    my $add = "";

    if (defined $content_location) {
	$add .= <<EOM
Content-Location: $content_location
EOM
;

    }

    if (@response_vary) {
	my $vary = join(', ',@response_vary);
	$add .= <<EOM
Vary: $vary
EOM
    }

    if ($last_modified) {
	my $lm = 
	    strftime ("%a, %d %b %Y %H:%M:%S GMT", gmtime($last_modified));
	$add .= <<EOM
Last-Modified: $lm
EOM
;
	# If browser was hot that already

	if (defined $if_modified_since &&
	    $if_modified_since eq $lm &&
	    $status =~ /^200/) {

	    $status = "304 Not Modified";
	    $have_body = 0;
	    undef $cl;
	} 
    }

    if (defined $cl) {
	$add .= <<EOM
Content-Length: $cl
EOM
    }

    print <<EOM
Content-Type: ${content_type}; charset="$cs"
Status: $status
${add}
EOM
;

    $| = 1;

    if ($have_body) {   # HEAD does not return body
	binmode STDOUT,":bytes";  
	print $raw;
    }

} elsif (defined $buffer) {
    print $buffer;
}

exit $exitval;