#!/usr/mesh/bin/perl
# *** This file is written by EUC code ***
# *** 3 gyou sita no nihongo ga mojibake suru baaini wa
# *** kono fairu wa EUC to site hirakarete imasen.
# *** EUC kohdo no fairu to shite hiraite kudasai.
#     このファイルはＥＵＣコードで書かれています。
#
# program name : gb_p.cgi (guest book written in EUC Code with password)
#
# function     : (1) count guest number and message number.
#                (2) show form for new message.
#                (3) show messages written on book1 by EUC code.
#                (4) add new message to book1 by EUC code.
#
# note         : This gb_p.cgi is first made by perl ver.4.
#                This cgi is written by EUC code.
# programmer   : makoto takenaka : takesoft@mxs.meshnet.or.jp
#
# copyright    : (c) 1996, 1997 by Makoto Takenaka
#
# version(date):
#     1.0(Jan   6, 1997) gb_sp.cgi (ver.1.0)を元に作成
#     1.1(Jan  12, 1997) Change comments and horizontal lines.
#     1.2(Jan  31, 1997) Add sub wrap to word-wrap $message for the other 
#                        browsers except Netscape Navigator 2.0/3.0
#     1.3(Feb  13, 1997) Change escape codes after sub wrap for $message.
#                        Change to "$year += 1900;", this works well until 
#                        2038/01/19. Change "local($jc) in sub wrap.
#
# calling form : <A HREF="***/gb_p.cgi"> called from other Web page.
#                <FORM METHOD=post ACTION="***/gb_p.cgi"> called from 
#                form in this cgi.
#                *** is URL or directory where gb_p.cgi is placed.
#
#(0) Print type of data and include jcode.pl.
#
   print "Content-type: text/html\n\n";
   require 'jcode.pl';
#
#(1) set constants and initial value.
#
   $limit        = 50000;              # limit of book1 byetes
   $msg_limit    = 2000;               # limit of $message (bytes)
   $msg_limit2   = $msg_limit/2;       # limit of $message (zenkaku chars)
   $line_limit   = 77;                 # limit of bytes in a line
   $home_page    = "../index.html";    # first web page html file
   $pwd          = "./";               # present working directory
   $book1        = $pwd."book1.html";  # file name of book1
   $book2        = $pwd."book2.html";  # file name of book2
   $user_file    = $pwd."user.dat";    # user file name
   $g_count_file = $pwd."g_count.txt"; # number of guests 
   $m_count_file = $pwd."m_count.txt"; # number of messages
#
   $owner_name   = '管理者';           # owner name
#
   $owner_mode   = "";                 # = "yes"; if owner mode.
#
   $line_limit     = $line_limit - 1;  # Adjust $line_limit
   $textarea_limit = $line_limit - 6;  # limit of bytes in line for hard wrap
   if(-e $book1)
      {$book1_byte = (-s $book1);}     # Get size of book1.
   else
      {&error_message("(1): File $book1 is not found.");}
#
   if(-e $book2)
      {$book2_byte = (-s $book2);}     # Get size of book2.
   else
      {&error_message("(1): File $book2 is not found.");}
#
#(2) get parameters from sent data.
#
if ($ENV{'REQUEST_METHOD'} eq "POST")
   {
   read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});  
   }
else
   {
    $buffer = $ENV{'QUERY_STRING'};
   }
#
   @pairs = split(/&/, $buffer);
#

   foreach $pair (@pairs)
      {
      ($pname, $value) = split(/=/, $pair);
      $value =~ tr/+/ /;
      $value =~ s/%([0-9a-fA-F][0-9a-fA-F])/pack("C", hex($1))/eg;
      &jcode'convert(*value, 'euc');  # Convert to EUC code
      if($pname ne 'message')
         {
         $value =~ s/&/&amp;/g;          # Change & to &amp;
         $value =~ s/\x22/&quot;/g;      # Change " to &quot;
         $value =~ s/</&lt;/g;           # Change < to &lt;
         $value =~ s/>/&gt;/g;           # Change > to &gt;
         }
      $value =~ s/\x0D\x0A/\x0A/g;    # Change CR LF to LF
      $value =~ s/\x0D/\x0A/g;        # Change CR to LF
      $parameters{$pname}    = $value;
      }
#
   $name    = $parameters{'name'};
   $upass   = $parameters{'upass'};
   $message = $parameters{'message'};
   if(length($message) > $msg_limit)
      {$message = substr($message, 0, $msg_limit);} # Cut long message.
#
#  Wrap $message if characters in a line is greater than $line_limit.
#
   &wrap(*message, $line_limit);
#
   $message =~ s/&/&amp;/g;             # Change & to &amp;
   $message =~ s/\x22/&quot;/g;         # Change " to &quot;
   $message =~ s/</&lt;/g;              # Change < to &lt;
   $message =~ s/>/&gt;/g;              # Change > to &gt;
#
   if($name eq $owner_name)
      {$owner_mode = "yes";}
#
   ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
   $year += 1900;   # Add 1900, which is valid until 2038/01/19.
   $mon++;
   $thisday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat)[$wday];
   if ($sec  < 10)  {$sec  = "0$sec";}
   if ($min  < 10)  {$min  = "0$min";}
   if ($hour < 10)  {$hour = "0$hour";}
   if ($mday < 10)  {$mday = "0$mday";}
   if ($mon  < 10)  {$mon  = "0$mon";}
#
   $date = "$year/$mon/$mday $thisday $hour:$min:$sec";
#
#(3) Show form and book1 and exit if some data are blank or wrong $upass.
#
#(3.1) Check existance of $name, $upass and $message.
#
   unless($name && $upass && $message)
      {
      &show_html(1);
      exit 0;
      }
#
#(3.2) Check $upass.
#
   open(USER_FILE, "$user_file")
      || &error_message("(3.2):Unable to open $user_file");

   $pass = 0;
   while(<USER_FILE>)
      {
      chop;
      ($namei, $cupass, $mail, $url) = split(/,/);
#
      if($namei eq $name)
         {
         if(crypt($upass, $cupass) eq $cupass){$pass = 2;}
         last;
         }
      }
   if($pass < 1)
      {
      &show_html(10);
      exit 1;
      }
#
#(4) Add new message to book1.
#
#(4.1) Read message number $m_count.
#
   open(COUNTFILE, "$m_count_file")
      || &error_message("(4.1):Unable to open $m_count_file");
   $m_count = <COUNTFILE>;
   $m_count = $m_count + 1;
   close(COUNTFILE);
#
#(4.2) Write new message to book2.
#
   open(BOOK2, "+<$book2")
      || &error_message("(4.2):Unable to open $book2");
   flock(BOOK2, 2);
#
   print BOOK2 "<HR>\n";
   if($url)
      {
      if($owner_mode)
         {
         print BOOK2 "[$m_count]<A HREF=\"$url\">$name </A>";
         }
      else
         {
         print BOOK2 "[$m_count]<A HREF=\"$url\">$name さん</A>";
         }
      }
   else
      {
      print BOOK2 "[$m_count] $name さん ";
      }
   if($mail)
      {
      print BOOK2 "(<A HREF=\"mailto:$mail\">$mail</A>) $date\n";
      }
   else
      {
      print BOOK2 " $date\n";
      }
#
   print BOOK2 "<PRE>\n$message\n</PRE>\n";
#
#(4.3) Add old message in book1 to book2.
#
   open(BOOK1, "+<$book1")
      || &error_message("(4.3):Unable to open $book1");
   flock(BOOK1, 2);
   print(BOOK2 <BOOK1>)
      || &error_message("(4.3):Unable add book1 to book2");
#
   truncate(BOOK2, tell(BOOK2));
#
#(4.4) Copy book2 to book1.
#
   seek(BOOK1, 0, 0);
   seek(BOOK2, 0, 0);
#
   print(BOOK1 <BOOK2>)
      || &error_message("(4.4):Unable copy book2 to book1");
   flock(BOOK1, 8);
   close(BOOK1);
   flock(BOOK2, 8);
   close(BOOK2);
#
#(4.5) Incremet $m_count on $m_count_file.
#      No increment for error between (4.2)-(4.4)
#      Increment to written $m_count because another process may
#      increment $m_count during (4.2)-(4.4).
#
   open(COUNTFILE, "+< $m_count_file")
      || &error_message("(4.5):Unable to open $m_count_file");
   flock(COUNTFILE, 2);
   $m_count = <COUNTFILE>;
   $m_count = $m_count + 1;
   seek(COUNTFILE, 0, 0);
   print COUNTFILE $m_count;
   flock(COUNTFILE, 8);
   close(COUNTFILE);
#
#(5) Show form and messages.
#
   &show_html(0);
   exit 0;                # End of Main Program
#
#  subroutine show_html
#
sub show_html
{
local($incr) = @_; 
#
# $incr = 1 if called from <A> tag, $incr = 0 if called from this form.
# $incr = 10 if $upass error.
#
#(S1) set guest number $g_count.
#
if ($incr == 1)
   {
   open(COUNTFILE, "+< $g_count_file")
      || &error_message("show_html:Unable to open $g_count_file");
   flock(COUNTFILE, 2);
   $g_count = <COUNTFILE>;
   $g_count = $g_count + $incr;
   seek(COUNTFILE, 0, 0);
   print COUNTFILE $g_count;
   flock(COUNTFILE, 8);
   close(COUNTFILE);
   }
else
   {
   open(COUNTFILE, "$g_count_file") 
      || &error_message("show_html:Unable to open $g_count_file");
   $g_count = <COUNTFILE>;
   close(COUNTFILE);
   }
#
#(S2) set message number $m_count.
#
   open(COUNTFILE, "$m_count_file") 
      || &error_message("show_html:Unable to open $m_count_file");
   $m_count = <COUNTFILE>;
   close(COUNTFILE);
#
#(S3) Show head part of guest book page.
#
print <<EOF;
<HTML>
<HEAD>
<TITLE>Guest Book</TITLE>
</HEAD>
<BODY BGCOLOR=\"#CCFFCC\">
<FONT FACE=\"ＭＳ ゴシック\">
[guest# $g_count][message# $m_count][book1 size $book1_byte B]
EOF
# Next line is an example of anchor tag to old message data.
# print "[<A HREF=\"msg100.html\">message 1-100</A>]\n";
print "[<A HREF=\"$home_page\">";
print <<'EOF';
ホームページへ戻る</A>]<BR>
<HR SIZE=3>
<CENTER>
<H1>掲　示　板</H1>
</CENTER>
EOF
#
#(S4) Show form for message. Note: ACTION="gb.cgi" is changed to "gb_p.cgi".
#
if($incr == 10)
 {print "<H2>***名前またはパスワードが違うので、書き込みできません***</H2>\n";}
if($book1_byte < $limit)
   {
   print <<'EOF';
   <HR SIZE=3>
   <FORM METHOD="POST" ACTION="gb_p.cgi">
竹ソフトのWebページに対する御意見御要望をどんどんお書き下さい。下の
”送る”ボタンを押すと送付され、このフォームの下に表示されます。
半角カタカナは文字化けしますので使用しないで下さい。”送る”ボタンを
押してから応答があるまでの間には、”送る”ボタンや再読み込みボタンを
押さないで下さい。二重書き込みになります。
パスワードをお持ちでない方は、お名前、メールアドレス、WebページのURL
(ある場合のみ)をお書きの上メールでお申し込み下さい。<BR><BR>

   お名前(必ず必要)<BR>
EOF
   print <<EOF;
   <INPUT NAME=\"name\" SIZE=40 MAXLENGTH=200 VALUE=\"$name\"><BR>
   パスワード(必ず必要)<BR>
   <INPUT NAME=\"upass\" TYPE=\"password\" SIZE=20 MAXLENGTH=20><BR>
   メッセージ(全角 $msg_limit2 文字まで。
   Netscape Navigator 2.0以上の場合自動改行。その他の場合一行が
   $line_limit バイトを越えると強制改行)<BR>
   <TEXTAREA NAME=\"message\" COLS=$textarea_limit ROWS=5 WRAP=hard></TEXTAREA>
   <BR>
   <INPUT TYPE=\"submit\" VALUE=\"　送る　\">
   <INPUT TYPE=\"reset\" VALUE=\"リセット\"><BR>
   </FORM>
EOF
   }
else
   {
   print <<'EOF';
   <HR SIZE=3>
   申し訳ありません。<BR>
   今は、掲示板ファイルがいっぱいになったか、掲示板ファイルに<BR>
   異常が発生したので書き込めません。<BR>
   またの御利用をお願いします。<BR>
   <HR SIZE=3>
EOF
   }
#
#(S5) Print book1.
#
open(BOOK1, "$book1") 
   || &error_message("show_html:Unable to open $book1");
print <BOOK1>; #print whole book1 to STDOUT.
close(BOOK1);
#
#(S6) Print last part of guest book page.
#
print "<P ALIGN=RIGHT>\n";
# Next line is an example of anchor tag to old message data.
# print "<A HREF=\"msg100.html\">[message 1-100]</A>\n";
print "[<A HREF=\"$home_page\">";
print <<'EOF';
ホームページへ戻る</A>]
</P>
<HR>
<!------------------------------------------------------------------->
<P>
初期設置日：1997年2月13日/最終変更日：1997年2月13日/gb_p (ver.1.3)
</P>
</FONT>
</BODY>
</HTML>
EOF
# END of SUBROUTINE show_html
}
#
# SUBROUTINE wrap
#
sub wrap
{
   local(*msg, $limit) = @_;
#
#  This subroutine wrap $msg, so that each line length is less or equal 
#  to ($limit + 1). Return number of lines in new $msg.
#
   local(@old_lines, @new_lines, @byte_lines, $max, $len, $iline, $i, $line);
   local($jc);
#
#(w1) Set constants.
#
   $jc = '[\241-\376][\241-\376]'; # EUC code
#
#(w2) Split $msg into lines.
#
   @old_lines = split(/\n/, $msg);
#
#(w3) Check length of each lines.
#
   $max = 0;
   foreach $i(0..$#old_lines)
      {
      $len = length($old_lines[$i]);
      $byte_lines[$i] = $len;
      $max = ($max > $len) ? $max : $len ;
      }
#
   if($max <= $limit){return ($#old_lines + 1);}
#
#(w4) Wrap long lines.
#
   $iline = 0; #new line number
#
   foreach $i(0..$#old_lines)
      {
      if($byte_lines[$i] <= $limit)
         {
         $new_lines[$iline] = $old_lines[$i];
         $iline++;
         }
      else
         {
         $line = ''; # Clear $line.
         $len  = 0;
         $_ = $old_lines[$i];
#
         while(length($_))
            {
            $zen_space = int(($limit - $len + 1)/2);
            s/^(($jc){1,$zen_space}|.)// ;
            $line .= $&;
            $len   = length($line);
            if($len >= $limit)
               {
               $new_lines[$iline] = $line;
               $line = '';
               $len  = 0;
               $iline++;
               }
            }
         if($len)
            {
            $new_lines[$iline] = $line;
            $iline++;
            }
         }
      }
   $msg = join("\n", @new_lines);
   $iline; # Return number of lines in new $msg.
}
#
# SUBROUTINE error_message
#
sub error_message
{
   local($msg) = @_;
#
#  print message and stop this perl program.
#
   print $msg;
#
   exit 1;
}