[posting.cgi]
--
#!/usr/local/bin/perl
use strict;
use Fcntl ':flock';
require "./webtool.pl";
require "./tree.pl";
require "./jcode.pl";
;##                                           ##
;## Copyright (C) 2002 by Junro YOSHINO       ##
;##                                           ##
;## Bulletin Board System; handler of posting ##
;##                                           ##
;#--------------------------------------------------
;# constants
my $GCONF = "./gen.conf";         # configuration file
my $BCONF = "./board.conf";
my $BCGI = "posting.cgi";
my $GCGI = "gen.cgi";
my $CGIDIR = "/cgi-bin/";
my $SITEROOT = "/~ju_y";
my ($_LITERAL, $_LIST, $_SET) = (0, 1, 2);

;# reseive data
my (%decoded_data);
webtool::parse_form_data(\%decoded_data, "POST");
my ($th) = ($decoded_data{"th"} =~ /([\d+])/);
my ($board) = ($decoded_data{"board"} =~ /([\d\w]+)/);
my $name = $decoded_data{"name"};
my $email = $decoded_data{"email"};
my $mes = $decoded_data{"mes"};

_error("Request Error: Invalid Thread No.: $th") if $th <= 0; 

;# get configuration 1
my $count = 0;
open(BFILE, "<" . $BCONF)
 || _error("File Error: Open Failed: board configuration");

my ($bconf_name, $bconf_type, @bconf_param);
tree::parse_treeroot(\*BFILE, \$bconf_name, \$bconf_type, \@bconf_param, \$count) 
 || _error("Data Error: Violation Found: at $BCONF line $count");

_error("Data Error: Not Configuration File: $BCONF")
  if($bconf_type != $_SET || $bconf_name ne "bconf");

my $bconf_ref = {'*NAME*' => "bconf"};
tree::parse_tree(\*BFILE, $bconf_ref, \$count, @bconf_param)
 || _error("Data Error: Violation Found: at $BCONF line $count");

;# the following structure required:
;# bconf/-+-(board id):-+-(id for gen)
;#        |             +-(Th1 name)
;#        |             +-(Th2 name)
;#        |             +-...
;#        +-...
close BFILE;

exists $bconf_ref->{$board}
 || _error("Request Error: Board Not Found: $board");
my $bid = tree::element_at($bconf_ref, "$board/1");

;# get configuration2
$count = 0;
open(GFILE, "<" . $GCONF)
 || _error("File Error: Open Failed: generator configuration");

my ($gconf_name, $gconf_type, @gconf_param);
tree::parse_treeroot(\*GFILE, \$gconf_name, \$gconf_type, \@gconf_param, \$count) 
 || _error("Data Error: Violation Found: at $GCONF line $count");

_error("Data Error: Not Configuration File: $GCONF")
  if($gconf_type != $_SET || $gconf_name ne "conf");

my $gconf_ref = {'*NAME*' => "conf"};
tree::parse_tree(\*GFILE, $gconf_ref, \$count, @gconf_param)
 || _error("Data Error: Violation Found: at $GCONF line $count");

;# the following structure required:
;# conf/-+-(entry id):-+-(name of directory containing datafiles)
;#       |             +-(name of indexfile)
;#       +-...
close GFILE;

exists $gconf_ref->{$bid}
  || _error("Data Error: Confliction Found: between board and generator configurations");

my ($path, $indexfile)
    = (
       tree::element_at($gconf_ref, "$bid/1"),
       tree::element_at($gconf_ref, "$bid/2")
      );

;# parse index tree
$count = 0;

open(IFILE, "+<" . $path . $indexfile)
 || _error("File Error: Open Failed: $path$indexfile");
flock(IFILE, LOCK_EX);

my ($root_name, $root_type, @root_param);
tree::parse_treeroot(\*IFILE, \$root_name, \$root_type, \@root_param, \$count)
 || _error("Data Error: Violation Found: at $path$indexfile line $count");

_error("Data Error: Not Index File: $path$indexfile")
  if($root_type != $_SET || $root_name ne "root");

my $root_ref = {'*NAME*' => "root"};
tree::parse_tree(\*IFILE, $root_ref, \$count, @root_param)
 || _error("Data Error: Violation Found: at $path$indexfile line $count");

;# the following structure required:
;# root/-+-files/   -+-(message id):---(real filename)
;#       |           +-...
;#       +-(iname): -+-(thread id): -+-(message id)
;#       |           |               +-...
;#       |           +-...
;#       +-control/ -+-indexname:   ---(iname)
my $iname = tree::element_at($root_ref, "control/indexname/");

;# get infomation about target board/thread
my $targetth = tree::element_at($root_ref, "$iname/Th$th");
defined($targetth) || _error("Request Error: No Such Thread: Th$th");
my($lastmes) = ($targetth->[1] =~ /Mes([\d]+)/);

_error("Request Error: このスレッドにはこれ以上書き込めません。") if $lastmes <=0;
my $currentmes = $lastmes + 1;

;# prepare data
jcode::convert(\$name, "euc", "", "z");
jcode::convert(\$email, "euc", "", "z");
if(($email !~ m{^[\d\w\-]+\@[\w\-\.\d]+$})
    && ($email !~ m{^[\d\w\-]+$})){
 $email = "";
}
jcode::convert(\$mes, "euc", "", "z");
$mes =~ s{\n}{<br />}g;
$mes =~ s/\n//g;
$mes =~ s/\r//g;
$name = "Anonymous visitor" if $name eq "";
my @times = localtime;
my $currentdate = sprintf("%s %02u, %04u (%s)",
                    (                     ["Jan.", "Feb.", "Mar.", "Apr.", "May", "Jun.", "Jul.",
                      "Aug.", "Sep.", "Oct.", "Nov.", "Dec."]->[$times[4]],
$times[3], 
                     $times[5] + 1900,
                     ["Sunday", "Monday", "Tuesday", "Wednesday",
                      "Thursday", "Friday", "Saturday"]->[$times[6]]));
my $currenttime = sprintf("%02u:%02u:%02u JST",
                     ($times[2],
                      $times[1],
                      $times[0]));
if ($ENV{'REMOTE_HOST'} eq "" ||
    $ENV{'REMOTE_HOST'} eq $ENV{'REMOTE_ADDR'}){
    $ENV{'REMOTE_HOST'} =
      gethostbyaddr(pack('C4', split(/\./, $ENV{'REMOTE_ADDR'})), 2) ||
      $ENV{'REMOTE_ADDR'};
}

;# compare current message with last message
my $lastmesname = tree::element_at($root_ref, "files/$targetth->[1]/");
$count = 0;
open(LFILE, "<" . $path . $lastmesname)
 || _error("File Error: Open Failed: $path$lastmesname");

my ($l_name, $l_type, @l_param);
tree::parse_treeroot(\*LFILE, \$l_name, \$l_type, \@l_param, \$count) 
 || _error("Data Error: Violation Found: at $path$lastmesname line $count");

_error("Data Error: Not Message File: $path$lastmesname")
  if($l_type != $_SET || $l_name ne "leaf");

my $l_ref = {'*NAME*' => "leaf"};
tree::parse_tree(\*LFILE, $l_ref, \$count, @l_param)
 || _error("Data Error: Violation Found: at $path$lastmesname line $count");

;# the following structure required:
;# leaf /-+-(message id)/-+-id:   ---(id)
;#                        +-email:---(email)
;#                        +-name: ---(name)
;#                        +-date: ---(date)
;#                        +-time: ---(time)
;#                        +-mes:  ---(message)
;#                        +-host: ---(remote host name)
;#                        +-addr: ---(remote host ip address)
close LFILE;

tree::element_at($l_ref, "Mes$lastmes/addr/") ne $ENV{'REMOTE_ADDR'}
 || tree::element_at($l_ref, "Mes$lastmes/name/") ne $name
 || tree::element_at($l_ref, "Mes$lastmes/email/") ne $email
 || tree::element_at($l_ref, "Mes$lastmes/mes/") ne $mes
 || _error("Request Error: 何か違うこと書いてくださいよぉ。");

;# write message to file
my $c_ref = {
             '*NAME*' => "leaf", 
             "Mes$currentmes" => {
                                  '*NAME*' => "Mes$currentmes",
                                  "id" => ["id", $currentmes],
                                  "email" => ["email", $email],
                                  "name" => ["name", $name],
                                  "mes" => ["mes", $mes],
                                  "date" => ["date", $currentdate],
                                  "time" => ["time", $currenttime],
                                  "host" => ["host", $ENV{'REMOTE_HOST'}],
                                  "addr" => ["addr", $ENV{'REMOTE_ADDR'}]
                                 }
            };
my $currentfilename = "Th$th/message" . $currentmes . ".dat";
open(DFILE, ">" . $path . $currentfilename)
  || _error("File Error: Cannot Create $path$currentfilename");
flock(DFILE, LOCK_EX);
tree::construct_tree(\*DFILE, $c_ref);
close DFILE;
chmod 0400, $path.$currentfilename;
;# update configuration
my $cmes = "Th$th" . "Mes$currentmes";
$root_ref->{"files"}->{$cmes} =  [$cmes, $currentfilename];
my $arraysize = $#{$targetth};
for(my $i = $arraysize; $i >= 1; $i --){
  $targetth->[$i + 1] = $targetth->[$i];
}
$targetth->[1] = $cmes;

seek(IFILE, 0, 0);
truncate(IFILE, 0);
tree::construct_tree(\*IFILE, $root_ref) || _error("Internal Error:");
close IFILE;

webtool::url_encode(\$decoded_data{'name'});
webtool::url_encode(\$decoded_data{'email'});

print "Location: http://$ENV{'SERVER_NAME'}$SITEROOT$CGIDIR$GCGI?name=$bid\&top=0\&cat=Th$th\&th=$th\&yname=$decoded_data{'name'}\&email=$decoded_data{'email'}\n\n";
exit(0);

sub _error{
    my ($errmes) = @_;
    webtool::url_encode(\$decoded_data{'name'});
    webtool::url_encode(\$decoded_data{'email'});
    webtool::url_encode(\$decoded_data{'mes'});

    print "Content-type: text/html; charset=euc-jp\n\n";
    print <<ENDQ;
    <?xml version="1.0" encoding="euc-jp"?>
    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transisional//EN"
      "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
    <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja">
      <head>
        <title>Error</title>
      </head>
      <body>
        <p>$errmes</p>
        <p><a href="./$GCGI?name=$bid\&amp\;top=0\&amp\;cat=Th$th\&amp\;th=$th\&amp\;yname=$decoded_data{'name'}\&amp\;email=$decoded_data{'email'}\&amp\;mes=$decoded_data{'mes'}">戻る</a></p>
      </body>
    </html>
ENDQ

    exit(0);
}
--
Copyright (C) Junro YOSHINO <yoshinok@muf.biglobe.ne.jp>