#!/usr/bin/perl ;#----------------------------------------------------- ;# 簡易ＢＢＳ２０００ - MiniBBS2000 ;# for UNIX/POST/SENDMAIL/SJIS (c)www.rescue.ne.jp ;#----------------------------------------------------- ;# 呼び出し方法 ;# http://設置したＵＲＬ/minibbs.cgi?log=データ名 ;# (設置構成の例) < >内はパーミッション相当値 ;# ;# /cgi-local/ ;# |--/tmp/ <777> ...これが無いと常にBUSY状態になります ;# |--/data/ <755> ;# | |--log1.cgi <666> ...データ名は任意 ;# | |--log2.cgi <666> ...拡張子は初期設定$extで設定したもの(CGIを装えるもの) ;# | |--データ名.cgi ...任意に増設してください(掲示板１つだけいいのならlog1.cgiだけで良い) ;# |--jcode.pl <644> ...日本語コード変換ライブラリ(v2.0以降を用意) ;# |--key.cgi <666> ...マスターキーが暗号化されて記録(空のファイルを用意) ;# |--minibbs.cgi <755> ;# ;# 注意：データには匿メール希望のＥメールも記録されますので、サーバのほかのユーザやＷｅｂ上から見えない ;# 位置を考慮して設置する必要があります. 設定を変えることにより、全く別の安全な場所に/data/を設置することができます. ;# 履歴 ;# 30,Oct,1999 v1.00 初版リリース ;# 11,Jan,2000 v1.01 ロックファイルのパス修正 ;# 23,Apr,2000 v1.02 検索モード時のページ処理のバグ修正 #-------------------------------------------------------------------------------------------------- # 初期設定 ここから #-------------------------------------------------------------------------------------------------- #●画面の「トップページ」リンク先(URL) $bye = 'http://www.jvtacademy.com/'; #●ブラウザのタイトルバーの名称 ... $title_bar{'データ名'} = ''; の書式で、用意したデータファイル分用意する. # ''内に'を記録したい場合は""で囲むこと. ただし文字化けに注意. 詳しくはFAQを参照のこと. # $title_bar{'log1'} = 'センターからのお知らせ'; $title_bar{'log2'} = '簡易ＢＢＳ２０００(2)'; #●画面の色や背景の設定(HTML) $body = ''; #●画面上部に挿入する文字列(HTML) ↓ $head_msg{'データ名'} = <<'EOF'; の次の行から EOF の直前までの間に直接書いてください. # 用意したデータファイル分用意する. # $head_msg{'whatsnew'} = <<'EOF';

センターからのお知らせ

EOF $head_msg{'log2'} = <<'EOF';

簡易ＢＢＳ２０００(2)

EOF #●日本語コード変換ライブラリ(PATH) .. 2.0以上のバージョンのもの require './jcode.pl'; #●管理者用パスワードファイル(PATH) $pwd_file = './key.cgi'; #●作業用ディレクトリ(PATH) $tmp_dir = "./tmp/"; #●ログファイルを設置する場所(PATH) .. プログラムと同じ位置関係なら"./" 最後は必ず/で閉じること. $log_dir = "./data/"; #●各ログファイルの拡張子 .. 直接アクセスできないようにＣＧＩを装う拡張子 # .cgiがCGIプログラムとして実行される場合、内容がプログラムでない場合にサーバエラーとなり、中身を見られる # ことがないようにCGIプログラクを装うようにするものです. 他人から見られない位置にデータファイルを設置すればこの限りではありません. # $ext = "cgi"; #●ファイルの記録上限サイズ(byte) .. この値を超えると、超えなくなるまで古い記事から削除されます. カンマで区切らないこと. $maxsize = 1000000; #●リモートホスト名を表示 1:する(推奨) 0:しない $viewhost = 0; #●１画面に一覧する記事件数 $page = 15; #●タイトル背景(帯)の色 $cellcolor = "#cacae6"; #●タイトルの文字色 $subject_color = "#333333"; #●付随情報(時刻,名前,ホスト名)の文字色 $info_color = "#555555"; #●男女の色分け @SEX = ('男','女'); #●メール送信プログラム(sendmail以外は要検討) $sendmail = '/usr/lib/sendmail'; #●メールの送信先(管理者のメールアドレス) # 匿メールは、このアドレスが送信元となって送信されます. # $administrator = 'office@jvtacademy.com'; #●匿メール時に送信者情報(ホスト名など)を添付 1:する(推奨) 0:しない # この機能で送信されるメールには発信源などの情報が欠落しますので、トラブル予防のためにも添付することを推奨します. # 送信されるメールのヘッダ内に記録されます. # $send_host = 0; #●時刻取得 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time); #●曜日名の表現 @wday_array = ('日','月','火','水','木','金','土'); #●管理者しか投稿できないように 1:する 0:しない $admin_mode = 1; #●管理者しか投稿できないようにした場合の表示メッセージ(HTML) #表題の下に表示されるメッセージ $admin_mode_msg = <<'EOF'; EOF #●サーバ名、スクリプト名の強制設定 # まず、?log=データ名 を付けずにminibbs.cgiを実行し、そこに表示されるＵＲＬと、実際のＵＲＬが異なる場合、 # 実際のＵＲＬと同じになるように設定してください. # # http:// という構成となっています. # #$ENV{'SERVER_NAME'} = "www.jvtacademy.com"; #$ENV{'SCRIPT_NAME'} = "/BBSjvta/minibbs.cgi?log=whatsnew"; # # ↑設定が必要な場合は、この２行の左端の # を削除してください. #●その他 # プロトコル https でご利用になる場合は、プログラム内の http という記述を https に置換する必要があります. #-------------------------------------------------------------------------------------------------- # ここまで #-------------------------------------------------------------------------------------------------- $| = 1; $date_now = sprintf("%04d/%01d/%01d(%s)%02d:%02d",$year +1900,$mon +1,$mday,$wday_array[$wday],$hour,$min); # 時刻構成 @wday_array2 = ('SUN','MON','TUE','WED','THU','FRI','SAT'); $date_now2 = sprintf("%04d/%01d/%01d(%s)%02d:%02d:%02d",$year +1900,$mon +1,$mday,$wday_array2[$wday],$hour,$min,$sec); # こちらは全角を使用しないこと if ($jcode'version < 2) { &Error('エラー','jcode.plは2.0以降のバージョンを設置してください.'); } &GetQuery(); &GetData(); &AdminSet(); &ReadCookie("$ENV{'SCRIPT_NAME'}\_$cmd{'log'}"); (@messages) = &ReadFile($message_file); if ($in{'action'} eq 'Toku_Mail') { &Toku_Mail; exit; } if (@DELETE) { &Delete_Message; (@messages) = &ReadFile($message_file); } if ($in{'action'} eq 'Write_Message') { &Write_Message; (@messages) = &ReadFile($message_file); } &View_Message; exit; sub GetQuery { $cmd = $ENV{'QUERY_STRING'}; @pairs = split(/&/,$cmd); foreach $pair (@pairs) { ($key,$val) = split(/=/,$pair); $val =~ tr/+/ /; $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; $cmd{$key} = $val; } if ($cmd{'img'} eq 'copyright') { &Copyright; } # アイコン画像生成へ elsif ($cmd{'log'} eq '') { &Error("Not Found","ログ名が指定されていません.","Usage http(s)://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}?log=ログ名"); } $message_file = "$log_dir$cmd{'log'}\.$ext"; # データファイル名の取得 if (!-e $message_file) { &Error("Not Found","メッセージファイルが見つかりません."); } if ($cmd{'num'} != 0) { &MailForm($cmd{'num'}); exit; } # 匿メールフォームへ } sub GetData { read(STDIN,$buffer,$ENV{'CONTENT_LENGTH'}); @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); # 半角カナ→全角(SJIS)変換 &jcode'convert(*val,'sjis'); # SJIS変換 if ($key =~ /Next:(\d+)/) { $in{'page_control'} = $1; } # 次のページの読み飛ばし行数 elsif ($key eq 'delete') { push(@DELETE,"$val\n"); next; } # 削除番号の取得 $val =~ s/\t//g; # タブコードを無効 $val =~ s/\r\n/\r/g; # Win → Mac (文中の改行はCRとする,行の終わりはLFとする) $val =~ s/\n/\r/g; # Unix → Mac $val =~ s/&/&/g; # タグ禁止 $val =~ s/"/"/g; $val =~ s//>/g; $in{$key} = $val; # 入力データは%inへ } } sub AdminSet { if (!-e $pwd_file) { &Error("エラー","管理者パスワード記録用ファイルが見つかりません."); } if ($in{'action'} eq 'Set_MasterPassword') { &Set_MasterPassword; } # 管理者パスワード記録へ if (-z $pwd_file || $cmd{'action'} eq 'PasswordForm') { &PasswordForm; } # 管理者パスワードの設定画面へ } 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 ReadFile { local($file) = @_; local(@lines); if (!open(IN,$file)) { &Error('エラー','メッセージファイルが見つかりません.'); } @lines = ; close(IN); @lines = reverse @lines; # 順番を入れ替える(新しい順に表示するため) return @lines; } sub Search { if ($in{'str'} ne '') { # 検索文字列がある場合は前処理 if ($in{'boolean'} eq 'or') { $OR = 'checked'; $MODE = ' または '; } elsif ($in{'boolean'} eq 'and' || $in{'boolean'} eq '') { $AND = 'checked'; $MODE = ' かつ '; } $keys = $target = $in{'str'}; $keys =~ s/　/ /g; # SJISの全角空白を半角に $keys =~ s//>/g; $keys =~ s/"/"/g; $target =~ s/　/ /g; $target =~ s/(\W)/\\$1/g; # 非英数字をエスケープ処理 @keys = split(/\\\s+/,$target); # スペースで分ける unless ($keys =~ / /) { $MODE = ''; } $keys2 = $keys; $keys2 =~ s/ /$MODE/g; # 表示用 } $page_control = $hit = 0; foreach $line (@messages) { $page_control++; if ($page_control < $in{'page_control'}) { next; } # 指定の行数まで読み飛ばす ($number,$pwd,$date,$name,$email,$sex,$host,$title,$mode,$link,$reserve,$value) = split(/\t/,$line,12); if ($deleted{$number} == 1) { next; } # 表示しない(削除)記事を読み飛ばす if ($in{'str'} ne '') { # 検索文字列がある場合は検索処理 $value =~ s/\n//; # 改行コードを削除 $string = "$number\t$name\t$email\t$sex\t$title\t$value"; # 検索の対象となる文字列 if ($in{'boolean'} eq 'or') { # 論理和処理(OR) $match = 1; foreach $term (@keys) { if ($string =~ /$term/i) { $match = 0; }} # １つでも合っているか？ } else { # 論理積処理(AND) $match = 0; foreach $term (@keys) { if (!($string =~ /$term/i)) { $match = 1; }} # １つでも合わないものがあるか？ } if ($match == 1) { next; } } if ($hit != $page) { push(@MESSAGE,$line); $hit++; } # １ページ($page件)に満たない場合は抽出して件数を数える else { $next_control = $page_control; last; } # 達したら、ここまで至った行数を次の読み飛ばし行数として指定して終了 } if ($in{'str'} ne '' && !@MESSAGE) { &Error("Not Found","「$keys2」では見当たりませんでした."); } # 検索モードで抽出が無かった場合 } sub MailForm { if ($send_host) { $msg = "・送信者のホスト名やブラウザ情報も送信されます."; } &Html_head; # ヘッダの出力 print "$body\n"; print <<"EOF";

$cmd{'name'}さんへのメール送信

名前
タイトル
Ｅメール (任意)
本文
　 　

$msg

〔前に戻る〕

EOF } sub Toku_Mail { if ($in{'num'} eq '') { &Error("エラー","異常があります."); } if ($in{'NAME'} eq '') { &Error("未記入があります","名前を入力してください."); } if ($in{'EMAIL'} ne '' && !($in{'EMAIL'} =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/)) { &Error("エラー","Ｅメールを半角で正しく入力してください."); } if ($in{'Subject'} eq '') { &Error("未記入があります","タイトルを入力してください."); } if ($in{'VALUE'} eq '') { &Error("未記入があります","内容を入力してください."); } @pickup = grep(/^$in{'num'}\t/,@messages); $i = @pickup; if ($i == 0) { &Error("エラー","メール送信先が見当たりません(記事が削除された可能\性があります)."); } elsif ($i > 1) { &Error("エラー","同じ番号の記事が存在しているために、データ異常です."); } ($number,$pwd,$date,$name,$email,$sex,$host,$title,$mode,$link,$toku_email,$value) = split(/\t/,$pickup[0],12); if ($deleted{$number} == 1) { &Error("エラー","送信しようとした相手の記事は削除されたために送信できませんでした."); } unless ($email =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/) { &Error("エラー","送信先が不適切な形式のＥメールまたは設定されていませんので送信できませんでした."); } if (open(OUT,"| $sendmail -t")) { # 匿メール送信 print OUT "X-DATE: $date_now2\n"; print OUT "To: $email\n"; print OUT "Errors-To: $administrator\n"; if ($in{'EMAIL'} ne '') { $resp = "$in{'NAME'} \<$in{'EMAIL'}\>さんから"; } else { $resp = "$in{'NAME'} <Ｅメール記入なし> さんから"; } print OUT "From: $administrator\n"; print OUT &jis("Subject: $in{'Subject'}\n"); # 全角を含むものはJIS変換 if ($send_host) { # 記入者情報 $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; } print OUT "X-HTTP_USER_AGENT: $ENV{'HTTP_USER_AGENT'}\n"; print OUT "X-REMOTE_HOST: $host\n"; print OUT "X-REMOTE_ADDR: $ENV{'REMOTE_ADDR'}\n"; } print OUT "Content-Transfer-Encoding: 7bit\n"; print OUT "Content-Type: text/plain; charset=iso-2022-jp\n\n"; $in{'NAME'} =~ s/<//g; $in{'NAME'} =~ s/"/"/g; $in{'NAME'} =~ s/&/&/g; print OUT &jis("$respのメールを転送します。\n\n"); print OUT &jis("------メッセージ------\n"); $in{'VALUE'} =~ s/<//g; $in{'VALUE'} =~ s/"/"/g; $in{'VALUE'} =~ s/&/&/g; print OUT &jis("$in{'VALUE'}\n"); print OUT &jis("----------------------\n\n"); print OUT &jis("$title_bar{$cmd{'log'}}から送信されたメールです.\n"); print OUT &jis("http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}?log=$cmd{'log'}\n\n"); } sub jis { $msg = $_[0]; &jcode'convert(*msg,'jis'); return $msg; } # JIS変換 close(OUT); &Html_head; print "$body\n"; print <<"EOF";

送信しました

〔掲示板に戻る〕

EOF } sub View_Message { &Search; # 抽出処理へ if ($in{'page_control'} != 0) { $jsback = '〔前に戻る〕'; } # 最初の画面以外は戻るリンクを用意 if ($COOKIE{'sex'} ne '') { $sex_checked[$COOKIE{'sex'}] = "checked"; } if ($COOKIE{'toku_email'} eq '') { $COOKIE{'toku_email'} = 0; } $toku_email_checked[$COOKIE{'toku_email'}] = "checked"; &Html_head; print <<"EOF"; $body $head_msg{$cmd{'log'}}

EOF if ($admin_mode) { print $admin_mode_msg; } print <<"EOF";

EOF # ↓更新・トップページリンク print <<"EOF";

$jsback〔更新〕〔トップページ〕 文字列 空白で区切って複数指定した場合に 全ての語を含む いずれかの語を含む
EOF if ($in{'str'} ne '') { # 検索処理をしたとき print "《検索モード》 → $keys2 (通常モードへは[更新]を行ってください)
\n"; } print <<"EOF";

EOF foreach $message (@MESSAGE) { $message =~ s/\n//; ($number,$pwd,$date,$name,$email,$sex,$host,$title,$mode,$link,$toku_email,$value) = split(/\t/,$message,12); $sex = $SEX[$sex]; if ($toku_email == 0 && $email =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/) { # $name = "$name ($sex) <$email> " $name = "$name $email> "; } # Ｅメール記載があればリンクする elsif ($toku_email == 1 && $email =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/) { $uname = $name; $uname =~ s/([^0-9A-Za-z_])/"%" . unpack("H2",$1)/ge; # URLエンコード # $name = "$name ($sex) & $name = "$name メール送信> "; } else { # $name = "$name ($sex) " $name = "$name"; } if ($host eq '') { $viewhost = 0; } # ホスト名の記録がない場合は表示しない if (!$viewhost) { $host = ''; } else { $host = "- $host"; } $delsw = ""; # ↓記事一覧 print <<"EOF";
【$number】$title
$date - $name $host $delsw

EOF if ($link) { # URLをリンクする $value =~ s/>/\t/g; $value =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1\:$2<\/a>/ig; $value =~ s/\t/>/g; } if ($mode == 0) { print "

"; } # 図/表モード(0)

		if ($mode == 0) { print $value; } # 図/表モード(0)
		elsif ($mode == 1) { $value =~ s/\r/
\r/g; print $value; } # 改行有効(1)
		else { $value =~ s/\r//g; print $value; } # 改行無効(2)

		if ($mode == 0) { print "

\n"; } # 図/表モード(0) print "

\n"; } if (!@MESSAGE) { print "・記事はありません."; } print <<"EOF";

EOF # ↓次のページ・削除ボタン print <<"EOF"; EOF if ($in{'str'} ne '') { if ($next_control ne '') { print "\n"; print "\n"; print "\n"; print "\n"; } } elsif ($next_control ne '') { print "\n"; } if (@MESSAGE) { print "\n"; } if ($in{'page_control'} != 0) { print "\n"; } print <<"EOF";
パスワード $jsback

　$jsback〔更新〕〔トップページ〕

EOF if ($next_control eq '') { print "次のページはありません.

\n"; } $size = -s $message_file; $free = $maxsize - $size; 1 while $free =~ s/(.*\d)(\d\d\d)/$1,$2/g; print <<"EOF"; 問い合わせ先：$administrator

EOF } sub Write_Message { if ($in{'NAME'} eq '' || $in{'NAME'} =~ /[\<\>\,\;\:]/) { &Error("未記入があります","名前を入力してください.","\<\>\,\;\:は使えません."); } if ($in{'sex'} eq '') { &Error("未記入があります","性別を選択してください."); } if ($in{'EMAIL'} eq '' && $in{'toku_email'} == 1) { &Error("未記入があります","匿メール送信のためにＥメールの記入が必須です."); } if ($in{'EMAIL'} ne '' && !($in{'EMAIL'} =~ /\b[-\w.]+@[-\w.]+\.[-\w]+\b/)) { &Error("未記入があります","Ｅメールを半角で正しく入力してください."); } if ($in{'TITLE'} eq '') { &Error("未記入があります","タイトルを入力してください."); } if ($in{'VALUE'} eq '') { &Error("未記入があります","本文を入力してください."); } if ($in{'PASSWD'} eq '' || $in{'PASSWD'} =~ /\W/ || length($in{'PASSWD'}) < 6) { &Error("未記入があります","６文字以上のパスワードを半角英数字で入力してください.","あなたが今投稿しようとしているこの記事を削除するためのパスワードです."); } if ($admin_mode) { ($admin) = &CheckAdmin($in{'PASSWD'}); if (!$admin) { &Error("記録不可","この掲示板は現在、管理者しか投稿できないようになっています.","パスワード欄には管理者パスワードを入力してください."); } } $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; } # 既に記録された最新のデータと比較 $sample = "$in{'NAME'}\t$in{'EMAIL'}\t$in{'sex'}\t$in{'toku_email'}\t$in{'TITLE'}\t$in{'MODE'}\t$in{'LINK'}\t$in{'VALUE'}"; if ($messages[0] ne '') { $messages[0] =~ s/\n//; } # 改行を削除 ($number2,$pwd2,$date,$name,$email,$sex,$host2,$title,$mode,$link,$toku_email,$value) = split(/\t/,$messages[0],12); $target = "$name\t$email\t$sex\t$toku_email\t$title\t$mode\t$link\t$value"; if ($sample eq $target && !$deleted{$number2}) { return; } ($number,$i) = split(/\t/,$messages[0],2); # 最大番号を取り出す $number ++; # 番号を+1する ($pwd) = &MakeCrypt($in{'PASSWD'}); # パスワードの暗号化 $new = "$number\t$pwd\t$date_now\t$in{'NAME'}\t$in{'EMAIL'}\t$in{'sex'}\t$host\t$in{'TITLE'}\t$in{'MODE'}\t$in{'LINK'}\t$in{'toku_email'}\t$in{'VALUE'}\n"; # 記録するデータ $lockfile = "$tmp_dir$cmd{'log'}\.lock"; &lock; if (!open(DB,">> $message_file")) { &Error('書出エラー','メッセージファイルが開けませんでした.'); } print DB $new; close(DB); while (-s $message_file > $maxsize) { # サイズ調整 if (!open(DB,$message_file)) { &Error('読込エラー','メッセージファイルが開けませんでした.'); } @lines = ; close(DB); shift(@lines); if (!open(DB,"> $message_file")) { &Error('書出エラー','メッセージファイルが開けませんでした.'); } print DB @lines; close(DB); } unlink($lockfile); if (!$in{'cookie'}) { # クッキーを削除するには正確な過去を設定する $date_gmt = "Sun, 01-Jan-1995 01:00:00 GMT"; $COOKIE{'NAME'} = $COOKIE{'EMAIL'} = $COOKIE{'PASSWD'} = $COOKIE{'sex'} = $COOKIE{'toku_email'} = ""; } else { ($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); if ($in{'cookie'}) { $COOKIE{'NAME'} = $in{'NAME'}; $COOKIE{'EMAIL'} = $in{'EMAIL'}; $COOKIE{'PASSWD'} = $in{'PASSWD'}; $COOKIE{'sex'} = $in{'sex'}; $COOKIE{'toku_email'} = $in{'toku_email'}; } } print "Set-Cookie: $ENV{'SCRIPT_NAME'}\_$cmd{'log'}=NAME:$COOKIE{'NAME'}\,EMAIL:$COOKIE{'EMAIL'}\,PASSWD:$COOKIE{'PASSWD'}\,sex:$COOKIE{'sex'}\,toku_email:$COOKIE{'toku_email'}; expires=$date_gmt\n"; # クッキーをセット } sub Delete_Message { if (!@DELETE) { return; } # １つもチェックされていなければ処理しない foreach $message (@messages) { # 記事の存在とパスワードを処理するための準備 ($number,$pwd,$i) = split(/\t/,$message,3); $check_pwd{$number} = $pwd; # 番号をキー、値をパスワードにした連想配列%check_pwdを用意 } ($admin) = &CheckAdmin($in{'PASSWD'}); # 管理者パスワードかどうか？ if ($admin) { # 管理者パスワードの場合は簡易チェックのみ foreach $number (@DELETE) { $number =~ s/\n//; if ($check_pwd{$number} eq '') { push(@ERR,"$number(N)"); } # 存在しない記事番号 elsif ($deleted{$number}) { push(@ERR,"$number(D)"); } # 削除済み else { $deleted{$number} = 1; # 削除指定記事とする push(@DELETE_OK,"$number"); # 削除する記事番号 } } } else { # 管理者パスワードでない場合は記事のパスワード照合 foreach $number (@DELETE) { $number =~ s/\n//; if ($check_pwd{$number} eq '') { push(@ERR,"$number(N)"); next; } elsif ($deleted{$number}) { push(@ERR,"$number(D)"); next; } if ($check_pwd{$number} =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; } if (crypt($in{'PASSWD'},substr($check_pwd{$number},$salt,2)) eq $check_pwd{$number}) { $deleted{$number} = 1; push(@DELETE_OK,"$number"); } # 認証 else { push(@ERR,"$number(A)"); } } } if (@ERR) { &Error('エラー','パスワードが合わない記事が１つ以上存在しています.','削除したいチェックしたすべての記事が削除権限(管理者またはパスワードが合う)を持っていないと削除実行できません.'); } $lockfile = "$tmp_dir/$cmd{'log'}\.lock"; &lock; if (!open(DB,$message_file)) { &Error('エラー','メッセージファイルが開けませんでした.'); } @lines = ; close(DB); foreach $line (@lines) { ($number,$pwd,$i) = split(/\t/,$line,3); $i = 1; foreach $num (@DELETE_OK) { if ($number == $num) { $i = 0; last; } } if ($i) { push(@new,$line); } } if (!open(DB,">$message_file")) { &Error('エラー','メッセージファイルが開けませんでした.'); } print DB @new; close(DB); unlink($lockfile); undef %check_pwd; # メモリ開放 } sub Html_head { $title_bar{$cmd{'log'}} =~ s/\n//g; print "Content-type: text/html\n\n"; print <<"EOF"; $title_bar{$cmd{'log'}} EOF } sub PasswordForm { &Html_head; print <<"EOF"; $body

管理者パスワードの設定/変更

EOF if (!-z $pwd_file) { print "現パスワード
\n"; } print <<"EOF"; 新パスワード
新パスワード (もう一度)

EOF if (!-z $pwd_file) { print "[戻る]

\n"; } 1 while $maxsize =~ s/(.*\d)(\d\d\d)/$1,$2/g; print "

\n"; print "

    \n"; print "
  • データの最大保存サイズ：$maxsize bytes\n"; print "

\n"; exit; } sub Set_MasterPassword { if (!-z $pwd_file) { if (!open(READ,$pwd_file)) { &Error('エラー','管理者用パスワードファイルが読み出せません.'); } $master = ; close(READ); $master =~ s/\n//g; if ($master =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; } if (crypt($in{'old_password'},substr($master,$salt,2)) ne $master) { &Error("Authorization Required",'現パスワードが認証されませんでした.'); } } if (length($in{'new_password'}) < 6 || $in{'new_password'} eq '') { &Error('入力ミス','6文字以上のパスワードを指定してください.'); } if ($in{'new_password'} ne $in{'retype_password'}) { &Error('入力ミス','２回入力したパスワードが合いません.'); } ($pwd) = &MakeCrypt($in{'new_password'}); if (!open(WRITE,"> $pwd_file")) { &Error('エラー','管理者用パスワードファイルに記録できません.'); } print WRITE $pwd; close(WRITE); } sub CheckAdmin { local($input) = @_; local($admin); $admin = 0; if (!open(READ,$pwd_file)) { &Error('エラー','管理者用パスワードファイルが読み出せません.'); } $master = ; close(READ); $master =~ s/\n//; if ($master =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; } if ($master eq '' || $input eq '') { ; } elsif (crypt($input,substr($master,$salt,2)) eq $master) { $admin = 1; } # 認証できたら$adminを定義 return $admin; } sub MakeCrypt { local($plain) = @_; # 入力:平文 local(@char,$f,$now,@saltset,$pert1,$pert2,$nsalt,$salt); @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]; $result = crypt($plain,$nsalt); if ($result =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; } if (crypt($plain,substr($result,$salt,2)) ne $result || $result eq '') { &Error("暗号処理エラー","パスワードの暗号化に失敗しました.","戻って再度実行してください."); } # 稀に暗号処理が正しくされていない場合があるので return $result; # 戻値:暗号 } sub lock { # ロック方式の自動判定 symlink()優先 $symlink_check = (eval { symlink("",""); }, $@ eq ""); if (!$symlink_check) { $c = 0; while(-f "$lockfile") { # file式 $c++; if ($c >= 3) { &Error('リトライエラー','ただいま混雑しております.
戻ってもう一度実行してみてください.'); } sleep(2); } open(LOCK,">$lockfile"); close(LOCK); } else { local($retry) = 3; while (!symlink(".", $lockfile)) { # symlink式 if (--$retry <= 0) { &Error('リトライエラー','ただいま混雑しております.
戻ってもう一度実行してください.'); } sleep(2); } } } sub Error { unlink($lockfile); local (@msg) = @_; local ($i); &Html_head; print <<"EOF"; $body

$msg[0]

EOF if ($msg[1] ne '') { print "
    \n"; foreach $i (1 .. $#msg) { print "
  • $msg[$i]\n"; } print "
\n"; } print <<"EOF";

[戻る]

EOF exit; } sub Copyright { @array = ( "47","49","46","38","39","61","27","00","1a","00","b3","00","00","00","00","00","ff","ff","ff","00", "00","00","00","00","00","00","00","00","00","00","00","00","00","00","00","00","00","00","00","00", "00","00","00","00","00","00","00","00","00","00","00","00","00","00","00","92","92","92","00","00", "00","21","f9","04","01","00","00","00","00","2c","00","00","00","00","27","00","1a","00","40","04", "b6","10","c8","49","ab","bd","d8","86","e0","b6","fb","1b","d7","01","5e","08","92","60","19","5c", "62","e7","b9","9f","2b","be","e1","86","d5","38","89","87","d2","6e","67","93","d6","88","33","eb", "f1","76","41","5e","c5","c7","6c","fa","58","29","14","cc","25","f5","9d","80","ad","df","2b","75", "bd","75","7b","d3","52","2a","2b","8c","6d","57","46","22","6d","cd","e6","ca","be","94","b2","59", "7e","da","c2","e3","f2","5a","6c","2e","e5","b3","da","6f","81","6c","44","40","69","3f","86","48", "19","35","1a","59","3a","73","34","58","70","62","81","63","6a","2a","32","25","1a","61","61","8e", "6f","26","82","4b","94","67","55","55","2a","45","14","7b","97","a9","a9","00","66","7b","ac","7f", "4e","4c","88","87","7f","63","b7","82","a6","54","8a","b8","9f","be","67","b5","50","bd","64","45", "9f","77","71","75","33","c5","ca","23","28","c1","41","ad","af","c6","a9","d3","51","85","d7","d8", "19","11","00","00","3b"); print "Content-type: image/gif\n\n"; foreach (@array) { $data = pack('C*',hex($_)); print $data; } exit; }