#!/usr/local/bin/perl
#--------------------------------------------------------------------------------------------------
# NTT Docomo/iMODE対応電子掲示板 iBBS v1.03 <FreeSOFT>
# (c)rescue.ne.jp http://www.rescue.ne.jp/
#
# 501/502対応
#
# 1999年12月12日現在のNTT DocomoのiMODE用絵文字リストに基づいたコード体系が採用されていますので、
# NTT Docomo側でコード体系が変更された場合は、絵文字データ(添付のemoji.dat)を更新する必要があります.
# この絵文字データは当サイトでその都度提供する義務を負いません.
#--------------------------------------------------------------------------------------------------
#
#《準備》
#
# ここでいう絵文字とは、Webで絵文字を表現するための"絵文字GIF画像"のことを指します.
# NTT Docomoからの勧告により、当サイトでは絵文字画像の配給は行いません. 従って各自、NTT Docomoのサイトへ
# アクセスし、166個(添付の1999年12月12日現在でのデータで構成されているemoji.dat内に記録された166個の
# 絵文字GIF画像)の絵文字GIF画像(イメージ)を、"番号(No).gif"という名前を付けて保存し、それを設置する
# サーバの画像が置ける場所にまとめて設置し、その場所をURLで、下記初期設定 $images に設定してください.
# なお、掲示板プログラムとは別のサーバに置くこともできます.
#
# http://www.nttdocomo.co.jp/mc-user/i/tag/ → 絵文字一覧を参照
# http://www.nttdocomo.co.jp/i/tag/emoji/images/1.gif ～ 166.gif を保存(.gifは小文字)
# ↓
# http://絵文字を設置するあなたのサーバと場所/images/1.gif ～ 166.gif に設置したとしたら、
# $images = "http://絵文字が設置されている場所/images/"; と設定することになります.
#
#--------------------------------------------------------------------------------------------------
#
#《設置構成》... < >内はパーミション(相当値)
#
# ○CGIプログラムとHTMLや画像が共存できる場合
#
# /任意のディレクトリ/
# |
# |--/images/ <755> .. 絵文字GIF画像を設置したディレクトリ
# | |
# | |- 1.gif
# | |- 2.gif ～ 166.gif
# |
# |--/tmp/ <777> .. 作業用ディレクトリ
# |
# |- crypt.cgi <755> .. 管理者用暗証番号設定に使う暗号化ツール
# |- emoji.cgi <755> .. 絵文字一覧用ＣＧＩプログラム(ibbs.cgiから呼び出される)
# |- emoji.dat <644> .. 絵文字データ
# |- ibbs.cgi <755> .. このプログラム
# |- jcode.pl <644> .. 日本語処理ライブラリ
# |- log.cgi <666> .. データが記録されるファイル
#
# ○CGIプログラムとHTMLや画像を同じサーバ内の別の場所に設置する必要がある場合
#
# |--/ＣＧＩが実行できる場所/
# | |
# | |--/tmp/ <777> .. 作業用ディレクトリ
# | |
# | |- crypt.cgi <755> .. 管理者用暗証番号設定に使う暗号化ツール
# | |- emoji.cgi <755> .. 絵文字一覧用ＣＧＩプログラム(ibbs.cgiから呼び出される)
# | |- emoji.dat <644> .. 絵文字データ
# | |- ibbs.cgi <755> .. このプログラム
# | |- jcode.pl <644> .. 日本語処理ライブラリ
# | |- log.cgi <666> .. データが記録されるファイル
# |
# |--/HTMLや画像を置く場所/
# |
# |--/images/ <755> .. 絵文字GIF画像を設置したディレクトリ
# | |
# | |- 1.gif
# | |- 2.gif ～ 166.gif
#
#--------------------------------------------------------------------------------------------------
#
#《履歴》
# 12,DEC,1999 v1.00 初リリース
# 13,DEC,1999 v1.01 正規コードで入力された絵文字を記録時に独自コード(63を除去)に変換する処理の追加
# 17,DEC,1999 v1.02 MD5暗号処理のトラブルの修正
# 29,DEC,1999 v1.03 CSVエンコード処理をしていなかったバグの修正
#--------------------------------------------------------------------------------------------------
# 初期設定 ここから
#--------------------------------------------------------------------------------------------------
#●タイトル設定 (全角なら７文字以内にするとiMODE時にすっきり表示できる)
$title = 'iMODE掲示板';
#●終了リンク(Web上のみリンクされる)
$bye = 'http://ホームページなどのURL/';
#●画面設定
$body_web = '<BODY BGCOLOR=#FFFFFF>'; # Web画面用
$body1 = '<BODY>'; # iモード対応HTML Version1.0用
$body2 = '<BODY BGCOLOR=#FFEEDD>'; # iモード対応HTML Version2.0用 (カラー対応)
#●日本語コード変換ライブラリ(PATH)
require './jcode.pl';
#●データファイル(PATH)
$message_file = "./log.cgi";
#●絵文字データファイル(PATH)
$image_data = "./emoji.dat";
#●作業用ディレクトリ(PATH)
$tmp_dir = "./tmp/";
#●絵文字画像用ディレクトリ(URL)
$images = "./images/";
#●絵文字表を画像で表現 1:する(絵文字すべて表示されるのでちょっと重いが便利) 0:しない(名称で一覧)
$EM1 = 0;
#●ファイルの記録上限サイズ(byte) .. この値を超えると、超えなくなるまで古い記事から削除されます.
$maxsize = 10000;
#●Web一覧時にメッセージ内容も表示 1:する 0:しない
$viewlist = 0;
#●リモートホスト名をWebソース表示 1:する 0:しない
$viewhost = 1;
#●iMODE時に電話番号をリンク(使用) 1:する 0:しない
$linktel = 0;
#●iMODE時にキー操作ヘルプを 1:入れる 0:入れない
$inHELP1 = 0;
#●管理者用暗証番号設定(削除用暗証番号に代って利用できる万能番号)
# 添付のパスワード生成ツールcrypt.cgiで生成した「暗号化されたパスワード」をそのままコピーします。
# 平文は文字でも構いませんが、携帯端末で入力する手間を考え、数字で構成(出来れば6桁以上)することをお勧めします。
# $admin = 'この部分にコピーします';
$admin = 'UpShKNXeU5mQQ';
#●削除用暗証番号の自動生成の桁数
$pw = 4;
#●時刻取得
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
#●曜日名の表現
@wday_array = ('日','月','火','水','木','金','土');
#--------------------------------------------------------------------------------------------------
# ここまで
#--------------------------------------------------------------------------------------------------
$| = 1;
$useimg = 1; # 変更しないこと
$page = 10; # 変更しないこと
$lockfile = "$tmp_dir" . "imode.lock";
if ($ENV{'HTTP_USER_AGENT'} =~ /DoCoMo/) {
$iMODE = 1;
if ($ENV{'HTTP_USER_AGENT'} =~ /502/) { $body = $body2; }
else { $body = $body1; }
}
else {
$body = $body_web;
if (!open(IN,$image_data)) { &error("●エラー","File Not Found"); }
@EMOJIs = <IN>;
close(IN);
foreach $data (0 .. $#EMOJIs) {
($num,$F16,$S10,$name) = &DecodeCSV($EMOJIs[$data]);
$EMOJI{$S10} = $num;
$EMOJI_NAME{$S10} = $name;
}
}
if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'}); }
else { $buffer = $ENV{'QUERY_STRING'}; }
&ReadCookie($ENV{'SCRIPT_NAME'});
@pairs = split(/&/,$buffer);
foreach $pair (@pairs) {
($key,$val) = split(/=/,$pair);
$key =~ tr/+/ /;
$key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
$val =~ tr/+/ /;
$val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
&jcode'h2z_sjis(*val); # 半角カナ→全角カナ変換
&jcode'convert(*val,'sjis'); # SJIS変換
if ($key eq 'rm') { $remove = $val; } # 削除番号の取得
$val =~ s/\t//g; # タブ無効
$val =~ s/\r//g; # 改行無効
$val =~ s/\n//g; # 復帰無効
$val =~ s/</</g; # タグ禁止
$val =~ s/>/>/g;
if ($key eq 'num') { $view = $val; last; } # iMODE閲覧番号の取得
$in{$key} = $val;
}
&lock;
if ($in{'action'} eq 'post') { &iMODE_Form; unlink($lockfile); exit; }
elsif ($in{'action'} eq 'post2') { &Web_Form; unlink($lockfile); exit; }
elsif ($in{'action'} eq 'regist') { &Write_Message; }
if (!open(IN,$message_file)) { &error("●エラー","File Not Found"); }
@BASE = <IN>;
@BASE = reverse @BASE;
close(IN);
if ($view) { &View; unlink($lockfile); exit; }
elsif ($remove) { &Delete_Message; }
unlink($lockfile);
if ($in{'FF'} eq '') { $FF = 0; } else { $FF = $in{'FF'}; }
$TO = $FF + $page - 1;
if ($TO > $#BASE) { $TO = $#BASE; }
$hit = 0;
foreach $num ($FF .. $#BASE) {
$BASE[$num] =~ s/\n//g;
$data = $BASE[$num];
if ($in{'FF'} ne '') {
$allhits = $in{'allhits'};
if ($hit == $page) { last; }
else { push(@NEW,$data); $hit++; }
}
else {
if ($allhits % $page == 0) { push(@Index,$num); }
if ($hit < $page) { $hit++; push(@NEW,$data); }
$allhits++;
}
}
if ($in{'allhits'} eq '') { push(@Buf,"allhits=$allhits"); $in{'allhits'} = $allhits; }
if ($in{'FF'} ne '') { @Index = split(/\s/,$in{'IDX'}); }
$count_new = @NEW;
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML><HEAD><TITLE>$title</TITLE></HEAD>
$body
EOF
if ($iMODE) { print "<DIV ALIGN=\"left\">略$title</DIV>\n"; }
else {
if ($useimg) { print "<H1 ALIGN=\"left\"><IMG SRC=\"$images" . "109.gif\" alt=\"\"> $title</H1>\n"; }
else { print "<H1 ALIGN=\"left\">$title</H1>\n"; }
}
$buf = join('&',@Buf);
$idx = join('+',@Index);
if (@NEW) {
if ($iMODE) { print "Page:"; }
else { print "全 $in{'allhits'} 件<FONT SIZE=+1> [ "; }
foreach (0 .. $#Index) {
$view_page = $_ + 1;
if ($FF == $Index[$_] || ($in{'FF'} eq '' && $_ == 0)) { print "↓"; $page_now = $view_page; }
else {
if (!$iMODE) { print " "; }
print "<a href=\"ibbs.cgi?$buf&IDX=$idx&FF=$Index[$_]\">$view_page</a>";
}
}
if (!$iMODE) { print " ]</FONT>\n"; }
$FROM = $page_now * $page - ($page - 1);
$LAST = $FROM + $count_new - 1;
}
if ($iMODE) { print "<hr size=1>\n"; }
else { print "<hr size=2 noshade>\n"; }
if (@NEW && $inHELP1 && $iMODE) {
print <<"EOF";
キー戀～憐で表\示
<hr size=1>
EOF
}
if (!@NEW) { print "なし"; }
foreach $data (0 .. $#NEW) {
($code,$date,$name,$email,$passwd,$value,$host) = &DecodeCSV($NEW[$data]);
$name =~ s/&#(\d\d\d);/?$1;/g;
$value =~ s/&#(\d\d\d);/?$1;/g;
if ($email ne '') {
if ($email =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/) { $email = "mailto:$email"; }
if ($email =~ /^\d+$/) { $email = "tel:$email"; }
}
if ($iMODE) {
if ($data == 0) { $chr = 63888; }
else { $chr = 63878 + $data; }
&jcode'z2h_sjis(*name); # 全角カナ→半角カナ変換
$name =~ s/&#(\d+);//g;
$name = substr($name,0,14);
if ($name eq '') { $name = ".."; }
print "&#$chr;<A HREF=\"ibbs.cgi?num=$code\" ACCESSKEY=\"$data\">$name</a><BR>\n";
}
else {
if ($data == 0) { $chr = 134; }
else { $chr = 124 + $data; }
if ($viewlist && $email =~ /^mailto:/) { $name = "<A HREF=\"$email\">$name</A>"; }
if ($useimg) {
$name =~ s/&#(\d+);/<IMG SRC=$images$EMOJI{$1}\.gif border=0 width=20>/g;
$value =~ s/&#(\d+);/<IMG SRC=$images$EMOJI{$1}\.gif width=20>/g;
if ($viewlist) { print "<A HREF=\"ibbs.cgi?num=$code\"><IMG SRC=\"$images$chr\.gif\" alt=\"$data\" width=20 border=0></a> $date > <b>$name</b> > $value<BR>\n"; }
else { print "<A HREF=\"ibbs.cgi?num=$code\"><IMG SRC=\"$images$chr\.gif\" alt=\"$data\" width=20 border=0></a> $date <b>$name</b><BR>\n"; }
}
else {
$name =~ s/&#(\d+);/\{$EMOJI_NAME{$1}\}/g;
$value =~ s/&#(\d+);/\{$EMOJI_NAME{$1}\}/g;
if ($viewlist) { print "【<A HREF=\"ibbs.cgi?num=$code\">$data</a>】$date > <b>$name</b> > $value<BR>\n"; }
else { print "【<A HREF=\"ibbs.cgi?num=$code\">$data</a>】$date <b>$name</b><BR>\n"; }
}
}
}
$copyr = "$images" . "108.gif";
if ($iMODE) {
print <<"EOF";
<hr size=1>
<A HREF="ibbs.cgi" ACCESSKEY="*">更新(*)</A><A HREF="ibbs.cgi?action=post" ACCESSKEY="#">投稿(#)</A>
<hr size=1>
<div align=right><a href="http://www.rescue.ne.jp/i/">掠iBBS</a></div>
EOF
}
else {
if ($viewlist) { $rem = " ※ 削除は番号をクリックしてから作業できます."; }
else { $rem = " ※ 番号をクリックすると内容文がご覧いただけます."; }
print <<"EOF";
<hr size=2 noshade>
[<A HREF="ibbs.cgi?action=post2">投稿</A>] [<A HREF="ibbs.cgi">更新</A>] [<A HREF="$bye" target="_top">終了</A>]$rem
<hr size=2 noshade>
EOF
if ($useimg) {
print <<"EOF";
<div align=right><a href="http://www.rescue.ne.jp/" target=_top><IMG SRC="$copyr" alt="iMODE対応iBBS" border=0></a></div><p>
EOF
}
else {
print <<"EOF";
<div align=right><a href="http://www.rescue.ne.jp/" target=_top>iBBS</a></div><p>
EOF
}
}
print <<"EOF";
</BODY></HTML>
EOF
exit;
sub View {
@PICKUP = grep(/^$view\,/,@BASE);
if (!@PICKUP) { &error("●エラー","$view Not Found"); }
($code,$date,$name,$email,$passwd,$value,$host) = &DecodeCSV($PICKUP[0]);
if ($host =~ /docomo.ne.jp/) { $From_iMODE = "掠"; }
$name =~ s/&#(\d\d\d);/?$1;/g;
$value =~ s/&#(\d\d\d);/?$1;/g;
if ($email ne '') {
if ($email =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/) { $email = "mailto:$email"; }
if ($linktel && $email =~ /^\d+$/) { $email = "tel:$email"; }
if (!($email =~ /^mailto:/) && !($email =~ /^tel:/)) { $email = ""; }
if ($email ne '') { $name = "<A HREF=\"$email\">$name</a>"; }
}
if ($iMODE) {
$name = "$From_iMODE$name<hr size=1>";
&jcode'z2h_sjis(*name); &jcode'z2h_sjis(*value);
}
else {
if ($viewhost) { $vhost = $host; } else { $vhost = ""; }
if ($useimg) {
$name =~ s/&#(\d+);/<IMG SRC=$images$EMOJI{$1}\.gif border=0 width=20>/g;
$value =~ s/&#(\d+);/<IMG SRC=$images$EMOJI{$1}\.gif width=20>/g;
$From_iMODE =~ s/&#(\d+);/<IMG SRC=$images$EMOJI{$1}\.gif width=20 alt="iMODEより">/g;
}
else {
$name =~ s/&#(\d+);/\{$EMOJI_NAME{$1}\}/g;
$value =~ s/&#(\d+);/\{$EMOJI_NAME{$1}\}/g;
$From_iMODE =~ s/&#(\d+);/(iMODE) /g;
}
$name = "<h3>$From_iMODE$name<hr size=1></h3><!--$vhost-->";
}
if ($value eq '') { $value = "(本文なし)"; }
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML><HEAD><TITLE>$title</TITLE></HEAD>
$body
$name
$value<hr size=1>
<form action="ibbs.cgi" method=POST>
<input type=hidden name="rm" value="$code">
削除用暗証番号<br><input type=password name="passwd" size=16>
EOF
if ($iMODE) { print "<input type=submit value=\"削除(*)\" ACCESSKEY=\"*\"> <A HREF=\"ibbs.cgi?action=post\" ACCESSKEY=\"#\">投稿(#)</A>\n"; }
else { print "<input type=submit value=\"削除\">\n"; }
print <<"EOF";
</form>
</BODY></HTML>
EOF
}
sub iMODE_Form {
$passwd = &MakeStr($pw);
if ($linktel) { $telmes = "or電話"; }
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML><HEAD><TITLE>$title</TITLE></HEAD>
$body
<form action="ibbs.cgi" method=POST>
<input type=hidden name="action" value="regist">
見出し又は名前<br>
<input type=text name="uname" size=16 maxlength=50><br>
Ｅメール$telmes<br>
<input type=text name="email" size=16><br>
(\@ドコモ省略可)<br>
内容文<br><textarea name="values" cols=16 rows=6></textarea><br>
削除暗証(変更可)<br><input type=text name="passwd" value="$passwd" size=16><br>
<input type=submit value="送信(*)" ACCESSKEY="*"><input type=reset value="リセット(#)" ACCESSKEY="#"><br>
</form>
<hr size=1>
<a href="emoji.cgi">絵文字表\</a> <A HREF="ibbs.cgi">一覧へ</A>
</BODY></HTML>
EOF
}
sub Web_Form {
$passwd = &MakeStr($pw);
if ($linktel) { $telmes = "又は電話番号"; }
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML><HEAD><TITLE>$title</TITLE></HEAD>
$body
<h3>《投稿》</h3>
<form action="ibbs.cgi" method=POST>
<input type=hidden name="action" value="regist">
見出し又は名前<br><input type=text name="uname" size=16 maxlength=50><br>
Ｅメール$telmes<br><input type=text name="email" value="$COOKIE{'email'}" size=30><br>
内容文<br><textarea name="values" cols=16 rows=12 wrap=on></textarea><br>
削除用暗証番号<br><input type=text name="passwd" value="$passwd" size=16> (変更可)<p>
<input type=submit value=" ○ 送信 "><input type=reset value=" × リセット ">
</form>
EOF
if ($linktel) { print "※ 電話番号リンクはiMODE端末のみとなります.<br>\n"; }
print <<"EOF";
※ Ｅメールアドレスで\@以下を省略すると、\@docomo.ne.jp が自動付加します.
<hr size=2 noshade>
EOF
if ($useimg && $EM1) {
print <<"EOF";
<h3>《絵文字番号対応表\》</h3>
EOF
foreach $key (sort {$a<=>$b;} keys %EMOJI) {
$alias = $key;
$alias =~ s/^63(\d\d\d)/$1/g;
print "<IMG SRC=$images$EMOJI{$key}\.gif width=20 alt=\"$alias $EMOJI_NAME{$key}\">\n";
}
print <<"EOF";
<hr size=2 noshade><p>
○絵文字画像にカーソ\ルを置くと番号と名称が表\示されます.<br>
EOF
}
else {
print <<"EOF";
<form>
<select>
<option>---《絵文字番号対応表\》---</option>
EOF
foreach $key (sort {$a<=>$b;} keys %EMOJI) {
$alias = $key;
$alias =~ s/^63(\d\d\d)/$1/g;
print "<option>$alias $EMOJI_NAME{$key}</option>\n";
}
print <<"EOF";
</select>
</form>
EOF
}
if (!$useimg) { print "○iMODE上では絵文字が表\示されますが、Web上ではされません.<br>\n"; }
print <<"EOF";
○絵文字の書き方 <font size=+2><b>&#番号\;</b></font> (最後にセミコロン;を忘れずに)と文中に記します.<p><hr size=2 noshade>
[<A HREF="ibbs.cgi">一覧へ</A>]
</BODY></HTML>
EOF
}
sub ReadCookie {
local($cname) = @_;
$cookies = $ENV{'HTTP_COOKIE'};
@pairs = split(/;/,$cookies); # 独自形式のデータの展開 項目名1:内容1,項目名2:内容2,...
foreach $pair (@pairs) {
($key,$val) = split(/=/,$pair,2);
$key =~ s/ //g;
if ($key eq $cname) {
@pairs = split(/,/,$val);
foreach $pair (@pairs) {
($key,$val) = split(/:/,$pair,2);
$COOKIE{$key} = $val;
}
last;
}
}
}
sub MakeStr {
local($count) = @_;
local($str);
@char = ('0'..'9');
srand(time|$$);
foreach (1..$count) {
{
local(@temp);
push(@temp,splice(@char,rand(@char),1)) while @char;
@char = @temp;
}
$str = $char[($_)] . $str;
}
$str;
}
sub Write_Message {
$host = $ENV{'REMOTE_HOST'};
$addr = $ENV{'REMOTE_ADDR'};
if ($host eq '') { $host = $addr; } # ホスト名にＩＰが入らない場合があるので
if ($host eq $addr) { $host = gethostbyaddr(pack('C4',split(/\./,$host)),2) || $addr; }
if ($in{'uname'} eq '' && $in{'values'} eq '') { &error("●エラー","未入力"); }
elsif ($in{'uname'} eq '') { $in{'uname'} = "From $host"; }
if ($in{'email'} ne '') {
if ($in{'email'} =~ /^\d+$/) { $email = $in{'email'}; }
elsif ($in{'email'} =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/) { $email = $in{'email'}; }
elsif ($in{'email'} =~ /\b[-\w.]+\b/) { $email = "$in{'email'}\@docomo.ne.jp"; }
}
if ($in{'passwd'} eq '') { &error("●エラー","暗証番号入力漏れ"); }
$in{'uname'} =~ s/?(\d\d\d);/&#$1;/g;
$in{'values'} =~ s/?(\d\d\d);/&#$1;/g;
$wsize = length($in{'uname'}) + length($in{'email'}) + length($in{'values'}) + length($in{'passwd'});
if ($wsize > 200) { &error("●エラー","容量オーバー","只今$wsizeバイト","200バイトまで!"); }
$date_now = sprintf("%01d/%01d(%s)%02d:%02d",$mon +1,$mday,$wday_array[$wday],$hour,$min); # 時刻構成
$date_num = sprintf("%04d%02d%02d%02d%02d%02d",$year +1900,$mon +1,$mday,$hour,$min,$sec); # 記事番号
($pwd) = &MakeCrypt($in{'passwd'}); # パスワードの暗号化
push(@CSV,$date_num);
push(@CSV,$date_now);
push(@CSV,$in{'uname'});
push(@CSV,$email);
push(@CSV,$pwd);
push(@CSV,$in{'values'});
push(@CSV,$host);
if (!open(DB,">> $message_file")) { &error('●書出エラー','記録不可'); }
print DB &EncodeCSV(@CSV) . "\n";
close(DB);
while (-s $message_file > $maxsize) { # サイズ調整
if (!open(DB,$message_file)) { &error('●読込エラー'); }
@lines = <DB>;
close(DB);
shift(@lines);
if (!open(DB,"> $message_file")) { &error('●書出エラー','記録不可'); }
print DB @lines;
close(DB);
}
if (!$iMODE) {
($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg,$ydayg,$isdstg) = gmtime(time + 30*24*60*60);# 期限を30日後に設定(GMT)
$y0="Sunday"; $y1="Monday"; $y2="Tuesday"; $y3="Wednesday"; $y4="Thursday"; $y5="Friday"; $y6="Saturday";
$m0="Jan"; $m1="Feb"; $m2="Mar"; $m3="Apr"; $m4="May"; $m5="Jun"; $m6="Jul"; $m7="Aug"; $m8="Sep"; $m9="Oct"; $m10="Nov"; $m11="Dec";
@youbi = ($y0,$y1,$y2,$y3,$y4,$y5,$y6);
@monthg = ($m0,$m1,$m2,$m3,$m4,$m5,$m6,$m7,$m8,$m9,$m10,$m11);
$date_gmt = sprintf("%s\, %02d\-%s\-%04d %02d:%02d:%02d GMT",$youbi[$wdayg],$mdayg,$monthg[$mong],$yearg +1900,$hourg,$ming,$secg);
$COOKIE{'email'} = $in{'email'};
print "Set-Cookie: $ENV{'SCRIPT_NAME'}=EMAIL:$COOKIE{'EMAIL'}; expires=$date_gmt\n"; # クッキーをセット
}
}
sub Delete_Message {
@PICKUP = grep(/^$remove\,/,@BASE);
if (!@PICKUP) { &error("●エラー","$remove Not Found"); }
($code,$date,$name,$email,$passwd,$value,$host) = &DecodeCSV($PICKUP[0]);
if ($passwd =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; }
if ($admin ne '' && crypt($in{'passwd'},substr($admin,$salt,2)) eq $admin) { ; }
elsif (crypt($in{'passwd'},substr($passwd,$salt,2)) ne $passwd) { &error("●エラー","暗証番号ミス"); }
@NOT_DELETED = grep(!/^$remove\,/,@BASE);
@NOT_DELETED = reverse @NOT_DELETED;
if (!open(DB,"> $message_file")) { &error('●書出エラー','記録不可'); }
print DB @NOT_DELETED;
close(DB);
if (!open(IN,$message_file)) { &error("●エラー","File Not Found"); }
@BASE = <IN>;
@BASE = reverse @BASE;
close(IN);
}
sub MakeCrypt {
local($plain) = @_; # 入力:平文
local(@char,$f,$now,@saltset,$pert1,$pert2,$nsalt,$salt);
local($retry) = 4;
@saltset = ('a'..'z','A'..'Z','0'..'9','.','/'); # 暗号が構成される文字群
$now = time; # ↓この辺は通称「らくだの本」を参照
srand(time|$$);
$f = splice(@saltset,rand(@saltset),1) . splice(@saltset,rand(@saltset),1);
($pert1,$pert2) = unpack("C2",$f);
$week = $now / (60*60*24*7) + $pert1 + $pert2 - length($plain);
$nsalt = $saltset[$week % 64] . $saltset[$now % 64];
while (crypt($plain,substr($result,$salt,2)) ne $result || $result eq '') {
$result = crypt($plain,$nsalt);
if ($result =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; }
if (--$retry <= 0) { &error('●暗号化エラー','再読み込みを'); }
sleep(1);
}
return $result; # 戻値:暗号
}
sub EncodeCSV {
local(@fields) = @_;
local(@CSV) = ();
foreach $text (@fields) {
$text =~ s/</</g;
$text =~ s/>/>/g;
$text =~ s/"/""/g;
if ($text =~ /,|"/) { $text = "\"$text\""; }
push(@CSV,$text);
}
return join(',',@CSV);
}
sub DecodeCSV {
local($text) = @_;
local(@fields) = ();
local($a);
$text =~ s/\n//;
if ($text eq '') { return (); }
while ($text =~ m/"([^\\]*(\\.[^\\]*)*)",?|([^,]+),?|,/g) {
$a = defined($1) ? $1 : $3;
$a =~ s/""/"/g;
$a =~ s/</</g;
$a =~ s/>/>/g;
push(@fields,$a);
}
push(@fields, undef) if $text =~ m/,$/;
@fields;
}
sub lock {
# ロック方式の自動判定 symlink()優先
$symlink_check = (eval { symlink("",""); }, $@ eq "");
if (!$symlink_check) {
$c = 0;
while(-f "$lockfile") { # file式
$c++;
if ($c >= 3) { &error("●Busy","再読み込みを"); }
sleep(2);
}
open(LOCK,">$lockfile");
close(LOCK);
}
else {
local($retry) = 3;
while (!symlink(".", $lockfile)) { # symlink式
if (--$retry <= 0) { &error("●Busy","再読み込みを"); }
sleep(2);
}
}
}
sub error {
unlink($lockfile);
local (@msg) = @_;
local ($i);
print "Content-type: text/html\n\n";
print <<"EOF";
<HTML><HEAD><TITLE>$title</TITLE></HEAD>
$body
EOF
foreach $i (0 .. $#msg) { print "$msg[$i]<BR>\n"; }
if ($iMODE) { print "<A HREF=\"ibbs.cgi\" ACCESSKEY=\"*\">リセット(*)</A>"; }
print "</body></html>\n";
exit;
}