Guestbook CGI (Otzov) (2003)

A full-featured CGI guestbook script with moderation capabilities, developed in 2003. Features include: adding guestbook entries with name and message, profanity filtering, duplicate request prevention, pagination (9 entries per page), admin moderation interface with enable/disable entries, IP address and browser tracking, and template-based HTML output.

File-Based Storage (No Database):

This script does not use a database. Instead, it reads and writes data directly to plain text files:

otzov.txt - Stores all guestbook entries in a custom XML-like format with entries wrapped in <gbrec> tags
otzov.dat - Stores the total count of entries
lastreq.dat - Stores the last request to prevent duplicate submissions
passwd.dat - Stores admin password for moderation access

This file-based approach was common in 2003 when database setup was more complex and many shared hosting providers didn't include database access. The script parses the text files line by line, extracts entry data using pattern matching, and writes new entries by appending to the file. While simpler than database-driven solutions, this approach works well for small to medium-sized guestbooks.

Features:

Add guestbook entries with name and message
Profanity filtering (Russian and English)
Duplicate request prevention
Pagination (9 entries per page)
Admin moderation interface
IP address and browser tracking
Template-based HTML output (otzov.dot)
File-based storage - no database required (otzov.txt, otzov.dat)

Perl Source Code (otzov.cgi):


#!/usr/bin/perl

sub ReqDecoder
{
	my($str, @qstr, $t1, $t2);
	$str = $_[0];
	$str =~ s/\+/ /g;
	@qstr = split(/&/,$str);
	foreach $i (@qstr)
	{
		if ($i =~ /=/)
		{
			$t1 = $`;
			$t2 = $';
			$t1 =~ s/%([0-9A-H]{2})/pack('C',hex($1))/egi;
			$t2 =~ s/%([0-9A-H]{2})/pack('C',hex($1))/egi;
			$t1 =~ tr/a-z/A-Z/;
			$hash{$t1} = $t2;
		}
	}

	return %hash;
}

################################################################################################

sub WriteBook
{
   	my($ans, $ok, $test, @time);
    $ans = "РЕЗУЛЬТАТ:<br>\n";
    $ok = 0;

	open (lastreq, "<lastreq.dat") || sub {$ans .= "Файла данных запроса нет - не могу прочитать!<br>\n";};
	$test = <lastreq>;
	close (lastreq);

	if ($q eq $test)
	{
	    return $ans."Повторный запрос - отклонен...<br>\n";
	}
	else
	{
	   	open (lastreq, ">lastreq.dat") || sub {$ans .= "Не могу записать в файл данных запроса!<br>\n";};
		print lastreq $q;
		close (lastreq);
	}

    if ($req{'NICK'} =~ /\S/)
    {
		$ok++;
    }
    else
    {
    	$ans .= "Имя не должено быть пустым!<br>\n";
	}

    if ($req{'MSG'} =~ /\S/)
    {
       	$req{'MSG'} =~ s/&/&amp;/g;
    	$req{'MSG'} =~ s/</&lt;/g;
    	$req{'MSG'} =~ s/>/&gt;/g;
    	$req{'MSG'} =~ s/\r\n/<br>/g;
        if ($req{'MSG'} =~ /ху[йеяе]/i || $req{'MSG'} =~ /пизд/i || $req{'MSG'} =~ /бля/i || $req{'MSG'} =~ /fuck/i)
	    {
			$ans .= "У нас не матерятся: &quot;..$&..&quot;...<br>\n";
		}
		else
		{
			$ok++;
		}
    }
    else
    {
    	$ans .= "Пустое cообщение!<br>\n";
	}

    if ($ok == 2)
    {
	    open(gb, ">>otzov.txt") || sub {$ans .= "Не могу открыть файл записей!<br>\n";};
		print gb "<gbrec>\n";
		print gb "Enabled > no\n";
		print gb "From > $ENV{'REMOTE_ADDR'}\n";
		print gb "Browser > $ENV{'HTTP_USER_AGENT'}\n";
		print gb "Referer > $ENV{'HTTP_REFERER'}\n";
		print gb "NICK > $req{'NICK'}\n";
		print gb "MSG > $req{'MSG'}\n";
		@time = localtime(time);
		@time[0] = (@time[0] < 10) ? "0".@time[0] : @time[0];
		@time[1] = (@time[1] < 10) ? "0".@time[1] : @time[1];
		@time[2] = (@time[2] < 10) ? "0".@time[2] : @time[2];
		@time[3] = (@time[3] < 10) ? "0".@time[3] : @time[3];
   		@time[4]++;
		@time[4] = (@time[4] < 10) ? "0".@time[4] : @time[4];
        @time[5] = @time[5] + 1900;
		print gb "TIME > @time[3].@time[4].@time[5]&nbsp;@time[2]:@time[1]:@time[0]\n";
		print gb "</gbrec>\n\n";
        close(gb);
		$count++;
        open(st, ">otzov.dat") || return $ans."Не могу записать в файл данных!<br.\n";
			print st $count."\n";
		close(st);
		$ans .= "Запись успешно добавлена!<br>\n";
        $succAdd = "true";
	}
	else
	{
		$ans .= "Запись не может быть добавлена!<br>\n";
        $succAdd = "false";
	}
    return $ans;
}

################################################################################################

sub GuestBook
{
   	my($ans, $i, $str, %current);
	$ans = "\n\n<!-- here otzov begins -->\n\n";
	open(gb, "otzov.txt") || sub {$ans .= "Файла записей нет - добавьте хотя бы одну запись!<br>\n";};
	$i = 0;
	do
	{
		while (($str = <gb>) && ($str !~ /<gbrec>/i)) {} #нашли начало записи (или конец файла)
		while (($str = <gb>) && ($str !~ /<\/gbrec>/i)) #обработка, пока не конец записи (или файла)
	    {
		    chomp($str);
		    $current{$`} = $' if ($str =~ / > /); #если подходит под шаблон - добавляем в хеш %current
		}
		if (%current)
		{
			$i++;
			if ($i >= $req{'READFROM'} && $i <= $req{'READTO'})
			{
				if (($current{'Enabled'} =~ /yes/i) && !$imboss)
				{
				$ans .= "<br>\n";
				$ans .= "<TABLE border=1 borderColor=darkgoldenrod cellPadding=1 cellSpacing=1>\n";
				$ans .= "<TR>\n";
				$ans .= " <TD width=5%>#$i</TD>\n";
				$ans .= " <TD width=10%>$current{'TIME'}</TD>\n";
				$ans .= " <TD><B>$current{'NICK'}</B></TD>\n";
				$ans .= "</TR>\n";
				$ans .= "<TR>\n";
				$ans .= " <TD colSpan=3>$current{'MSG'}</TD>\n";
				$ans .= "</TR>\n";
				$ans .= "</TABLE>\n";
				}
				elsif ($imboss)
				{
				$ans .= "<br>\n";
				$ans .= "<TABLE border=1 cellPadding=1 cellSpacing=1>\n";
				$ans .= "<TR>\n";
				$ans .= " <TD width=5%>#$i</TD>\n";
				$ans .= " <TD width=10%>$current{'TIME'}</TD>\n";
				$ans .= " <TD><B>$current{'NICK'}</B></TD>\n";
				$ans .= "</TR>\n";
				$ans .= "<TR>\n";
				$ans .= " <TD colSpan=3>$current{'MSG'}</TD>\n";
				$ans .= "</TR>\n";
				$ans .= "<TR>\n";
				$ans .= " <TD colSpan=1><center><a href=http://$ENV{'HTTP_HOST'}/cgi-bin/otzov.cgi?readfrom=$req{'READFROM'}&readto=$req{'READTO'}&authority=$req{'AUTHORITY'}&action=sanitarize&what=$i>" . (($current{'Enabled'} =~ /no/i) ? "разрешить" : "запретить") . "</a></center></TD>\n";
				$ans .= " <TD colSpan=1><center>$current{'From'}</center></TD>\n";
				$ans .= " <TD colSpan=1><center>$current{'Browser'}<br>Клиент пришел <a href=\"$current{'Referer'}\">отсюда...</a></center></TD>\n";
				$ans .= "</TR>\n";
				$ans .= "</TABLE>\n";
				}
		    }
		}
		%current = %a; #убили хеш
	}
	until (eof || $i > $req{'READTO'});
	$ans .= "Гостевая книга пуста - добавьте хотя бы одну запись!<br>\n" if ($i == 0);
   	close(gb);
	$ans .= "\n\n<!-- here otzov ends -->\n\n";

	return $ans;
}

################################################################################################

sub SanitarizeGuestBook
{
   	my($ans, $i, $str);
    $ans = "Обработка гостевой книги:<br>\n";
    open(newgb,">>otzov.tmp") || return $ans."Не могу создать новый файл записей!<br>\n";
	open(gb, "otzov.txt") || return $ans."Не могу открыть старый файл записей!<br>\n";
	$i = 0;
	$count = 0;
	do
	{
		while (($str = <gb>) && ($str !~ /<gbrec>/i)) {} #нашли начало записи (или конец файла)
		while (($str = <gb>) && ($str !~ /<\/gbrec>/i)) #обработка, пока не конец записи или файла
	    {
		    chomp($str);
		    $current{$`} = $' if ($str =~ / > /); #если подходит под шаблон - добавляем в хеш
		}
		if (%current)
		{
			$i++;
			if ($i == $_[0])
			{
				$current{'Enabled'} = ($current{'Enabled'} =~ /no/) ? "yes" : "no";
			}

			if ($_[0] || $current{'Enabled'} =~ /yes/)
			{
				$count++;
				print newgb "\n<gbrec>\n";
				foreach $key (sort(keys %current))
				{
					print newgb "$key > $current{$key}\n";
				}
				print newgb "<\/gbrec>\n";
			}
		}
		%current = %a; #убили хеш
	}
	until (eof gb);
	$ans .= "Гостевая книга оказалась пуста - нечего было обрабатывать!<br>\n" if ($i == 0);
   	close(gb);
   	close(newgb);

    unlink "otzov.txt";
    rename "otzov.tmp", "otzov.txt";

	open(st, ">otzov.dat") || return $ans."Не могу записать в файл данных!<br.\n";
		print st $count."\n";
	close(st);

	return $ans."Обработано $count записей (всего было $i).\n";
}

################################################################################################

sub Numbers
{
   	my($ans, $i, $k);
  	$ans = "\n<!-- here numbers begin -->\n";
	for ($i = 1; $i < $count; $i+=$_[0])
	{
		$k = $i + $_[0];
		$k = $count if $k > $count;
		if ($i >= $req{'READFROM'} && $k <= $req{'READTO'})
		{
			$ans .= "[$i..$k]\n";
		}
		else
		{
	        $ans .= "<a href=http://$ENV{'HTTP_HOST'}/cgi-bin/otzov.cgi?readfrom=$i&readto=$k" . (($imboss) ? "&authority=$req{'AUTHORITY'}" : "") . ">[$i..$k]</a>\n";
	    }
	}
   	$ans .= "<br>\n<!-- here numbers end -->\n";
   	return $ans;
}

################################################################################################

sub CheckBoss
{
	my($pw,$ans);
	if (open(pwf, "passwd.dat"))
	{
		$pw = <pwf>;
		$ans = ($_[0] eq $pw);
      	close(pwf);
	}
	else
	{
		open(pwf, ">passwd.dat");
		print pwf $_[0];
		$ans = true;
      	close(pwf);
	}
	return $ans;
}

################################################################################################

sub Error
{
	print $_[0];
}

################################################################################################

if ($ENV{'REQUEST_METHOD'} =~ /get/i)
{
	$q = ($ENV{'QUERY_STRING'});
}
if ($ENV{'REQUEST_METHOD'} =~ /post/i)
{
	sysread STDIN, $q = ($ENV{'QUERY_STRING'}), $ENV{'CONTENT_LENGTH'};
}

%req = ReqDecoder($q);

################################################################################################

print "Content-Type: text/html\n\n";
open SHABLON, "otzov.dot" || Error("Отсутствует шаблон страницы!<br>\n");
while (($str = <SHABLON>) !~ /<!--%otzov%-->/i)
{
print $str;
}

################################################################################################

$imboss = CheckBoss($req{'AUTHORITY'}) if ($req{'AUTHORITY'});

open(st, "otzov.dat") || Error("Файла данных нет - необходимо инициализировать счетчик!<br>\n");
	$count = <st>;
   	$count = $& if ($count =~ /\d+/g);
close(st);

$succAdd = "true";

$a = WriteBook if ($req{'ACTION'} =~ /add/i);

$b = SanitarizeGuestBook($req{'WHAT'}) if ($req{'ACTION'} =~ /sanitarize/i && $imboss);

if (!$req{'READFROM'} || !$req{'READTO'} || $req{'READFROM'} > $count || $req{'READFROM'} > $req{'READTO'})
{
	$req{'READFROM'} = $count - 9;
	$req{'READTO'} = $count;
}

print Numbers(9);

print $a.$b if ($a || $b);

print GuestBook;

print Numbers(9);

print "<a href=http://$ENV{'HTTP_HOST'}/cgi-bin/otzov.cgi?action=sanitarize&authority=$req{'AUTHORITY'}>|Почистить книгу|</a> <a href=http://$ENV{'HTTP_HOST'}/cgi-bin/otzov.cgi>|Выйти из режима хозяина|</a><br>" if ($imboss);


################################################################################################

if ($succAdd eq "true")
{
print <<EOF;

<form action="http://$ENV{'HTTP_HOST'}/cgi-bin/otzov.cgi" method=post>
<TABLE border=1 borderColor=darkgoldenrod cellPadding=1 cellSpacing=1 width="100%">

  <TR>
    <TD align=middle colSpan=2>Добавьте новую запись:</TD></TR>
  <TR>
    <TD>
      ваше имя:<br><INPUT name=nick></TD>
    <TD rowSpan=2><TEXTAREA cols=45 name=msg rows=5></TEXTAREA></TD></TR>
  <TR>
    <TD><INPUT name=action type=hidden value=add><INPUT type=submit value="добавить запись"></TD></TR></TABLE>
</form>
EOF
}
else
{
$req{'MSG'} =~ s/<br>/\n/g;
print <<EOF;
<form action="http://$ENV{'HTTP_HOST'}/cgi-bin/otzov.cgi" method=post>
<TABLE border=1 cellPadding=1 cellSpacing=1 width="100%">
  <TR>
    <TD align=middle colSpan=2>Исправьте свою запись:</TD></TR>
  <TR>
    <TD>
      ваше имя:<br><INPUT name=nick value="$req{'NICK'}"></TD>
    <TD rowSpan=2><TEXTAREA cols=45 name=msg rows=5>$req{'MSG'}</TEXTAREA></TD></TR>
  <TR>
    <TD><INPUT name=action type=hidden value=add><INPUT type=submit value="добавить запись"></TD></TR></TABLE>
</form>
EOF
}

################################################################################################
do
{
	$str = <SHABLON>;
	print $str;
}
until (eof);
close(SHABLON);

HTML Template (otzov.dot):


<HTML>
<HEAD>
<TITLE>Сталактитовая пещера - сауна VIP (812)322-54-03</TITLE>
<META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=windows-1251">
<meta name="description" content="Сталактитовая пещера, сауна-vip, 2-ух этажная сауна с русской, турецкой парной, все виды массажа, бассейн с гейзером, квалифицированный парильщик, караоке, бильярд, домашний кинотеатр, шоу программа, шашлыки, охраняемая стоянка.">
<meta name="keywords" content="Сталактитовая пещера, сауна-vip, 2-ух этажная сауна с русской, турецкой парной, все виды массажа, бассейн с гейзером, квалифицированный парильщик, караоке, бильярд, домашний кинотеатр, шоу программа, шашлыки, охраняемая стоянка.">
<link href="main.css" rel="stylesheet" type="text/css">
<base href="www.stalaktit.ru">
<body bgcolor="DAC17E">
<table width="0" height="0" border="0" align="center" cellpadding="0" cellspacing="0">
  <tr>
    <td>
      <br><SCRIPT TYPE="text/javascript">
<!--

function newImage(arg) {
	if (document.images) {
		rslt = new Image();
		rslt.src = arg;
		return rslt;
	}
}

function changeImages() {
	if (document.images && (preloadFlag == true)) {
		for (var i=0; i<changeImages.arguments.length; i+=2) {
			document[changeImages.arguments[i]].src = changeImages.arguments[i+1];
		}
	}
}

var preloadFlag = false;
function preloadImages() {
	if (document.images) {
		foto_over = newImage("images/foto-over.jpg");
		otzivi_over = newImage("images/otzivi-over.jpg");
		stoimost_over = newImage("images/stoimost-over.jpg");
		adres_over = newImage("images/adres-over.jpg");
		preloadFlag = true;
	}
}

// -->
</SCRIPT>
<!-- End Preload Script -->
<script language="JavaScript" type="text/JavaScript">
<!--
function MM_reloadPage(init) {  //reloads the window if Nav4 resized
  if (init==true) with (navigator) {if ((appName=="Netscape")&&(parseInt(appVersion)==4)) {
    document.MM_pgW=innerWidth; document.MM_pgH=innerHeight; onresize=MM_reloadPage; }}
  else if (innerWidth!=document.MM_pgW || innerHeight!=document.MM_pgH) location.reload();
}
MM_reloadPage(true);
//-->
</script>
<link href="main.css" rel="stylesheet" type="text/css">
</HEAD>
<BODY BGCOLOR=#FFFFFF LEFTMARGIN=0 TOPMARGIN=0 MARGINWIDTH=0 MARGINHEIGHT=0 ONLOAD="preloadImages();">
      <!-- ImageReady Slices (Sait_stile2.psd) -->
      <div align="center">
        <TABLE WIDTH=640 BORDER=0 CELLPADDING=0 CELLSPACING=0>
          <!--DWLayoutTable-->
          <TR>
            <TD COLSPAN=2 BGCOLOR=#FFCC66> <A HREF="foto.html" TARGET="_self"
				ONMOUSEOVER="window.status='Фотографии салона'; changeImages('foto', 'images/foto-over.jpg'); return true;"
				ONMOUSEOUT="window.status=''; changeImages('foto', 'images/foto.jpg'); return true;">
              <IMG NAME="foto" SRC="images/foto.jpg" WIDTH=145 HEIGHT=53 BORDER=0 ALT="Фотографии"></A></TD>
            <TD COLSPAN=3 BGCOLOR=#FFCC66> <A HREF="/cgi-bin/otzov.cgi" TARGET="_self"
				ONMOUSEOVER="window.status='Отзовы наших посетителей'; changeImages('otzivi', 'images/otzivi-over.jpg'); return true;"
				ONMOUSEOUT="window.status=''; changeImages('otzivi', 'images/otzivi.jpg'); return true;">
              <IMG NAME="otzivi" SRC="images/otzivi.jpg" WIDTH=176 HEIGHT=53 BORDER=0 ALT="Отзовы"></A></TD>
            <TD COLSPAN=3 BGCOLOR=#FFCC66> <A HREF="stoimost.html" TARGET="_self"
				ONMOUSEOVER="window.status='Наши цены'; changeImages('stoimost', 'images/stoimost-over.jpg'); return true;"
				ONMOUSEOUT="window.status=''; changeImages('stoimost', 'images/stoimost.jpg'); return true;">
              <IMG NAME="stoimost" SRC="images/stoimost.jpg" WIDTH=156 HEIGHT=53 BORDER=0 ALT="Цены"></A></TD>
            <TD COLSPAN=2 BGCOLOR=#FFCC66> <A HREF="adres.html" target="_self"
				ONMOUSEOVER="window.status='Наши координаты'; changeImages('adres', 'images/adres-over.jpg'); return true;"
				ONMOUSEOUT="window.status=''; changeImages('adres', 'images/adres.jpg'); return true;">
              <IMG NAME="adres" SRC="images/adres.jpg" WIDTH=163 HEIGHT=53 BORDER=0 ALT="Координаты"></A></TD>
          </TR>
          <TR>
            <TD width="70" BGCOLOR=#FFCC33> <IMG SRC="images/back.jpg" WIDTH=70 HEIGHT=255 ALT=""></TD>
            <TD BGCOLOR=#FFCC33> <IMG SRC="images/back_02.jpg" WIDTH=75 HEIGHT=255 ALT=""></TD>
            <TD BGCOLOR=#FFCC33> <IMG SRC="images/back_03.jpg" WIDTH=75 HEIGHT=255 ALT=""></TD>
            <TD BGCOLOR=#FFCC33> <IMG SRC="images/back_04.jpg" WIDTH=75 HEIGHT=255 ALT=""></TD>
            <TD COLSPAN=2 BGCOLOR=#FFCC33> <IMG SRC="images/back_05.jpg" WIDTH=75 HEIGHT=255 ALT=""></TD>
            <TD BGCOLOR=#FFCC33> <IMG SRC="images/back_06.jpg" WIDTH=75 HEIGHT=255 ALT=""></TD>
            <TD COLSPAN=2 BGCOLOR=#FFCC33> <IMG SRC="images/back_07.jpg" WIDTH=75 HEIGHT=255 ALT=""></TD>
            <TD BGCOLOR=#FFCC33> <img src="images/back_08.jpg" width=120 height=255 alt=""></TD>
          </TR>
          <TR >
            <TD background="images/News_2.jpg" height="172" COLSPAN=10 BGCOLOR=#FFCC00 style="padding: 5px; padding-bottom: 15px " >
              <div  style="width:630px; height:143px; overflow: auto; padding: 10px">
                <table width="100%">
                  <!--DWLayoutTable-->
                  <tr>
                    <td width="640" height="271" valign="top" class="main">
                    <!--%otzov%-->
					</td>
                  </tr>
                  <!--DWLayoutTable-->
                </table>
                <p>&nbsp;</p>
                <table width="100%" border="0" cellspacing="0" cellpadding="0">
                </table>
              </div></TD>
          </TR>
          <TR>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=70 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=75 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=75 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=75 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=26 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=49 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=75 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=32 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=43 HEIGHT=1 ALT=""></TD>
            <TD> <IMG SRC="images/spacer.gif" WIDTH=120 HEIGHT=1 ALT=""></TD>
          </TR>
        </TABLE>
        <!-- End ImageReady Slices -->
        &nbsp;</div></div></div></td>
  </tr>
  <tr>
    <td><p align="center"><a
target=_top href="http://top.mail.ru/jump?from=661959"><img
src="http://top.list.ru/counter?js=na;id=661959;t=55"
border=0 height=31 width=88
alt="Рейтинг@Mail.ru"></a><a href="http://u5403.08.spylog.com/cnt?cid=540308&f=3&p=0" target="_blank"><img src="http://u5403.08.spylog.com/cnt?cid=540308&p=0" alt='SpyLOG' border='0' width=88 height=31 >
        </a>
        <!-- SpyLOG -->
      </p>
      <p align="center"><font size="2"><a href="http://www.ozarenie.spb.ru">Copyright
        © 2004 Ozarenie Design Stidio.</a></font></p></td>
  </tr>
</table>

</BODY>
</HTML>

Perl Source Code (SCR.cgi):


#!bin/perl

	######################
	# Guest Book for CGI #
	#     (c) kusaku     #
	# No rights reserved #
	######################

################################################################################################

sub ReqDecoder
{
	my($str, @qstr, $t1, $t2);
	$str = $_[0];
	$str =~ s/\+/ /g;
	@qstr = split(/&/,$str);
	foreach $i (@qstr)
	{
		if ($i =~ /=/)
		{
			$t1 = $`;
			$t2 = $';
			$t1 =~ s/%([0-9A-H]{2})/pack('C',hex($1))/egi;
			$t2 =~ s/%([0-9A-H]{2})/pack('C',hex($1))/egi;
			$t1 =~ tr/a-z/A-Z/;
			$hash{$t1} = $t2;
		}
	}

	return %hash;
}

################################################################################################

sub WriteBook
{
   	my($ans, $ok, $test, @time);
    $ans = "<font color=red>РЕЗУЛЬТАТ:</font><br>\n";
    $ok = 0;

	open (lastreq, "<lastreq.dat") || sub {$ans .= "<font color=red>Файла данных запроса нет - не могу прочитать!</font><br>\n";};
	$test = <lastreq>;
	close (lastreq);

	if ($q eq $test)
	{
	    return $ans."<font color=orange>Повторный запрос - отклонен...</font><br>\n";
	}
	else
	{
	   	open (lastreq, ">lastreq.dat") || sub {$ans .= "<font color=red>Файла данных запроса нет - не могу записать!</font><br>\n";};
		print lastreq $q;
		close (lastreq);
	}

    if ($req{'NICK'} =~ /\S/)
    {
		$ok++;
    }
    else
    {
    	$ans .= "<font color=orange>Имя не должено быть пустым!</font><br>\n";
	}

	if ($req{'MAIL'} =~ /[0-9A-Z\.\-\_]+@([0-9A-Z\-]+\.){1,3}([A-Z]){2,4}/i)
	{
		$req{'MAIL'} = $&;
		$ok++;
	}
	elsif ($req{'MAIL'} !~ /\S/)
	{
		$ans .= "<font color=lightblue>Почтовый адрес отсутствует...</font><br>\n";
		$ok++;
	}
   	else
	{
		$ans .= "<font color=orange>Странный адрес: &quot;$req{'MAIL'}&quot;...</font><br>\n";
	}

	if ($req{'PAGE'} =~ /(\d)+\.(\d)+\.(\d)+\.(\d)+.*/i || $req{'PAGE'} =~ /((\w)+\.){1,4}(\w){2,4}.*/)
    {
        $req{'PAGE'} = "http://" . $&;
		$ok++;
    }
    elsif ($req{'PAGE'} !~ /\S/)
    {
    	$ans .= "<font color=lightblue>Адрес страницы отсутствует...</font><br>\n";
   		$ok++;
	}
    else
    {
    	$ans .= "<font color=orange>Плохой адрес у страницы...<font><br>\n";
	}

    if ($req{'MSG'} =~ /\S/)
    {
       	$req{'MSG'} =~ s/&/&amp;/g;
    	$req{'MSG'} =~ s/</&lt;/g;
    	$req{'MSG'} =~ s/>/&gt;/g;
    	$req{'MSG'} =~ s/\r\n/<br>/g;
        if ($req{'MSG'} =~ /ху[йеяе]/i || $req{'MSG'} =~ /пизд/i || $req{'MSG'} =~ /бля/i || $req{'MSG'} =~ /fuck/i)
	    {
			$ans .= "<font color=orange>У нас не матерятся: &quot;..$&..&quot;...</font><br>\n";
		}
		else
		{
			$ok++;
		}
    }
    else
    {
    	$ans .= "<font color=orange>Пустое cообщение!</font><br>\n";
	}

    if ($ok == 4)
    {
	    open(gb, ">>guestbook.txt") || sub {$ans .= "<font color=red>Не могу открыть файл записей!</font><br>\n";};
		print gb "<gbrec>\n";
		print gb "From > $ENV{'REMOTE_ADDR'}\n";
		print gb "Browser > $ENV{'HTTP_USER_AGENT'}\n";
		print gb "Referer > $ENV{'HTTP_REFERER'}\n";
		print gb "MAIL > $req{'MAIL'}\n";
		print gb "NICK > $req{'NICK'}\n";
		print gb "PAGE > $req{'PAGE'}\n";
		print gb "MSG > $req{'MSG'}\n";
		@time = localtime(time);
		@time[0] = (@time[0] < 10) ? "0".@time[0] : @time[0];
		@time[1] = (@time[1] < 10) ? "0".@time[1] : @time[1];
		@time[2] = (@time[2] < 10) ? "0".@time[2] : @time[2];
		@time[3] = (@time[3] < 10) ? "0".@time[3] : @time[3];
   		@time[4]++;
		@time[4] = (@time[4] < 10) ? "0".@time[4] : @time[4];
        @time[5] = @time[5] + 1900;
		print gb "TIME > @time[3].@time[4].@time[5]&nbsp;@time[2]:@time[1]:@time[0]\n";
		print gb "</gbrec>\n\n";
        close(gb);
		$count++;
        open(st, ">stat.dat") || return $ans."<font color=red>Не могу записать в файл данных!</font><br.\n";
			print st $count."\n";
		close(st);
		$ans .= "Запись успешно добавлена!<br>\n";
        $succAdd = "true";
	}
	else
	{
		$ans .= "<font color=red>Запись не может быть добавлена!</font><br>\n";
        $succAdd = "false";
	}

    return $ans;
}

################################################################################################

sub GuestBook
{
   	my($ans, $i, $str, %current);
	$ans = "\n\n<!-- here guestbook begins -->\n\n";
	open(gb, "guestbook.txt") || sub {$ans .= "<font color=red>Файла записей нет - добавьте хотя бы одну запись!</font><br>\n";};
	$i = 0;
	do
	{
		while (($str = <gb>) && ($str !~ /<gbrec>/i)) {} #нашли начало записи (или конец файла)
		while (($str = <gb>) && ($str !~ /<\/gbrec>/i)) #обработка, пока не конец записи или файла
	    {
		    chomp($str);
		    $current{$`} = $' if ($str =~ / > /); #если подходит под шаблон - добавляем в хеш
		}
		if (%current)
		{
			$i++;
			if ($i >= $_[0] && $i <= $_[1])
			{
				$ans .= "<br>\n";
				$ans .= "<TABLE class='simple' width=90%>\n";
				$ans .= "<TR>\n";
				$ans .= " <TD width=5%>#$i</TD>\n";
				$ans .= " <TD width=10%>$current{'TIME'}</TD>\n";
				$ans .= " <TD width=55%>Господин " . (($current{'MAIL'}) ? "<A href='mailto:".$current{'MAIL'}."'>$current{'NICK'}</A>" : $current{'NICK'}) . " пишет:</TD>\n";
				$ans .= " <TD width=30%>" . (($current{'PAGE'}) ? "<A href='".$current{'PAGE'}."'>страница</A>" : "(нет страницы)") . "</TD>\n";
				$ans .= "</TR>\n";
				$ans .= "<TR>\n";
				$ans .= " <TD colSpan=4>$current{'MSG'}</TD>\n";
				$ans .= "</TR>\n";
				if ($imboss)
				{
				$ans .= "<TR>\n";
				$ans .= " <TD colSpan=1><center><a href=?readfrom=$req{'READFROM'}&readto=$req{'READTO'}&authority=$req{'AUTHORITY'}&action=sanitarize&what=$i>удалить</a></center></TD>\n";
				$ans .= " <TD colSpan=2><center>$current{'Browser'}</center></TD>\n";
				$ans .= " <TD colSpan=1><center>$current{'From'}</center></TD>\n";
				$ans .= "</TR>\n";
				}
				$ans .= "</TABLE>\n";
		    }
		}
		%current = ''; #убили хеш
	}
	until (eof);
	$ans .= "<font color=red>Гостевая книга пуста - добавьте хотя бы одну запись!</font><br>\n" if ($i == 0);
   	close(gb);
	$ans .= "\n\n<!-- here guestbook ends -->\n\n";

	return $ans;
}

################################################################################################

sub SanitarizeGuestBook
{
   	my($ans, $i, $str);
    $ans = "<font color=red>Обработка гостевой книги:</font><br>\n";
    open(newgb,">>guestbook.tmp") || return $ans."<font color=red>Не могу создать новый файл записей!</font><br>\n";
	open(gb, "guestbook.txt") || return $ans."<font color=red>Не могу открыть старый файл записей!</font><br>\n";
	$i = 0;
	$count = 0;
	do
	{
		while (($str = <gb>) && ($str !~ /<gbrec>/i)) {} #нашли начало записи (или конец файла)
		while (($str = <gb>) && ($str !~ /<\/gbrec>/i)) #обработка, пока не конец записи или файла
	    {
		    chomp($str);
		    $current{$`} = $' if ($str =~ / > /); #если подходит под шаблон - добавляем в хеш
		}
		if (%current)
		{
			$i++;
			if ($i != $_[0])
			{
				$count++;
				print newgb "\n<gbrec>\n";
				foreach $key (sort(keys %current))
				{
					print newgb "$key > $current{$key}\n";
				}
				print newgb "<\/gbrec>\n";
		    }
		}
		%current = ''; #убили хеш
	}
	until (eof gb);
	$ans .= "<font color=red>Гостевая книга пуста - нечего обрабатывать!</font><br>\n" if ($i == 0);
   	close(gb);
   	close(newgb);

    unlink "guestbook.txt";
    rename "guestbook.tmp", "guestbook.txt";

	open(st, ">stat.dat") || return $ans."<font color=red>Не могу записать в файл данных!</font><br.\n";
		print st $count."\n";
	close(st);

	return $ans."Обработано $count записей (было $i).\n";
}

################################################################################################

sub Numbers
{
   	my($ans, $i, $k);
  	$ans = "\n\n<!-- here numbers begin -->\n\n";
	$ans .= "<div style='width=90%;'>\n";
	for ($i = 1; $i < $count; $i+=$_[0])
	{
		$k = $i + $_[0];
		$k = $count if $k > $count;
		if ($i >= $req{'READFROM'} && $k <= $req{'READTO'})
		{
			$ans .= "[$i..$k]\n";
		}
		else
		{
	        $ans .= "<a href=?readfrom=$i&readto=$k" . (($imboss) ? "&authority=$req{'AUTHORITY'}" : "") . ">[$i..$k]</a>\n";
	    }
	}
   	$ans .= "</div>\n";
   	$ans .= "\n\n<!-- here numbers end -->\n\n";
   	return $ans;
}

################################################################################################

sub CheckBoss
{
	my($pw,$ans);
	if (open(pwf, "passwd.dat"))
	{
		$pw = <pwf>;
		$ans = ($_[0] eq $pw);
      	close(pwf);
	}
	else
	{
		open(pwf, ">passwd.dat");
		print pwf $_[0];
		$ans = true;
      	close(pwf);
	}
	return $ans;
}

################################################################################################

sub Error
{
	print $_[0];
}

################################################################################################

if ($ENV{'REQUEST_METHOD'} =~ /get/i)
{
	$q = ($ENV{'QUERY_STRING'});
}
if ($ENV{'REQUEST_METHOD'} =~ /post/i)
{
	sysread STDIN, $q = ($ENV{'QUERY_STRING'}), $ENV{'CONTENT_LENGTH'};
}

%req = ReqDecoder($q);

################################################################################################

print "Content-Type: text/html\n\n";
print <<EOF;
<html>
<head>
<title>Гостевая книга</title>
<link rel="stylesheet" href="http://127.0.0.1/physfac/html/style.css" type="text/css">
</head>
<body>
<h1>Гостевая книга</h1>
<h3>Не ругайтесь громко!</h3>
EOF

################################################################################################

$imboss = CheckBoss($req{'AUTHORITY'}) if ($req{'AUTHORITY'});

open(st, "stat.dat") || Error("<font color=red>Файла данных нет - необходимо инициализировать счетчик!</font><br>\n");
	$count = <st>;
   	$count = $& if ($count =~ /\d+/g);
close(st);

$succAdd = "true";

$a = WriteBook if ($req{'ACTION'} =~ /add/i);

$b = SanitarizeGuestBook($req{'WHAT'}) if ($req{'ACTION'} =~ /sanitarize/i && $imboss);

if (!$req{'READFROM'} || !$req{'READTO'} || $req{'READFROM'} > $count || $req{'READFROM'} > $req{'READTO'})
{
	$req{'READFROM'} = $count - int($count/20) - 10;
	$req{'READTO'} = $count;
}

print "<hr>";
print Numbers(int($count/20) + 10);
print "<hr>";

print "$b<hr>" if ($b);
print GuestBook($req{'READFROM'}, $req{'READTO'});

print "<hr>";
print Numbers(int($count/20) + 10);
print "<hr>";
print "<a href=?action=sanitarize&authority=boss>|Почистить книгу|</a><a href=?>|Выйти из режима хозяина|</a><hr>" if ($imboss);
print "$a<hr>" if ($a);

################################################################################################

if ($succAdd eq "true")
{
print <<EOF;

Добавьте новую запись:
<form action=http://127.0.0.1/cgi-bin/scr.cgi method=post>
<table class='simple'>
  <tr>
    <td><center>ваше имя:<input name=nick><font color=#f09900>*</font></center></td>
    <td rowspan=4><textarea cols=50 name=msg rows=7 width="100%"></textarea><font color=#f09900>*</font></td>
  <tr>
    <td><center>ваш mail:<input name=mail></center></td>
  </tr>
  <tr>
    <td><center>страница:<input name=page></center></td>
  </tr>
  <tr>
    <td><center><font color=#f09900>*</font> - обязательные
      поля</center></td>
  </tr>
  <tr>
    <td colspan=2>
    <center>
    <input name=action type=hidden value=add>
    <input type=submit value="добавить запись">
    </center>
    </td>
  </tr>
</table>
</form>

EOF
}
else
{
$req{'MSG'} =~ s/<br>/\n/g;
print <<EOF;

Исправьте свою запись:
<form action=http://127.0.0.1/cgi-bin/scr.cgi method=post>
<table class='simple'>
  <tr>
    <td><center>ваше имя:<input name=nick value="$req{'NICK'}"><font color=#f09900>*</font></center></td>
    <td rowspan=4><textarea cols=50 name=msg rows=7 width="100%">$req{'MSG'}</textarea><font color=#f09900>*</font></td>
  <tr>
    <td><center>ваш mail:<input name=mail value="$req{'MAIL'}"></center></td>
  </tr>
  <tr>
    <td><center>страница:<input name=page value="$req{'PAGE'}"></center></td>
  </tr>
  <tr>
    <td><center><font color=#f09900>*</font> - обязательные
      поля</center></td>
  </tr>
  <tr>
    <td colspan=2>
    <center>
    <input name=action type=hidden value=add>
    <input type=submit value="добавить запись">
    </center>
    </td>
  </tr>
</table>
</form>

EOF
}

################################################################################################

print <<EOF;
<hr>
<p>О всех ошибках просьба сообщать на e-mail: <A href="mailto:aks\@nm.ru?subject=webmaster">aks\@nm.ru</a></p>
</body>
</html>
EOF

################################################################################################