#!/usr/local/bin/perl

# ↑上記の perl へのパスはサーバーによって異なります。
# ご自分の環境に合うように書き換えてください。
# Hi-HO, biglobe の場合は、#!/usr/local/bin/perl5 になります。

#--------------------------------------------
# 超ぷち
# Copyright(c) ミスキタ
# webmaster@misskita.com
# http://www.misskita.com/cgi/ できるCGI
#--------------------------------------------

$ver = '超ぷち v0.3b3';

# --- ここから管理者設定項目 ---
$data_dir    = "chopetit";		# データーディレクトリ
$log_file    = "chopetit.log";	# ログファイル名
$log_max     = 5;				# ログ保存数
$len_msg     = 100;				# メッセージの文字数制限

$cookie_name = "chopetit";		# クッキー名
$lock_dir    = "lock/lock";		# ロックディレクトリ

# 超ぷちを表示するページのURL(http:// からの記入も可)
$location    = "./";

# 日付の表示形式
$date_format = "mm/dd(wj) HH:MM";

# スクリプト名 (表示させるページが別サーバーの場合、http:// から指定すること)
$script = $ENV{'SCRIPT_NAME'};

# 書き込みを拒否するホスト名
# ホスト名が取得できないサーバーの場合は、IPアドレスで記入
@deny = ();

# 書き込みを拒否した場合に表示するメッセージ
$deny_message = '書き込みが拒否されました<BR>管理者にお問合せください';
# --- ここまで ---

sub read_html {
# ------------------------------------------------------------------------
# メッセージの表示形式
# フォントのサイズや色などはここで指定してください
# ダブルクォーテーション(")を使うとエラーになるので注意
# <KOROSCRIPT>〜</KOROSCRIPT>の間は、表示されません
# ------------------------------------------------------------------------

	$t_boader  = '#CCCCFF';	# テーブル枠の色
	$td_color1 = '#FFFFFF';	# テーブルの色(1行目)
	$td_color2 = '#EEEEFF';	# テーブルの色(2行目)
	$d_color   = '#FF8000';	# 日付の色
	$m_color   = '#000000';	# メッセージの色
	$n_color   = '#0000FF';	# 名前の色

$html = <<'HTML';
<TABLE BORDER=0 CELLSPACINT=0 CELLPADDING=0 WIDTH=80%><TR><TD BGCOLOR='$t_boader'>
<TABLE BORDER=0 CELLSPACING=2 CELLPADDING=2>
<!-- CHOP -->
<KOROSCRIPT>
<!--
# 一行ごとにテーブルの色を変えるためのスクリプト
$td_color = $td_color eq $td_color1? $td_color2: $td_color1;
-->
</KOROSCRIPT>
<TR>
<TD BGCOLOR=$td_color VALIGN=TOP NOWRAP><FONT COLOR='$d_color'>$date</FONT></TD>
<TD BGCOLOR=$td_color WIDTH=100%><FONT COLOR='$m_color'>$message</FONT>
 <FONT COLOR='$n_color'>($name)</FONT></TD>
</TR>
<!-- CHOP -->
</TABLE>
</TD></TR></TABLE>
<TABLE><TR>
<FORM ACTION='$script' METHOD='post'>
<INPUT TYPE='hidden' NAME='log' VALUE='$in{'log'}'>
<TD STYLE='font-size:9pt; color=#8080FF' ALIGN=CENTER>+ name +</TD>
<TD STYLE='font-size:9pt; color=#8080FF' ALIGN=CENTER>+ message +</TD>
<TD>&nbsp;</TD>
</TR><TR>
<TD><INPUT TYPE='text' NAME='name' VALUE='$COOKIE{'name'}' SIZE=8></TD>
<TD><INPUT TYPE='text' NAME='message' SIZE=20></TD>
<TD NOWRAP><INPUT TYPE='submit' VALUE='送信' STYLE='
background   : #DDDDFF;
border-bottom: #8080FF 1px solid;
border-left:   #8080FF 1px solid;
border-right:  #8080FF 1px solid;
border-top:    #8080FF 1px solid;
cursor:        hand'>
&nbsp;【<A HREF='http://www.misskita.com/cgi/' TARGET='_blank'>超ぷち</A>】
</TD></FORM></TR></TABLE>
HTML
}

# ----------------------------------------------------------
# これ以降は、触らない方がいいかも．．．
# ----------------------------------------------------------
if ($ENV{'REQUEST_METHOD'} eq "POST") {
	$post = 1;
	read(STDIN, $query, $ENV{'CONTENT_LENGTH'});
} else {
	$query = $ENV{'QUERY_STRING'};
}
%in = split /&|=/, $query;
foreach (keys %in) {
	$in{$_} =~ tr/+/ /;
	$in{$_} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
	$in{$_} =~ s/&/&amp;/g;
	$in{$_} =~ s/"/&quot;/g;
	$in{$_} =~ s/</&lt;/g;
	$in{$_} =~ s/>/&gt;/g;
	$in{$_} =~ s/\x0D\x0A/<BR>/g;
	$in{$_} =~ s/\x0D/<BR>/g;
	$in{$_} =~ s/\x0A/<BR>/g;
}

$in{'log'}  =~ tr/\///d;
$in{'form'} =~ tr/\///d;

$in{'log'} and $log_file = "$in{'log'}.log";
$lock_dir .= ".$log_file";

if ($in{'form'}) {
	eval { require "$data_dir/$in{'form'}.html" };
	$@ and error($@);
} else {
	read_html();
}

($head, $body, $foot) = split /\n?<!-- CHOP -->\n?/, $html;

if ($in{'message'}) {
	$in{'name'} or error_html("お名前を入力してください");
	if (length($in{'message'}) > ($len_msg * 2)) {
		error_html("メッセージが長すぎます<BR>全角で$len_msg文字以下にして下さい");
	}
	date_now();
	get_host();
	access_deny();

	$line = "$date\t$in{'name'}\t$in{'message'}\t$host\n";
	my_flock();
	open LOG, "$data_dir/$log_file" or error_html("ログファイルが開けません $data_dir/$log_file");
	@data = <LOG>;
	close LOG;
	unshift(@data, $line);
	splice(@data, $log_max);
	open  LOG, ">$data_dir/$log_file" or error_html("ログファイルに書き込めません $data_dir/$log_file");
	print LOG @data;
	close LOG;
	my_funlock();

	($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+60*24*60*60);
	@month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	@week  = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
	$gmt = sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",
	       $week[$wday],$mday,$month[$mon],$year+1900,$hour,$min,$sec);
	$in{'name'} =~ s/;/%3B/g;
	$in{'name'} =~ s/=/%3D/g;
	$cookie = "name<>$in{'name'}";
	print "Set-Cookie: $cookie_name=$cookie; expires=$gmt\n";
	location($location);
}

$post and location($location);

open LOG, "$data_dir/$log_file" or error("ログファイルが開けません $data_dir/$log_file");
@data = <LOG>;
close LOG;

%TEMP   = split /; *|=/, $ENV{'HTTP_COOKIE'};
%COOKIE = split /<>/,  $TEMP{$cookie_name};
$in{'name'} and $COOKIE{'name'} = $in{'name'};
$COOKIE{'name'} =~ s/%3B/;/g;
$COOKIE{'name'} =~ s/%3D/=/g;

print_header();

if ($in{'mode'} eq 'ssi') {
	print "<!-- $ver http://www.misskita.com/cgi/ -->\n";
} else {
	print "<!--\n";
	print "/* $ver */\n";
}

print_html($head);
foreach (@data) {
	chomp;
	($date, $name, $message, $host) = split /\t/;
	print_html($body);
}
print_html($foot);

if ($in{'mode'} eq 'ssi') {
	print "<!-- 超ぷち ここまで -->\n";
} else {
	print "//-->\n";
}

sub date_now {
	$ENV{'TZ'} = "JST-9";
	$time = time;
	($sec,$min,$hour,$day,$month,$year,$wday) = localtime($time + ($time_difference * 3600));
	$year  += 1900;
	$month ++;
	$date_format =~ /AM\/PM|午前\/午後/ and $use_ap = 1;

	($S,$M,$H,$d,$m,$yyyy) = ($sec,$min,$hour,$day,$month,$year);
	$yy = sprintf "%02d", $yyyy - 2000;
	$mm = sprintf "%02d", $m;
	$dd = sprintf "%02d", $d;
	if ($use_ap) {
		if ($H < 12) { $ap = "AM"; $apj = "午前"; }
		else         { $ap = "PM"; $apj = "午後"; $H -= 12; }
		$H or $H = 12;
	}
	$HH = sprintf "%02d", $H;
	$MM = sprintf "%02d", $M;
	$SS = sprintf "%02d", $S;

	@mmm   = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
	@mmmm  = qw(January February March April May June July August September October November December);

	@wwe = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
	@we  = qw(Sun Mon Tue Wed Thu Fri Sat);
	@wj  = qw(日 月 火 水 木 金 土);

	$_ = $date_format;
	s/AM\/PM/\0/g;
	s/午前\/午後/$apj/g;
	s/(H+)/${$1}/g;
	s/(M+)/${$1}/g;
	s/(S+)/${$1}/g;
	s/\0/$ap/g;
	s/((?:yy)+)/${$1}/g;
	s/(mmm+)/${$1}[$m - 1]/g;
	s/(m+)/${$1}/g;
	s/(d+)/${$1}/g;
	s/(we|wwe|wj)/${$1}[$wday]/g;
	$date = $_;
}

sub get_host {
	$host = $ENV{'REMOTE_HOST'};
	$addr = $ENV{'REMOTE_ADDR'};
	if ($host eq "" || $host eq "$addr") {
		$host = gethostbyaddr(pack("C4", split(/\./, $addr)), 2);
	}
	if ($host eq "") { $host = $addr; }
}

sub access_deny {
	foreach (@deny) {
		s/\./\\./g;
		s/\*/\.\*/g;
		$host =~ /$_/i and error_html($deny_message);
	}
}

sub location {
	my $location = shift;
	print "Location: $location\n\n";
	print "Content-type: text/html\n\n";
	print <<HTML;
<HTML><HEAD>
<META HTTP-EQUIV="Refresh" CONTENT="0;URL=$location">
<TITLE>超ぷち</TITLE>
</HEAD>
<BODY><A HREF="$location">戻る</A></BODY>
</HTML>
HTML
exit;
}

sub print_header {
	print "Pragma: no-cache\n";
	print "Cache-Control: no-cache\n";
	print "Expires: 0\n";
	print "Content-type: text/html; charset=SHIFT_JIS\n\n";
}

sub print_html {
	$_ = shift;
	while (s/<KOROSCRIPT>\n*(?:<!--)?((?:.|\n)*?)\n*(?:-->)?\n*<\/KOROSCRIPT>//) {
		eval($1);
		$@ and print_html("ERROR: $@");
	}
	s/\$(\w+?){'(.+?)'}/${$1}{$2}/g;
	s/\$(\w+)/${$1}/g;
	if ($in{'mode'} eq 'ssi') {
		print;
	} else {
		tr/\n//d;
		print "document.write(\"$_\");\n";
	}
}

sub my_flock {
	$locked = 0;
	my $n   = 5;
	foreach ( 1 .. $n ) {
		if (mkdir($lock_dir, 0755)) { $locked = 1; return; }
		elsif ($_ == 1) { rmdir($lock_dir) if (time - (stat($lock_dir))[9] > 60); }
		elsif ($_ < $n) { sleep 1; }
	}
	error_html("ファイルロックエラーです<BR>$lock_dir");
}

sub my_funlock { rmdir($lock_dir) if $locked; }

sub error {
	my_funlock();
	print_header();
	if ($in{'mode'} eq 'ssi') {
		print "<!-- $ver -->\n";
		print "<FONT COLOR=RED>@_</FONT>";
	} else {
		print "<!--\n";
		print "/* $ver */\n";
		print_html("<FONT COLOR=RED>@_</FONT>");
		print "//-->\n";
	}
	exit;
}

sub error_html {
	my_funlock();
	print_header();
	print <<HTML;
<HTML>
<HEAD>
<TITLE>超ぷち - ERROR</TITLE>
<STYLE type=text/css>
<!--
BODY,TD,TH { font-size:10pt }
A          { text-decoration:none }
A:link     { color=blue;     text-decoration:none }
A:visited  { color=darkblue; text-decoration:none }
A:hover    { color=brown;    text-decoration:none }
}
-->
</STYLE>
</HEAD>
<BODY>
<CENTER>
<B><FONT COLOR="#FF0000">■</FONT> ERROR <FONT COLOR="#FF0000">■</FONT></B>
<BR><BR>@_<BR><BR>
<HR><BR>
<!-- $ver -->
<A HREF="http://www.misskita.com/cgi/" TARGET="_top">超ぷち</A>
</CENTER>
</BODY></HTML>
HTML
	exit;
}

__END__
■ 更新履歴 ■
2001/06/02     b3 キャッシュ対策
2001/05/28     b2 キャッシュコントロール追加(再)
2001/05/16     b1 セキュリティー向上
2001/05/09 v0.3b  マルチログ化, スキン採用, ロック処理追加 など
2001/04/27        説明文修正＆追加
2001/04/26 v0.2b  公開