#!/usr/local/bin/perl
# -------------------------------------------------------------------------------------
#
# つぶやき掲示板 ver.β2.4(murmur.cgi)by TED
# E-mail: ted@uranus.interq.or.jp
# URL: http://www.interq.or.jp/uranus/ted/
#
# -------------------------------------------------------------------------------------
#
# ■免責事項
# このスクリプトは製作者(TED)が、pealプログラミングの習作として作成したものです。
# 将来的にはフリー配布することを目指していますが、現在はまだβ版の動作試験の段階です。
# このスクリプトはフリーで使用することができますが、このスクリプトを使用したいかなる
# 損害や不利益も、作者は一切の責任を負わないものとさせて頂きます。
#
# -------------------------------------------------------------------------------------
#
# [基本構成] ( )内はパーミッション値
#
# /public_html/(ホームページディレクトリ)
# |
# |-- /cgi-bin/(任意のディレクトリ)
# |
# |-- jcode.pl (644 or 604)
# |-- murmur.cgi (755 or 705)
# |-- index.html (666 or 606)
# |-- data.cgi (666 or 606)
#
# index.html と data.cgi はテキストエディタ等で空のファイルを用意。
# これら4つののファイルはすべてアスキーモードでアップロードする。
#
# パーミッション設定後、murmur.cgi をブラウザ上から実行する。
# (index.html にタグが書き込まれ、HTML文章として生成される)
#
# 以降、murmur.cgi には記事投稿時のみアクセスし、
# 掲示板のアドレスは index.html に指定すること。
#
## --- 初期設定ここから ---------------------------------------------------------------
# ■管理者記事削除用パスワード(変更して下さい)
$password = "del";
# ■掲示板タイトル(『お気に入り』や『ブックマーク』の保存時タイトルになります)
$title = "MY GuestBook!!";
# ■「終了」先URL
$homepage = 'http://ted.pekori.to/';
# ■このCGIファイルのURL(http://から始まるフルパスで)
$cgifile = './murmurbbs.cgi';
# ■HTML表示ファイルディレクトリ (フルパスの場合 / から)
$HTMLfile = './index.html';
# ■HTML表示ファイルアドレス(フルパスの場合 http://から)
$HTML_URL = './';
## --- 必要に応じて設定 ---------------------------------------------------------------
# ■ログ保存ファイル名
$logfile = 'data.cgi';
# ■ログ保存ファイルディレクトリ(フルパスの場合 / から)
$log_dir = './';
# ■日本語コード変換ライブラリ
require './jcode.pl';
# ■最大メッセージ数(あまり大きくしないこと)
# (1画面に表示する記事件数=書き込みの最大登録件数)
$maxmessage = 50;
# ■1記事の最大記録サイズ(bytes) 0で無制限
$maxsize = 1000;
# ■入力形式の設定(標準='POST' その他'GET')
$method = 'POST';
# ■画面の色や背景の設定 (BODYタグ HTML書式)
$body = '
';
# ■タイトル及び日付の色
$title_color ="#5944FF";
# ■ホストやユーザー情報の表示色
$host_color ="#606060";
# ■タイトルのフォント
$title_font ='face ="Arial"';
# ■投稿者のリモートホストの表示(1=する 0=しない)
$disphost = 1;
## --- 初期設定ここまで ---------------------------------------------------------------
## --- メインルーチン
&get_host;
&get_date;
&form_decode; # 投稿内容を読みこむ
&load_file; # ログ保存ファイルを読み込む
if ($mode eq 'post') {
®ist; # ログ保存ファイルへの出力
} elsif ($mode eq 'del') {
&remove_data; # 記事削除
}
&output_HTML; # HTML表示ファイルへの出力
exit;
## --- 記事表示部サブルーチン
sub output_HTML {
open(FILE,">$HTMLfile") ;
print FILE <<"HERE";
$title
$body
$title
- ページの来訪記念に足跡をどうぞ。
- タグは無効です。URLやmailto:で始まるE-mailアドレスを入力すると、そこから自動的にリンクされます。
murmurbbs ver.β2.4 by TED
HERE
close(FILE);
if ($ENV{PERLXS} eq "PerlIS") {
print "HTTP/1.0 302 Temporary Redirection\r\n";
print "Content-type: text/html\n";
}
print "Location: $HTML_URL\n\n";
exit;
}
## --- フォームから受け取ったデータを処理する
sub form_decode {
if ($ENV{'REQUEST_METHOD'} eq "POST") {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
} else {
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$name =~ tr/+/ /;
$value =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
&jcode'convert(*value,'sjis');
&jcode'convert(*name,'sjis');
# 入力データのチェック
# jcode.plライブラリを呼び出して半角カナを全角文字に変換
&jcode'h2z_sjis(*value);
# HTMLで表示できない&や"などの文字を表示可能な形式に変換する
$value =~ s/&/&anp;/g;
$value =~ s/"/"/g;
# タグが入力されていれば、<などにに置き換えて無効にする
$value =~ s/</g;
$value =~ s/>/>/g;
# 改行コードを
に変換(上からWin、Mac、Unix用の処理)
$value =~ s/\r\n/
/g;
$value =~ s/\r/
/g;
$value =~ s/\n/
/g;
# 連想配列に格納
$FORM{$name} = $value;
}
$mode = $FORM{'mode'};
$text = $FORM{'text'};
$pwd = $FORM{'pwd'};
if ($mode eq 'post') {
if ($text eq '') {
&error('入力ミス',"メッセージが入力されていません.");
} elsif ($maxsize) {
$value_size = length($text);
if ($value_size > $maxsize) {
&error('入力ミス',"最大記録サイズ$maxsizeを超えています. 現在$value_sizeサイズです.");
}
}
} elsif ($mode eq 'del') {
if (($pwd ne $password)&&($pwd ne '')) {
&error('削除エラー',"管理者用パスワードが正しくありません.");
}
}
# 自動リンク(本文中にあるメールアドレスやURLアドレスにタグをつける)
$text =~ s/(https?|ftp|gopher|telnet|whois|news):\/\/([\w|\!\#\$\%\&\'\(\)\=\-\^\`\\\|\@\~\[\{\]\}\;\+\:\*\,\.\?\/]+)/$1:\/\/$2<\/a>/g;
$text =~ s/(mailto:[\w|\!\#\$\%\'\=\-\^\`\\\|\~\[\{\]\}\+\*\.\?\/]+)\@([\w|\!\#\$\%\'\(\)\=\-\^\`\\\|\~\[\{\]\}\+\*\.\?\/]+)/$1\@$2<\/a>/g;
}
## --- データファイルを読みこむ
sub load_file {
open(FILE,"$log_dir\/$logfile") || &error('オープンエラー',"$log_dir\/$logfileが開けません。");
@lines = ;
close(FILE);
}
## --- 投稿された内容をファイルに書きこむ
sub regist {
$tmp_date = "$date";
$tmp = "$text<>$tmp_date<>$host<>$agent<>\n";
$number = unshift (@lines, $tmp);
if ($number > $maxmessage) {
pop @lines;
}
open(FILE,">$log_dir\/$logfile") || &error('オープンエラー',"$log_dir\/$logfileが開けません。");
print FILE @lines;
close(FILE);
}
## --- 記事削除処理
sub remove_data {
for($i = 1; $i < $maxmessage + 1; $i++){
if($FORM{"del_$i"} ne ''){
push(@removelist, $FORM{"del_$i"});
}
}
foreach $remove (@removelist) {
$i = 0;
foreach $line (@lines) {
($text, $tmp_date, $tmp_host, $tmp_agent) = split(/<>/,$line);
if ($tmp_date eq $remove) {
if (($host eq $tmp_host)||($password eq $pwd)) {
splice (@lines, $i, 1);
last;
}
}
$i++
}
}
open(FILE,">$log_dir\/$logfile") || &error('オープンエラー',"$log_dir\/$logfileが開けません。");
print FILE @lines;
close(FILE);
}
## --- ホスト名、ユーザー情報取得
sub get_host {
$host = $ENV{'REMOTE_HOST'};
$addr = $ENV{'REMOTE_ADDR'};
if (($host eq '')||($host =~ /^null$/i)) {
$host = $addr;
}
if ($host eq $addr) {
$host = gethostbyaddr(pack('C4',split(/\./,$host)),2) || $addr;
}
$agent = $ENV{'HTTP_USER_AGENT'};
}
## --- 日付取得
sub get_date {
@weeklist = ("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday");
@monthlist = ("January","February","March","April","May","June","July","August","September","October","November","December");
($sec, $min, $hour, $day, $mon, $year, $wdy, $yday, $isdat) = localtime(time);
$year += 1900;
if ($hour >= 12) { $hour = $hour - 12; $head = 'PM'; }
else { $head = 'AM'; }
if (length($hour) < 2) { $hour = "0$hour"; }
if ($day < 10) { $day = "0$day"; }
if ($min < 10) { $min = "0$min"; }
if ($sec < 10) { $sec = "0$sec"; }
$date = "@weeklist[$wdy],@monthlist[$mon], $day $year $head $hour:$min:$sec";
}
## --- エラー処理
sub error {
print "Content-type: text/html\n\n";
($error,@error_fields) = @_;
print <<"HERE";
$title
$body
$error
@error_fields
戻る