#!/usr/bin/perl # ↑ Perl処理系のパスを指定。不明な場合はプロバイダかサーバー管理者に確認。 # マルチ里親募集型掲示板 [ハイパー里親募集BBS] # - Version 2.16 / Aug 4, 2003 / Freesoft # - Copyright(C)2003 WEB POWER. All Rights Reserved. # - 最新版・最新情報は &showErrorSign if ($ENV{'QUERY_STRING'} eq 'error'); #━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━# # 初期設定ここから (設置方法等の詳細は、同梱の"readme.txt"を参照してください) # #───────────────────────────────────────# # # ●印の項目は必ず変更してください。 # ○印の項目は主にレイアウト関連です。基本的に変更不要です。 # △印の項目は上の項目を有効にしている場合のみ設定してください。 # ◎印の項目はサーバー環境によって変更する必要があります。(1行目も含みます) # # ・ ''内に記述しますが、'を入れたい場合は 中の'は \'にしてください。 # ・ 行の頭に"#"を付けると、その行は無効になります。(コメントアウト) # ・ "$"、";"、"="等は間違って消さないようにしてください。エラーになります。 # ・ 詳しくは本サイトの解説/FAQ等を参照してください。 # # ◎ 排他的ロック (0:使わない/1:使う <推奨>) $E{'UseLock'} = 1; # ○ プロクシ経由投稿規制 (0:なし/1:匿名プロクシのみ/2:すべてのプロクシ) # * 1にすると、JPドメイン以外のプロクシと匿名プロクシを弾きます # * 2にすると、ISP・会社・学校等の正規のプロクシまで弾く場合があります $SET{'NoProxy'} = 1; # △ 例外的に許可するプロクシ (正規表現可、部分一致、空白で区切っていくつでも) #@AllowHost = qw(yyyy1.ne.jp yyyy2.ne.jp yyyy3.ne.jp); # ○ 投稿を拒否するホスト (正規表現可、部分一致、空白で区切っていくつでも) #@DenyHost = qw(xxxx1.ne.jp xxxx2.ne.jp xxxx3.ne.jp); @DenyHost = qw(78.46.198.162 94.102.49.46 xxxx2.ne.jp xxxx3.ne.jp); # ○ 最低連続投稿間隔 (0:制限なし/1以上:秒単位で指定) $SET{'WaitTime'} = 1800; # ○ 掲示板のURLの一部 (外部のURLからの不正投稿を禁止する場合のみ) $SET{'SetUrl'} = 'http://www.wnlll.com/search/'; # ○ メッセージの書込許容最大キロバイト数 # * (1KByte = 1024 Bytes = 全角 512 文字) $SET{'ByteMax'} = 3; # ○ 日付の表示書式 $SET{'TimeFormat'} = 'yyyy/mm/dd (ww) hh:nn:ss'; # ○ 解決済み里親募集に付けるマーク $SET{'SolvedImage'} = '解決済み'; # ○ ファイル添付里親募集に付けるマーク $SET{'AttachImage'} = '添付ファイルあり'; # ○ 未読新記事里親募集に付けるマーク $SET{'NoreadImage'} = '未読新記事あり'; # ○ 時間帯 (GMT=英国ロンドンとの時差 日本は9時間) $SET{'TimeZone'} = 9; # ○ ページあたりの最大記事表示件数 $SET{'PageMax'} = 20; # ○ ページあたりの最大里親募集表示件数 $SET{'TopicMax'} = 50; # ○ 里親募集の拡張を許可 (0:しない/1:する) $SET{'ExtendTopic'} = 1; # ○ 解決マーク機能を (0:付けない/1:付ける) # * 管理モードの場合、いつでも解決チェックができます。 $SET{'UseSolved'} = 1; # △ 解決済み里親募集への投稿を許可 (0:しない/1:する) # * 解決済み里親募集への投稿を許可しない場合、悪戯防止のため、 # 解決チェックを里親募集作成者に限定することを推奨します。 # * 管理モードの場合、いつでも投稿及び解決キャンセルができます。 $SET{'PostSolved'} = 1; # △ 解決チェックは (0:里親募集作成者or管理者のみ/1:誰でも) $SET{'SetSolved'} = 1; # ● 管理者メールアドレス $SET{'AdminEmail'} = 'info@wnlll.com'; # ○ 匿メール機能を (0:使わない/1:使う) $SET{'UseTokumail'} = 1; # ○ 投稿があったら管理者宛にメール通知 (0:しない/1:する) $SET{'SendMail'} = 1; # ○ クッキーの名前 (通常変更不要) $SET{'CookieName'} = 'HyperThread'; # ○ 添付ファイル1個の制限キロバイト数 # * ファイル添付機能を使わない場合は 0 にする # * 巨大なファイルは受信できません。(最大 128KB) $SET{'MaxSize'} = 128; # △ 添付可能ファイルの個数 $SET{'MaxFile'} = 3; # △ 里親募集への投稿の際もファイル添付を許可 (1:する/0:しない) $SET{'AttachRepaly'} = 1; # ○ メッセージがある里親募集の削除を許可 (0:する/1:しない) $SET{'NoRemove'} = 0; # ○ ID(IPを暗号化したもの 同じIPでも日付ごとに異なる)表示 (1:する/0:しない) $SET{'ID-ON'} = 1; # ○ 里親募集内に投稿フォームを (1:付ける/0:付けない) $SET{'FORM_ON'} = 1; # ○ 新規里親募集作成を管理者のみに限定 (1:する/0:しない) # * 里親募集作成時には、里親募集作成フォームに管理者用パスワードを入力する。 $SET{'AdminOnly'} = 0; # ○ 投稿前に確認ページを表示 (1:する <推奨>/0:しない) # * 表示する場合でも、ユーザーが任意で2回目以降はスキップできます。 $SET{'Confirm'} = 1; # ○ 全文検索機能を (1:使う/0:使わない) # * データ容量が大きい場合(数メガバイトある)は使わないでください。 # (サーバー負荷が大きくなります。必要な場合は「Namazu」を使いましょう) $SET{'SearchAll'} = 1; # ○ 管理者投稿メッセージの名前と後に付ける識別子 $SET{'AdminPlus'} = ' (管理人)'; # ○ 使用規制ワード (複数個の場合はホワイトスペースで区切る) # * しつこい宣伝URLなどを登録しておくとよいでしょう。 # * 正規表現は使えません。形態素解析等はされません。 # * 例えば、「カー」は「サーカー」「カーテン」「スカーフ」等の「カー」を含 # むすべてのメッセージに反応します。意図しないメッセージまで規制する場合 # があります。短い単語は避け、規制は必要最小限にしましょう。 @NGWord = qw(cheap link=http:// pharmacy penis naked comment vagina teens nude anal porn lolita fuck pussy hardcore asian-girls pharmacy mammamia propecia 馬鹿 バカ 殺すぞ お前 販売 258bag.com); #---<パスについて>------------------------------------------------------------- # # ・ パスとはサーバー内での場所です。httpで始まるURIとは違うものです。 # ・ 相対パスとはスクリプトの場所を基準としたパスの指定です。 # ../ => 1つ上のディレクトリ ./ => 同じディレクトリ # ・ 絶対パスとはサーバー内の一番上のディレクトリを基準としたパスの指定です。 # /usr/lib/sendmail /home/foo/public_html/cgi-bin/script.cgi # ・ 仮想アドレスとはURIの一部分(ドメイン名以降)を指します。 # http://www.domain.com/~foo/cgi-bin/script.cgi # ^ ドメイン名の後のスラッシュ"/"以降の部分 # (/~foo/cgi-bin/script.cgi のこと) # ○ 日本語変換ライブラリ jcode.plの[パス] require 'jcode.pl'; # ○ CGI標準入出力ライブラリ stdio.pl の[パス] # * 必ず同梱のものを使ってください require 'stdio.pl'; # ◎ メール送信コマンド sendmail の[パス] # * メール送信関連機能を使用しない(できない)場合はコメントアウト $sendmail = '/usr/sbin/sendmail'; # ○ データ格納用ディレクトリの[パス] # * このディレクトリのパーミッションは<777>or<707>にする $DataDir = 'data/'; # ○ データファイルのファイル名 (ファイル名であってパスではない) # * データを記録するファイル $DataName = 'data.txt'; # ○ 添付ファイル格納用ディレクトリのパス # * このディレクトリのパーミッションは<777>or<707>にする # * このディレクトリはWebから直接参照できる場所を指定 $FileDir = 'file/'; # △ ↑の場所をURL(http://..)で指定する $FileUrl = 'http://www.wnlll.com/search/wanoya2/file/'; #------------------------------------------------------------------------------ # ○ 里親募集一覧ページ : 里親募集名表示部分の背景色 (1と2を交互表示) $bgColor1 = '#ffffff'; $bgColor2 = '#F4F4D3'; # ○ 里親募集一覧ページ : 管理者が立てた里親募集名表示部分の背景色 $bgColor8 = '#FFCCCC'; # ○ 里親募集一覧ページ : 項目名の背景色と文字色 $bgColor3 = '#99cccc'; $ftColor3 = '#ffffff'; # ○ 里親募集作成・投稿ページ : タイトルバーの背景色と文字色 $bgColor4 = '#99cccc'; $ftColor4 = '#FFFFFF'; # ○ 里親募集作成・投稿ページ : フォーム項目名の背景色と文字色 $bgColor5 = '#ffcccc'; $ftColor5 = '#FFFFFF'; # ○ 里親募集閲覧ページ : 里親募集のタイトルバーの背景色と文字色 $bgColor6 = '#e6e6fa'; $ftColor6 = '#6600cc'; # ○ 里親募集閲覧ページ : 管理者が立てた里親募集のタイトルバーの背景色と文字色 $bgColor0 = '#e6e6fa'; $ftColor0 = '#6600cc'; # ○ 里親募集閲覧ページ : メッセージのタイトルバーの背景色と文字色 $bgColor7 = '#ffcccc'; $ftColor7 = '#6600cc'; # ○ 里親募集閲覧ページ : 管理者が投稿したメッセージのタイトルバーの背景色と文字色 $bgColor9 = '#99cccc'; $ftColor9 = '#6600cc'; # ○ 引用部分の文字色 $quote_color = '#808080'; # ○ BODY要素の属性 (の****の部分) $SET{'Body'} = ' bgcolor=#ccccff link=#cc33cc vlink=#0000FF alink=#bf0000 background=image/bk7_t.jpg TOPMARGIN=0 LEFTMARGIN=0 MARGINHEIGHT=0 MARGINWIDTH=0'; # ○ タイトル (等で表示) $SET{'Title'} = 'Wan里親探し'; # ● 各ページの上部に表示する文字列 $SET{'Header'} =<<'_EOF_'; <!-- ヘッダー広告を挿入する場合はここにHTMLを記述 --> <div align="center"> <TABLE border="0" cellspacing="0" cellpadding="0"> <TR> <TD align="center" valign="middle"><img src="../image/sear_oyawan.gif"></TD> </TR> </table> <p align=center><a href="search.cgi?mode=newtopic">里親を募集する</a> || <a href="search.cgi">里親募集一覧</a> || <a href="search.cgi?mode=mylist">ウォッチリスト</a> || <a href="http://www.wnlll.com/search/index.html">里親トップ</a></p> <p><font color="ff0000">2009/9/27--こちらの掲示板は金銭の発生する里親里子は基本的に認めておりません。 <br>WNLLLでは、責任もって飼ってくださる里親の方、<br>諸事情でどうしても手放ければならない方の情報を公開する目的で運営しております。<br>再度ご確認ください。</font></p> _EOF_ # ↑ ここまで (_EOF_行は削除しない) # ○ 里親募集一覧ページのフッター $SET{'Footer'} =<<'_EOF_'; <!-- フッター広告を挿入する場合はここにHTMLを記述 --> _EOF_ # ↑ ここまで (_EOF_行は削除しない) # ○ 投稿フォームの下に表示する文字列 $SET{'Center'} = <<'_EOF_'; <dl> <dd><b><font color=blue>★ワンポイント</font></b> <dd> ※ "#{xx}" で当該里親募集へリンクを設定できます。(例: #{10}) <dd> ※ ">>xx" で同一里親募集内の当該メッセージへのリンクを設定できます。(例: >>26 >>1-100) <dd> ※ 名前欄に 「#passcode」を加えることでパスコードになります。("passcode"は6〜10バイトの任意の文字列) <dd> ※ メールアドレスを公開しないでメールを受け取るには[アドレス非公開]をチェックします。 </dl> </font> <!-- フッター広告を挿入する場合はここにHTMLを記述 --> _EOF_ # ↑ ここまで (_EOF_行は削除しない) # ○ 投稿の際の承諾事項(確認ページに表示しない場合は無効) # * 確認ページの投稿ボタンの上に表示されます。 $SET{'Warning'} = <<'_EOF_'; <dl> <dd><b><font color=red>!ご注意!</font></b> <dd> - <font color=red>ご自身の投稿されたメッセージに関する全責任は投稿者自身に帰します。</font> <dd> - 誹謗中傷、個人情報、著作権侵害等の投稿は削除されます。場合によっては法的責任を問われる場合があります。 <dd> - 投稿内容は管理者の裁量により、連絡なしに削除・編集される場合があります。 <dd> - 投稿内容は不特定多数が閲覧可能な状態となります。出典明記無しに引用・転載される場合があります。 <dd> - アクセスログはすべてサーバーに記録されます。%REMOTE_HOST (%REMOTE_ADDR) </dl> </font> <p align="center"><b>投稿内容をご確認の上、上記事項に承諾されましたら下の投稿ボタンを一度だけ押してください</b></p> _EOF_ # ↑ ここまで (_EOF_行は削除しない) #---<特殊な設定>--------------------------------------------------------------- # # 通常は自動的にセットされるため設定不要。ただし、CGI-WRAP等を採用して # いるサーバー(interQ等)は、設定する必要がある。 # * 設定した場合は、$の前のシャープ"#"を取り除く # ◎ サーバー名 (通常は設定不要) # * "www.hostname.jp"と"hostname.jp"のようにアクセスできるホスト名が複数ある # 場合、標準として使うホスト名を指定します。 #$SENV{'SERVER_NAME'} = 'www.hostname.jp'; # ◎ このCGIの仮想パス (通常は設定不要) # * URLが不自然に長くなっていく場合は設定してください。 # * ホスト名の"/"以降の部分が仮想パスです。 #$SENV{'SCRIPT_PATH'} = '/~foo/cgi-bin/sbbs.cgi'; # ◎ URLが不自然に長くなっていく場合はコメントを解除 #$ENV{'PATH_INFO'} = ""; #───────────────────────────────────────# # 初期設定ここまで (以下1バイトでも変更した場合の動作保証&サポートは一切なし) # #━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━# $VERSION = "\x48\x59\x50\x45\x52\x5f\x54\x48\x52\x45\x41\x44\x5f\x42\x42\x53\x2f\x32\x2e\x31\x36"; # 修正禁止. $stdio::ver = $stdio::ver; if ($stdio::ver != 6.27) { showErrorMessage('301 初期設定 [例外発生]', undef, "ライブラリエラー", "ライブラリ[stdio.pl]は同梱のバージョン(6.27)を使用してください。"); } # 漢字コード認識 if (ord "漢" == 0xb4 || ord "漢" == -76) { $jcode = "euc"; $CharSet = '; charset=EUC-JP'; } elsif (ord "漢" == 0x8a || ord "漢" == -118) { $jcode = "sjis"; $CharSet = '; charset=Shift_JIS'; } elsif (ord "漢" == 0x1b) { $jcode = "jis"; $CharSet = '; charset=ISO-2022-JP'; } #$MetaContentType = qq|<meta http-equiv=Content-Type content="text/html$CharSet">\n| if ($CharSet); # 独自環境変数の設定 setEnv(); $SET{'MaxSize'} *= 1024; $DataFile = $DataDir . $DataName; $SET{'SearchAll'} = $SET{'SearchAll'} ? '' : ' disabled="disabled"'; # バッファをフラッシュする $| = 1; # 標準入力からデータ読込 %STDIN = (); stdio::setQueryString(*STDIN, 1, $jcode, 1); # メイン関数呼出 main(); exit(0); #---------------------------------------------------------- # ■ メインルーチン (void) = main(void) # # 呼出元 : (開始) # 引 数 : (なし) # 戻り値 : (なし) #---------------------------------------------------------- sub main #(void) { fileStringCheck($STDIN{'Code'}, $STDIN{'unique'}, $STDIN{'topic'}); # パスワード設定ページ if (!-f "$DataFile.passwd.cgi") { setPassword(); # パスワード読込 } else { open(IN, "$DataFile.passwd.cgi"); $E{'Passwd'} = <IN>; close(IN); chomp($E{'Passwd'}); } # 新しい里親募集作成ページ if ($STDIN{'mode'} eq 'newtopic') { showNewTopic_addPage(); # 引用 } elsif ($STDIN{'quote'} ne "") { quote($STDIN{'Code'}); # 里親募集拡張 } elsif ($SET{'ExtendTopic'} && $STDIN{'extend'} ne "") { showNewTopic_addPage(undef, undef, $STDIN{'Code'}); # ファイル添付 } elsif ($STDIN{'mode'} eq 'attach') { attachFile($STDIN{'unique'}); # 里親募集作成 } elsif ($STDIN{'mode'} eq 'mktopic') { outputNewTopic(); # メッセージ書き込み } elsif ($STDIN{'mode'} eq 'newmsg') { outputNewMessage(); # メッセージ削除 } elsif ($STDIN{'mode'} eq 'remove') { removeMessage($STDIN{'Code'}); # 里親募集の一括削除 } elsif ($STDIN{'mode'} eq 'multiremove') { Remove_MultiThread(); # 全文検索 } elsif ($STDIN{'Keyword'} ne "" && $STDIN{'target'} eq 'all' && $SET{'SearchAll'} eq "") { searchAll(); # メッセージ一覧表示 } elsif ($STDIN{'mode'} eq 'view' && $STDIN{'target'} ne 'title') { showTopicMessages(); # ウォッチリストへの追加・削除 } elsif ($STDIN{'mode'} eq 'add' || $STDIN{'mode'} eq 'rmlist') { Edit_Mylist(); # 匿メール送信ページ表示 } elsif ($STDIN{'mode'} eq 'mail') { showSendmailFormPage($STDIN{'topic'}, $STDIN{'Code'}); # 匿メール送信 } elsif ($STDIN{'mode'} eq 'sendmail') { anonymousSendmail($STDIN{'topic'}, $STDIN{'Code'}); # 管理モードログインページ } elsif ($STDIN{'mode'} eq 'admin') { Show_AdminPage(); } # 里親募集一覧表示 showTopics(); return; } #---------------------------------------------------------- # ■ 里親募集一覧表示 (void) = showTopics(void) # # 呼出元 : main() # 引 数 : (なし) # 戻り値 : (なし) #---------------------------------------------------------- sub showTopics #() { #--- 変数宣言 ---# local(@record, %COOKIE); my($lines, $top, $under); %COOKIE = (); stdio::getCookie(*COOKIE, "$SET{'CookieName'}.2"); $noread_cookie = $COOKIE{'R'}; if ($STDIN{'target'} eq "title") { $STDIN{'target'} = "" if ($STDIN{'Keyword'} =~ /^[\s ]*$/); $mylist = qq|<font color="gray">※<b>$STDIN{'Keyword'}</b>の検索結果を表\示しています。(最大50件)</font>|; $query = qq|;mode=search;target=title;mhmode=$STDIN{'mhmode'};aimai=$STDIN{'aimai'};Keyword=| . stdio::urlencode($STDIN{'Keyword'}); $search = qq|;mode=view;target=thread;mhmode=$STDIN{'mhmode'};aimai=$STDIN{'aimai'};Keyword=| . stdio::urlencode($STDIN{'Keyword'}); } elsif ($STDIN{'mode'} eq 'mylist') { foreach (split /\//, $COOKIE{'W'}) { push @mylist, $_; } if (!@mylist) { $mylist = '<font color="gray">※ウォッチリストに登録されている里親募集はありません</font>'; } else { $mylist = '<font color="gray">※ウォッチリストに登録されている里親募集のみを表\示しています</font>'; } $query = ';mode=mylist'; } $STDIN{'start'} = 1 if (!$STDIN{'start'} || $IN{'start'} =~ /\D/); # データファイル読み込み $STDI $lines = stdio::readFile1($DataFile, *record, $STDIN{'start'}, $SET{'TopicMax'}, $E{'UseLock'}, undef, @mylist); if ($lines == -2) { showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。<br> 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1); } elsif ($lines == -3) { showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。'); } # HTML表示開始 print "Content-Type: text/html", $CharSet, "\n"; print "\n"; print <<_EOF_; <html> <head> <title>$SET{'Title'} $SET{'Header'} _EOF_ $top = <<_EOF_;
$mylist
番号 里親募集 最終投稿者 最終更新日
_EOF_ $under = <<_EOF_;
※ [新]マークの付いている里親募集は、一度閲覧した後に新しいメッセージが投稿された里親募集です。
背景色がこの色の里親募集は、管理人が立てた里親募集です。
_EOF_ # for Administrator only if (checkAdminMode()) { my($size) = $stdio::size; $stdio::size = $stdio::size; $size += (-s "$DataDir$DataName"); 1 while $size =~ s/([\dA-Fa-f]+)([\dA-Fa-f]{3})/$1,$2/; $under = <<_EOF_; ※ [新]マークの付いている里親募集は、一度閲覧した後に新しいメッセージが投稿された里親募集です。
背景色がこの色の里親募集は、管理人が立てた里親募集です。


管理者専用

使用ディスクスペース : $size bytes (添付ファイルは除く)

_EOF_ } print "

この掲示板には里親募集がありません

" if (!showList(*record, $STDIN{'start'}, $lines-1, $SET{'TopicMax'}, $query, "showTopicType", $top, $under)); 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'; } print <<_EOF_;
キーワード  曖昧検索
里親募集No.
$SET{'Footer'} _EOF_ # ↑ ページ内に掲示板管理者への連絡方法(メールアドレス or 問い合わせページへのリンク)は必ず明示してください。 # !注意! この部分を無許諾に削除・改竄されますと不正使用(著作権侵害・ライセンス違反)となります。 # !WARN! If you remove this part without an author's agreement, you infringe on copyright and will be punished by law. print <<_EOF_;

_EOF_ return; } #---------------------------------------------------------- # ■ 里親募集内のメッセージ表示 (exit) = showTopicMessages(void) # # 呼出元 : main() # 引 数 : (なし) # 戻り値 : (終了) #---------------------------------------------------------- sub showTopicMessages #() { #--- 変数宣言 ---# my($attachFile, $extButton, $subTopic, $cookie, $top, $query, @superTopic, $bgColor, $ftColor, $admin); my($topicFile) = $DataDir . $STDIN{'Code'} . '.tpc'; local(%fileHead, %otherHead); # データファイル読み込み $fileHead{$STDIN{'Code'}} = ""; $lines = stdio::readFile2($DataFile, *fileHead, $E{'UseLock'}); if ($lines == -1) { showErrorMessage('100 ファイル未検出',undef, 'データファイルが存在しません', 'データファイルが見つかりません。里親募集がまだ存在しない、もしくは里親募集が消えてしまった可能性があります。'); } elsif ($lines == -2) { showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。
 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1); } elsif ($lines == -3) { showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。'); } %fileHead = stdio::readData(split /\t/, $fileHead{$STDIN{'Code'}}); # 拡張里親募集あり if ($SET{'ExtendTopic'}) { undef $lines; if ($fileHead{'Parent'}) { $otherHead{$fileHead{'Parent'}} = ""; $subTopic = $fileHead{'Parent'} } if ($fileHead{'Reply'}) { foreach (split /:/, $fileHead{'Reply'}) { $otherHead{$_} = ""; push(@superTopic, $_); } } $lines = stdio::readFile2($DataFile, *otherHead, $E{'UseLock'}); if ($lines == -1) { showErrorMessage('100 ファイル未検出',undef, 'データファイルが存在しません', 'データファイルが見つかりません。里親募集がまだ存在しない、もしくは里親募集が消えてしまった可能性があります。'); } elsif ($lines == -2) { showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。
 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1); } elsif ($lines == -3) { showErrorMessage('101 ファイル読込エラー', undef, 'データファイルの読み込みに失敗しました', 'データファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。データファイルの属性(パーミッション)が正しく設定されているかを確認してください。'); } %subTopic = stdio::readData(split /\t/, $otherHead{$fileHead{'Parent'}}); $subTopic = qq|
この里親募集は [$fileHead{'Parent'}] $subTopic{'Title'} の子里親募集です
| if ($otherHead{$fileHead{'Parent'}}); $extButton= qq| \n|; } $STDIN{'start'} = 1 if (!$STDIN{'start'} || $STDIN{'start'} =~ /\D/); # 里親募集ファイル読み込み $lines = stdio::readFile1($topicFile, *record, $STDIN{'start'}, $SET{'PageMax'}, $E{'UseLock'}); if ($lines == -1) { showErrorMessage('100 ファイル未検出',undef, '里親募集ファイルが存在しません', '里親募集ファイルが見つかりません。この里親募集は存在しない、もしくは里親募集が消えてしまった可能性があります。'); } elsif ($lines == -2) { showErrorMessage('110 排他制御中 (排他的ロック)', 'しばらくお待ちください', '只今 混雑しています', '只今、システムに多大なアクセス要求が寄せられ、処理しきれない状況です。10秒後に自動的に再試行されます。申し訳ありませんが、今しばらくお待ちください。
 再度、このエラーが表示された場合、ある程度の時間をおいて、もう一度アクセスしてください。', 1); } elsif ($lines == -3) { showErrorMessage('101 ファイル読込エラー', undef, '里親募集ファイルの読み込みに失敗しました', '里親募集ファイルからの読み込みに失敗しました。誤った設定がなされている可能性があります。里親募集ファイルの属性(パーミッション)が正しく設定されているかを確認してください。'); } if (!$STDIN{'start'} || $STDIN{'start'} == 1) { # 添付ファイルあり if ($fileHead{'AttachFile'}) { foreach (split /\s/, $fileHead{'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|
  • $size bytes ($width x $height) クリックで拡大表\示\n|; } else { $attachFile .= qq|
  • $size bytes ($width x $height)\n|; } } else { $attachFile .= qq|
  • 添付ファイル ($_ - $size bytes)\n|; } } else { $attachFile .= qq|
  • 添付ファイル ($_ - $size bytes)\n|; } } } if ($attachFile) { $attachFile = qq|
      \n$attachFile
    |; } } else { $attachFile = '
     '; } # メールアドレス処理 if ($fileHead{'Email'}) { if ($sendmail && $fileHead{'SecretEmail'}) { $fileHead{'Name'} = qq|$fileHead{'Name'}|; } else { $fileHead{'Name'} = qq|$fileHead{'Name'}|; } } # URI処理 if ($fileHead{'Url'} =~ /^http:\/\/.+/) { $fileHead{'Url'} = qq| - [URL]|; } else { $fileHead{'Url'} = ""; } # ID処理 if ($fileHead{'IPID'} && $SET{'ID-ON'}) { $fileHead{'IPID'} = qq| - ID:$fileHead{'IPID'}|; } else { $fileHead{'IPID'} = ""; } # 引用部分の処理 if ($fileHead{'MsgType'} != 3) { local($quotedMessage); foreach (split /
    /, $fileHead{'Message'}) { s/^(>|>)(.*)$/$1$2<\/font>/ unless (/^>>\d{1,5}/); $quotedMessage .= $_ . "
    \n"; } $quotedMessage =~ s/
    \n$//; $fileHead{'Message'} = $quotedMessage; } $bgColor = $bgColor6; $ftColor = $ftColor6; if ($fileHead{'Passwd'} eq "") { $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_ print <<_EOF_ if ($STDIN{'res'} eq "" && (!$STDIN{'start'} || $STDIN{'start'} == 1));
    $subTopic
    $fileHead{'Title'} 里親募集削除
    No.$STDIN{'Code'}-1 - @{[stdio::setTime($SET{'TimeFormat'}, 9, $fileHead{'Time'})]} - $fileHead{'Name'}$admin$fileHead{'IPID'}$fileHead{'Url'}
    $fileHead{'Message'}$attachFile$log


    _EOF_ print "

    この里親募集にはメッセージがありません

    " if (!showList(*record, $STDIN{'start'}, $lines-1, $SET{'PageMax'}, ";mode=view;Code=$STDIN{'Code'};R=$STDIN{'R'}$query", "showMessageType", $top, "", $STDIN{'R'})); # スーパー里親募集あり if ($SET{'ExtendTopic'} && @superTopic) { print qq|

    子里親募集 (この里親募集の拡張里親募集です)

      \n|; foreach (@superTopic) { local(%field) = stdio::readData(split /\t/, $otherHead{$_}); print qq|
    • $field{'Title'}\n| if ($otherHead{$_}); } print "
    \n"; } if (checkAdminMode() || !$SET{'UseSolved'} || !$fileHead{'Solved'} || $SET{'PostSolved'}) { $quote_button = q||; } print <<_EOF_;

    $quote_button $extButton

    パスワード
    _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_; _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|
  • $size bytes ($width x $height) クリックで拡大表\示\n|; } else { $attachFile .= qq|
  • $size bytes ($width x $height)\n|; } } else { $attachFile .= qq|
  • 添付ファイル ($_ - $size bytes)\n|; } } else { $attachFile .= qq|
  • 添付ファイル ($_ - $size bytes)\n|; } } } if ($attachFile) { $attachFile = qq|
      \n$attachFile
    |; } } $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_;
  • @{[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_ print <<_EOF_ if ($field{'Message'} ne "" || $attachFile ne ""); _EOF_ print <<_EOF_;
    $field{'Title'} $field{'Solved'} 削除/引用
    No.$STDIN{'Code'}-$field{'Code'} - @{[stdio::setTime($SET{'TimeFormat'}, 9, $field{'Time'})]} - $field{'Name'}$admin$field{'IPID'}$field{'Url'}
    $field{'Message'}$attachFile$log
    _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; $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'}
    里親を募集する作成$confirm$title
    $errMessage $form[0] $form[10] $exCode
    _EOF_ print <<_EOF_ if ($SET{'MaxSize'}); _EOF_ print <<_EOF_;
    名前 : $form[1]
    メール : $form[2]$sendmlForm
    里親募集名 : $form[4]
    添付 :
    本文 : $form[5]$form[6]
    暗証 : $form[7] $form[9]
    $form[8]

    $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_ if (@files) { print qq| \n|; print qq| \n|; foreach (@files) { chomp; if (-f "$FileDir$_") { my($size) = (-s "$FileDir$_"); 1 while $size =~ s/([\dA-Fa-f]+)([\dA-Fa-f]{3})/$1,$2/; if (/\.(gif|jpe?g|png)$/) { print qq| \n|; } else { local($kaku) = $1 if (/\.(.+)$/); print qq| \n|; } $i ++; } } print qq|
    $size bytes
    \n|; print qq| 添付ファイル
    ($size bytes)
    $kaku
    \n|; print qq| 添付ファイル
    ($size bytes)
    \n|; } if ($i) { print qq|

      
    \n|; print qq|  ※ 削除するファイルをチェックしてボタンを押します

    \n|; } if ($i < $SET{'MaxFile'}) { print qq|

      ○添付ファイル   

    \n|; } print <<_EOF_;

    ご注意

    • ID:$uniqueCode
      この数字と投稿フォームの[ファイル添付]ボタンにある数字が一致しない場合は添付できません。そのような場合は、アップロードされたファイルを一度削除してから、このウィンドウを一度閉じてください。
    • 添付できるファイルの種類は GIF、JPEG、PNG、TEXT、MIDI、WAV、ZIP、LZHに限られます。
    • $SET{'MaxFile'}個まで添付できます。1個あたりのファイルサイズは$SET{'MaxSize'} bytes以下に限られます。
    • ファイルサイズや回線状況によっては時間がかかる場合がありますが、ボタンは一度だけ押してください。
    • アップロード後、投稿せずに一定時間経過するとファイルが削除されます。その場合は、再アップロードしてください。
    • 添付を中止する場合は、アップロードされたファイルをすべて削除してから、このウィンドウを閉じてください。
    • 添付を終了して投稿を継続する場合は、このウィンドウを必ず一度閉じてください。
    _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; $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_;
    $value{'noconfirm'} $form[0] $form[11]
    _EOF_ print <<_EOF_ if ($SET{'MaxSize'} && $SET{'AttachRepaly'}); _EOF_ print <<_EOF_;
    名前 : $form[1]
    メール : $form[2]$sendmlForm
    タイトル : $form[4]
    添付 :
    本文 : $form[5]$form[6]    $quotedMessage
    暗証 : $form[7] $form[9] $form[10] $solvedForm
    $form[8]

    $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'}
    [$title]への投稿

    _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" . $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'}]への投稿
      $errMsg
    _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 (/^]*>/); 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|
    1. |,$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$errMsg
    \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'}
    $nameToさんへメール送信
    $errMessage
         名前 
    メール   貴方宛にもメール控えを送信
      タイトル 
    本文 
     
    ※ 送信される通信記録 $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_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 = "&#X" . sprintf("%X", ord $char) . ";"; } elsif ($rand == 2) { $char = "&#x" . 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); }