0032 source

#!/usr/bin/perl

;# WWWBBS version 3.0（フリーソフト）
;#
;# Created on: 01/Sep/97
;# I can be reached at: resq@rescue.ne.jp
;# Scripts Found at: http://www.rescue.ne.jp/
;#
;# <履歴>
;# v1.3 11/Feb/98
;# v1.3 12/Jul/98 モード矯正を追加
;# v1.3 24/Aug/98 初期設定の充実
;# v2.0 17/Sep/98 西暦2000〜2069年対応、３改行モード、自動リンク、リファレンスチェック、ホスト名表示スイッチ等
;# v2.1 18/Sep/98 Eメール自動リンクの中止
;# v2.2 20/Sep/98 v1とv2のデータ互換性を検討修正
;# ----- (ここを境にデータ互換はありません)
;# v3.0 03/Apr/99 番号の整列、一覧取得処理の変更

###########################################################################################
#
# 基本構成（初期設定はこの構成を前提に設定されています）[ ] 内はパーミッッション値の例
#
# public_html/（ホームページディレクトリ）
# |
# |---- bbs/（ＣＧＩが実行できる任意のディレクトリ）
# |
# |-- data/ (データディレクトリ) [777]
# |
# |-- jcode.pl [644]
# |-- wwwbbs.cgi [755] <- このＣＧＩスクリプトを実行
# |-- master.cgi [666] <- 空のファイル(マスターキーが暗号化されて記録)(*1)
#
# (*1)..この拡張子は単にCGIとして認識させてウェブ上から見えなくするためのもの.
# 運用初回の場合、空のファイルを用意する.
#
###########################################################################################

## 初期設定 ##

#●運用責任者のＥメール
$administrator = 'golog@issp.u-tokyo.ac.jp';

#●設置したＵＲＬ
$reload = 'http://www.issp.u-tokyo.ac.jp/labs/spectroscopy/akiyama/golgo/cgi-bin/wwwbbs.cgi';

#●設置したＵＲＬ以外からの不正な投稿を検知する　する=1 しない=0
#　(正規に投稿しても不正検知してしまう場合は仕方ないので 0 に設定する)
$ref_axs = 0;

#●終了ボタンを押すと表示するページのＵＲＬ
$bye = 'http://www.issp.u-tokyo.ac.jp/labs/spectroscopy/akiyama/golgo/index.html';

#●画面表示するタイトル
$title = '電子掲示板';

#●ブラウザの上部バーに表示するタイトル
$title2 = 'WWWBBS';

#●冒頭にＨＴＭＬ形式でメッセージが入れられます
$message = '

<ul>
<li>ここにメッセージが入れられます.
<li>ＨＴＭＬ形式で自由に記述してください.
<li>何も書かなくても結構です.
</ul>

';

#●１回に画面表示する件数
#インデックスファイルを持たないシステムなので
#この件数を大きくするとその回数だけ記事ファイルにアクセスしますので
#できるだけこれ以下でご利用ください.
$def = 20;

#●<body>設定
$body = '<body bgcolor="#ffeedd">';

#●jcode.plの設定(パス)
require './jcode.pl';

#●マスターキーファイルmaster.cgiの設定(パス)
$pwd_file = './master.cgi';

#●msg/ディレクトリの場所の設定(パス)
$data_dir = './data/';

#●インターネットエスクプローラ利用時に表示フォントを大きくする　する=1 しない=0
#　(図表モード<pre>表示時にＩＥではフォントサイズが小さくなってしまう現象を是正する処理)
#　(処理の都合上、図表モードに限らず全てのモードで大きくなる)
$IEfont = 1;

#●リモートホスト名を表示する　する=1 しない=0
$viewhost = 1;

###########################################################################################

#■時間処理

($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
@wday_array = ('日','月','火','水','木','金','土');
$date_now = sprintf("%04d/%01d/%01d(%s) %02d:%02d",$year +1900,$mon +1,$mday,$wday_array[$wday],$hour,$min);

#■入力処理

$number = $ENV{'QUERY_STRING'};

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

#■入力処理

$line_count = 0;
@pairs = split(/&/,$buffer);
foreach $pair (@pairs) {

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

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

$value =~ s/</</g;
$value =~ s/>/>/g;
$value =~ s/\t//g;

#改行処理 WINDOWS -> UNIX
$value =~ s/\r\n/\n/g;

#改行処理 MAC -> UNIX
$value =~ s/\r/\n/g;

if ($name eq "ikkatsu") { push(@IKKATSU,$value); }
else { $FORM{$name} = $value; }
}

#■マスターキー確認

if (!open(IN,$pwd_file)) { &error('システム設定','マスターキーが開けません.'); }
$master = <IN>; chop($master) if $master =~ /\n$/;
close(IN);
if ($FORM{'action'} eq 'change_master') { &set_master; }
if ($FORM{'action'} eq 'set_master') { &set_master2; }
if ($master eq '') { &set_master; }

#■分岐

if ($number =~ /\d+/) { &view; }
if ($buffer eq '') { $start = 0; } else { $start = $FORM{'start'} + 1; }

if ($master =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; }
if ($FORM{'action'} eq 'post') { &post; }
elsif ($FORM{'action'} eq 'write') { &write; }
elsif ($FORM{'action'} eq 'remove') { &remove; }
elsif ($FORM{'action'} eq 'admin' && (crypt($FORM{'master'}, substr($master,$salt,2)) eq $master)) { $admin = 1; &list; }
elsif ($FORM{'action'} eq 'admin_remove' && (crypt($FORM{'master'}, substr($master,$salt,2)) eq $master)) { &ikkatsu; }

&list;

sub getdir {

chdir($data_dir);
@newls = ();

$od_check = (eval { opendir(DIR,'.'); }, $@ eq "");
if (!$od_check) {

$ls_check = (eval { $ls = `ls`; }, $@ eq "");
if (!$ls_check) { &error("致命的なエラー","一覧を抽出することができません."); }
else { @ls = split(/\s+/,$ls); }
}
else {
@ls = readdir(DIR);
close(DIR);
}

foreach (@ls) {

next if $_ eq '.';
next if $_ eq '..';
next if -d $_;
if (/(\d+)\.txt/) { push(@newls,$_); }
}

$all = @newls;
@newls = sort { $b <=> $a; } @newls;
chdir('..');
}

sub list {

&getdir;

if ($all <= ($start + $def - 1)) { $end = $all - 1; }
else { $end = $start + $def - 1; }

print "Content-type: text/html\n\n";
print "<html>\n<head>\n<title>$title2</title>\n\n";
print "<!--\n";
print " This WWWBBS's administrator is $administrator\n";
print " この電子掲示板の運用責任者へのお問い合わせ先は $administrator です.\n";
print "-->\n\n</head>\n\n";
print "$body\n";
print "<h2>$title</h2>\n";
print "$message<p>\n";

if ($all != 0) {

$start1 = $start + 1;
$end1 = $end + 1;
print "全$all件<p>\n";

print "<table border=2 cellpadding=1 cellspacing=1>\n";

if ($admin) { print "<tr><th>削除</th><th>番号</th><th>記録日</th><th>記録者</th><th>題名</th><th>サイズ</th><th>参照数</th></tr>\n"; }
else { print "<tr><th>番号</th><th>記録日</th><th>記録者</th><th>題名</th><th>サイズ</th><th>参照数</th></tr>\n"; }
print "<tr><th colspan=6></th></tr>\n";

foreach $file ($start .. $end) {

($file,$ext) = split(/\./,$newls[$file],2);

if (!open(IN,"$data_dir$file\.txt")) { push(@ERR,$file); next; }
@lines = <IN>;
close(IN);

&header;

if (length($name) > 20) { $name = substr($name,0,18); $name = $name . '..'; }
if (length($subject) > 60) { $subject = substr($subject,0,58); $subject = $subject . '..'; }

print "<tr>\n";
if ($admin) {

print "<form method=post action=\"$reload\">\n";
print "<input type=hidden name=\"action\" value=\"admin_remove\">\n";
print "<input type=hidden name=\"master\" value=\"$FORM{'master'}\">\n";
print "<th><input type=checkbox name=\"ikkatsu\" value=\"$file\"></th>\n";
}

print "<td><center><a href=\"$reload\?$file\">$file</a></center></td>\n";
print "<td>$date</td>\n";

if ($email =~ /(.*)\@(.*)\.(.*)/) { print "<td><a href=\"mailto:$email\">$name</a></td>\n"; }
else { print "<td>$name</td>\n"; }

print "<td>$subject</td>\n";
print "<td><center>$size</center></td>\n";
print "<td><center>$rc</center></td></tr>\n";
}

print "</table><p>\n";
}
else { print "メッセージはありません.<p>\n"; }

if (@ERR) { print "<b>警告！</b>次のメッセージのファイルが開けません > @ERR<p>\n"; }

if ($admin) { print "<br><input type=submit value=\"一括削除の実行\"></form>\n"; }

print "<form method=post action=\"$reload\">\n";
print "<table border=0><tr>\n";

$i = $all - 1;
if ($end < $i) {

if ($admin) {

print "<input type=hidden name=\"action\" value=\"admin\">\n";
print "<input type=hidden name=\"master\" value=\"$FORM{'master'}\">\n";
}

print "<input type=hidden name=\"start\" value=\"$end\">\n";
print "<th><input type=submit value=\"次のページ\"></th>\n";
}


print "<th><font size=+1><b>[<a href=\"$reload\?action=post\">新規投稿</a>]";
print " [<a href=\"$reload\">更新</a>]";
print " [<a href=\"$bye\">終了</a>]</b></font></th></tr></table></form>\n";

# 表示義務
print "<h5 align=right><a href=\"http://www.rescue.ne.jp/\" target=\"_top\">WWWBBS v3.0</a></h5>\n";

if (! $admin) {

print "<pre>\n\n\n\n\n</pre><p>\n";

print "<form method=post action=\"$reload\">\n";
print "<input type=hidden name=\"action\" value=\"admin\">\n";
$start--;
print "<input type=hidden name=\"start\" value=\"$start\">\n";
print "<hr noshade size=1>マスターキー <input type=password name=\"master\" size=10> <input type=submit value=\"一括削除\">";
print " <font size=-1>[<a href=\"$reload\?action=change_master\">マスターキー変更</a>]</font></form>\n";
}

print "</body></html>\n";
exit;
}

sub header {

if ($lines[0] =~ /^Crypt\:(.*)/) { $crypt = $1; }
if ($lines[1] =~ /^Rc\:(.*)/) { $rc = $1; }
if ($lines[2] =~ /^Date\:(.*)/) { $date = $1; }
if ($lines[3] =~ /^Subject\:(.*)/) { $subject = $1; }
if ($lines[4] =~ /^Name\:(.*)/) { $name = $1; }
if ($lines[5] =~ /^Email\:(.*)/) { $email = $1; }
if ($lines[6] =~ /^Size\:(.*)/) { $size = $1; }
if ($lines[7] =~ /^Host\:(.*)/) { $host = $1; }
if ($lines[8] =~ /^Homepage\:(.*)/) { $homepage = $1; }
if ($lines[9] =~ /^Tree\:(.*)/) { $tree = $1; }
}

sub view {

if (!open(IN,"$data_dir$number\.txt")) { &error('入出力エラー',"$number番のメッセージファイルは削除されました."); }
@lines = <IN>;
close(IN);
&header;
$axs = @lines;

print "Content-type: text/html\n\n";
print "<html><head><title>$title2</title></head>\n\n";
print "$body\n";
print "<h2>$number $subject<hr></h2>\n";

if ($IEfont && $ENV{'HTTP_USER_AGENT'} =~ /MSIE/i) { $IE = 1; } else { $IE = 0; }
if ($ver == 1) { print "<pre>"; }
if ($IE) { print "<font size=+1>"; }
foreach $num (11 .. $axs - 1) { print $lines[$num]; }
if ($IE) { print "</font>"; }
if ($ver == 1) { print "</pre>"; }
print "<p>\n";

if ($homepage ne '') { print "<a href=\"$homepage\">$homepage</a><p>\n"; }

if ($viewhost) { $host = "[$host]"; } else { $host = ""; }

print "<hr><p>\n";
if ($email =~ /(.*)\@(.*)\.(.*)/) { print "●記録者 <a href=\"mailto:$email\">$name</a> $host<br>\n"; }
else { print "●記録者 $name $host<br>\n"; }
print "●記録日 $date<p>\n";

print "<table border=1 cellpadding=0 cellspacing=1><tr>\n";
print "<form method=post action=\"$reload\">\n";
print "<input type=hidden name=\"action\" value=\"post\">\n";
print "<input type=hidden name=\"resp_number\" value=\"$number\">\n";
print "<input type=hidden name=\"resp_subject\" value=\"$subject\">\n";
print "<input type=hidden name=\"resp_base\" value=\"$tree\">\n";
print "<th><input type=submit value=\"このメッセージへ返事を書く\"></th></form>\n";

print "<form method=post action=\"$reload\">\n";
print "<input type=hidden name=\"action\" value=\"remove\">\n";
print "<input type=hidden name=\"remove_number\" value=\"$number\">\n";
print "<th>パスワード <input type=password name=\"pwd\" size=10>";
print "<input type=submit value=\"削除\"></th></form>\n";

print "<form action=\"$reload\">\n";
print "<th><input type=submit value=\"　一覧　\"></th></tr></table></form><p>\n";

print "<hr><p>\n";

#■参照数処理

$rc++;
$lines[1] = "Rc:$rc\n";
if (!open(OUT,"> $data_dir$number\.txt")) { &error('入出力エラー',"$number番のメッセージファイルに参照数データを記録できません."); }
print OUT @lines;
close(OUT);

#■スレッド処理

if (!open(IN,"$data_dir$tree\.tre")) { print '<b>構成の最初の記事が削除されたため構成図は表示されません.</b><p>' . "\n"; exit; }
@tr_file = <IN>;
close(IN);

print '<h3>メッセージの構成図</h3>' . "\n";
print "<blockquote><i>\n";
foreach (@tr_file) {

if (/.*\s\s$number.*/) { s/(.*) $number(.*)/\1 \<\;<b>$number<\/b>\>\;\2/g; }
elsif (/.*\s\s(\d+).*/) { s/(.*\s\s)(\d+)(.*)/\1\<\;<a href\=\"$reload\?\2\"\>\2<\/a>\>\;\3/g; }
elsif (/.*\`\-\-$number.*/) { s/(.*)\`\-\-$number(.*)/\1<b>\`\-\-$number<\/b>\2/g; }
else { s/(.*)\`\-\-(\d+)(.*)/\1\`\-\-\<a href\=\"$reload\?\2\"\>\2<\/a>\3/g; }
print;
}
print "</i></blockquote><p></body></html>\n";

exit;
}

sub post {

#■クッキー処理

$cookies = $ENV{'HTTP_COOKIE'};

@pairs = split(/;/,$cookies);
foreach $pair (@pairs) {

($key,$val) = split(/=/,$pair,2);
$key =~ s/ //g;

if ($key eq $reload) {

@pairs = split(/,/,$val);
foreach $pair (@pairs) {

($key,$val) = split(/:/,$pair,2);
$COOKIE{$key} = $val;
}
last;
}
}

if ($COOKIE{'name'} =~ /匿名/) { $COOKIE{'name'} = ''; }

#■画面

if ($FORM{'resp_number'} ne '') { $write_title = "$FORM{'resp_number'}への返信"; }
else { $write_title = "新規投稿"; }

print "Content-type: text/html\n\n";
print "<html><head><title>$title2</title></head>\n\n";
print "$body\n";
print "<h2>$write_title<hr></h2>\n";

print "<form method=post action=\"$reload\">\n";
print "<input type=hidden name=\"action\" value=\"write\">\n";
print "<input type=hidden name=\"resp_number\" value=\"$FORM{'resp_number'}\">\n";
print "<input type=hidden name=\"resp_subject\" value=\"$FORM{'resp_subject'}\">\n";
print "<input type=hidden name=\"resp_base\" value=\"$FORM{'resp_base'}\">\n";

#■タイトル処理

print "<b>記録者　　</b> <input type=text name=\"name\" size=20 value=\"$COOKIE{'name'}\"><br>\n";
print "<b>Ｅメール　</b> <input type=text name=\"email\" size=40 value=\"$COOKIE{'email'}\"><p>\n";

if ($FORM{'resp_subject'} eq '') { print "<b>題名　　　</b> <input type=text name=\"subject\" size=40><br>\n"; }
elsif ($FORM{'resp_subject'} =~ /^re\((.*)\):(.*)/) {

$title = $2;
if ($1 =~ /(\d+)/) {

$resnum = ($1 + 1);
print "<b>題名</b> <input type=text name=\"subject\" size=40 value=\"re($resnum)\:$title\"><p>\n";
}
else { print "<b>題名</b> <input type=text name=\"subject\" size=40 value=\"re\:$FORM{'resp_subject'}\"><p>\n"; }
}
else { print "<b>題名　　　</b> <input type=text name=\"subject\" size=40 value=\"re(1)\:$FORM{'resp_subject'}\"><p>\n"; }

print "<b>内容</b><font size=-1>\n";
print "<input type=radio name=\"pre\" value=\"-1\" checked>改行有効";
print "<input type=radio name=\"pre\" value=\"0\">改行無効";
print "<input type=radio name=\"pre\" value=\"1\">図/表\モード</font><br>\n";

print "<textarea name=\"value\" rows=5 cols=70 wrap=off></textarea><br>\n";
print "　<font size=-1><input type=checkbox name=\"link\" value=\"1\" checked>内容にURLがあればリンクさせる</font><p>\n";

print "<b>パスワード</b> <input type=password name=\"pwd\" size=10 value=\"$COOKIE{'pwd'}\"> (記事の削除時に使用)<p>\n";
print "<input type=submit value=\"　投稿　\"><input type=reset value=\"リセット\">\n";
print "</form><p>\n";

print "<ul>\n";
print "<li>注意！投稿直後にブラウザの[更新]ボタンを押すと２重投稿になります.<p>\n";
print "<li>[改行有効] 改行を入れた位置で折り返し、行頭などの半角スペースを無視して記録します.\n";
print "<li>[改行無効] 行頭などの半角スペースや改行位置を無視して詰めて記録します.\n";
print "<li>[図/表\モード] 記入された通りに記録します.\n";
print "</ul>\n";

print "</body></html>\n";
exit;
}

sub write {

#■入力チェック

if ($ENV{'REQUEST_METHOD'} ne "POST") { &error('エラー','標準入力(POST)のみ使用できます.'); }

if ($ref_axs) {

$ref = $ENV{'HTTP_REFERER'};
$ref =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$ref_url = $reload;
$ref_url =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

if (!($ref =~ /$ref_url/i)) { &error('投稿不可',"「$reload」以外からの投稿を検知しました."); }
}

&getdir;
$basenum = sprintf("%04d",$newls[0] + 1);

if ($basenum > 9999) { &error("DISK FULL","管理できる記事番号を超えましたので、投稿できません."); }

if ($FORM{'resp_number'} ne '') { if (!-e "$data_dir$FORM{'resp_number'}\.txt") { &error('返信エラー',"返信元となる$FORM{'resp_number'}番の記事は削除されていますので投稿できません."); }}
if ($FORM{'resp_base'} ne '') { if (!-e "$data_dir$FORM{'resp_base'}\.txt") { $no_tree = 1; }}
else { $FORM{'resp_base'} = $basenum; }

if ($FORM{'name'} eq '') { $FORM{'name'} = '匿名'; }
if ($FORM{'subject'} eq '') { &error('入力不備','題名が書かれていません.'); }
if ($FORM{'pwd'} =~ /\W/ || $FORM{'pwd'} eq '') { &error('入力不備','パスワードを半角英数字で入力してください.'); }
if ($FORM{'value'} eq '') { &error('入力不備','内容が書かれていません.'); }

if ($FORM{'link'} == 1) {

$FORM{'value'} =~ s/>/\t/g;
$FORM{'value'} =~ s/(https?|ftp|gopher|telnet|whois|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/<a href=\"$1\:$2\" target=\"_blank\">$1\:$2<\/a>/ig;
$FORM{'value'} =~ s/\t/>/g;
}

if ($FORM{'pre'} == -1) { $FORM{'value'} =~ s/\n/<br>\n/g; }
elsif ($FORM{'pre'} == 1) { $FORM{'value'} = "<pre>$FORM{'value'}</pre>"; }

$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; }

($crypt_password) = &MakeCrypt($FORM{'pwd'});

#■記録

if (!open(DB,"> $data_dir$basenum\.txt")) { &error('記録エラー',"$data_dir$basenum\.txt 記事の記録ができません."); }
print DB "Crypt:$crypt_password\n";
print DB "Rc:0\n";
print DB "Date:$date_now\n";
print DB "Subject:$FORM{'subject'}\n";
print DB "Name:$FORM{'name'}\n";
print DB "Email:$FORM{'email'}\n";
$size = length($FORM{'value'});
print DB "Size:$size\n";
print DB "Host:$host\n";
print DB "Homepage:$FORM{'homepage'}\n";
print DB "Tree:$FORM{'resp_base'}\n\n";
print DB $FORM{'value'};
close(DB);

chmod(0666,"$data_dir$basenum\.txt");

if (! $no_tree) { &tree; }

#■クッキー処理


($secg,$ming,$hourg,$mdayg,$mong,$yearg,$wdayg,$ydayg,$isdstg) = gmtime(time + 30*24*60*60);
$y0="Sunday"; $y1="Monday"; $y2="Tuesday"; $y3="Wednesday"; $y4="Thursday"; $y5="Friday"; $y6="Saturday";
@youbi = ($y0,$y1,$y2,$y3,$y4,$y5,$y6);

$m0="Jan"; $m1="Feb"; $m2="Mar"; $m3="Apr"; $m4="May"; $m5="Jun";
$m6="Jul"; $m7="Aug"; $m8="Sep"; $m9="Oct"; $m10="Nov"; $m11="Dec";
@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);

$cook="name\:$FORM{'name'}\,email\:$FORM{'email'}\,pwd\:$FORM{'pwd'}";
print "Set-Cookie: $reload=$cook; expires=$date_gmt\n";

$start = 0;
&list;
}

sub MakeCrypt {

#----------------------------------------------------------------
# 関数 文字列の暗号化
# 引数 平文
# 戻値 暗号文
#----------------------------------------------------------------

local($plain) = @_;
local(@char,$f,$now,@saltset,$pert1,$pert2,$nsalt);

@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];
return crypt($plain,$nsalt);
}

sub tree {

#■スレッド処理

if ($basenum eq $FORM{'resp_base'}) {

if (!open(OUT,"> $data_dir$basenum\.tre")) { &error('記録エラー','スレッドファイルに記録できません.'); }
print OUT "<dl>\n";
print OUT "<dt> $basenum\n";
print OUT "<dd>";
print OUT "<!--$basenum-->\n";
print OUT "</dl>\n";
close(OUT);

chmod(0666,"$data_dir$basenum\.tre");

return;
}
else { if (!-e "$data_dir$FORM{'resp_base'}\.tre") { return; }}

if (!open(IN,"$data_dir$FORM{'resp_base'}\.tre")) { return; }
@tr_file = <IN>;
close(IN);

if (!open(OUT,"> $data_dir$FORM{'resp_base'}\.tre")) { return; }

foreach $line (@tr_file) {

if ($line =~ /<dd><!--$FORM{'resp_number'}-->/) {

print OUT "<dl>\n";
print OUT "<dt>`--$basenum\n";
print OUT "<dd><!--$basenum-->\n";
print OUT "</dl>\n";
print OUT "<dd><!--$FORM{'resp_number'}-->\n";
}
else { print OUT $line; }
}

close(OUT);

chmod(0666,"$data_dir$FORM{'resp_base'}\.tre");

}

sub remove {

$start = 0;

#■削除処理

if (!-e "$data_dir$FORM{'remove_number'}\.txt") {

&error('削除','このメッセージは既に削除されています.');
unlink("$data_dir$FORM{'remove_number'}\.tre") || return;
}

if (!open(IN,"$data_dir$FORM{'remove_number'}\.txt")) { &error('削除失敗',"$FORM{'remove_number'}番のメッセージは異常により削除できません. 管理者が直接削除してください."); }
@lines = <IN>;
close(IN);
&header;

$ok = 1;
if ($crypt =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; }
if (crypt($FORM{'pwd'}, substr($crypt,$salt,2)) eq $crypt) { $ok = 0; }
elsif (crypt($FORM{'pwd'}, substr($master,$salt,2)) eq $master) { $ok = 0; }
if ($ok) { &error('削除失敗',"パスワードが認証されませんので削除できません."); }

unlink("$data_dir$FORM{'remove_number'}\.txt") || push(@REMOVE,"MSG/$FORM{'remove_number'}");
if (-e "$data_dir$FORM{'remove_number'}\.tre") { unlink("$data_dir$FORM{'remove_number'}\.tre") || push(@REMOVE,"TREE/$FORM{'remove_number'}"); }

#■スレッド処理

if (!open(IN,"$data_dir$tree\.tre")) { return; }
@tr_file = <IN>;
close(IN);

if (!open(OUT,"> $data_dir$tree\.tre")) { return; }
foreach $line (@tr_file) { $line =~ s/$FORM{'remove_number'}/DELETED/g; print OUT $line; }
close(OUT);

chmod(0666,"$data_dir$tree\.tre");

if (@REMOVE) { &error('削除失敗',"次のファイルの削除に失敗しました. 管理者が直接削除してください. > @REMOVE"); }

&list;
}

sub ikkatsu {

$start = 0;

#■一括削除処理

foreach $temp (@IKKATSU) {

if (!-e "$data_dir$temp\.txt") { unlink("$data_dir$temp\.tre"); next; }

if (!open(IN,"$data_dir$temp\.txt")) {

unlink("$data_dir$temp\.txt") || push(@REMOVE,"MSG/$temp");
unlink("$data_dir$temp\.tre");
next;
}

@lines = <IN>;
close(IN);
&header;

unlink("$data_dir$temp\.txt") || push(@REMOVE,"MSG/$temp");
if (-e "$data_dir$temp\.tre") { unlink("$data_dir$temp\.tre") || push(@REMOVE,"TREE/$temp"); }

#■スレッド処理

if (!open(IN,"$data_dir$tree\.tre")) { next; }
@tr_file = <IN>;
close(IN);

if (!open(OUT,"> $data_dir$tree\.tre")) { next; }
foreach $line (@tr_file) { $line =~ s/$temp/DELETED/g; print OUT $line; }
close(OUT);

chmod(0666,"$data_dir$tree\.tre");

}

if (@REMOVE) { &error('削除失敗',"次のファイルの削除に失敗しました. 管理者が直接削除してください. > @REMOVE"); }

&list;
}

sub set_master {

print "Content-type: text/html\n\n";
print "<html><head><title>$title2</title></head>\n";
print "$body\n";
print "<h1>マスターキーの設定</h1>\n";
print "<form method=post action=\"$reload\">\n";
print "<input type=hidden name=\"action\" value=\"set_master\">\n";
print "<p>\n";
print "旧パスワード <input type=password name=\"old\" size=10><br>\n";
print "新パスワード <input type=password name=\"new1\" size=10><br>\n";
print "新パスワード <input type=password name=\"new2\" size=10>（確認のためもう一度）<p>\n";
print "<input type=submit value=\"　　実行　　\"><input type=reset value=\"リセット\">\n";
print "</form>\n";
print "<p></body></html>\n";
exit;
}

sub set_master2 {

if ($master =~ /^\$1\$/) { $salt = 3; } else { $salt = 0; }
if ($FORM{'old'} eq '' && $FORM{'new1'} eq '' && $FORM{'new2'} eq '') { &error('マスターキー設定','入力してください.'); }
elsif ($master eq '' && $FORM{'old'} ne '') { &error('マスターキー設定','新規設定ですので、旧パスワード欄は空欄にしてください.'); }
elsif ($master eq '' && ($FORM{'new1'} eq '' || $FORM{'new2'} eq '')) { &error('マスターキー設定','新パスワードは確認も含めて２回入力してください.'); }
elsif ($master ne '' && $FORM{'old'} eq '') { &error('マスターキー設定','旧パスワードを入力してください.'); }
elsif ($FORM{'new1'} ne $FORM{'new2'}) { &error('マスターキー設定','確認のために入力したパスワードが一致しません.'); }
elsif ($FORM{'new1'} =~ /\s/ || $FORM{'new1'} =~ /\W/) { &error('マスターキー設定','半角英数字で入力してください.'); }
elsif (length("$FORM{'new1'}") < 6) { &error('マスターキー設定','６文字以上で入力してください.'); }
elsif ($master ne '') { if (crypt($FORM{'old'}, substr($master,$salt,2)) ne $master) { &error('マスターキー設定','旧パスワードが認証されませんでした.'); }}

($crypt_password) = &MakeCrypt($FORM{'new1'});
$master = $crypt_password;

if (!open(OUT,"> $pwd_file")) { &error('マスターキー設定','マスターキーファイルに記録できません.'); }
print OUT $crypt_password;
close(OUT);
}

sub error {

local (@msg) = @_;
local ($i);

print "Content-type: text/html\n\n";

print <<"EOF";
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">
<HTML>
<HEAD>
<TITLE>ERROR</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=x-sjis">
<SCRIPT language="JavaScript">
<!--
function PageBack(){ history.back(); }
//-->
</SCRIPT>
</HEAD>
$body
<h1>$_[0]</h1>
EOF

print "<ul>\n";
foreach $i (1 .. $#msg) { print "<li>$msg[$i]\n"; }
print "</ul>\n";

print <<"EOF";
<h3>[<A HREF="JavaScript:history.back()">戻る</A>]</h3>
</body></html>
EOF
exit;
}

●記録者 匿名 [dhcp-015-243.issp.u-tokyo.ac.jp]
●記録日 7/2(火)

パスワード

Content-type: text/html ERROR

入出力エラー

[戻る]