") {
$bgColor = $bgColor0 if ($bgColor0 ne "");
$ftColor = $ftColor0 if ($ftColor0 ne "");
$admin = $SET{'AdminPlus'};
}
# 図表モード (挿入)
if ($fileHead{'MsgType'} == 2) {
$fileHead{'Message'} =~ s/ //gi;
$fileHead{'Message'} = '' . $fileHead{'Message'} . ' ';
}
$fileHead{'Message'} =~ s/<>/\n/g;
# インラインリンク
$fileHead{'Message'} = stdio::inlineLink($fileHead{'Message'}, 'target="new"') if ($fileHead{'AutoLink'});
$fileHead{'Message'} =~ s/#\{(\d{1,5})\}/#{$1}<\/a>/g;
$fileHead{'Message'} =~ s/>>(\d{1,5})(-\d{1,5})?/ >>$1$2<\/a>/g;
}
if (checkAdminMode()) {
$log = "$fileHead{'Host'} ($fileHead{'Addr'}) $fileHead{'Agent'}
";
}
# 最終参照日時のクッキー設定
{
local(%COOKIE, @cookie) = ();
local($i) = 0;
stdio::getCookie(*COOKIE, "$SET{'CookieName'}.2");
push(@cookie, "$STDIN{'Code'}-" . time);
foreach (split /\//, $COOKIE{'R'}) {
local($key, $value) = split /-/;
push(@cookie, $_) if ($key != $STDIN{'Code'});
last if ($i ++ > 50);
}
$cookie = "R:" . join("/", @cookie). "&W:$COOKIE{'W'}";
}
if ($STDIN{'target'} eq "thread") {
$top = qq|※この里親募集内の$STDIN{'Keyword'} の検索結果を表\示しています。(最大50件) 全件表\示 |;
$query = qq|;mhmode=$STDIN{'mhmode'};aimai=$STDIN{'aimai'};target=thread;Keyword=| . stdio::urlencode($STDIN{'Keyword'});
} elsif ($STDIN{'res'} =~ /^\d{1,5}(-\d{1,5})?$/) {
$top = qq|※この里親募集内の記事番号($STDIN{'res'}) を表\示しています。全件表\示 |;
$query = qq|;res=$STDIN{'res'}|;
}
# HTML表示開始
print "Content-Type: text/html", $CharSet, "\n";
print "Set-Cookie: $SET{'CookieName'}.2=$cookie; expires=" . gmtime(time + 3600 * $SET{'TimeZone'} + 86400 * 30) ."\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [$fileHead{'Title'}]
$SET{'Header'}
_EOF_
local($_) = shutoutHost($SET{'NoProxy'}, *AllowHost, *DenyHost);
if ($_ == 1) {
print "※ あなたの所属するホストからの投稿は規制されています。
\n";
} elsif ($_ == 2) {
print "※プロクシサーバー等経由での投稿はできません。
\n";
} elsif (checkAdminMode() || !$SET{'UseSolved'} || !$fileHead{'Solved'} || $SET{'PostSolved'}) {
if (!$SET{'FORM_ON'}) {
print "※この里親募集に投稿する場合は、[起稿/引用して起稿]ボタンを押してください。
\n";
} else {
showNewMessage_addForm(undef, undef, $fileHead{'Title'});
}
} else {
print "※解決済み里親募集への投稿はできません。
\n";
}
if ($STDIN{'mhmode'} eq "OR") {
$checked{'OR'} = ' selected';
} elsif ($STDIN{'mhmode'} eq "BOOLEAN") {
$checked{'BOOLEAN'} = ' selected';
} else {
$checked{'AND'} = ' selected';
}
if ($STDIN{'aimai'}) {
$checked{'aimai'} = ' checked';
}
# HTMLフッター
print <<_EOF_;
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ 一覧表示 (void) = showList(*Array, Scalar, Scalar, Scalar, Scalar, Scalar, Scalar, Scalar)
#
# 呼出元 : showTopicMessages() showTopics
# 引 数 : (表示レコード, 開始レコード, 全レコード, 表示レコード数,
# 次頁への引数, 呼び出す関数, 上部表示文字列, 下部表示文字列)
# 戻り値 : (1:レコードあり/0:なし)
#----------------------------------------------------------
sub showList #(*record, $start, $max, $step, $query, $func, $top, $under)
{
#--- 仮 引 数 ---#
local(*record, $start, $max, $step, $query, $func, $top, $under, $reverse) = @_;
#--- 変数宣言 ---#
local(
$pageEnd, $allPages, $nowPage,
$nextStart, $nextLink, $nextLinkd,
$backStart, $backLink, $backLinkd,
$navi, $i);
return 0 if ($record[0] eq "");
# 1ページ目
if (!$start || $start <= 1 || $start > $max) {
$start = 1;
if ($step >= $max) {
$pageEnd = $max;
} else {
$nextStart = $start + $step;
$pageEnd = $start + $step - 1;
$nextLink = qq| |;
$nextLinkd = qq| |;
}
# 2ページ目以降
} else {
$backStart = $start - $step;
$backStart = 1 if ($backStart < 1);
$backLink = qq||;
$backLinkd = qq| |;
if ($start + $step > $max) {
$pageEnd = $max;
} else {
$nextStart = $start + $step;
$pageEnd = $start + $step - 1;
$nextLink = qq||;
$nextLinkd = qq| |;
}
}
$allPages = int($max / $step);
$allPages ++ if ($max % $step != 0);
$nowPage = int(($start-1)/$step) + 1;
if ($allPages <= 10) {
for ($i=1; $i<=$allPages; $i++) {
if ($i == $nowPage) {
$navi .= qq| $nowPage. |;
} else {
my($num) = ($i-1)*$step+1;
$navi .= qq| $i. |;
}
}
} elsif ($nowPage <= 5) {
for ($i=1; $i<10; $i++) {
if ($i == $nowPage) {
$navi .= qq| $nowPage. |;
} else {
my($num) = ($i-1)*$step+1;
$navi .= qq| $i. |;
}
}
} elsif ($allPages - $nowPage <= 4) {
for ($i=$allPages-8; $i<=$allPages; $i++) {
if ($i == $nowPage) {
$navi .= qq| $nowPage. |;
} else {
my($num) = ($i-1)*$step+1;
$navi .= qq| $i. |;
}
}
} else {
for ($i=$nowPage-4; $i<=$nowPage+4; $i++) {
if ($i == $nowPage) {
$navi .= qq| $nowPage. |;
} else {
my($num) = ($i-1)*$step+1;
$navi .= qq| $i. |;
}
}
}
{
my($num) = ($allPages-1)*$step+1;
$navi .= qq| /$allPages |;
}
if ($func eq "showMessageType") {
$query =~ s/;R=1?//;
if (!$reverse) {
my($num) = ($allPages-1)*$step+1;
$navi .= qq| [ ▼降順 \| ▲昇順 ] |;
} else {
@record = reverse @record;
$navi .= qq| [ ▼降順 \| ▲昇順 ] |;
}
}
$navi = qq{全$max 件 ( $start 〜 $pageEnd ) $backLink新$backLinkd | $nextLink古$nextLinkd 1 /$navi\n};
print qq|$navi
|;
print $top;
foreach (@record) {
local(%field) = stdio::readData(split /\t/);
&$func(*field);
}
print $under;
print qq|$navi
|;
return 1;
}
#----------------------------------------------------------
# ■ 里親募集表示雛形 (void) = showTopicType(*Hash)
#
# 呼出元 : main()
# 引 数 : (表示値のハッシュ)
# 戻り値 : (なし)
#----------------------------------------------------------
sub showTopicType #(*field)
{
#--- 仮 引 数 ---#
local(*field) = @_;
#--- 変数宣言 ---#
my($solvedImage, $attachImage, $noreadImage, $search_link);
#static $bgColor, $i;
# 10行毎に新規テーブル
if ($x ++ >= 10) {
print qq| \n|;
$x = 1;
}
$field{'Message'} =~ s/<[^>]*>//g;
if (length $field{'Message'} > 128) {
$field{'Message'} = substr($field{'Message'}, 0, 128) . "...";
}
# 背景色を交互に変える
$bgColor = $bgColor eq $bgColor2 ? $bgColor1 : $bgColor2;
if ($field{'Passwd'} eq "" && $bgColor8 ne "") {
$bgColor = $bgColor8;
}
# 解決/添付マークセット
$solvedImage = $SET{'SolvedImage'} if ($field{'Solved'});
$attachImage = $SET{'AttachImage'} if ($field{'AttachFile'});
# 未読マークの設定
foreach (split /\//, $noread_cookie) {
my($key, $value) = split /-/;
if ($key == $field{'Code'} && $field{'Time2'} - $value >= 0) {
$noreadImage = $SET{'NoreadImage'};
$field{'Title'} = '' . $field{'Title'} . ' ';
}
}
if ($search) {
$search_link = qq| [この里親募集から検索] |;
}
# HTML表示
print <<_EOF_;
@{[sprintf("%04d",$field{'Code'})]}
$field{'Title'} $search_link $solvedImage $attachImage $noreadImage
$field{'ResCount'} 件のメッセージがあります by $field{'Name'} since @{[stdio::setTime('yyyy/mm/dd', 9, $field{'Time'})]}
$field{'Name2'}
@{[stdio::setTime($SET{'TimeFormat'}, 9, $field{'Time2'})]}
_EOF_
return;
}
#----------------------------------------------------------
# ■ メッセージ表示雛形 (void) = showMessageType(*Hash)
#
# 呼出元 : showList()
# 引 数 : (表示値のハッシュ)
# 戻り値 : (なし)
#----------------------------------------------------------
sub showMessageType #(*field)
{
#--- 仮 引 数 ---#
local(*field) = @_;
my($attachFile, $bgColor, $ftColor, $admin);
if ($field{'AttachFile'}) {
foreach (split /\s/, $field{'AttachFile'}) {
if (-f "$FileDir$_") {
my($size) = (-s "$FileDir$_");
1 while $size =~ s/([\dA-Fa-f]+)([\dA-Fa-f]{3})/$1,$2/;
if (/\.(gif|jpe?g|pi?ng)$/i) {
my($type, $width, $height) = stdio::getImageSize("$FileDir$_");
if ($type =~ /^(GIF|JPG|PNG)$/ && $width) {
if ($width > 128 || $height > 96) {
if ($width > 128) {
$width2 = int($width * (128 / $width)) + 1;
$height2= int($height* (128 / $width)) + 1;
} else {
$width2 = int($width * (96 / $height))+ 1;
$height2= int($height* (96 / $height))+ 1;
}
$attachFile .= qq| \n|;
} else {
$attachFile .= qq| \n|;
}
} else {
$attachFile .= qq| 添付ファイル ($_ - $size bytes) \n|;
}
} else {
$attachFile .= qq| 添付ファイル ($_ - $size bytes) \n|;
}
}
}
if ($attachFile) {
$attachFile = qq||;
}
}
$bgColor = $bgColor7;
$ftColor = $ftColor7;
if ($field{'Passwd'} eq "") {
$bgColor = $bgColor9 if ($bgColor9 ne "");
$ftColor = $ftColor9 if ($ftColor9 ne "");
$admin = $SET{'AdminPlus'};
}
# メールアドレス処理
if ($field{'Email'}) {
if ($sendmail && $field{'SecretEmail'}) {
$field{'Name'} = qq|$field{'Name'} |;
} else {
$field{'Name'} = qq|$field{'Name'} |;
}
}
# URI処理
if ($field{'Url'} =~ /^http:\/\/.+/) {
$field{'Url'} = qq| - [URL] |;
} else {
$field{'Url'} = "";
}
# ID処理
if ($field{'IPID'} && $SET{'ID-ON'}) {
$field{'IPID'} = qq| - ID:$field{'IPID'}|;
} else {
$field{'IPID'} = "";
}
# 引用部分の処理
if ($field{'MsgType'} != 3) {
local($quotedMessage);
foreach (split / /, $field{'Message'}) {
s/^(>|>)(.*)$/$1$2<\/font>/ unless (/^>>\d{1,5}/);
$quotedMessage .= $_ . " \n";
}
$quotedMessage =~ s/ \n$//;
$field{'Message'} = $quotedMessage;
}
# 図表モード (挿入)
if ($field{'MsgType'} == 2) {
$field{'Message'} =~ s/ //gi;
$field{'Message'} = '' . $field{'Message'} . ' ';
}
$field{'Message'} =~ s/<>/\n/g;
# 里親募集位置保持発言?
if ($field{'Sage'} eq "") {
$field{'Title'} = "$field{'Title'} ";
}
if (checkAdminMode()) {
$log = "$field{'Host'} ($field{'Addr'}) $field{'Agent'}
";
}
# 解決済み?
$field{'Solved'} = $SET{'SolvedImage'} if ($field{'Solved'});
# インラインリンク
$field{'Message'} = stdio::inlineLink($field{'Message'}, 'target="new"') if ($field{'AutoLink'});
$field{'Message'} =~ s/#\{(\d{1,5})\}/#{$1}<\/a>/g;
$field{'Message'} =~ s/>>(\d{1,5})(-\d{1,5})?/ >>$1$2<\/a>/g;
print <<_EOF_;
_EOF_
return;
}
#----------------------------------------------------------
# ■ ウォッチリストに追加
#
# 呼出元 : main()
# 引 数 : (なし)
# 戻り値 : (終了)
#----------------------------------------------------------
sub Edit_Mylist
{
local $cookie;
local %COOKIE = ();
stdio::getCookie(*COOKIE, "$SET{'CookieName'}.2");
push @mylist, $STDIN{'Code'} if ($STDIN{'mode'} eq "add");
foreach (split /\//, $COOKIE{'W'}) {
if (/^\d{1,5}$/ && (-f "$DataDir$_.tpc") && $STDIN{'Code'} != $_) {
push @mylist, $_;
}
}
$cookie = "R:$COOKIE{'R'}&W:" . join("/", @mylist);
print "Content-Type: text/html\n"
. "Cache-Control: no-cache\n"
. "Pragma: no-cache\n"
. "Refresh: 3; URL=http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}?mode=mylist\n";
print "Set-Cookie: $SET{'CookieName'}.2=$cookie; expires=" . gmtime(time + 3600 * $SET{'TimeZone'} + 86400 * 30) ."\n";
print "\n";
print <<_EOF_;
$SET{'Title'}
ウォッチリストへの追加・削除を行いました
ウォッチリストはクッキーを使っています。クッキーを無効にしている場合や拒否した場合は機能\しません。
ウォッチリストの有効期限は最終アクセスから30日です。
クッキーを削除した場合はウォッチリストも削除されます。
ウォッチリスト
_EOF_
exit;
}
#----------------------------------------------------------
# ■ 里親募集作成ページ表示 (void) = showNewTopic_addPage(void)
#
# 呼出元 : main()
# 引 数 : (なし)
# 戻り値 : (終了)
#----------------------------------------------------------
sub showNewTopic_addPage #(*value, $errMessage)
{
#--- 仮 引 数 ---#
local(*value, $errMessage, $exCode) = @_;
#--- 変数宣言 ---#
local(%checked, @form, $uniqueCode);
# プロクシ経由のアクセス拒否
{
local($_) = shutoutHost($SET{'NoProxy'}, *AllowHost, *DenyHost);
if ($_ == 1) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', "[$SENV{'REMOTE_HOST'}] からのアクセスはできません", '申し訳ありませんが、あなたの所属するホスト(プロバイダ・会社・学校等)からのアクセスは制限されています。対処方法及び詳細はこのサイトの管理者に連絡してください。');
} elsif ($_ == 2) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', 'プロクシサーバーを経由してのアクセスはできません', 'プロクシサーバー等を経由してのアクセスは制限されています。プロクシを外して再度アクセスしてください。もしプロバイダ、会社、学校等でプロクシサーバー経由でなければアクセスできない環境の場合、このサイトの管理者に連絡してください。');
}
}
# クッキーから読み込む
if (!%value) {
%value = ();
stdio::getCookie(*value, $SET{'CookieName'});
$value{'Url'} = 'http://' if ($value{'Url'} eq "");
$checked{'MsgType1'} = ' checked';
$checked{'AutoLink'} = ' checked';
$checked{'SetCookie'} = ' checked';
$checked{'SecretEmail'}=' checked' if ($value{'SecretEmail'});
# 仮引数から読み込む
} else {
if ($value{'MsgType'} == 3) {
$checked{'MsgType3'} = ' checked';
} elsif ($value{'MsgType'} == 2) {
$value{'Message'} =~ s/ /\n/gi;
$checked{'MsgType2'} = ' checked';
} else {
$value{'Message'} =~ s/ /\n/gi;
$checked{'MsgType1'} = ' checked';
}
$checked{'AutoLink'} = ' checked' if ($value{'AutoLink'});
$checked{'SetCookie'} = ' checked' if ($value{'SetCookie'});
$checked{'Sendmail'} = ' checked' if ($value{'Sendmail'});
$checked{'SecretEmail'}= ' checked' if ($value{'SecretEmail'});
}
# 里親募集拡張の場合
if ($SET{'ExtendTopic'} && $exCode) {
local(%record, %field);
$record{$exCode} = "";
$result = stdio::readFile2($DataFile, *record, $E{'UseLock'}, 1);
%field = stdio::readData(split /\t/, $record{$exCode});
$title = " [ $field{'Title'} の拡張] ";
$value{'Title'} = "Ext:$field{'Title'}" if ($value{'Title'} eq "");
$exCode = qq|\n |;
}
if (!$STDIN{'post'}) {
if ($sendmail) {
$tokumlForm = qq| アドレス非公開| if ($SET{'UseTokumail'});
$sendmlForm = qq| 返信をメールで受信|;
$sendmlForm = qq|$tokumlForm$sendmlForm |;
}
$form[0] = qq| |;
$form[1] = qq| |;
$form[2] = qq| |;
$form[3] = qq| |;
$form[4] = qq| |;
$form[5] = qq| 通常モード 図表\モード HTMLモード 本文中のアドレスを自動リンク \n|;
$form[6] = qq||;
$form[7] = qq| |;
$form[8] = qq|
|;
$form[9] = qq| フォーム情報を保存 |;
} else {
$confirm = ' (内容確認)';
if ($sendmail) {
$tokumlForm = qq| (アドレス非公開)| if ($checked{'SecretEmail'} && $SET{'UseTokumail'});
$sendmlForm = qq| (返信をメールで受信)| if ($checked{'Sendmail'});
$sendmlForm = qq| $tokumlForm$sendmlForm |;
}
$form[0] = qq| |;
$form[1] = qq| $value{'Name'}|;
$form[2] = qq| $value{'Email'}|;
$form[3] = qq| $value{'Url'}|;
$form[4] = qq| $value{'Title'}|;
$form[5] = qq| |;
if ($value{'MsgType'} == 1) {
$value{'Message'} =~ s/\n/
/g;
$form[6] = qq| |;
$value{'Message'} =~ s/
/ /g;
} elsif ($value{'MsgType'} == 2) {
$value{'Message'} =~ s/\n/
/g;
$form[6] = qq| |;
$value{'Message'} =~ s/
/\n/g;
$value{'Message'} = qq|$value{'Message'} |;
} else {
$value{'Message'} =~ s/&/&/g;
$value{'Message'} =~ s/"/"/g;
$value{'Message'} =~ s/<>/
/g;
$value{'Message'} =~ s/</g;
$value{'Message'} =~ s/>/>/g;
$form[6] = qq| |;
$value{'Message'} =~ s/<//g;
$value{'Message'} =~ s/"/"/g;
$value{'Message'} =~ s/&/&/g;
}
$form[6].= qq|$value{'Message'}|;
$form[7] = qq| |;
$value{'Passwd'} =~ s/./*/g;
$form[7].= qq|$value{'Passwd'}|;
$SET{'Center'} = "";
$SET{'Warning'} =~ s/%REMOTE_HOST/$SENV{'REMOTE_HOST'}/g;
$SET{'Warning'} =~ s/%REMOTE_ADDR/$ENV{'REMOTE_ADDR'}/g;
$SET{'Warning'} =~ s/%USER_AGENT/$SENV{'HTTP_USER_AGENT'}/g;
$form[8] = <<_EOF_;
$SET{'Warning'}
_EOF_
$form[9] = qq| (フォーム情報を保存) | if ($checked{'SetCookie'});
$form[10]= qq| | if ($checked{'AutoLink'});
}
$errMessage = " " if (!$errMessage);
$uniqueCode = ($STDIN{'unique'} =~ /[\d-]/) ? $STDIN{'unique'} : $$;
print "Content-Type: text/html", $CharSet, "\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [里親募集作成]
$SET{'Header'}
$SET{'Center'}
_EOF_
removeTrashFile() if ($SET{'MaxSize'});
exit(0);
}
#----------------------------------------------------------
# ■ ファイル添付 (exit) = attachFile(scalar)
#
# 呼出元 : main()
# 引 数 : (ユニークな識別コード)
# 戻り値 : (終了)
#----------------------------------------------------------
sub attachFile #($uniqueCode)
{
#--- 仮引数 -----#
local($uniqueCode) = @_;
#--- 変数宣言 ---#
local(@files, $msg);
local($i) = 0;
return if (!$SET{'MaxSize'} || !$uniqueCode);
# アップ済みファイルあり?
if (-f "$FileDir$uniqueCode.fup") {
open(IN, "$FileDir$uniqueCode.fup") || showErrorMessage('101 ファイル読込エラー', undef, '添付用インデックスファイルの読み込みに失敗しました', '添付用インデックスファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。添付ファイル格納ディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
@files = ;
close(IN);
}
# ファイル削除
if ($STDIN{'remove'}) {
local($flag) = 0;
foreach (@files) {
local($file) = $_;
chomp($file);
if ($STDIN{$file} eq 'remove') {
unlink("$FileDir$file") if (-e "$FileDir$file");
undef($_);
$flag = 1;
}
}
if ($flag) {
if (join("", @files) eq "") {
unlink("$FileDir$uniqueCode.fup") if (-f "$FileDir$uniqueCode.fup");
} else {
open(OUT, ">$FileDir$uniqueCode.fup");
print OUT @files;
close(OUT);
}
}
# ファイル追加
} elsif ($STDIN{'file.name'}) {
if ($#files >= $SET{'MaxFile'} - 1) {
$msg = " \n ■ 添付可能\なファイルは$SET{'MaxFile'}個までです。これ以上の添付はできません。";
goto out;
} elsif (length $STDIN{'file'} > $SET{'MaxSize'}) {
$msg = " \n ■ 添付可能\なファイルサイズは$SET{'MaxSize'}Bytesまでです。(現在 " . length($STDIN{'file'}) . "Bytes)";
goto out;
} elsif ($STDIN{"file.name"} !~ /\.(gif|jpe?g|png|pdf|txt|midi?|wav|zip|lzh)$/) {
$msg = " \n ■ 添付可能\なファイル種類は GIF、JPEG、PNG、PDF、TEXT、MIDI、WAV、ZIP、LZHに限られます。";
goto out;
}
local($kaku) = $1 if ($STDIN{"file.name"} =~ /(\..+)$/);
local($fname) = 'tmp.' . time . $kaku;
open(OUT, ">$FileDir$fname") || showErrorMessage('102 ファイル書込エラー', undef, '添付ファイルへの書き込みに失敗しました', '添付ファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。添付ファイル格納ディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
binmode(OUT);
print OUT $STDIN{'file'};
close(OUT);
push(@files, "$fname\n");
open(OUT, ">$FileDir$uniqueCode.fup") || showErrorMessage('102 ファイル書込エラー', undef, '添付用インデックスファイルへの書き込みに失敗しました', '添付用インデックスファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。添付ファイル格納ディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
print OUT @files;
close(OUT);
}
out:
# HTML表示開始
print "Content-Type: text/html", $CharSet, "\n";
print "Pragma: no-cache\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [ファイル添付]
$msg
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ ゴミ添付ファイル削除 (void) = removeTrashFile(void)
#
# 呼出元 : showNewTopic_addPage()
# 引 数 : (なし)
# 戻り値 : (なし)
#----------------------------------------------------------
sub removeTrashFile #(void)
{
if ($SET{'MaxSize'}) {
if (opendir(DIR, $FileDir)) {
while ($_ = readdir DIR) {
if (/^tmp\./ || /\.fup$/) {
if (time - (stat("$FileDir$_"))[9] > 1800) {
unlink("$FileDir$_") if (-f "$FileDir$_");
}
}
}
closedir(DIR);
} else {
return 0;
}
}
return 1;
}
#----------------------------------------------------------
# ■ メッセージ投稿フォーム表示 (void) = showNewMessage_addForm(*Hash, Scalar)
#
# 呼出元 : main()
# 引 数 : (初期値のハッシュ, 引用文)
# 戻り値 : (なし)
#----------------------------------------------------------
sub showNewMessage_addForm #(*value, $quotedMessage)
{
#--- 仮 引 数 ---#
local(*value, $quotedMessage, $title) = @_;
#--- 変数宣言 ---#
my(%checked, $solvedForm, $uniqueCode, $sendmlForm, @form);
# <既入力域の設定>
# クッキーから読み込む
if (!%value) {
%value = ();
stdio::getCookie(*value, $SET{'CookieName'});
$value{'noconfirm'} = qq| | if ($value{'noconfirm'});
$checked{'MsgType1'} = ' checked';
$checked{'AutoLink'} = ' checked';
$checked{'SetCookie'} = ' checked';
$checked{'SecretEmail'}=' checked' if ($value{'SecretEmail'});
$value{'Url'} = 'http://' if ($value{'Url'} eq "");
if ($quotedMessage) {
$value{'Message'} = $quotedMessage;
$quotedMessage = '※引用文は必要最小限に。無駄な全文引用は避けましょう。 ';
}
# 仮引数から読み込む
} else {
if ($value{'MsgType'} == 3) {
$checked{'MsgType3'} = ' checked';
} elsif ($value{'MsgType'} == 2) {
$value{'Message'} =~ s/ /\n/gi;
$checked{'MsgType2'} = ' checked';
} else {
$value{'Message'} =~ s/ /\n/gi;
$checked{'MsgType1'} = ' checked';
}
$value{'noconfirm'} = qq| | if ($value{'noconfirm'});
$checked{'AutoLink'} = ' checked' if ($value{'AutoLink'});
$checked{'SetCookie'} = ' checked' if ($value{'SetCookie'});
$checked{'Solved'} = ' checked' if ($value{'Solved'});
$checked{'SecretEmail'}= ' checked' if ($value{'SecretEmail'});
$checked{'Nomove'} = ' checked' if ($value{'Nomove'});
}
# 既入力域の設定>
if (!$STDIN{'post'}) {
$solvedForm = qq| 解決| if (checkAdminMode() || $SET{'UseSolved'});
$solvedForm.= qq| 解決キャンセル| if (checkAdminMode());
$sendmlForm = qq| アドレス非公開 | if ($sendmail && $SET{'UseTokumail'});
$form[0] = qq| |;
$form[1] = qq| |;
$form[2] = qq| |;
$form[3] = qq| |;
$form[4] = qq| |;
$form[5] = qq| 通常モード 図表\モード HTMLモード 本文中のアドレスを自動リンク \n|;
$form[6] = qq||;
$form[7] = qq| |;
$form[8] = qq|
|;
$form[9] = qq| フォーム情報を保存 |;
$form[10]= qq| 里親募集位置保持|;
} else {
$solvedForm = qq| (解決チェック)| if ($checked{'Solved'});
$solvedForm.= qq| (解決キャンセル)| if ($checked{'SolvedClear'});
$sendmlForm = qq| (アドレス非公開)| if ($checked{'SecretEmail'});
$form[0] = qq| |;
$form[1] = qq| $value{'Name'}|;
$form[2] = qq| $value{'Email'}|;
$form[3] = qq| $value{'Url'}|;
$form[4] = qq| $value{'Title'}|;
$form[5] = qq| |;
if ($value{'MsgType'} == 1) {
$value{'Message'} =~ s/\n/
/g;
$form[6] = qq| |;
$value{'Message'} =~ s/
/ /g;
} elsif ($value{'MsgType'} == 2) {
$value{'Message'} =~ s/\n/
/g;
$form[6] = qq| |;
$value{'Message'} =~ s/
/\n/g;
$value{'Message'} = qq|$value{'Message'} |;
} else {
$value{'Message'} =~ s/&/&/g;
$value{'Message'} =~ s/"/"/g;
$value{'Message'} =~ s/<>/
/g;
$value{'Message'} =~ s/</g;
$value{'Message'} =~ s/>/>/g;
$form[6] = qq| |;
$value{'Message'} =~ s/<//g;
$value{'Message'} =~ s/"/"/g;
$value{'Message'} =~ s/&/&/g;
}
$form[6].= qq|$value{'Message'}|;
$form[7] = qq| |;
$value{'Passwd'} =~ s/./*/g;
$form[7].= qq|$value{'Passwd'}|;
$SET{'Center'} = "";
$SET{'Warning'} =~ s/%REMOTE_HOST/$SENV{'REMOTE_HOST'}/g;
$SET{'Warning'} =~ s/%REMOTE_ADDR/$ENV{'REMOTE_ADDR'}/g;
$SET{'Warning'} =~ s/%USER_AGENT/$SENV{'HTTP_USER_AGENT'}/g;
$form[8] = <<_EOF_;
$SET{'Warning'}
今後はこの確認画面を表\示しない (クッキーを有効に)
_EOF_
$form[9] = qq| (フォーム情報を保存) | if ($checked{'SetCookie'});
$form[10]= qq| (里親募集位置保持)| if ($checked{'Nomove'});
$form[11]= qq| | if ($checked{'AutoLink'});
}
$uniqueCode = ($STDIN{'unique'} =~ /[\d-]/) ? $STDIN{'unique'} : $$;
print <<_EOF_;
$SET{'Center'}
_EOF_
return;
}
#----------------------------------------------------------
# ■ メッセージ引用 (exit) = quote(scalar)
#
# 呼出元 : main()
# 引 数 : (里親募集番号)
# 戻り値 : (終了)
#----------------------------------------------------------
sub quote #($topicCode)
{
#--- 仮 引 数 ---#
local($topicCode) = @_;
#--- 変数宣言 ---#
local($topicFile) = $DataDir . $topicCode . '.tpc';
local($title, %value, $qutedMessage);
# プロクシ経由のアクセス拒否
{
local($_) = shutoutHost($SET{'NoProxy'}, *AllowHost, *DenyHost);
if ($_ == 1) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', "[$SENV{'REMOTE_HOST'}] からのアクセスはできません", '申し訳ありませんが、あなたの所属するホスト(プロバイダ・会社・学校等)からのアクセスは制限されています。対処方法及び詳細はこのサイトの管理者に連絡してください。');
} elsif ($_ == 2) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', 'プロクシサーバーを経由してのアクセスはできません', 'プロクシサーバー等を経由してのアクセスは制限されています。プロクシを外して再度アクセスしてください。もしプロバイダ、会社、学校等でプロクシサーバー経由でなければアクセスできない環境の場合、このサイトの管理者に連絡してください。');
}
}
if (!-f $topicFile) {
showErrorMessage('100 ファイル未検出', undef, '里親募集ファイルが存在しません', '里親募集ファイルが見つかりません。里親募集が存在しない、もしくは里親募集が消えてしまった可能性があります。');
} elsif (!stdio::lockCheck($topicFile)) {
showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
} elsif (!open(IN, $topicFile)) {
showErrorMessage('101 ファイル読込エラー', undef, '里親募集ファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。里親募集ファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
local $_ = ;
$title = $1 if (/\tTitle=(.*)\t/);
while () {
if ($STDIN{(split(/\t/, $_, 2))[0]}) {
local %field = stdio::readData(split /\t/);
$field{'Message'} = ">>$field{'Code'} $field{'Name'}さんは書きました :\n" . '> ' . $field{'Message'};
$field{'Message'} =~ s/ <>/\n> /gi;
$field{'Message'} =~ s/ |<>/\n> /gi;
$field{'Message'} =~ s/<[^>]+>//g; # HTMLタグ除去
$qutedMessage .= "$field{'Message'}\n\n";
}
}
close(IN);
print "Content-Type: text/html", $CharSet, "\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [$title]
$SET{'Header'}
_EOF_
showNewMessage_addForm(undef, $qutedMessage, $title);
print <<_EOF_;
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ 新しい里親募集作成 (exit) = outputNewTopic(void)
#
# 呼出元 : main()
# 引 数 : (なし)
# 戻り値 : (なし)
#----------------------------------------------------------
sub outputNewTopic #(void)
{
#--- 変数宣言 ---#
local(%rmRecord);
my($cryptPasswd, $errMsg, $topicRecord);
# スレ立て権が管理者のみ
if ($SET{'AdminOnly'} && !checkAdminMode()) {
if ($STDIN{'Passwd'} eq "") {
$errMsg = qq| パスワード を入力してください。(新規里親募集作成は管理者のみ可能\です) \n|;
} elsif (!stdio::recryptString($STDIN{'Passwd'}, $E{'Passwd'})) {
$errMsg = qq| パスワード が不正です。(新規里親募集作成は管理者のみ可能です) \n|;;
}
} else {
# プロクシ経由のアクセス拒否
{
local($_) = shutoutHost($SET{'NoProxy'}, *AllowHost, *DenyHost);
if ($_ == 1) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', "[$SENV{'REMOTE_HOST'}] からのアクセスはできません", '申し訳ありませんが、あなたの所属するホスト(プロバイダ・会社・学校等)からのアクセスは制限されています。対処方法及び詳細はこのサイトの管理者に連絡してください。');
} elsif ($_ == 2) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', 'プロクシサーバーを経由してのアクセスはできません', 'プロクシサーバー等を経由してのアクセスは制限されています。プロクシを外して再度アクセスしてください。もしプロバイダ、会社、学校等でプロクシサーバー経由でなければアクセスできない環境の場合、このサイトの管理者に連絡してください。');
}
}
# 標準エラーチェック
if ($SET{'SetUrl'} && $SENV{'HTTP_REFERER'} !~ $SET{'SetUrl'}) {
showErrorMessage('204 参照元エラー', '不正なリクエストです', '不正なリクエストです', 'この掲示板の投稿用アドレス以外から呼び出されました。掲示板に投稿するには正規の投稿フォームから送信してください。環境変数を書き換えるアプリケーション、もしくはプロクシサーバーを経由を設定している場合、それらを使わないようにしてください。');
} elsif ($method eq 'POST' && $ENV{'REQUEST_METHOD'} ne 'POST') {
showErrorMessage('203 メソッドエラー', '不正なリクエストです', '不正なリクエストです', 'リクエストメソッドが不正です','リクエストメソッドが[GET]で呼び出されました。掲示板に投稿するには、リクエストメソッドを[POST]で送信する必要があります。環境変数を書き換えるアプリケーション、もしくはプロクシサーバーを経由を設定している場合、それらを使わないようにしてください。');
}
}
# <フォーム入力内容チェック>
if ($STDIN{'Name'} =~ /^[ ]*$/){
$errMsg = qq| 名前 は必須項目のため入力してください。\n|;
} elsif (length($STDIN{'Name'}) > 30){
$errMsg = qq| 名前 は30バイト以内(全角でその半分)で入力してください。(現在 | . length($STDIN{'Name'}) . qq|バイト)\n|;
}
if ($STDIN{'Age'} =~ /\D/ || length($STDIN{'Age'}) > 2) {
$errMsg .= qq| 年齢 は半角数字2桁以内で入力してください。\n|;
}
if ($STDIN{'Email'} ne "") {
if ($STDIN{'Email'} !~ /^[\w\+\.-]+@[\w\+\.-]*[A-Za-z0-9-]{2,23}\.[A-Za-z]{2,4}$/){
$errMsg .= qq| メールアドレス の形式が間違っています。(半角で正しく入力してください)\n|;
} elsif (length($STDIN{'Email'}) > 60) {
$errMsg .= qq| メールアドレス は60バイト以内で入力してください。(現在 | . length($STDIN{'Email'}) . qq|バイト)\n|;
}
} elsif ($STDIN{'Sendmail'}) {
$errMsg .= qq| 返信をメール送信するためメールアドレス を入力してください。\n|;
} elsif ($STDIN{'SecretEmail'}) {
$errMsg .= qq| アドレス非公開時はメールは転送されるためメールアドレス を入力してください。\n|;
}
if ($STDIN{'Url'} eq "" || $STDIN{'Url'} eq 'http://'){
$STDIN{'Url'} = "";
} else {
if ($STDIN{'Url'} !~ /^http:\/\/[\w|\:\@\-]+\.[\w|\:\!\#\%\=\&\-\|\@\~\+\.\?\/\;]+$/) {
$errMsg .= qq| URI の形式が間違っています。(半角で正しく入力してください)\n|;
} elsif (length($STDIN{'Url'}) > 80) {
$errMsg .= qq| URI は80バイト以内で入力してください。(現在 | . length($STDIN{'Url'}) . qq|バイト)\n|;
}
}
if ($STDIN{'Title'} =~ /^[ ]*$/) {
$errMsg .= qq| 里親募集名 は必須項目のため入力してください。\n|;
} elsif (length($STDIN{'Title'}) > 60) {
$errMsg .= qq| 里親募集名 は60バイト(全角でその半分)以内で入力してください。(現在 | . length($STDIN{'Title'}) . qq|バイト)\n|;
}
if ($STDIN{'Message'} =~ /^[ ]*$/) {
$errMsg .= qq| メッセージ を入力してください。\n|;
} else {
$SET{'ByteMax'} *= 1024;
if (length($STDIN{'Message'}) > $SET{'ByteMax'}) {
$errMsg .= qq|メッセージ は$SET{'ByteMax'}バイト(全角でその半分)以内で入力してください。(現在 | . length($STDIN{'Message'}) . qq|バイト)\n|;
} elsif (($STDIN{'Message'} =~ s/ / /g) > 50){
$errMsg .= qq|メッセージ は50行以内で入力してください。(現在 | . ($STDIN{'Message'} =~ s/ / /g) . qq|行)\n|;
} elsif (@NGWord) {
foreach (@NGWord) {
if (index("$STDIN{'Name'}$STDIN{'Title'}$STDIN{'Message'}", $_) >= 0) {
$errMsg .= qq| 使用できないワードが含まれています。($_)\n|;
last;
}
}
}
}
if ($STDIN{'Passwd'} ne "") {
if ($STDIN{'Passwd'} =~ /\W/) {
$errMsg .= qq| パスワード に半角英数字以外の文字は使えません。\n|;
} elsif (length($STDIN{'Passwd'}) < 6 || length($STDIN{'Passwd'}) > 12) {
$errMsg .= qq| パスワード は8バイト以上、12バイト以内で入力してください。(現在 | . length($STDIN{'Passwd'}) . qq|バイト)\n|;
}
}
# フォーム入力内容チェック>
# HTMLモード? => 文法チェック
if ($STDIN{'MsgType'} == 3) {
local($str, $res) = htmlSyntaxCheck($STDIN{'Message'});
if ($errMsg || !$res || $STDIN{'back'}) {
$STDIN{'Message'} =~ s/ /\n/gi;
if (!$res) {
$errMsg .= qq| $str\n|;
}
} else {
$STDIN{'Message'} = $str;
}
}
# フォーム入力不備あり => フォーム自体を既入力状態で再表示
if ($errMsg || $STDIN{'back'}) {
$STDIN{'post'} = 0;
$errMsg = "\n";
showNewTopic_addPage(*STDIN, $errMsg, $STDIN{'exCode'});
exit(0);
# 内容チェック
} elsif ($STDIN{'post'} == 1 && $SET{'Confirm'}) {
showNewTopic_addPage(*STDIN, undef, $STDIN{'exCode'});
exit(0);
}
# 不正な文字列を排除/修正 (破壊防止)
$STDIN{'Name'} =~ s/ //gi;
$STDIN{'Age'} =~ s/ //gi;
$STDIN{'Email'} =~ s/ //gi;
$STDIN{'Title'} =~ s/ //gi;
$STDIN{'Url'} =~ s/ //gi;
$STDIN{'Sex'} = ($STDIN{'Sex'} ne "" && $STDIN{'Sex'} ne "male" && $STDIN{'Sex'} ne "female") ? undef : $STDIN{'Sex'};
$STDIN{'AutoLink'}= ($STDIN{'AutoLink'}) ? 1 : undef;
$STDIN{'MsgType'} = ($STDIN{'MsgType'} > 0 && $STDIN{'MsgType'} <= 3) ? $STDIN{'MsgType'} : 1;
$namex = $STDIN{'Name'};
$namex =~ s/◆([A-Za-z0-9.\/]{8})/◇$1/g;
$namex =~ s/#([^\s ]{6,10})/getPasscode($1)/e;
$ipid = &makeID;
#if (!stdio::logicalLock("$DataFile.adr", 300, $ENV{'REMOTE_ADDR'}, length($STDIN{'Message'}))) {
# return;
#}
if ($SET{'WaitTime'}) {
if (!stdio::logicalLock("$DataFile.adr2", $SET{'WaitTime'}, $ENV{'REMOTE_ADDR'}, $SENV{'HTTP_USER_AGENT'})) {
showErrorMessage('連続投稿不可', 'もうしばらくお待ちください', '連続投稿はもうしばらくお待ちください', '同一IPアドレスからの一定時間内の連続投稿はできません。投稿はもうしばらく時間をおいてからお願いします。');
}
}
# ファイルロック
if (!stdio::Lock($DataFile, $E{'UseLock'})) {
showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
# 既にトピが存在する => データファイル読み込み
if (-f $DataFile) {
local($result) = 0;
$record{'FileHeader'} = "";
$record{$STDIN{'exCode'}} = "" if ($STDIN{'exCode'}); # スーパー里親募集作成の場合
$result = stdio::readFile2($DataFile, *record, undef, 1);
if ($result == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', '里親募集ファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
%fileHead = stdio::readData(split /\t/, $record{'FileHeader'});
# 初回利用
} else {
$fileHead{'Newcode'} = $fileHead{'Tree'} = 0;
}
# ファイルヘッダ設定
$fileHead{'Newcode'} ++;
$fileHead{'Tree'} ++;
$fileHead{'Version'} = $Version if (!$fileHead{'Version'});
$fileHead{'Start'} = time if (!$fileHead{'Start'});
$addRecord[0] = "FileHeader" . "\t"
. "Version=" . $fileHead{'Version'} . "\t"
. "Start=" . $fileHead{'Start'} . "\t"
. "Newcode=" . $fileHead{'Newcode'} . "\t"
. "Tree=" . $fileHead{'Tree'} . "\t"
. "\n";
# 添付ファイル処理
if ($SET{'MaxSize'}) {
if (-f "$FileDir$STDIN{'unique'}.fup") {
local(@attachFile);
open(IN, "$FileDir$STDIN{'unique'}.fup") || showErrorMessage('101 ファイル読込エラー', undef, '添付用インデックスファイルの読み込みに失敗しました', '添付用インデックスファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。添付ファイル格納ディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
while () {
chomp;
local($file) = $_;
$file =~ s/^tmp\./$fileHead{'Newcode'}-1./;
push(@attachFile, $file);
rename("$FileDir$_", "$FileDir$file");
}
close(IN);
unlink("$FileDir$STDIN{'unique'}.fup");
$attachFile = join(" ", @attachFile);
$attachments = "\n\n[添付ファイル]\n";
foreach (@attachFile) {
$attachments .= "$FileUrl$_\n";
}
}
}
# パスワード暗号化
$cryptedPasswd = stdio::recryptString($STDIN{'Passwd'}, $E{'Passwd'}) ? "" : stdio::cryptString($STDIN{'Passwd'}) if ($STDIN{'Passwd'} ne "");
local(%subTopic) = stdio::readData(split /\t/, $record{$STDIN{'exCode'}}) if ($SET{'ExtendTopic'} && $STDIN{'exCode'});
local($rootTopic)= $subTopic{'Root'} ? $subTopic{'Root'} : $fileHead{'Newcode'};
# 今回作成する里親募集レコード
$addRecord[1] = $fileHead{'Newcode'} . "\t" # レコードキー (トピ番号)
. "Code=" . $fileHead{'Newcode'} . "\t" # トピ番号
. "Time=" . time . "\t" # トピ作成UTCミリ秒
. "Time2=" . time . "\t" # 最終更新UTCミリ秒
. "Name=" . $namex . "\t" # トピ作成者
. "Name2=" . $namex . "\t" # 最終投稿者
. "Age=" . $STDIN{'Age'} . "\t" # トピ作成者年齢
. "Sex=" . $STDIN{'Sex'} . "\t" # トピ作成者性別
. "Email=" . $STDIN{'Email'} . "\t" # トピ作成者メールアドレス
. "Url=" . $STDIN{'Url'} . "\t" # トピ作成者URI
. "SecretEmail=". $STDIN{'SecretEmail'} . "\t" # 匿メール使用
. "Title=" . $STDIN{'Title'} . "\t" # 里親募集名
. "Solved=" . "\t" # 解決済み
. "AttachFile=" . $attachFile . "\t" # 添付ファイル名
. "Sendmail=" . $STDIN{'Sendmail'} . "\t" # メール通知
. "Message=" . $STDIN{'Message'} . "\t" # メッセージ
. "MsgType=" . $STDIN{'MsgType'} . "\t" # メッセージ表示型
. "AutoLink=" . $STDIN{'AutoLink'} . "\t" # 自動リンク有効
. "ResCount=" . '1' . "\t" # メッセージ数
. "Passwd=" . $cryptedPasswd . "\t" # 暗号化パスワード
. "Root=" . $rootTopic . "\t" # ルートトピ
. "Reply=" . "\t" # スーパートピ
. "Parent=" . $STDIN{'exCode'} . "\t" # サブトピ
. "IPID=" . $ipid . "\t" # IP-ID
. "Host=" . $SENV{'REMOTE_HOST'} . "\t" # トピ作成者ホスト
. "Addr=" . $SENV{'REMOTE_ADDR'} . "\t" # トピ作成者IPアドレス
. "Agent=" . $SENV{'HTTP_USER_AGENT'}."\t" # トピ作成者エージェント
. "AuthUser=" . $ENV{'REMOTE_USER'} . "\t" # BASIC認証を受けたユーザー名
. "\n";
$cryptedPasswd = "" if ($cryptedPasswd ne "");
# 今回作成する里親募集レコード2
$topicRecord = "1" . "\t"
. "Code=" . "1" . "\t"
. "Time=" . time . "\t"
. "Name=" . $namex . "\t"
. "Age=" . $STDIN{'Age'} . "\t"
. "Sex=" . $STDIN{'Sex'} . "\t"
. "Email=" . $STDIN{'Email'} . "\t"
. "Url=" . $STDIN{'Url'} . "\t"
. "SecretEmail=". $STDIN{'SecretEmail'} . "\t"
. "Title=" . $STDIN{'Title'} . "\t"
. "Solved=" . "\t"
. "AttachFile=" . "\t"
. "Message=" . $STDIN{'Message'} . "\t"
. "MsgType=" . $STDIN{'MsgType'} . "\t"
. "AutoLink=" . $STDIN{'AutoLink'} . "\t"
. "Passwd=" . $cryptedPasswd . "\t"
. "Root=" . "1" . "\t"
. "Reply=" . "" . "\t"
. "Parent=" . "" . "\t"
. "IPID=" . $ipid . "\t"
. "Host=" . $SENV{'REMOTE_HOST'} . "\t"
. "Addr=" . $SENV{'REMOTE_ADDR'} . "\t"
. "Agent=" . $SENV{'HTTP_USER_AGENT'}."\t"
. "AuthUser=" . $ENV{'REMOTE_USER'} . "\t"
. "\n";
# サブ里親募集レコード
if ($SET{'ExtendTopic'} && $STDIN{'exCode'}) {
$subTopic{'Reply'} .= $subTopic{'Reply'} ? ":$fileHead{'Newcode'}" : $fileHead{'Newcode'};
$rmRecord{$STDIN{'exCode'}} =
$subTopic{'Code'} . "\t"
. "Code=" . $subTopic{'Code'} . "\t"
. "Time=" . $subTopic{'Time'} . "\t"
. "Time2=" . $subTopic{'Time2'} . "\t"
. "Name=" . $subTopic{'Name'} . "\t"
. "Name2=" . $subTopic{'Name2'} . "\t"
. "Age=" . $subTopic{'Age'} . "\t"
. "Sex=" . $subTopic{'Sex'} . "\t"
. "Email=" . $subTopic{'Email'} . "\t"
. "Url=" . $subTopic{'Url'} . "\t"
. "SecretEmail=". $subTopic{'SecretEmail'} . "\t"
. "Title=" . $subTopic{'Title'} . "\t"
. "Solved=" . $subTopic{'Solved'} . "\t"
. "AttachFile=" . $subTopic{'attachFile'} . "\t"
. "Sendmail=" . $subTopic{'Sendmail'} . "\t"
. "Message=" . $subTopic{'Message'} . "\t"
. "MsgType=" . $subTopic{'MsgType'} . "\t"
. "AutoLink=" . $subTopic{'AutoLink'} . "\t"
. "ResCount=" . $subTopic{'ResCount'} . "\t"
. "Passwd=" . $subTopic{'Passwd'} . "\t"
. "Root=" . $subTopic{'Root'} . "\t"
. "Reply=" . $subTopic{'Reply'} . "\t"
. "Parent=" . $subTopic{'Newcode'} . "\t"
. "IPID=" . $subTopic{'IPID'} . "\t"
. "Host=" . $subTopic{'Host'} . "\t"
. "Addr=" . $subTopic{'Addr'} . "\t"
. "Agent=" . $subTopic{'Agent'} . "\t"
. "AuthUser=" . $subTopic{'AuthUser'} . "\t"
. "\n";
$subTo = "この里親募集は [$subTopic{'Title'}]のスーパー里親募集です。\n";
}
# ファイル書き込み
{
local($_);
if ($fileHead{'Newcode'} == 1) {
$_ = stdio::writeFile2($DataFile, join("", @addRecord));
} else {
$rmRecord{'FileHeader'} = "";
$_ = stdio::writeFile1($DataFile, *rmRecord, *addRecord, undef);
}
if ($_ == -1) {
showErrorMessage('100 ファイル未検出', undef, 'データファイルが存在しません', 'データファイルが見つかりません。里親募集が存在しない、もしくは里親募集が消えてしまった可能性があります。');
} elsif ($_ == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($_ == -4) {
showErrorMessage('102 ファイル書込エラー', undef, 'データファイルへの書き込みに失敗しました', 'データファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($_ == -5) {
showErrorMessage('110 排他制御中 (共有ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
}
# 里親募集ファイルの作成
open(OUT, ">$DataDir$fileHead{'Newcode'}.tpc") || showErrorMessage('102 ファイル書込エラー', undef, '里親募集ファイルへの書き込みに失敗しました', 'データファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
print OUT "FileHeader" . "\t"
. "Version=" . $Version . "\t"
. "Start=" . time . "\t"
. "Newcode=" . '1' . "\t"
. "Tree=" . '1' . "\t"
. "Title=" . $STDIN{'Title'} . "\t"
. "\n";
print OUT $topicRecord;
close(OUT);
# アンロック
stdio::unLock($DataFile);
# <メール送信>
if ($sendmail) {
if ($STDIN{'Sendmail'} || $SET{'SendMail'} || $subTopic{'Sendmail'}) {
my($htmlMail, $br);
my($mailMessage) = $STDIN{'Message'} . $attachments;
if ($STDIN{'MsgType'} != 3) {
$mailMessage =~ s/ /\n/g;
$mailMessage =~ s/<//g;
$mailMessage =~ s/&/&/g;
$mailMessage =~ s/"/"/g;
} else {
$mailMessage =~ s/<>/\n/g;
$htmlMail = 1;
$br = ' ';
}
$mailMessage =<<_EOF_;
$br
このメールは$SET{'Title'}に投稿された記事を送信しています。$br
$subTo$br
---------------------------------------------------------------------$br
$br
[投 稿 日] @{[scalar gmtime(time + 3600 * $SET{'TimeZone'})]}$br
[ホ ス ト] $SENV{'REMOTE_HOST'}$br
[アドレス] $SENV{'REMOTE_ADDR'}$br
[ブラウザ] $SENV{'HTTP_USER_AGENT'}$br
$br
[投 稿 者] $STDIN{'Name'}$br
[Eメール] $STDIN{'Email'}$br
[里親募集] $STDIN{'Title'}$br
$br
$mailMessage
$br
---------------------------------------------------------------------$br
$br
■この里親募集への投稿は以下のURLから行えます$br
http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}?mode=view;Code=$fileHead{'Newcode'}$br
$br
_EOF_
# 実際にメール送信
stdio::sendMail($sendmail, $STDIN{'Email'}, undef, undef, $STDIN{'Email'}, undef, $SET{'AdminEmail'}, $STDIN{'Title'}, $mailMessage, $htmlMail) if ($STDIN{'Sendmail'});
stdio::sendMail($sendmail, $SET{'AdminEmail'}, undef, undef, $STDIN{'Email'}, undef, $SET{'AdminEmail'}, $STDIN{'Title'}, $mailMessage, $htmlMail) if ($SET{'SendMail'});
stdio::sendMail($sendmail, $subTopic{'Email'}, undef, undef, $STDIN{'Email'}, undef, $SET{'AdminEmail'}, $STDIN{'Title'}, $mailMessage, $htmlMail) if ($subTopic{'Sendmail'});
}
}
# メール送信>
# リロード/クッキー設定
print "Content-Type: text/html\n";
print "Cache-Control: no-cache\n";
print "Pragma: no-cache\n";
print "Refresh: 2; URL=http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}$ENV{'PATH_INFO'}?\n";
if ($STDIN{'SetCookie'}) {
print "Set-Cookie: "
. stdio::setCookie($SET{'CookieName'}, "Name:$STDIN{'Name'}&Email:$STDIN{'Email'}&Url=$STDIN{'Url'}&SecretEmail:$STDIN{'SecretEmail'}&Passwd:$STDIN{'Passwd'}", 820)
. "\n";
}
print "\n";
print <<_EOF_;
$SET{'Title'} [里親募集完了]
正常に里親募集作成されました
里親募集の作成が終わりました。自動的にページが切り替わりますので、しばらくお待ちください。
切り替わらない場合はクリックしてください
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ 里親募集へ投稿 (exit) = outputNewMessage(void)
#
# 呼出元 : main()
# 引 数 : (なし)
# 戻り値 : (終了)
#----------------------------------------------------------
sub outputNewMessage #(void)
{
#--- 変数宣言 ---#
my($errMsg, $cryptPasswd);
my($topicFile) = $DataDir . $STDIN{'Code'} . '.tpc';
# プロクシ経由のアクセス拒否
{
local($_) = shutoutHost($SET{'NoProxy'}, *AllowHost, *DenyHost);
if ($_ == 1) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', "[$SENV{'REMOTE_HOST'}] からのアクセスはできません", '申し訳ありませんが、あなたの所属するホスト(プロバイダ・会社・学校等)からのアクセスは制限されています。対処方法及び詳細はこのサイトの管理者に連絡してください。');
} elsif ($_ == 2) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', 'プロクシサーバーを経由してのアクセスはできません', 'プロクシサーバー等を経由してのアクセスは制限されています。プロクシを外して再度アクセスしてください。もしプロバイダ、会社、学校等でプロクシサーバー経由でなければアクセスできない環境の場合、このサイトの管理者に連絡してください。');
}
}
# 標準エラーチェック
if ($SET{'SetUrl'} && $SENV{'HTTP_REFERER'} !~ $SET{'SetUrl'}) {
showErrorMessage('204 参照元エラー', '不正なリクエストです', '不正なリクエストです', 'この掲示板の投稿用アドレス以外から呼び出されました。掲示板に投稿するには正規の投稿フォームから送信してください。環境変数を書き換えるアプリケーション、もしくはプロクシサーバーを経由を設定している場合、それらを使わないようにしてください。');
} elsif ($method eq 'POST' && $ENV{'REQUEST_METHOD'} ne 'POST') {
showErrorMessage('203 メソッドエラー', '不正なリクエストです', '不正なリクエストです', 'リクエストメソッドが不正です','リクエストメソッドが[GET]で呼び出されました。掲示板に投稿するには、リクエストメソッドを[POST]で送信する必要があります。環境変数を書き換えるアプリケーション、もしくはプロクシサーバーを経由を設定している場合、それらを使わないようにしてください。');
}
# <フォーム入力内容チェック>
if ($STDIN{'Name'} =~ /^[ ]*$/) {
$errMsg = qq| 名前 は必須項目のため入力してください。\n|;
} elsif (length($STDIN{'Name'}) > 30) {
$errMsg = qq| 名前 は30バイト(全角でその半分)以内で入力してください。(現在 | . length($STDIN{'Name'}) . qq|バイト)\n|;
}
if ($STDIN{'Age'} =~ /\D/ || length($STDIN{'Age'}) > 2) {
$errMsg .= qq| 年齢 は半角数字2桁以内で入力してください。\n|;
}
if ($STDIN{'Email'} ne "") {
if ($STDIN{'Email'} !~ /^[\w\+\.-]+@[\w\+\.-]*[A-Za-z0-9-]{2,23}\.[A-Za-z]{2,4}$/) {
$errMsg .= qq| メールアドレス の形式が間違っています。(半角で正しく入力してください)\n|;
} elsif (length($STDIN{'Email'}) > 60) {
$errMsg .= qq| メールアドレス は60バイト以内で入力してください。(現在 | . length($STDIN{'Email'}) . qq|バイト)\n|;
}
} elsif ($STDIN{'SecretEmail'}) {
$errMsg .= qq| 転送メールを送信するためメールアドレス を入力してください。\n|;
}
if ($STDIN{'Url'} eq "" || $STDIN{'Url'} eq 'http://'){
$STDIN{'Url'} = "";
} else {
if ($STDIN{'Url'} !~ /^http:\/\/[\w|\:\@\-]+\.[\w|\:\!\#\%\=\&\-\|\@\~\+\.\?\/\;]+$/) {
$errMsg .= qq| URI の形式が間違っています。(半角で正しく入力してください)\n|;
} elsif (length($STDIN{'Url'}) > 80) {
$errMsg .= qq| URI は80バイト以内で入力してください。(現在 | . length($STDIN{'Url'}) . qq|バイト)\n|;
}
}
if ($STDIN{'Title'} =~ /^[ ]*$/ && $STDIN{'Message'} =~ /^[ ]*$/) {
$errMsg .= qq| タイトル かメッセージ のどちらか一方は入力してください。\n|;
}
if (length($STDIN{'Title'}) > 70) {
$errMsg .= qq| タイトル は70バイト(全角でその半分)以内で入力してください。(現在 | . length($STDIN{'Title'}) . qq|バイト)\n|;
}
if ($STDIN{'Message'} ne "") {
$SET{'ByteMax'} *= 1024;
if (length($STDIN{'Message'}) > $SET{'ByteMax'}) {
$errMsg .= qq| メッセージ は$SET{'ByteMax'}バイト(全角でその半分)以内で入力してください。(現在 | . length($STDIN{'Message'}) . qq|バイト)\n|;
} elsif (($STDIN{'Message'} =~ s/ / /g) > 50) {
$errMsg .= qq| メッセージ は50行以内で入力してください。(現在 | . ($STDIN{'Message'} =~ s/ / /g) . qq|行)\n|;
} elsif (@NGWord) {
foreach (@NGWord) {
if (index("$STDIN{'Name'}$STDIN{'Title'}$STDIN{'Message'}", $_) >= 0) {
$errMsg .= qq| 使用できないワードが含まれています。($_)\n|;
last;
}
}
}
}
if ($STDIN{'Passwd'} ne "") {
if ($STDIN{'Passwd'} =~ /\W/) {
$errMsg .= qq| パスワード に半角英数字以外の文字は使えません。\n|;
} elsif (length($STDIN{'Passwd'}) < 6 || length($STDIN{'Passwd'}) > 12) {
$errMsg .= qq| パスワード は6バイト以上、12バイト以内で入力してください。(現在 | . length($STDIN{'Passwd'}) . qq|バイト)\n|;
}
} elsif (!checkAdminMode() && $STDIN{'Solved'} && !$SET{'SetSolved'} && $SET{'UseSolved'}) {
$errMsg .= qq| 解決チェック時は里親募集作成時に入力したパスワード を入力してください。\n|;
}
# フォーム入力内容チェック>
# HTMLモード? => 文法チェック
if ($STDIN{'MsgType'} == 3) {
local($str, $res) = htmlSyntaxCheck($STDIN{'Message'});
if ($errMsg || !$res || $STDIN{'back'}) {
$STDIN{'Message'} =~ s/ /\n/gi;
if (!$res) {
$errMsg .= qq| $str\n|;
}
} else {
$STDIN{'Message'} = $str;
}
}
# 不正な文字列を排除/修正
$STDIN{'Name'} =~ s/ //gi;
$STDIN{'Age'} =~ s/ //gi;
$STDIN{'Email'} =~ s/ //gi;
$STDIN{'Title'} =~ s/ //gi;
$STDIN{'Url'} =~ s/ //gi;
$STDIN{'Sex'} = ($STDIN{'Sex'} ne "" && $STDIN{'Sex'} ne "male" && $STDIN{'Sex'} ne "female") ? undef : $STDIN{'Sex'};
$STDIN{'AutoLink'}= ($STDIN{'AutoLink'}) ? 1 : undef;
$STDIN{'MsgType'} = ($STDIN{'MsgType'} > 0 && $STDIN{'MsgType'} <= 3) ? $STDIN{'MsgType'} : 1;
# フォーム入力不備あり
if ($errMsg || $STDIN{'back'}) {
$STDIN{'post'} = 0;
print "Content-Type: text/html", $CharSet, "\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [$STDIN{'threadtitle'}への投稿]
$SET{'Header'}
[$STDIN{'threadtitle'}]への投稿
_EOF_
showNewMessage_addForm(*STDIN, undef, $STDIN{'threadtitle'});
exit(0);
# 内容チェック
} elsif ($STDIN{'post'} == 1 && !$STDIN{'noconfirm'} && $SET{'Confirm'}) {
print "Content-Type: text/html", $CharSet, "\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [$STDIN{'threadtitle'}への投稿]
$SET{'Header'}
[$STDIN{'threadtitle'}]への投稿 (内容確認)
_EOF_
showNewMessage_addForm(*STDIN, undef, $STDIN{'threadtitle'});
exit(0);
}
$STDIN{'Title'} = '(無題)' if ($STDIN{'Title'} eq '');
$namex = $STDIN{'Name'};
$namex =~ s/◆([A-Za-z0-9.\/]{8})/◇$1/g;
$namex =~ s/#([^\s ]{6,10})/getPasscode($1)/e;
$ipid = &makeID;
# ファイルロック
if (!stdio::Lock($DataFile, $E{'UseLock'})) {
showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
# データファイルから読み出し
{
$dataHash{$STDIN{'Code'}} = "";
$dataHash{'FileHeader'} = "";
local($_) = stdio::readFile2($DataFile, *dataHash);
if ($_ == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
$addRecord2[0] = $dataHash{'FileHeader'};
%dataHash = stdio::readData(split /\t/, $dataHash{$STDIN{'Code'}});
# 解決投稿の場合 => 投稿者のチェック
if (!checkAdminMode()) {
if (!$SET{'PostSolved'} && $dataHash{'Solved'}) {
showErrorMessage('201 パスワード不備', undef, '解決済み里親募集への投稿はできません。', '解決した里親募集を新規に投稿をすることはできません。');
}
} else {
$SET{'UseSolved'} = 1 ;
goto out;
}
if ($STDIN{'Solved'} && !$SET{'SetSolved'} && $SET{'UseSolved'}) {
if (stdio::recryptString($STDIN{'Passwd'}, $E{'Passwd'})) {
goto out;
}
if ($dataHash{'Passwd'} eq "") {
showErrorMessage('201 パスワード不備', undef, '解決チェックが付けられるのは管理者だけです', '解決チェックが付けられるのは管理者だけです。管理者用パスワードを入力して再試行してください。');
} elsif (!stdio::recryptString($STDIN{'Passwd'}, $dataHash{'Passwd'})) {
showErrorMessage('201 パスワード不備', undef, '解決チェックが付けられるのは里親募集作成者か管理者だけです', '解決チェックが付けられるのは里親募集作成者か管理者だけです。里親募集作成時に指定したパスワードか管理者用パスワードを入力して再試行してください。');
}
}
out:
}
# 里親募集ファイルから読み出し
{
local @record;
local %lastRecord;
local $_ = stdio::readFile1($topicFile, *record, 0, 2);
if ($_ == -3) {
showErrorMessage('101 ファイル読込エラー', undef, '里親募集ファイルの読み込みに失敗しました', '里親募集ファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。里親募集ファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
%fileHead = stdio::readData(split /\t/, $record[0]);
%lastRecord = stdio::readData(split /\t/, $record[1]);
return if ($lastRecord{'Message'} eq $STDIN{'Message'});
if ($SET{'WaitTime'} && $ENV{'REMOTE_ADDR'} eq $lastRecord{'Addr'} && time - $lastRecord{'Time'} < $SET{'WaitTime'}) {
showErrorMessage('連続投稿不可', 'もうしばらくお待ちください', '連続投稿はもうしばらくお待ちください', '同一IPアドレスからの一定時間内の連続投稿はできません。投稿はもうしばらく時間をおいてからお願いします。');
}
}
$STDIN{'Nomove'} = 1 if ($STDIN{'Nomove'});
# 添付ファイル処理
if ($SET{'MaxSize'} && $SET{'AttachRepaly'}) {
if (-f "$FileDir$STDIN{'unique'}.fup") {
local(@attachFile);
open(IN, "$FileDir$STDIN{'unique'}.fup") || showErrorMessage('101 ファイル読込エラー', undef, '添付用インデックスファイルの読み込みに失敗しました', '添付用インデックスファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。添付ファイル格納ディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
while () {
chomp;
local($file) = $_;
$file =~ s/^tmp\./$dataHash{'Code'}-$fileHead{'Newcode'}./;
push(@attachFile, $file);
rename("$FileDir$_", "$FileDir$file");
}
close(IN);
unlink("$FileDir$STDIN{'unique'}.fup");
$attachFile = join(" ", @attachFile);
$attachments = "\n\n[添付ファイル]\n";
foreach (@attachFile) {
$attachments .= "$FileUrl$_\n";
}
}
}
# ファイルヘッダ設定
$fileHead{'Newcode'} ++;
$fileHead{'Tree'} ++;
$fileHead{'Version'} = $Version if (!$fileHead{'Version'});
$fileHead{'Start'} = time if (!$fileHead{'Start'});
$addRecord[0] = "FileHeader" . "\t"
. "Version=" . $fileHead{'Version'} . "\t"
. "Start=" . $fileHead{'Start'} . "\t"
. "Newcode=" . $fileHead{'Newcode'} . "\t"
. "Tree=" . $fileHead{'Tree'} . "\t"
. "Title=" . $fileHead{'Title'} . "\t"
. "\n";
# パスワード暗号化
$cryptedPasswd = stdio::recryptString($STDIN{'Passwd'}, $E{'Passwd'}) ? "" : stdio::cryptString($STDIN{'Passwd'}) if ($STDIN{'Passwd'} ne "");
# 里親募集ファイルレコード
$addRecord[1] = $fileHead{'Newcode'} . "\t"
. "Code=" . $fileHead{'Newcode'} . "\t"
. "Time=" . time . "\t"
. "Name=" . $namex . "\t"
. "Age=" . $STDIN{'Age'} . "\t"
. "Sex=" . $STDIN{'Sex'} . "\t"
. "Email=" . $STDIN{'Email'} . "\t"
. "Url=" . $STDIN{'Url'} . "\t"
. "SecretEmail=". $STDIN{'SecretEmail'} . "\t"
. "Title=" . $STDIN{'Title'} . "\t"
. "Sage=" . $STDIN{'Nomove'} . "\t"
. "Solved=" . $STDIN{'Solved'} . "\t"
. "AttachFile=" . $attachFile . "\t"
. "Message=" . $STDIN{'Message'} . "\t"
. "MsgType=" . $STDIN{'MsgType'} . "\t"
. "AutoLink=" . $STDIN{'AutoLink'} . "\t"
. "Passwd=" . $cryptedPasswd . "\t"
. "Root=" . $fileHead{'Newcode'} . "\t"
. "Reply=" . $fileHead{'Newcode'} . "\t"
. "Parent=" . $fileHead{'Newcode'} . "\t"
. "IPID=" . $ipid . "\t"
. "Host=" . $SENV{'REMOTE_HOST'} . "\t"
. "Addr=" . $SENV{'REMOTE_ADDR'} . "\t"
. "Agent=" . $SENV{'HTTP_USER_AGENT'} . "\t"
. "AuthUser=" . $ENV{'REMOTE_USER'} . "\t"
. "\n";
$dataHash{'ResCount'} ++;
$dataHash{'Solved'} = $STDIN{'Solved'} if (!$dataHash{'Solved'});
$dataHash{'Solved'} = "" if (checkAdminMode() && $STDIN{'SolvedClear'});
if ($STDIN{'Nomove'}) {
$tim = $dataHash{'Time2'};
$nam = $dataHash{'Name2'};
} else {
$tim = time;
$nam = $namex;
}
# データファイルレコード
$addRecord2[1] = $dataHash{'Code'} . "\t"
. "Code=" . $dataHash{'Code'} . "\t"
. "Time=" . $dataHash{'Time'} . "\t"
. "Time2=" . $tim . "\t"
. "Name=" . $dataHash{'Name'} . "\t"
. "Name2=" . $nam . "\t"
. "Age=" . $dataHash{'Age'} . "\t"
. "Sex=" . $dataHash{'Sex'} . "\t"
. "Email=" . $dataHash{'Email'} . "\t"
. "Url=" . $dataHash{'Url'} . "\t"
. "SecretEmail=". $dataHash{'SecretEmail'} . "\t"
. "Title=" . $dataHash{'Title'} . "\t"
. "Solved=" . $dataHash{'Solved'} . "\t"
. "AttachFile=" . $dataHash{'AttachFile'} . "\t"
. "Message=" . $dataHash{'Message'} . "\t"
. "MsgType=" . $dataHash{'MsgType'} . "\t"
. "Sendmail=" . $dataHash{'Sendmail'} . "\t"
. "AutoLink=" . $dataHash{'AutoLink'} . "\t"
. "ResCount=" . $dataHash{'ResCount'} . "\t"
. "Passwd=" . $dataHash{'Passwd'} . "\t"
. "Root=" . $dataHash{'Root'} . "\t"
. "Reply=" . $dataHash{'Reply'} . "\t"
. "Parent=" . $dataHash{'Parent'} . "\t"
. "IPID=" . $dataHash{'IPID'} . "\t"
. "Host=" . $dataHash{'Host'} . "\t"
. "Addr=" . $dataHash{'Addr'} . "\t"
. "Agent=" . $dataHash{'Agent'} . "\t"
. "AuthUser=" . $dataHash{'AuthUser'} . "\t"
. "\n";
# 里親募集ファイル更新
{
local($_);
local($rmRecord{'FileHeader'}) = "";
$_ = stdio::writeFile1($topicFile, *rmRecord, *addRecord);
if ($_ == -1) {
showErrorMessage('100 ファイル未検出', undef, '里親募集ファイルが存在しません', '里親募集ファイルが見つかりません。里親募集が存在しない、もしくは里親募集が消えてしまった可能性があります。');
} elsif ($_ == -3) {
showErrorMessage('101 ファイル読込エラー', undef, '里親募集ファイルの読み込みに失敗しました', '里親募集ファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。里親募集ファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($_ == -4) {
showErrorMessage('102 ファイル書込エラー', undef, '里親募集ファイルへの書き込みに失敗しました', '里親募集ファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($_ == -5) {
showErrorMessage('110 排他制御中 (共有ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
}
# データファイル更新
{
local(%rmRecord, $_);
if ($STDIN{'Nomove'}) {
$rmRecord{$STDIN{'Code'}} = $addRecord2[1];
undef $addRecord2[1];
} else {
$rmRecord{$STDIN{'Code'}} = "";
}
$rmRecord{'FileHeader'} = "";
$_ = stdio::writeFile1($DataFile, *rmRecord, *addRecord2);
if ($_ == -1) {
showErrorMessage('100 ファイル未検出', undef, 'データファイルが存在しません', 'データファイルが見つかりません。データが存在しない、もしくはデータが消えてしまった可能性があります。');
} elsif ($_ == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($_ == -4) {
showErrorMessage('102 ファイル書込エラー', undef, 'データファイルへの書き込みに失敗しました', 'データファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($_ == -5) {
showErrorMessage('110 排他制御中 (共有ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
}
# アンロック
stdio::unLock($DataFile);
# <メール送信>
if ($sendmail) {
if ($dataHash{'Sendmail'} || $SET{'SendMail'}) {
my($htmlMail, $br);
my($mailMessage) = $STDIN{'Message'} . $attachments;
if ($STDIN{'MsgType'} != 3) {
$mailMessage =~ s/ /\n/g;
$mailMessage =~ s/<//g;
$mailMessage =~ s/&/&/g;
$mailMessage =~ s/"/"/g;
} else {
$mailMessage =~ s/<>/\n/g;
$htmlMail = 1;
$br = ' ';
}
$mailMessage =<<_EOF_;
$br
このメールは$SET{'Title'}に投稿された記事を送信しています。$br
$br
---------------------------------------------------------------------$br
$br
[投 稿 日] @{[scalar gmtime(time + 3600 * $SET{'TimeZone'})]}$br
[ホ ス ト] $SENV{'REMOTE_HOST'}$br
[アドレス] $SENV{'REMOTE_ADDR'}$br
[ブラウザ] $SENV{'HTTP_USER_AGENT'}$br
$br
[投 稿 者] $STDIN{'Name'}$br
[Eメール] $STDIN{'Email'}$br
[里親募集] $dataHash{'Title'}$br
[タイトル] $STDIN{'Title'}$br
$br
$mailMessage
$br
---------------------------------------------------------------------$br
$br
■この里親募集への投稿は以下のURLから行えます$br
http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}?mode=view;Code=$dataHash{'Code'}$br
$br
_EOF_
# 実際にメール送信
stdio::sendMail($sendmail, $dataHash{'Email'}, undef, undef, $STDIN{'Email'}, undef, $SET{'AdminEmail'}, $STDIN{'Title'}, $mailMessage, $htmlMail) if ($dataHash{'Sendmail'} && !$dataHash{'Solved'});
stdio::sendMail($sendmail, $SET{'AdminEmail'}, undef, undef, $STDIN{'Email'}, undef, $SET{'AdminEmail'}, $STDIN{'Title'}, $mailMessage, $htmlMail) if ($SET{'SendMail'});
}
}
# メール送信>
if ($STDIN{'noconfirm'}) {
$cookie = "noconfirm:1&"
}
if ($STDIN{'SetCookie'}) {
$cookie .= "Name:$STDIN{'Name'}&Email:$STDIN{'Email'}&Url=$STDIN{'Url'}&SecretEmail:$STDIN{'SecretEmail'}&Passwd:$STDIN{'Passwd'}&";
}
# リロード/クッキー設定
print "Content-Type: text/html\n";
print "Cache-Control: no-cache\n";
print "Pragma: no-cache\n";
print "Refresh: 2; URL=http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}?mode=view&Code=$STDIN{'Code'}\n";
if ($cookie) {
print "Set-Cookie: "
. stdio::setCookie($SET{'CookieName'}, $cookie, 820)
. "\n";
}
print "\n";
print <<_EOF_;
$SET{'Title'} [書き込み完了]
正常に書き込まれました
メッセージの書き込みが終わりました。自動的にページが切り替わりますので、しばらくお待ちください。
切り替わらない場合はクリックしてください
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ ID生成 (makeID)
#
# 戻り値 : (生成されたID)
#----------------------------------------------------------
sub makeID
{
local($hex_ip, $day, $mon, $crypt_ip);
$hex_ip = sprintf("%02x%02X%02x%02X", (split /\./, $ENV{'REMOTE_ADDR'})[3,0,2,1]);
$day = sprintf("%02d", (gmtime(time + 3600 * $SET{'TimeZone'}))[3]);
$mon = sprintf("%02d", (gmtime(time + 3600 * $SET{'TimeZone'}))[4]);
$crypt_ip = crypt $hex_ip, $day;
$crypt_ip =~ s/^\$1\$\$day\$//;
$crypt_ip =~ s/^$day//;
$crypt_ip = crypt $crypt_ip, $mon;
$crypt_ip =~ s/^\$1\$\$mon\$//;
$crypt_ip =~ s/^$mon//;
if ($E{'Passwd'}) {
local $salt = substr $E{'Passwd'}, -2, 2;
$crypt_ip = crypt $crypt_ip, $salt;
$crypt_ip =~ s/^\$1\$\$salt\$//;
$crypt_ip =~ s/^$salt//;
}
return substr $crypt_ip, 0, 8;
}
#----------------------------------------------------------
# ■ HTML文法チェック (String, int) = htmlSyntaxCheck(scalar)
#
# 呼出元 : outputNewTopic() outputNewMessage()
# 引 数 : (文法チェック文字列)
# 戻り値 : (結果, 0:NG/1:OK)
#----------------------------------------------------------
sub htmlSyntaxCheck #($str)
{
#--- 仮 引 数 ---#
local($str) = @_;
#--- 変数宣言 ---#
local($mode, @element, %element);
local($i, $j) = (0, 1);
local(@allow_elements) = qw(a abbr acronym address b bdo big blink blockquote br center cite
code dd dt dl del dfn div em font h1 h2 h3 h4 h5 h6 i ins kbd li
nobr ol p pre q s strike samp small sub sup strong tt u ul var);
$str =~ s/"/"/g;
$str =~ s/>/>/g;
$str =~ s/ /\n/gi;
$str =~ tr/\t//;
foreach (@allow_elements) {
unless (/^\//) {
$str =~ s/<$_(\s+)([^>]{0,256})>/<$_$1$2>/gi;
if (&wquote($2) > 0) {
return "HTML構\文エラー : 属性値は " か ' で囲む必要があります。";
} elsif ($str =~ /<$_\s*.*style=/i || $str =~ /<$_\s*.*class=/i || $str =~ /<$_\s*.*id=/i || $str =~ /<$_\s*.*on[A-Za-z]+=/i || $str =~ /<$_\s*.*javascript:/i) {
return "セキュリティー上、style属性、class属性、id属性、onXxxxx属性とURLのスキームに"javascript:"は使えません。";
}
$str =~ s/<$_>/<$_>/gi;
}
$str =~ s/<\/$_>/<\/$_>/gi;
}
$str =~ s/>/\t/g;
$str =~ s/>/>/g;
$str =~ s/\t/>/g;
foreach (split(/(<[^>]*>)/, $str)) {
local($element);
$j += tr/\n/\n/;
next if (/^\s*$/ || /^<\/?(area|body|br|col|coldd|dt|embed|group|head|hr|html|img|input|li|meta|option|p|td|th|tr|tbody|thead|tfoot)/i || /\/>$/);
if (/^) {
if (/^<\//) {
$mode = 0;
$i --;
} else {
$mode = 1;
}
$element = $1 if (/<\/?(\w+)[^>]*>/);
return "HTML構\文エラー : 終了タグ </$element> に対応する開始タグがありません。($j行目)" if ($i < 0);
if ($mode) {
$element =~ tr/[A-Z]/[a-z]/;
$element[$i++] = $element;
$element{$element} ++;
} else {
$element =~ tr/[A-Z]/[a-z]/;
return "HTML構\文エラー : </$element> 前後の終了タグの記述順序が違います。($j行目)" if ($element ne $element[$i]);
undef $element[$i];
$element{$element} --;
}
if ($element{$element} >= 5) {
return "HTML構\文エラー : $element 要素のネストが深すぎます。5階層未満にしてください。($j行目)";
} elsif ($element{'a'} > 1) {
return "HTML構\文エラー : a 要素内に a 要素は子要素として配置できません。($j行目)";
}
}
}
return "HTML構\文エラー : " . join(" ", @element) . " 要素に対応する終了タグがありません。" if ($i != 0);
$str =~ s/&/&/g;
$str =~ s/\n/<>/gi;
return $str, 1;
}
sub wquote #($_)
{
local($_) = @_;
local($i , $j);
$i = tr/"/"/ % 2;
$j = tr/'/'/ % 2;
return ($i + $j);
}
#----------------------------------------------------------
# ■ 全体検索 (exit) = searchAll(void)
#
# 呼出元 : main()
# 引 数 : (なし)
# 戻り値 : (終了)
#----------------------------------------------------------
sub searchAll #(void)
{
opendir(DIR, $DataDir) || showErrorMessage('131 ディレクトリ読込エラー', undef, 'データディレクトリ一覧の取得に失敗しました');
print "Content-Type: text/html", $CharSet, "\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [$STDIN{'Keyword'}の検索結果]
$SET{'Header'}
キーワード $STDIN{'Keyword'} で検索しています。しばらくお待ちください。
_EOF_
loop: while ($_ = readdir DIR) {
next if ($_ !~ /\.tpc$/);
next if (!open(IN, "$DataDir$_"));
local $title = ;
local $code = $1 if (/(\d+)\.tpc/);
if ($title =~ /\tTitle=(.*)\t/) {
$title = $1;
}
while () {
local($_2) = $_;
$_2 =~ s/<[^>]*>//g; # タグを除去
if (stdio::searchString($_2, $STDIN{'Keyword'}, $STDIN{'mhmode'}, 1, $STDIN{'aimai'}, $STDIN{'aimai'}, $STDIN{'aimai'})) {
local %field = stdio::readData(split /\t/);
$field{'Message'} =~ s/ |<>//gi;
print qq|\n|;
printf(qq| |,$i+1);
print qq|$title [この里親募集から検索] \n|;
print substr($field{'Message'}, 0, 300) . '...';
print qq| \n|;
$i ++;
next loop;
}
}
close(IN);
}
closedir(DIR);
if ($i) {
print qq| \n|;
print "検索の結果 $i 件の該当がありました。\n";
print qq| \n|;
} else {
print qq|検索の結果、該当する里親募集は見つかりませんでした。 \n|;
}
if ($STDIN{'mhmode'} eq 'BOOLEAN') {
$checked{'BOOLEAN'} = ' checked';
} elsif ($STDIN{'mhmode'} eq 'OR') {
$checked{'OR'} = ' selected';
} else {
$checked{'AND'} = ' selected';
}
if ($STDIN{'aimai'}) {
$checked{'aimai'} = ' selected';
}
print <<_EOF_;
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ 本人確認用パスコード取得 getPasscode
#
# 呼出元 : outputNewMessage() outputNewTopic
# 引 数 : (なし)
# 戻り値 : (パスコード)
#----------------------------------------------------------
sub getPasscode
{
local($code) = @_;
local($salt, $pass);
$salt = substr $code, -2, 2;
$pass = substr $code, 0, 8;
$pass = crypt $pass, $salt;
$pass =~ s/^\$1\$..\$//;
$pass =~ s/^..//;
$pass = substr $pass, 0, 8;
return "◆$pass";
}
#----------------------------------------------------------
# ■ 管理モードであるかどうか checkAdminMode
#
# 呼出元 : main()
# 引 数 : (なし)
# 戻り値 : (1:YES 0:NO)
#----------------------------------------------------------
sub checkAdminMode
{
local(%copa);
%copa = ();
stdio::getCookie(*copa, "$SET{'CookieName'}.3");
if ($copa{'Pass'} ne "" && $E{'Passwd'} ne "" && stdio::recryptString($copa{'Pass'}, $E{'Passwd'})) {
return 1;
}
return 0;
}
#----------------------------------------------------------
# ■ 管理パネルへのログインページ Show_AdminPage
#
# 呼出元 : main()
# 引 数 : (なし)
# 戻り値 : (終了)
#----------------------------------------------------------
sub Show_AdminPage
{
local($err_msg, $cookie, %copa);
$err_msg = 'ログインしていません。
';
if (checkAdminMode) {
$err_msg = 'ログイン中です。〔ログアウト 〕
';
} elsif ($STDIN{'password'} ne "") {
if (stdio::recryptString($STDIN{'password'}, $E{'Passwd'})) {
$err_msg = 'ログインは完了しました。
';
$cookie = "Set-Cookie: " . stdio::setCookie("$SET{'CookieName'}.3", "Pass:$STDIN{'password'}") . "\n";
} else {
$err_msg = 'パスワードが間違っています。
';
}
}
print <<_EOF_;
Content-Type: text/html
$cookie
$SET{'Title'} [管理パネル]
$SET{'Header'}
管理パネル
$err_msg
管理パネルにログインします。
ログイン中は常にクッキーを有効にしておいてください。
_EOF_
exit;
}
#----------------------------------------------------------
# ■ ファイル文字列チェック (exit) = fileStringCheck(array)
#
# 呼出元 : main()
# 引 数 : (チェックする文字列のリスト)
# 戻り値 : (終了)
#----------------------------------------------------------
sub fileStringCheck #($_)
{
foreach (@_) {
showErrorMessage('406 パラメータエラー', '不正なリクエストです', 'パラメータに不正な文字列が含まれています') if ($_ && /(^\/|\.\.|[^\w\-\.\/])/);
}
}
#----------------------------------------------------------
# ■ 匿メール送信ページ表示 (exit) = showSendmailFormPage(Scalar, Scalar)
#
# 呼出元 : main()
# 引 数 : (里親募集番号, 記事番号)
# 戻り値 : (終了)
#----------------------------------------------------------
sub showSendmailFormPage #($topicCode, $msgCode)
{
#--- 仮 引 数 ---#
my($topicCode, $msgCode) = @_;
my($code);
if (!$sendmail) {
showErrorMessage('409 メール送信不可', 'メール送信機能は使えません', 'メール送信機能は使えません', 'メール送信関連の機能は管理者により使えないように設定してあります。');
} elsif (!-x $sendmail) {
showErrorMessage('111 コマンド未検出', undef, 'メール送信プログラム [sendmail] が使えません', 'メール送信プログラム [sendmail] が指定された場所に見つからないか機能していません。メール送信プログラム [sendmail] が指定された場所に存在するか、機能しているかを確認してください。');
}
# プロクシ経由のアクセス拒否
{
local($_) = shutoutHost($SET{'NoProxy'}, *AllowHost, *DenyHost);
if ($_ == 1) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', "[$SENV{'REMOTE_HOST'}] からのアクセスはできません", '申し訳ありませんが、あなたの所属するホスト(プロバイダ・会社・学校等)からのアクセスは制限されています。対処方法及び詳細はこのサイトの管理者に連絡してください。');
} elsif ($_ == 2) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', 'プロクシサーバーを経由してのアクセスはできません', 'プロクシサーバー等を経由してのアクセスは制限されています。プロクシを外して再度アクセスしてください。もしプロバイダ、会社、学校等でプロクシサーバー経由でなければアクセスできない環境の場合、このサイトの管理者に連絡してください。');
}
}
if ($msgCode) {
$DataFile = $DataDir . $topicCode . '.tpc';
$code = $msgCode;
} else {
$code = $topicCode;
}
# <メール送信先の決定>
if (!-f $DataFile) {
showErrorMessage('100 ファイル未検出', undef, '里親募集ファイルが存在しません', '里親募集ファイルが見つかりません。里親募集が存在しない、もしくは里親募集が消えてしまった可能性があります。');
} elsif (!stdio::lockCheck($DataFile)) {
showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
} elsif (!open(IN, $DataFile)) {
showErrorMessage('101 ファイル読込エラー', undef, '里親募集ファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。里親募集ファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
;
while () {
local %field = stdio::readData(split /\t/);
if ($field{'Code'} == $code) {
if ($field{'Title'} eq '') {
showErrorMessage('120 レコード未検出', undef, '指定されたコードの記事は削除されています。');
} elsif (!$field{'SecretEmail'} || !$field{'Email'}) {
showErrorMessage('120 レコード未検出', 'メールを送信できません', '指定された投稿者にはメール送信できません');
}
showSendmailForm(undef, $field{'Name'});
exit(0);
}
}
close(IN);
showErrorMessage('120 レコード未検出', undef, '指定されたコードの記事は存在しません。');
# メール送信先の決定>
exit(0);
}
#----------------------------------------------------------
# ■ 匿メール送信 (exit) = anonymousSendmail(*Hash, Scalar, Scalar)
#
# 呼出元 : showSendmailFormPage() sendAnonymousMail()
# 引 数 : (初期値のハッシュ, 受信者名, エラーメッセージ)
# 戻り値 : (終了)
#----------------------------------------------------------
sub anonymousSendmail #(void)
{
#--- 仮 引 数 ---#
my($topicCode, $msgCode) = @_;
#--- 変数宣言 ---#
my($code, $mailMessage, $flag, $errMsg, $corbonCopy);
if (!$sendmail) {
showErrorMessage('409 メール送信不可', 'メール送信機能は使えません', 'メール送信機能は使えません', 'メール送信関連の機能は管理者により使えないように設定してあります。');
} elsif (!-x $sendmail) {
showErrorMessage('111 コマンド未検出', undef, 'メール送信プログラム [sendmail] が使えません', 'メール送信プログラム [sendmail] が指定された場所に見つからないか機能していません。メール送信プログラム [sendmail] が指定された場所に存在するか、機能しているかを確認してください。');
}
# プロクシ経由のアクセス拒否
{
local($_) = shutoutHost($SET{'NoProxy'}, *AllowHost, *DenyHost);
if ($_ == 1) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', "[$SENV{'REMOTE_HOST'}] からのアクセスはできません", '申し訳ありませんが、あなたの所属するホスト(プロバイダ・会社・学校等)からのアクセスは制限されています。対処方法及び詳細はこのサイトの管理者に連絡してください。');
} elsif ($_ == 2) {
showErrorMessage('403 アクセス拒否', 'アクセスが拒否されました', 'プロクシサーバーを経由してのアクセスはできません', 'プロクシサーバー等を経由してのアクセスは制限されています。プロクシを外して再度アクセスしてください。もしプロバイダ、会社、学校等でプロクシサーバー経由でなければアクセスできない環境の場合、このサイトの管理者に連絡してください。');
}
}
# <フォーム入力内容チェック>
if ($STDIN{'Name'} eq "") {
$errMsg = qq| 名前 は必須項目のため入力してください。\n|;
} elsif (length($STDIN{'Name'}) > 30) {
$errMsg = qq| 名前 は30バイト(全角でその半分)以内で入力してください。(現在 | . length($STDIN{'Name'}) . qq|バイト)\n|;
}
if ($STDIN{'Email'} ne "") {
if ($STDIN{'Email'} !~ /^[\w\+\.-]+@[\w\+\.-]*[A-Za-z0-9-]{2,23}\.[A-Za-z]{2,4}$/) {
$errMsg .= qq|メールアドレス の形式が間違っています。(半角で正しく入力してください)\n|;
} elsif (length($STDIN{'Email'}) > 60) {
$errMsg .= qq|メールアドレス は60バイト以内で入力してください。(現在 | . length($STDIN{'Email'}) . qq|バイト)\n|;
}
} elsif ($STDIN{'SendCorbonCopy'}) {
$errMsg .= qq|内容の控えをメール送信するためメールアドレス を入力してください。\n|;
}
if ($STDIN{'Title'} eq "") {
$errMsg .= qq| タイトル は必須項目のため入力してください。\n|;
} elsif (length($STDIN{'Title'}) > 60) {
$errMsg .= qq|タイトル は60バイト(全角でその半分)以内で入力してください。(現在 | . length($STDIN{'Title'}) . qq|バイト)\n|;
}
if ($STDIN{'Message'} eq "") {
$errMsg .= qq|メッセージ は必須項目のため入力してください。\n|;
} else {
$SET{'ByteMax'} *= 1024;
if (length($STDIN{'Message'}) > $SET{'ByteMax'}) {
$errMsg .= qq|メッセージ は$SET{'ByteMax'}バイト(全角でその半分)以内で入力してください。(現在 | . length($STDIN{'Message'}) . qq|バイト)\n|;
} elsif (($STDIN{'Message'} =~ s/ / /g) > 100) {
$errMsg .= qq|メッセージ は100行以内で入力してください。(現在 | . ($STDIN{'Message'} =~ s/ / /g) . qq|行)\n|;
}
}
# <フォーム入力内容チェック>
# フォーム入力内容不備
if ($errMsg) {
showSendmailForm(*STDIN, $STDIN{'NameTo'}, "\n");
exit(0);
}
# メールアドレスが未記入
$STDIN{'Email'} = 'anonymous@on.the.net' if ($STDIN{'Email'} eq "");
$corbonCopy = $STDIN{'Email'} if ($STDIN{'SendCorbonCopy'});
if ($msgCode) {
$DataFile = $DataDir . $topicCode . '.tpc';
$code = $msgCode;
} else {
$code = $topicCode;
}
# <メール送信先の決定>
if (!-f $DataFile) {
showErrorMessage('100 ファイル未検出' , undef, '里親募集ファイルが存在しません', '里親募集ファイルが見つかりません。里親募集が存在しない、もしくは里親募集が消えてしまった可能性があります。');
} elsif (!stdio::lockCheck($DataFile)) {
showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
} elsif (!open(IN, $DataFile)) {
showErrorMessage('101 ファイル読込エラー', undef, '里親募集ファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。里親募集ファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
;
while () {
local %field = stdio::readData(split /\t/);
if ($field{'Code'} == $code) {
if ($field{'Title'} eq '') {
showErrorMessage('120 レコード未検出', undef, '指定されたコードの記事は削除されています。');
} elsif (!$field{'SecretEmail'} || !$field{'Email'}) {
showErrorMessage('120 レコード未検出', 'メールを送信できません', '指定された投稿者にはメール送信できません');
}
$to = $field{'Email'};
$flag = 1;
last;
}
}
close(IN);
showErrorMessage('120 レコード未検出', undef, '指定されたコードの記事は存在しません。') if (!$flag);
# メール送信先の決定>
$mailMessage = $STDIN{'Message'};
$mailMessage =~ s/ /\n/g;
$mailMessage =~ s/<//g;
$mailMessage =~ s/&/&/g;
$mailMessage =~ s/"/"/g;
$mailMessage =~ s/[\r\n\s]*$//g;
# 送信メール本文
$mailMessage = <<_EOF_;
このメールは$SET{'Title'}からフォーム経由で送信しています。
-----------------------------------------------------------
$mailMessage
-----------------------------------------------------------
[送信者の情報]
送信日時 : @{[scalar gmtime(time + $SET{'TimeZone'} * 3600)]}
ホ ス ト : $SENV{'REMOTE_HOST'}
アドレス : $SENV{'REMOTE_ADDR'}
ブラウザ : $SENV{'HTTP_USER_AGENT'}
_EOF_
# 重複送信チェック
showErrorMessage('408 送信済み', 'すでに送信されました', 'メール送信は完了しています') if (!stdio::logicalLock($DataFile . "wsend.txt", 300, $ENV{'REMOTE_ADDR'}, length($STDIN{'Message'})));
# メール送信
showErrorMessage('608 メール送信エラー', undef, 'メールの送信に失敗しました') if (!stdio::sendMail($sendmail,$to, $corbonCopy, undef, "$STDIN{'Name'} <$STDIN{'Email'}>", undef, $SET{'AdminEmail'}, $STDIN{'Title'}, $mailMessage));
# リロード/クッキー設定
print "Content-Type: text/html\n";
print "Cache-Control: no-cache\n";
print "Pragma: no-cache\n";
print "Refresh: 2; URL=http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}$ENV{'PATH_INFO'}?\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [送信完了]
正常に送信されました
メールの送信が終わりました。自動的にページが切り替わりますので、しばらくお待ちください。
切り替わらない場合はクリックしてください
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ 匿メール送信フォーム表示 (exit) = showSendmailForm(*Hash, Scalar, Scalar)
#
# 呼出元 : showSendmailFormPage() sendAnonymousMail()
# 引 数 : (初期値のハッシュ, 受信者名, エラーメッセージ)
# 戻り値 : (終了)
#----------------------------------------------------------
sub showSendmailForm #(*value, $nameTo, $errMessage)
{
#--- 仮 引 数 ---#
local(*value, $nameTo, $errMessage) = @_;
#--- 変数宣言 ---#
my(%checked);
$checked{'SendCorbonCopy'} = ' checked' if ($STDIN{'SendCorbonCopy'});
$errMessage = " " if (!$errMessage);
# HTML表示開始
print "Content-type: text/html", $CharSet, "\n";
print "\n";
print <<_EOF_;
$SET{'Title'} [$nameToさんへメール送信]
$SET{'Header'}
※ 送信される通信記録 $SENV{'REMOTE_HOST'} ($SENV{'REMOTE_ADDR'}) | $SENV{'HTTP_USER_AGENT'}
※ 半角カタカナ、機種依存文字(全角ローマ数字、○の中の数字等)、HTMLタグは使わないでください。
※ ここに入力された内容を確実に相手に届くことを保証するものではありません。
※ あなたのメールアドレスを入力しないと返事を受け取ることはできません。
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ メッセージ削除 (exit) = removeMessage(scalar)
#
# 呼出元 : main()
# 引 数 : (里親募集番号)
# 戻り値 : (終了)
#----------------------------------------------------------
sub removeMessage #($topicCode)
{
#--- 仮 引 数 ---#
my($topicCode) = @_;
#--- 変数宣言 ---#
local($authOK) = 0;
local(%dataHash, %removeHash, %field, $last_writer);
my($topicFile) = $DataDir . $topicCode . '.tpc';
my($i, $result) = 0;
if (checkAdminMode()) {
$authOK = 1;
} else {
# パスワード入力チェック
showErrorMessage('405 フォーム入力不備', '入力されていない項目があります', '削除キー(パスワード)を入力してください。') if ($STDIN{'Passwd'} eq "");
# 管理者かどうかを認証
if (stdio::recryptString($STDIN{'Passwd'}, $E{'Passwd'})) {
$authOK = 1;
}
}
# (関) 里親募集削除 => 終了
removeTopic($topicCode) if ($STDIN{'topic'});
# ファイルロック
if (!stdio::Lock($DataFile, $E{'UseLock'})) {
showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
if (!-f $topicFile) {
showErrorMessage('100 ファイル未検出', undef, '里親募集ファイルが存在しません', '里親募集ファイルが見つかりません。この里親募集は存在しない、もしくは里親募集が消えてしまった可能性があります。');
} elsif (!open(IN, $topicFile)) {
showErrorMessage('101 ファイル読込エラー', undef, '里親募集ファイルの読み込みに失敗しました', '里親募集ファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。里親募集ファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
;
while () {
local %field = stdio::readData(split /\t/);
$last_writer = $field{'Name'} if ($last_writer eq "");
if ($STDIN{$field{'Code'}}) {
if (!$authOK) {
if (!stdio::recryptString($STDIN{'Passwd'}, $field{'Passwd'})) {
next;
}
}
foreach (split /\s/, $field{'AttachFile'}) {
unlink("$FileDir$_") if (-f "$FileDir$_");
}
$removeHash{$field{'Code'}} = "";
$last_writer = "";
$i ++;
}
}
close(IN);
if (!$i) {
showErrorMessage('403 削除失敗','メッセージの削除に失敗しました', '削除できませんでした', 'メッセージの削除に失敗しました。削除するメッセージがチェックされていない、もしくはあなたにメッセージを削除する権限が与えられていないことが原因です。');
}
# データファイルからレコード抽出
$dataHash{$topicCode} = "";
$result = stdio::readFile2($DataFile, *dataHash);
if ($lines == -1) {
showErrorMessage('100 ファイル未検出', undef, 'データファイルが存在しません', 'データファイルが見つかりません。このデータは存在しない、もしくはデータが消えてしまった可能性があります。');
} elsif ($lines == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
undef $result;
showErrorMessage('120 レコード未検出', undef, '指定されたコードの記事は存在しません') if (!$dataHash{$topicCode});
%field = stdio::readData(split /\t/, $dataHash{$topicCode});
# 削除したレコード数を記事数から減算
$field{'ResCount'} -= $i;
$field{'Name2'} = $last_writer;
# データファイルレコード
$dataHash{$topicCode} = $field{'Code'} . "\t"
. "Code=" . $field{'Code'} . "\t"
. "Time=" . $field{'Time'} . "\t"
. "Time2=" . $field{'Time2'} . "\t"
. "Name=" . $field{'Name'} . "\t"
. "Name2=" . $field{'Name2'} . "\t"
. "Age=" . $field{'Age'} . "\t"
. "Sex=" . $field{'Sex'} . "\t"
. "Email=" . $field{'Email'} . "\t"
. "SecretEmail=". $field{'SecretEmail'} . "\t"
. "Title=" . $field{'Title'} . "\t"
. "Solved=" . $field{'Solved'} . "\t"
. "AttachFile=" . $field{'AttachFile'} . "\t"
. "Message=" . $field{'Message'} . "\t"
. "MsgType=" . $field{'MsgType'} . "\t"
. "Sendmail=" . $field{'Sendmail'} . "\t"
. "AutoLink=" . $field{'AutoLink'} . "\t"
. "ResCount=" . $field{'ResCount'} . "\t"
. "Passwd=" . $field{'Passwd'} . "\t"
. "Root=" . $field{'Root'} . "\t"
. "Reply=" . $field{'Reply'} . "\t"
. "Parent=" . $field{'Parent'} . "\t"
. "IPID=" . $field{'IPID'} . "\t"
. "Host=" . $field{'Host'} . "\t"
. "Addr=" . $field{'Addr'} . "\t"
. "Agent=" . $field{'Agent'} . "\t"
. "AuthUser=" . $field{'AuthUser'} . "\t"
. "\n";
# 里親募集ファイル書き換え
$result = stdio::writeFile1($topicFile, *removeHash);
if ($result == -1) {
showErrorMessage('100 ファイル未検出', undef, '里親募集ファイルが存在しません', '里親募集ファイルが見つかりません。里親募集が存在しない、もしくは里親募集が消えてしまった可能性があります。');
} elsif ($result == -3) {
showErrorMessage('101 ファイル読込エラー', undef, '里親募集ファイルの読み込みに失敗しました', '里親募集ファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。里親募集ファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($result == -4) {
showErrorMessage('102 ファイル書込エラー', undef, '里親募集ファイルへの書き込みに失敗しました', '里親募集ファイルへの里親募集書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($result == -5) {
showErrorMessage('110 排他制御中 (共有ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
undef $result;
# データファイル書き換え
$result = stdio::writeFile1($DataFile, *dataHash);
if ($result == -1) {
showErrorMessage('100 ファイル未検出', undef, 'データファイルが存在しません', 'データファイルが見つかりません。データが存在しない、もしくはデータが消えてしまった可能性があります。');
} elsif ($result == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($result == -4) {
showErrorMessage('102 ファイル書込エラー', undef, 'データファイルへの書き込みに失敗しました', 'データファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($result == -5) {
showErrorMessage('110 排他制御中 (共有ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
# アンロック
stdio::unLock($DataFile);
# 里親募集をリロード
print "Location: http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}$ENV{'PATH_INFO'}?mode=view;Code=$field{'Code'}\n";
print "\n";
exit(0);
}
#----------------------------------------------------------
# ■ 里親募集削除 (exit) = removeTopic(scalar)
#
# 呼出元 : removeMessage()
# 引 数 : (里親募集番号)
# 戻り値 : (終了)
#----------------------------------------------------------
sub removeTopic #($topicCode)
{
#--- 仮 引 数 ---#
my($topicCode) = @_;
#--- 変数宣言 ---#
local(%dataHash);
my($topicFile) = $DataDir . $topicCode . '.tpc';
my(%field, $result);
# ファイルロック
if (!stdio::Lock($DataFile, $E{'UseLock'})) {
showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
# データファイルから読み込み
$dataHash{$topicCode} = "";
$result = stdio::readFile2($DataFile, *dataHash);
if ($result == -1) {
showErrorMessage('100 ファイル未検出', undef, 'データファイルが存在しません', 'データファイルが見つかりません。このデータは存在しない、もしくはデータが消えてしまった可能性があります。');
} elsif ($result == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
if (!$dataHash{$topicCode}) {
showErrorMessage('120 レコード未検出', undef, '指定されたコードの里親募集は存在しません');
}
undef $result;
%field = stdio::readData(split /\t/, $dataHash{$topicCode});
# パスワードチェック
if (!$authOK) {
if ($SET{'NoRemove'} && $field{'ResCount'} > 1) {
showErrorMessage('409 削除不可', '削除できません', '里親募集の投稿者削除はできません','メッセージがある里親募集の投稿者削除はできません。どうしても削除が必要な場合は、管理者へ連絡してください。');
} elsif ($field{'Passwd'} eq "") {
showErrorMessage('409 削除不可', '削除できません', 'この里親募集の投稿者削除はできません', 'この里親募集の投稿者削除はできません。どうしても削除が必要な場合は、管理者へ連絡してください。');
}
if (!stdio::recryptString($STDIN{'Passwd'}, $field{'Passwd'})) {
showErrorMessage('201 パスワード不備', 'パスワードが不正です', '入力されたパスワードは間違っています', '入力されたパスワードは正しくありません。大文字・小文字・記号類に注意して再度入力してください。管理者によってパスワードが変更、もしくは無効にされている場合もあります。');
}
}
# インデックスファイルからレコード削除
$dataHash{$topicCode} = "";
$result = stdio::writeFile1($DataFile, *dataHash);
if ($result == -1) {
showErrorMessage('100 ファイル未検出', undef, 'データファイルが存在しません', 'データファイルが見つかりません。データが存在しない、もしくはデータが消えてしまった可能性があります。');
} elsif ($result == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($result == -4) {
showErrorMessage('102 ファイル書込エラー', undef, 'データファイルへの書き込みに失敗しました', 'データファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($result == -5) {
showErrorMessage('110 排他制御中 (共有ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
# アンロック
stdio::unLock($DataFile);
# 添付ファイル削除
if (opendir DIR, $FileDir) {
while ($_ = readdir DIR) {
if (/$topicCode-\d+\./) {
unlink "$FileDir$_";
}
}
closedir DIR;
}
# 里親募集ファイル削除
unlink($topicFile) if (-f $topicFile);
# 里親募集一覧ページをリロード
print "Location: http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}$ENV{'PATH_INFO'}?\n";
print "\n";
exit(0);
}
#----------------------------------------------------------
# ■ 里親募集一括削除 (exit) = Remove_MultiThread
#
# 呼出元 : removeMessage()
# 引 数 : (なし)
# 戻り値 : (終了)
#----------------------------------------------------------
sub Remove_MultiThread
{
local($i, $j, $result, %removeHash);
if (!checkAdminMode()) {
showErrorMessage('403 削除失敗','里親募集の削除に失敗しました', '削除できませんでした', '里親募集の削除に失敗しました。削除する里親募集がチェックされていない、もしくはあなたに里親募集を削除する権限が与えられていないことが原因です。');
}
# ファイルロック
if (!stdio::Lock($DataFile, $E{'UseLock'})) {
showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
if (!-f $DataFile) {
showErrorMessage('100 ファイル未検出', undef, 'データファイルが存在しません', 'データファイルが見つかりません。');
} elsif (!open(IN, $DataFile)) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
}
;
while () {
local %field = stdio::readData(split /\t/);
if ($STDIN{'rm1'} && $STDIN{'Code2'} && $STDIN{'Code2'} <= ++ $j) {
push @rmcode, $field{'Code'};
if (-f "$DataDir$field{'Code'}.tpc") {
unlink "$DataDir$field{'Code'}.tpc";
}
$removeHash{$field{'Code'}} = "";
$i ++;
} elsif ($STDIN{'rm2'}) {
if ($STDIN{$field{'Code'}}) {
push @rmcode, $field{'Code'};
if (-f "$DataDir$field{'Code'}.tpc") {
unlink "$DataDir$field{'Code'}.tpc";
}
$removeHash{$field{'Code'}} = "";
$i ++;
}
}
}
close(IN);
# 添付ファイル削除
if (opendir DIR, $FileDir) {
my($file);
while ($file = readdir DIR) {
foreach (@rmcode) {
if ($file =~ /$_-\d+\./) {
unlink "$FileDir$file";
}
}
}
closedir DIR;
}
if (!$i) {
showErrorMessage('403 削除失敗','里親募集の削除に失敗しました', '削除できませんでした', '里親募集の削除に失敗しました。削除する里親募集がチェックされていない、もしくはあなたに里親募集を削除する権限が与えられていないことが原因です。');
}
# データファイル書き換え
$result = stdio::writeFile1($DataFile, *removeHash);
if ($result == -1) {
showErrorMessage('100 ファイル未検出', undef, 'データファイルが存在しません', 'データファイルが見つかりません。データが存在しない、もしくはデータが消えてしまった可能性があります。');
} elsif ($result == -3) {
showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($result == -4) {
showErrorMessage('102 ファイル書込エラー', undef, 'データファイルへの書き込みに失敗しました', 'データファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');
} elsif ($result == -5) {
showErrorMessage('110 排他制御中 (共有ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1);
}
# アンロック
stdio::unLock($DataFile);
# 里親募集一覧ページをリロード
print "Location: http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}$ENV{'PATH_INFO'}?\n";
print "\n";
exit(0);
}
sub checkString #($_)
{
local($_) = @_;
local($i) = 0;
local(%code);
foreach (split //) {
local($_) = ord;
if (!$code{$_}) {
$code{$_} = 1;
$i ++;
}
}
return $i;
}
sub setPassword #(void)
{
local($errMsg);
if ($STDIN{'Passwd'} ne "") {
if (length $STDIN{'Passwd'} < 8 || length $STDIN{'Passwd'} > 12) {
$errMsg = ' ■ パスワードは8〜12文字で入力してください。';
} elsif ($STDIN{'Passwd'} ne $STDIN{'Passwd_retype'}) {
$errMsg = '
■ 確認用のパスワードと一致しません。';
} else {
local($PasswdFile) = $DataFile . '.passwd.cgi';
open(OUT, ">$PasswdFile") || showErrorMessage('102 ファイル書込エラー', undef, 'パスワードファイルへの書き込みに失敗しました', 'データファイルへのデータ書き込みに失敗しました。誤った設定がなされている可能性があります。データディレクトリの属性(パーミッション)が正しく設定されているかを確認してください。');;
print OUT stdio::cryptString($STDIN{'Passwd'});
close(OUT);
print "Location: http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}$ENV{'PATH_INFO'}?\n";
print "\n";
exit(0);
}
}
print "Content-Type: text/html", $CharSet, "\n";
print "\n";
print <<_EOF_;
パスワード設定
$errMsg
パスワードは8〜12文字の半角英数字で入力してください。
名前、メール、単純な文字列など推測されやすいものは避けましょう。
[生成]をクリックすると、指定文字数で乱文字を自動生成します。
パスワードを変更(忘れた)する場合、データディレクトリのパスワードファイルを削除してください。
_EOF_
exit(0);
}
#----------------------------------------------------------
# ■ 第二環境変数設定 (void) = setEnv(void)
#
# 呼出元 : main()
# 引 数 : (なし)
# 戻り値 : (なし)
#----------------------------------------------------------
sub setEnv #(void)
{
$SENV{'HTTP_USER_AGENT'} = substr($ENV{'HTTP_USER_AGENT'}, 0, 150);
$SENV{'HTTP_USER_AGENT'} =~ s/&/&/g;
$SENV{'HTTP_USER_AGENT'} =~ s/"/"/g;
$SENV{'HTTP_USER_AGENT'} =~ s/</g;
$SENV{'HTTP_USER_AGENT'} =~ s/>/>/g;
$SENV{'HTTP_REFERER'} = $ENV{'HTTP_REFERER'};
$SENV{'HTTP_REFERER'} =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$SENV{'REMOTE_HOST'} = $ENV{'REMOTE_HOST'};
$SENV{'REMOTE_ADDR'} = $ENV{'REMOTE_ADDR'};
if ($SENV{'REMOTE_HOST'} eq $SENV{'REMOTE_ADDR'} || !$SENV{'REMOTE_HOST'}) {
$SENV{'REMOTE_HOST'} = gethostbyaddr(pack('C4',split(/\./, $SENV{'REMOTE_ADDR'})),2) || $SENV{'REMOTE_ADDR'};
$SENV{'REMOTE_HOST'} = $SENV{'REMOTE_ADDR'} if ($SENV{'REMOTE_HOST'} eq "");
}
$SENV{'SCRIPT_PATH'} = $ENV{'SCRIPT_NAME'} if ($SENV{'SCRIPT_PATH'} eq "");
$SENV{'SERVER_NAME'} = $ENV{'SERVER_NAME'} if ($SENV{'SERVER_NAME'} eq "");
$SENV{'SCRIPT_URL'} = "http://$SENV{'SERVER_NAME'}$SENV{'SCRIPT_PATH'}" if ($SENV{'SCRIPT_URL'} eq "");
$SENV{'SCRIPT_NAME'} = $1 if ($SENV{'SCRIPT_NAME'} =~ /([^\\\/]+$)/);
$SENV{'VIA_PROXY'} = 0;
$SENV{'VIA_PROXY'} = 2 if ($SENV{'REMOTE_HOST'} =~ /(proxy|via|cache)/i || $SENV{'HTTP_USER_AGENT'} =~ /(proxy|via|cache|anonym|turing)/i);
$SENV{'VIA_PROXY'} = 1 if ($SENV{'REMOTE_HOST'} =~ /\.jp$/i && $SET{'NoProxy'} == 1 && $SENV{'VIA_PROXY'});
foreach ('HTTP_VIA','HTTP_FORWARDED','HTTP_PROXY_CONNECTION','HTTP_CACHE_CONTROL','HTTP_CACHE_INFO','HTTP_XROXY_CONNECTION','HTTP_XONNECTION','HTTP_X_FORWARDED_FOR') {
next unless (defined $ENV{$_});
$SENV{'VIA_PROXY'} = 2 if (!$SENV{'VIA_PROXY'});
if ($_ eq 'HTTP_VIA' || $_ eq 'HTTP_FORWARDED') {
$SENV{'ROW_REMOTE_HOST'} = $ENV{$_} if ($ENV{$_}=~ s/.*\s(\d+)\.(\d+)\.(\d+)\.(\d+)/$1.$2.$3.$4/);
$SENV{'VIA_PROXY'} = 1;
} elsif ($_ eq 'HTTP_X_FORWARDED_FOR') {
$SENV{'ROW_REMOTE_HOST'} = $ENV{$_} if ($ENV{$_} =~s/^(\d+)\.(\d+)\.(\d+)\.(\d+)(\D*).*/$1.$2.$3.$4/);
$SENV{'VIA_PROXY'} = 1;
}
}
}
#----------------------------------------------------------
# ■ アクセス拒否識別 (int) = shutoutHost(scalar, *array, *array)
#
# 呼出元 : (すべての関数)
# 引 数 : (プロクシ拒否レベル, アクセス許可ホスト, アクセス拒否ホスト)
# 戻り値 : (なし)
#----------------------------------------------------------
sub shutoutHost #($proxyLevel, *allowHost, *denyHost)
{
local($proxyLevel, *allowHost, *denyHost) = @_;
if (@allowHost) {
foreach (@allowHost) {
return 0 if ($SENV{'REMOTE_HOST'} =~ /$_/i);
}
}
if (@denyHost) {
foreach (@denyHost) {
return 1 if ($SENV{'REMOTE_HOST'} =~ /$_/i);
}
}
return 2 if ($proxyLevel && $proxyLevel == $SENV{'VIA_PROXY'});
}
#-------------------------------------------------------------------------------
# ■ ASCII文字列を10進/16進エンティティに変換する
#
# 呼出元 : *
# 引 数 : (エンティティする文字列)
# 戻り値 : (エンティティ化された文字列)
#-------------------------------------------------------------------------------
sub entityString #($data)
{
my($data) = @_;
my($encoded_data);
for ($i = 0; $i < length($data); $i ++) {
my($char, $rand);
$char = substr $data, $i, 1;
$rand = int(rand 6);
if ($rand == 0) {
$char = "" . sprintf("%X", ord $char) . ";";
} elsif ($rand == 2) {
$char = "" . sprintf("%x", ord $char) . ";";
} elsif ($rand == 3 || $rand == 4) {
$char = "" . ord($char) .";";
}
$encoded_data .= $char;
}
return $encoded_data;
}#entityString
#----------------------------------------------------------
# ■ エラーメッセージ表示 (exit) = showErrorMessage(Scalar, Scalar, Scalar, Scalar, Scalar)
#
# 呼出元 : (すべての関数)
# 引 数 : (エラー, エラータイトル, エラー原因, エラー詳細, ヘッダ出力なし)
# 戻り値 : (終了)
#----------------------------------------------------------
sub showErrorMessage #($errMsg1, $errMsg2, $errMsg3, $errMsg4, $noHeader)
{
local($errMsg1, $errMsg2, $errMsg3, $errMsg4, $refresh, $noHeader) = @_;
$errMsg1 = '000 システムエラー' if ($errMsg1 eq "");
$errMsg2 = 'システムエラーが発生しました' if ($errMsg2 eq "");
$errMsg3 = 'システム内部でエラーが発生しました' if ($errMsg3 eq "");
if ($errMsg4 eq "") {
$errMsg4 = ' システム内部でエラー発生したため処理は中断されました。エラーの発生原因として、リクエスト内容の不備、アクセス権が与えられていない、誤った設定がなされている、あるいは突発的なサーバーエラー等の可能\性が考えられます。
';
} else{
$errMsg4 = ' ' . $errMsg4 . '
';
}
stdio::unLock($DataFile);
if (!$noHeader) {
print "Content-Type: text/html", $CharSet, "\n";
print "Refresh: 10\n" if ($refresh);
print "Pragma: no-cache\n";
print "\n";
}
print <<_EOF_;
$SET{'Title'} [$errMsg1]
$errMsg2
$errMsg3
$errMsg4
◇
問題が解決しない、もしくは繰り返しエラーメッセージが表\示される場合は、このサイトの管理者へご連絡ください。
戻る (再試行 )
$errMsg1
$Version
_EOF_
exit(1);
}
sub showErrorSign #(void)
{
local(@array) = (
'47','49','46','38','39','61','1c','00','1c','00','a1','00','00','00','00','00','ff','00','00',
'ff','ff','ff','bf','bf','bf','21','f9','04','01','00','00','03','00','2c','00','00','00','00',
'1c','00','1c','00','00','02','68','9c','8f','a9','cb','18','1f','9a','4c','30','ce','59','df',
'95','d9','6e','d5','69','1f','15','8e','4e','28','9a','68','fa','65','82','90','a9','d5','1b',
'b7','f3','0b','57','36','24','00','40','0e','d9','b8','7a','3f','20','8b','31','f4','d1','74',
'9c','1b','11','57','43','3a','95','cb','a0','94','87','a3','56','8f','87','e1','4b','6b','f4',
'9c','b0','b8','32','94','39','7e','98','c1','61','12','39','5b','2c','47','07','5e','b3','3d',
'ba','ca','97','e8','fa','be','c6','0f','18','08','c8','27','88','32','50','00','00','3b'
);
print "Content-Type: image/gif\n";
print "Content-Length: 151\n";
print "\n";
binmode(STDOUT);
foreach (@array) {
print pack('C*', hex($_));
}
exit(0);
}