#!/usr/local/bin/perl

#
#       簡易掲示板スクリプト stlfbbs.cgi
#         Ver.1.12 (09/21/99 modified)
#    by Naoto Mochizuki(stlf@blk.mmtr.or.jp)
# <URL> http://www.blk.mmtr.or.jp/~stlf/softwares/
#

# 設定ファイル、jcode.plのインクルード

require './stlfbbs.ini';
require $jcscript;

# フォームデータを受け取る

if ($ENV{'REQUEST_METHOD'} eq "POST") {
	read(STDIN, $form_info, $ENV{'CONTENT_LENGTH'}); }
else {
	$form_info = $ENV{'QUERY_STRING'}; }

# フォームデータのデコード

@key_value_pairs = split(/&/, $form_info);

foreach $key_value (@key_value_pairs) {
	($key, $value) = split(/=/, $key_value);
	$value =~ tr/+/ /;
	$value =~ s/%([\dA-Fa-f][\dA-Fa-f])/pack("C", hex($1))/eg;

	&jcode'convert(*value,'sjis');

	$value =~ s/&/&amp;/g;
	$value =~ s/</&lt;/g;
	$value =~ s/>/&gt;/g;
	$value =~ s/"/&quot;/g;

	$value =~ s/ ;; /　;;　/g;
	$value =~ s/  /　/g;

	$FORMDAT{$key} = $value;
}

if ($FORMDAT{'vnum'} =~ /^\d+$/) { $vnum = $FORMDAT{'vnum'}; }
else { $vnum = $subnum; }

$name = $FORMDAT{'name'};
$addr = $FORMDAT{'addr'};
$url = $FORMDAT{'url'};
$subj = $FORMDAT{'subj'};
$note = $FORMDAT{'note'};
$cookie = $FORMDAT{'cookie'};
$mode = $FORMDAT{'mode'};

if ($clkurl eq 'on') {
	$note =~ s/(http:\/\/[\w\.\/\~\-\+\=\#\%\&\?\(\)]+)/<A HREF="$1" TARGET="_blank">$1<\/A>/ig;
}

if ($taguse eq 'on') { $note =~ s/&lt;(\/?(B|I|S|U))&gt;/<$1>/ig; }

$name =~ s/\r|\n//g;
$addr =~ s/\r|\n//g;
$url =~ s/\r|\n//g;
$subj =~ s/\r|\n//g;

$note =~ s/\r\n/<BR>/g;
$note =~ s/\r|\n/<BR>/g;
$note =~ s/(<BR>)*$//;

if ($addr !~ /.+\@.+\..+/) { $addr = ''; }
if ($url !~ /http:\/\/.{3,}/) { $url = ''; }

if ($mode eq 'reg') {
	if ($note ne '') { &regist; }
	&mkcook;
} else { &cookie; }

if ($url eq '') { $url = 'http://'; }
if ($name eq '') { $cook = 'CHECKED'; } else { $cook = ''; }

# ファイルをロック

if ($lock ne 'off') { &filelock; }

# ログファイルを開く

open(LOGFILE, $logfile) || &return_error('stlfbbs', 'ログファイルが開けません。壊れている可能性があります。');
@logs = <LOGFILE>;
close(LOGFILE);

# 出力HTMLファイル(1)を開く

open(OPUT, $output_html) || &return_error('stlfbbs', '出力HTMLファイル(1)が開けません。壊れている可能性があります。');
@stlfoput = <OPUT>;
close(OPUT);

# 出力HTMLファイル(2)を開く

open(SPUT, $suboutput_html) || &return_error('stlfbbs', '出力HTMLファイル(2)が開けません。壊れている可能性があります。');
@stlfsput = <SPUT>;
close(SPUT);

# ファイルをアンロック

if ($lock ne 'off') { unlink($lockfile); }

# HTML生成

if ($#logs >= $vnum) { $#logs = $vnum - 1; }
chop(@logs);

print 'Content-type: text/html', "\n";
print 'Pragma: no-cache', "\n\n";

foreach $line (@stlfoput) {
	if ($line =~ /<!--bbslog_include-->/i) {
		foreach $log (@logs) {
			($s_name, $s_addr, $s_url, $s_subj, $s_note, $s_date, $s_res) = split(/ ;; /,$log);
			if ($s_url ne '') {
				$s_url = '(<A HREF="' . $s_url . '" TARGET="_top">URL</A>)';
			}
			if ($s_addr ne '') {
				$s_name = '<A HREF="mailto:' . $s_addr . '">' . $s_name . '</A>';
			}
			@puttemp = @stlfsput;
			foreach $inline (@puttemp) {
				$inline =~ s/name<!--s-->/$s_name/i;
				$inline =~ s/\(URL\)<!--s-->/$s_url/i;
				$inline =~ s/subj<!--s-->/$s_subj/i;
				$inline =~ s/note<!--s-->/$s_note/i;
				$inline =~ s/date<!--s-->/$s_date/i;
				$inline =~ s/res<!--s-->/$s_res/i;
				print $inline;
			}
		}
	} else {
		$line =~ s/(NAME="name")/$1 VALUE="$name"/i;
		$line =~ s/(NAME="addr")/$1 VALUE="$addr"/i;
		$line =~ s/(NAME="url")/$1 VALUE="$url"/i;

		$line =~ s/(NAME="cookie")/$1 $cook/i;

		$line =~ s/vnum<!--s-->/$vnum/i;
		print $line;
	}
}

exit;

# End of Mainstream


# Cookieデータのデコード

sub cookie {
	@key_value_pairs = split(/;\s/, $ENV{'HTTP_COOKIE'});

	foreach $key_value (@key_value_pairs) {
		($key, $value) = split(/=/, $key_value);

		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

		&jcode'convert(*value,'sjis');

		$cookie_data{$key} = $value;
	}

	@pairs = split(/,/,$cookie_data{$cookid});

	foreach $pair (@pairs) {
		($key, $value) = split(/ \^n /, $pair);
		$cookie{$key} = $value;
	}

	$name = $cookie{'name'};
	$addr = $cookie{'addr'};
	$url = $cookie{'url'};
}

# 登録サブルーチン

sub regist {
	# 日付の取得

	($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
	$mon = $mon + 1;
	$thisday = (Sun,Mon,Tue,Wed,Thu,Fri,Sat) [$wday];
	$year += 1900;
	$time_string = sprintf("%02d/%02d/%04d (%s) %02d:%02d:%02d", $mon, $mday, $year, $thisday, $hour, $min, $sec);

	# 記録データをパック

	if ($name eq '') { $rname = $ENV{'REMOTE_ADDR'}; }
	else { $rname = $name; }

	$registlog = join(' ;; ', $rname, $addr, $url, $subj, $note, $time_string, '');

	# ファイルをロック

	if ($lock ne 'off') { &filelock; }

	# ログファイルに記録

	open(LOGFILE, $logfile) || &return_error('stlfbbs', 'ログファイルが開けません。壊れている可能性があります。');
	@logs = <LOGFILE>;
	close(LOGFILE);

	unshift (@logs, $registlog . "\n");
	$#logs = $max - 1;

	open(LOGFILE, ">$logfile") || &return_error('stlfbbs', 'ログファイルが開けません。壊れている可能性があります。');
	print LOGFILE @logs;
	close(LOGFILE);

	# ファイルをアンロック

	if ($lock ne 'off') { unlink($lockfile); }
}

# Cookieヘッダの出力

sub mkcook {
	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + 2*30*24*60*60);

	$thisday = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday)[$wday];
	$month = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec)[$mon];
	$year += 1900;

	$date_gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT", $thisday, $mday, $month, $year, $hour, $min, $sec);

	if ($cookie eq 'on') {
		print "Set-Cookie: $cookid=name \^n $name\,addr \^n $addr\,url \^n $url; expires=$date_gmt\n";
	} else { &cookie; }
}

# ファイルロックサブルーチン

sub filelock {
	local($retry) = 9;
	while (!symlink(".", $lockfile)) {
		if (--$retry <= 0) { &return_error('stlfbbs', 'ファイルがロックされています。続けてこの表示が出る場合はロックファイルが壊れている可能性があります。'); }
	sleep(2);
	}
}

# エラー時処理サブルーチン

sub return_error {
	local($location, $message) = @_;

	print 'Content-type: text/html', "\n";
	print 'Pragma: no-cache', "\n\n";

	print '<HTML><HEAD><TITLE>500 CGI internal Error</TITLE></HEAD>', "\n";
	print '<BODY><H1>500 CGI internal Error</H1>', "\n";
	print $location, 'で内部エラーが発生しました。<BR><BR>', "\n";
	print 'Please contact the webmaster, ', $webmaster, "\n";
	print 'and inform them of the time occurred, and', "\n";
	print ' anything you might have done that may have caused the error.<BR><BR>', "\n";
	print '<B>Error:', $message, '</B><BR><BR>', "\n";
	print '</BODY></HTML>', "\n";

	if ($lock ne 'off') { unlink($lockfile); }
	exit;
}

# End of Script