#!/usr/local/bin/perl # --------------------------------------------------------------------- # # bbs.cgi # # 1998/01/23 Ver.0.05 # 1998/01/23 Ver.0.06 bugfix # 1998/01/26 Ver.0.07 # タイトルにハンドル名を付加 ID 欄には E-mail addr の名前部分を # 1998/01/30 Ver.0.08 # 書き込むとモードが初期値になる。bugfix # webmaster へのメール # カスタマイズ可能な設定値を外部化し bbs.env としました。 # 1998/01/30 Ver.0.10 # 未読ポインターの付加&モードの保存 # Re: への対応 第1弾 # 1998/01/30 Ver.0.14 bugfix # 1998/01/31 Ver.0.15 # 新しいメッセージがないときに n メッセージ表示のボタンを追加 # 偽 pc-van のため w コマンドを追加。こんなの使わないよなぁ(^^;;; # 1998/02/03 Ver.0.16 # 排他ロック設定忘れ(^^;;; bugfix # メッセージ#のカウントアップ bugfix # 1998/02/06 Ver.0.17 # 内容の中の http アドレスへもリンクをつける。 # URL のチェックしていますが、チェックしないほうがよいかもしれませんね(^^;;; # 引用マークのカスタマイズを可能にしました。 # 1998/02/16 Ver.0.18 # bugfix 内容の中の http アドレスがエラーの時 TEXTAREA に TAG が入る。 # chkurl の名称変更に対応 # 1998/03/02 Ver.0.19 # 日本語コード変換へ対応 # email の入力が省略できるように設定できませんでした。 bugfix # webmaster へのメールの < 等の除去忘れも発見。 bugfix # res での tag 除去忘れも発見。 bugfix # mail address の 形式チェックの @ より前の . を考慮。 bugfix # http アドレス判定の文字列を見直し bugfix # 1998/03/03 Ver.0.20 エラーの時 タイトル に TAG が入る。 bugfix # 1998/03/25 Ver.0.21 # jcodeg.pl の改変部を getcode.pl とし jcode.pl のオリジナルと併用する # cookie の設定が動作していませんでした。 bugfix # 1998/03/25 Ver.0.21j0 日本語コード変換の為の試作版 # 1998/03/28 Ver.0.22 # 1998/04/06 Ver.0.23 # 日本語コードの判定 ブラウザの Win Mac の判定忘れ(^^;;; bugfix # 1998/04/07 Ver.0.24 chkurl のパッケージ化 # 1998/04/08 Ver.0.25 mail の送信先を複数指定できるように拡張しました。 # 1998/05/08 Ver.0.32 # タイトルと名前の中の改行を削除 bugfix # POST method を使わない設定を可能にしました。for luke # 1998/05/13 Ver.0.33 # バッファリングを停止し高速化を狙ってみました。 # mail への subject でボード名を [] で囲うようにしました。 # 日本語コードの判定で [ja-euc] の処理を変更しました。 # 1998/05/13 Ver.0.34 # 1998/05/14 Ver.0.35 cookie のタイミングを訂正 bugfix # 1998/06/15 Ver.0.36 日本語コードの判定を変更しました。 # 1998/06/17 Ver.0.37 # エラー時の処理の bugfix bugfix # cookie のタイミングを訂正 bugfix # mail への subject で NO も [] で囲うようにしました。 # 1998/08/24 Ver.0.38 アンロックの処理の bugfix bugfix # 1998/10/20 Ver.0.39 URL のチェックでのステータス 302 へ対応 # 1999/01/08 Ver.0.40 # 歓迎メッセージの有無を $welcome で指定 # cookie と未読処理の動作を見直しました # cookie の日付を正規化 # $head, $tail を指定できるように拡張 # url のチェックでのステータス 301 に対応 # メールの送付を CC か BCC を指定できるように # 1999/01/08 Ver.0.41 メールの発信元、送付先を整理しました。 # 1999/01/11 Ver.0.42 ボタン表示を見直しました。 # 1999/01/19 Ver.0.43 URL のチェックを $chkurl でオプション化 # 1999/01/29 Ver.0.44 # flock の使用を $useflock でオプション化 # メールの subject にタイトルを追加 # cookie の有効期限を MSIE へ対応 (MSIE の方がおかしいと思う(^^;;; # 1999/02/11 Ver.0.46 # メールの subject にタイトルを位置調整&ニックネームを追加 # アクセス制限域での未読ポインタファイル機能を追加準備 (BIGLOBE では使えませんが(^^;;; # 書込み時のレスポンスのタイミングを変更 # 2重書込をエラーにする。 # 1999/02/11 Ver.0.48 # 1999/02/20 Ver.0.49 # 1999/02/24 Ver.0.50 # Mail 中の URL を HTTP_REFERER から、そのメッセージへの Res へ変更 # 1999/02/25 Ver.0.51 Re: でタイトル先頭の Re:#> は複写しない。 # 1999/02/27 Ver.0.52 メールのサブジェクト内で encode されてしまうのを修正 # 1999/02/27 Ver.0.53 $locator を追加 # 1999/03/07 Ver.0.54 # 削除機能を追加 # 書込み用テキストエリアの大きさをカスタマイズ可能に # 1999/03/08 Ver.0.55 # 1999/03/09 Ver.0.56 # MSIE での書込み用テキストエリアの大きさを調整機能 # ホスト側未読ポインタファイルへハンドル名を付加。 # 未読ポインタファイルに互換性がありません。いちど空にしてください。 # 1999/03/16 Ver.0.57 # 1999/03/17 Ver.0.58 メールの形式をシンプルに変更しました。 # 1999/03/18 Ver.0.59 bugfix # 1999/03/23 Ver.0.60 オプション $pre, $mlist を追加 # 1999/03/24 Ver.0.61 メール配信先の include # 1999/03/25 Ver.0.62 # 1999/03/26 Ver.0.63 # 1999/03/26 Ver.0.64 本文中の http アドレスの誤判定を調整 # 1999/03/26 Ver.0.65 to: $mlist を追加 # 1999/03/28 Ver.0.66 $border を追加 # 1999/04/16 Ver.0.68 # 1999/04/18 Ver.0.69 # 1999/04/26 Ver.0.70 # 1999/04/26 Ver.0.71 bugfix # 1999/05/05 Ver.0.72 削除の動作を改善 # 1999/05/18 Ver.0.73 削除の範囲の bugfix 午前中に誤動作していました。 # 1999/09/01 Ver.0.74 2000 年問題への対応 # 1999/11/24 Ver.0.75 bugfix # 1999/11/26 Ver.0.76 bugfix # 1999/12/14 Ver.0.77 Date ヘッダーを追加し、カスタマイズ用変数 $timezone を追加 # 1999/12/19 Ver.0.78 サーチ用 # 1999/12/20 Ver.0.81 # 2000/01/06 Ver.0.82 # 2000/01/07 Ver.0.83 # 2000/01/20 Ver.0.84 # 2000/01/21 Ver.0.85 整形済モードを追加 # 2000/01/21 Ver.0.86 $body を追加 # 2000/01/26 Ver.0.87 bugfix # 2000/01/29 Ver.0.88 書きこみ完了メッセージの処理を変更 # 2000/01/30 Ver.0.89 公開版 # 2000/03/19 Ver.0.90 当日と1日前のメッセージを削除できるよう変更 # 2000/05/11 Ver.0.91 # Mail のヘッダーへ追加 MIME-Version,Content-Type,Content-Transfer-Encoding # 2000/07/30 Ver.0.92 # 2000/12/10 Ver.0.93 # 2000/12/11 Ver.0.94 MSIE 対応,暫定対策 # 2000/12/13 Ver.0.95 MSIE 対応,暫定対策 # 2000/12/20 Ver.0.96 Content-Type text/html; charset=Shift_JIS を追加 # 2000/12/20 Ver.0.98 # 2001/10/23 Ver.0.99 Locate にも、charset=Shift_JIS を追加 # $copyright ='掲示板 Ver.0.99 Copyright (C) 1998-2000 gama'; # Copyright (C) 1998-2000 がま <gama@mvg.biglobe.ne.jp> # http://www2d.biglobe.ne.jp/~gama/cgi/index.cgi # # --------------------------------------------------------------------- # メール配信モード # $webmaser か @mailgr が設定されている時 # # @mailgr 送付先のリスト # 'include:ファイル名' # を設定することにより、ファイルから読み込まれる。 # # $cc @mailgr への送信方法の指定 To,Cc,Bcc # # $webmaster が設定されている時 # $webmaster と @mailgr へ配信される。 # # From: $from で指定されたアドレス # $from を省略した場合は、$webmaster # To: $webmaster で指定されたアドレス # Reply-to: 書き込んだ人のアドレス # # --------------------------------------------------------------------- # メーリングリストモード # # $mlist が設定されている場合 # # $webmaster, @mailgr, $from の設定は無視されます。 # # $pre =1 の設定を推奨しますが必須ではありません。 # # From: 書き込んだ人のアドレス # Reply-to: $mlist で指定されたアドレス # # メーリングリストとしての機能は別途有償で提供されています。 # # --------------------------------------------------------------------- $body ='<BODY BGCOLOR="#FFFFFF">'; $cc ='Bcc'; # グループメールの指定 'Cc' or 'Bcc' or 'To' $q_char ='》'; # 引用マーク $m_mode ='p'; # 書込みの method p: post g: get $u_mode =''; # 書込み $delmsg = 1; # 削除機能 0:なし 1:あり $d_mode =''; # 削除モード $r_mode =''; # 参照モード $welcome = 1; # 歓迎メッセージ 0:なし 1:あり $delmsg = 1; # 削除機能 0:なし 1:あり $chkurl = 1; # url のチェック 0:なし 1:あり $useflock = 1; # flock 使用 0:なし 1:あり # --------------------------------------------------------------------- # 検索機能は限定リリース中です。いろいろと矛盾が生じる場合があります。 $usesrch = 0; # 検索機能使用 0:なし 1:あり $idxfile = 'msgdb.dat'; # メッセージ検索用インデックス # --------------------------------------------------------------------- $ENV{'TZ'} = 'JST-9'; # timezone の指定 $timezone = '+0900 (JST)';# メールのヘッダー用のタイムゾーン $debug = 0; # debug 用フラグ # --------------------------------------------------------------------- $usepfile = 0; # 未読ポインタファイル使用 0:なし 1:あり # 注意! # $usepfile は個別の UserID でアクセス制限されている場合だけ使用できる。 # BIGLOBE では使用できない。 # また @guests にホスト側で管理しない ID を列挙できる。 # --------------------------------------------------------------------- $form_rows = 20; # 書込み用テキストエリア 行数 $form_cols = 80; # 書込み用テキストエリア 桁数 # --------------------------------------------------------------------- require 'bbs.env'; # 環境設定、カスタマイズ用 require 'getcode.pl'; # 改造版 getcode require 'jcode.pl'; # jcode require 'chkurl.pl' if $chkurl; # chkurl require 'k2k.pl' if $usesrch; # k2k # --------------------------------------------------------------------- $file ="$msgdir/$filehead"; # --------------------------------------------------------------------- $LOCK_SH = 1; # 共有ロック $LOCK_EX = 2; # 排他的にロック $LOCK_NB = 4; # ブロックしない # --------------------------------------------------------------------- { # MSIE は、# 書込み用テキストエリア 桁数 を調整 ------------------ if ( $ENV{'HTTP_USER_AGENT'} =~ /^Mozilla.*compatible; MSIE / ) { $form_cols = int($form_cols *1); } $|=1; # YY/MM/DD hh:mm ------------------------------------------------------ my($sec,$min,$hour,$mday,$mon,$year,$wday)=localtime; $time = sprintf("%2.2d\/%2.2d\/%2.2d %2.2d:%2.2d", $year%100,$mon+1,$mday,$hour,$min ); # mail ヘッダー内の Date----------------------------------------------- # 10 Aug 2000 12:34:56 +GMT ;RFC1123 など # Wdy, 10-Aug-2000 12:34:56 GMT ;RFC822 では Wdy は省略可なのだが... # Date: Tue, 16 Nov 1999 06:34:15 +0900 (JST) :NN4.5 での例 # $mail_date =sprintf("Date: %s, %2.2d %s %4.4d %2.2d:%2.2d:%2.2d %s", &getweek($wday),$mday,&getmonth($mon),$year+1900, $hour,$min,$sec,$timezone); # --------------------------------------------------------------------- if ( $ENV{'CONTENT_TYPE'} eq "application/x-www-form-urlencoded") { read(STDIN, $in, $ENV{'CONTENT_LENGTH'}); } else { $in=$ENV{'QUERY_STRING'}; } ($cmd,undef) = split('&',$in); if ($cmd =~ /=/ ){ my(@pairs) = split('&', $in); # foreach $pair (@pairs) { my($name, $value) = split('=', $pair); unless ($FORM{$name}) { $FORM{$name} = &str_decode_from_form($value); } else { $FORM{$name} = $FORM{$name}.','.&str_decode_from_form($value); } } $cmd = $FORM{'cmd'}; $name = $FORM{'Name'}; $email = $FORM{'E_mail'}; $hp = $FORM{'HomePage'}; $title = $FORM{'Title'}; $comment = $FORM{'Comment'}; $pre_mode = $FORM{'pre_mode'}; $ml_header = $FORM{'ml_header'}; $keyword = $FORM{'Keyword'}; } # --------------------------------------------------------------------- &set_mode; # --------------------------------------------------------------------- &get_lastno; # 発言 # のカウント # ----------------------------------------------------------------------- if ($u_mode) { &write_bbs; } elsif ($s_mode and $usesrch) { &get_cookie; # cookie &srch_msg; } elsif ($cmd =~ /i/ and $usesrch) { &gen_idx; } elsif ($d_mode eq 'z' ) { &get_cookie; # cookie &delete_msg; } else { &get_cookie; # cookie &read_bbs; } exit; } # mode の設定 -------------------------------------------------------- # t タイトル表示 # m 内容表示 # f 発言順 # b 逆順 # r レスポンスの書込み # n 未読処理 # w 書込み FORM のみ # x 書込み完了メッセージ # u FORM からの書込み # d 削除モード # c 削除確認! # z 削除! # s 検索 # i 検索用インデックス作成 sub set_mode { $no = $cmd; $no =~ s/[a-z]*//; if ( $cmd =~ /([dcz])/ ) { # 削除 $d_mode = $1; } if ( $cmd =~ /([tm])/ ) { $r_mode = $1; } elsif ( $c_r_mode ) { $r_mode = $c_r_mode; } if ( $cmd =~ /([fb])/ ) { $o_mode = $1; } elsif ( $c_o_mode ) { $o_mode = $c_o_mode; } if ( $cmd =~ /r/ ) { # Responce to $no $r_no = $no; } if ( $cmd =~ /u/ ) { $u_mode = 'u'; $cmd =~ s/u//; } if ( $cmd =~ /s/ ) { $s_mode = $FORM{'srchmode'}; } if ( $no eq '' && $cmd eq '' ) { $cmd = $cmd . "n"; # 未読処理モードを追加 } if ( $c_point < 1 ) { $c_point = 1; } # ----------------------------------------------------------------------- if ($r_mode eq 'm' ) { # m 内容表示 $per_scr = $m_per_scr; # msg 表示数 } else { $per_scr = $t_per_scr; # タイトル表示数 } # ----------------------------------------------------------------------- &set_pre; } # --------------------------------------------------------------------------- sub set_pre { if ($pre_mode eq 'off') { undef $pre; undef $spre; } elsif ( ($pre_mode eq 'on') or $pre or $ml_header) { $pre ='<PRE>'; $spre ='</PRE>'; $pre_mode = 'on'; } else { $pre_mode = 'off'; } } # --------------------------------------------------------------------------- sub get_lastno { # 発言 # のカウント ----------------------------------------------------- open(FCTR,"<$fctr"); flock(FCTR,$LOCK_SH) if $useflock; # 共有ロック $last_no=<FCTR>; close(FCTR); chomp($last_no); } # 削除 --------------------------------------------------------------- sub delete_msg { unless ($delmsg) { &err_html("削除できません。(delmsg disable)"); exit; } unless (open(MSG, "+<$file$no")) { # open &err_html("指定されたメッセージを読めません。($file$no.)"); exit; } flock(MSG,$LOCK_EX) if $useflock; # 排他ロック my(@temp)=<MSG>; if (¬_author($temp[1])) { &err_html("削除できません。(not author)"); exit; } seek(MSG, 0, 0); print(MSG "<!-- delete at $time by $ENV{'REMOTE_USER'}:$name <$email>"); print MSG @temp; print(MSG " -->\n"); close(MSG); my($nextcmd)= "$o_mode$r_mode" .'n'; #ex9 print "Content-type: text/html\n\n"; print <<END; <HTML><HEAD><TITLE>削除されました</TITLE></HEAD> $body <H2>削除されました</H2> <HR><BLOCKQUOTE> @temp <CENTER> <FORM METHOD="GET" ACTION="$cgi_name"> <INPUT TYPE="hidden" NAME="cmd" VALUE="$nextcmd"> <INPUT TYPE="submit" VALUE="戻る"></FORM> </CENTER> </BLOCKQUOTE><HR> </BODY></HTML> END # MAIL ----------------------------------------------------------------- &send_mail($no, '発言者削除', '', ''); } # 削除権限のチェック ------------------------------------------------------ sub not_author{ #★タイトル の行から E-Mail, 日付を取出す my($tit) = $_[0]; $tit =~ /.*<A HREF=\"mailto:(.*?)\".*(\d\d\/\d\d\/\d\d).*/; my($msg_email) =$1; my($msg_date) =$2; # YY/MM/DD unless ($msg_email eq $email) { # e-mail addr の一致を確認 return 1; # not author } # ---------------------------------------------------------------------- # 昨日に設定 my($sec,$min,$hour,$mday,$mon,$year)=localtime(time); my($date0) = sprintf("%2.2d\/%2.2d\/%2.2d", $year%100,$mon+1,$mday); ($sec,$min,$hour,$mday,$mon,$year) =localtime(time-60*60*24); my($date1) = sprintf("%2.2d\/%2.2d\/%2.2d", $year%100,$mon+1,$mday); # 日付が一致したとき if ( $date0 eq $msg_date ) { return 0; # OK } # 日付が1日前のとき if ( $date1 eq $msg_date ) { return 0; # OK } return 1; # NG 削除期限を超過 } # 書込 -------------------------------------------------------------------- sub write_bbs { # jcode ------------------------------------------------------- local($jstr)=join(' ', $title, $name, $comment); local($match, $icode) = &getcode'getcode(*jstr); unless ($icode) { if ( $ENV{'HTTP_USER_AGENT'}=~ /Mac|Win/) { $icode = 'sjis'; } else { $icode = 'euc'; } } if ($icode ne 'sjis') { &jcode'convert(*title, 'sjis', $icode ); &jcode'convert(*name, 'sjis', $icode ); &jcode'convert(*comment, 'sjis', $icode ); } # ------------------------------------------------------------- $name = &str_conv_for_html($name); $title = &str_conv_for_html($title); $comment = &str_conv_for_html($comment); chomp($name); chomp($title); # ------------------------------------------------------------- unless ($name) { # Nickname がないとき Error &err_html("ニックネームが入力されていません。"); exit; } if ($email eq $dflt_email) { # email addr 記入なし $email = ""; } if ($need_email ) { unless ($email) { # email addr がないとき Error &err_html("E-Mail アドレスが入力されていません。"); exit; } unless ($email =~ /^[\w\-\_\.]+@[\w\-\_]+(\.[\w\-\_]+)+$/ ) { &err_html("E-Mail アドレスの形式がエラーになりました。"); exit; } } if ( $hp eq $dflt_hp ) { # Homepage URL 記入なし $hp = ''; } if ( $hp ne '' ) { # HomePage の URL のチェック my($err) = &check_url($hp); if ($err) { &err_html("入力されたアドレスへアクセスできませんでした。<BR>" ."$hp<BR>$err<BR>"); exit; } } unless ( $title ) { # title がないときは Error を表示 &err_html("タイトルが入力されていません。\n"); exit; } $title =~ s/#(\d+)/<A HREF=\"${cgi_name}?cmd=${o_mode}${r_mode}$1\">#$1<\/A>/; # 本文内の http アドレス ----------------------------------------------- $comment=~ s/(http:\/\/\S+?)(\s| |$)/<A HREF=\"$1\">$1<\/A>$2/g; # 空白文字以外 my($temp) = $comment; while ( $temp=~ /(<A HREF=\".+?\">)(.*)/ ) { my($url) = $1; # マッチした文字列 $temp=$2; # マッチしたのより後ろ $url =~ s/.*<A HREF=\"(.+?)\">.*/$1/; my($err) = &check_url($url); if ($err) { &err_html( "本文中に記述されたアドレスへアクセスできませんでした。<BR>" ."$url<BR>$err<BR>" ); exit; } } # 発言 # のカウント ---------------------------------------------------- unless (open(FCTR,"+<$fctr")) { &err_html( "内部エラー<BR>" ."$fctr が open できません。(設置の状態を確認してください)"); exit; } flock(FCTR,$LOCK_EX) if $useflock; # 排他ロック my($old_no)=<FCTR>; chomp($old_no); # 新メッセージのタイトルと内容 ----------------------------------------- $tit_name .= $title.' '.$name; $msghead = "$tit_name<BR>\n" ."★内容<BR>\n$pre"; $msgbody = "$comment\n"; unless ($pre) { $msgbody =~ s/\n/<BR>\n/g; # 改行を <BR> へ } else { $msgbody .= "$spre\n"; } if ($hp) { $msgbody .= sprintf("<A HREF=\"%s\">%s</A><BR>\n", $hp, $hp); } $msgbody .= "<HR WIDTH=90%>\n"; if ($locator) { # $locator の処理 $msgbody =~ s/(<A HREF=\")http/$1$locator/g; } # 2重書込のチェック --------------------------------------------------- if ( open(OLDMSG,"$file$old_no") ) { flock(OLDMSG,$LOCK_SH) if $useflock; # 共有ロック <OLDMSG>; # 2行分読み飛ばし <OLDMSG>; my($oldmsg); while (<OLDMSG>) { $oldmsg .=$_; } if ($oldmsg eq $msghead.$msgbody) { &err_html( "このメッセージは書込済です。"); exit; } close OLDMSG; } # 発言 # のカウントアップ ---------------------------------------------- my($new_no) = $old_no + 1; seek(FCTR, 0, 0); printf(FCTR "%d", $new_no); # COOKIE---------------------------------------------------------------- &set_cookie_name; # ---------------------------------------------------------------------- my($t_name) = $name; if ( $email ne '' ) { $t_name = $email; $t_name =~ s/^([\w\-\_\.]+)@[\w\-\_\.]+$/$1/; $t_name = "<A HREF=\"mailto:$email\">$t_name</A>"; } $bbsmsg = sprintf("#%s %s<BR>\n", $new_no,$bbsname) .sprintf("★タイトル (%s) %s<BR>\n",$t_name,$time) .$msghead .$msgbody; # BBS ------------------------------------------------------------------ unless (open(BBS,">$file$new_no")) { &err_html("Can't open $file$new_no.<BR>" ."ディレクトリ($msgdir/)とパーミッション(777)を確認してください。"); exit; } flock(BBS,$LOCK_EX) if $useflock; # 排他ロック print(BBS $bbsmsg); # ここで書き込み! close(FCTR); close(BBS); # 古いメッセージを削除 ------------------------------------------------- $delno=$new_no - $msg_max; unlink("$file$delno"); # 古いメッセージを一つ削除 $delno=$delno - 1; unlink("$file$delno"); # 念のため古いメッセージをもう一回削除 # MAIL ----------------------------------------------------------------- &send_mail($new_no, $title, $name, $msgbody); # Location ------------------------------------------------------------- my($nextcmd)= "$o_mode$r_mode" .'nx'; print "Location: ${cgi_name}?cmd=$nextcmd\n\n"; # print "Location: ${cgi_name}?cmd=$nextcmd; charset=Shift_JIS\n\n"; } # -------------------------------------------------------------------------- sub send_mail { my($no) = $_[0]; my($subj) = &str_detag($_[1]); # tag を除去 my($name) = &str_detag($_[2]); # tag を除去 my($msg) = &str_detag($_[3]); # tag を除去 # MAIL ----------------------------------------------------------------- if ( $mlist or $webmaster or @mailgr) { $msg =~ s/^#/\$/; # pcvan の log への配慮 unless (open(MAIL, "| $nkf -S | $sendmail -t")) { &err_html("内部エラー<BR>" ."sendmail が open できません。(設置の状態を確認してください)"); exit; } if ($mlist) { print(MAIL "From: \"$name\" <$email>\r\n"); print(MAIL "To: $mlist\r\n"); print(MAIL "Reply-To: $mlist\r\n"); } else { if ($from) { print(MAIL "From: $from\r\n"); } else { print(MAIL "From: $webmaster\r\n"); } print(MAIL "To: $webmaster\r\n"); if ($email) { print(MAIL "Reply-To: \"$name\" <$email>\r\n"); } $subj .= ' '.$name; foreach $member (@mailgr) { if ($member =~ /^include:(.*)/i) { open(MAILGR,"$1"); flock(MAILGR,$LOCK_SH) if $useflock; # 共有ロック while (<MAILGR>) { chomp; print(MAIL "$cc: $_\r\n"); } close(MAILGR); } else { print(MAIL "$cc: $member\r\n"); } } } print(MAIL $mail_date,"\r\n"); print(MAIL "MIME-Version: 1.0\r\n"); print(MAIL "Content-Type: text/plain; charset=ISO-2022-JP\r\n"); print(MAIL "Content-Transfer-Encoding: 7bit\r\n"); print(MAIL "Subject: [$bbsname $no] $subj\r\n","\r\n"); unless ($d_mode eq 'z') { print(MAIL $msg ); print(MAIL "\n\n"); print(MAIL 'Re:#', $no, ' http://' , $ENV{'SERVER_NAME'}, $ENV{'SCRIPT_NAME'}, , '?cmd=mr', $no ); } close(MAIL); } } # 検索用 インデックスの作成------------------------------------------------------ sub gen_idx { $idxwk =$idxfile.'.tmp'; unless (open(IDXWK,"+<$idxwk") or open(IDXWK,">$idxwk")) { &err_html("作業用ファイルが開けませんでした。($idxwk)"); exit; } if ($useflock) { unless (flock(IDXWK, $LOCK_EX+$LOCK_NB )) { # ロック ブロックしない &err_html("作業用ファイルが使用中のため処理できませんでした。($idxwk)"); exit; } } # ----------------------------------------------------------------------- &html_head; &html_next; print "<HR>\n"; print "<BLOCKQUOTE>\n"; print "<H3>**** $bbsname ****</H3>\n"; print "検索用インデックス作成<br>\n"; # 逆順 新しいものが上 print "<HR WIDTH=90%>\n"; seek(IDXWK, 0, 0); # ファイルの先頭に移動 truncate(IDXWK, 0); # ファイルを空にする。 $no = $last_no; # 発言 # のカウント print "作成開始<br>\n"; print "作成中 #$no<br>\n"; while ( $no > 1 ) { print "作成中 #$no<br>\n" if $no%100 == 0; if (my($dstr)=&get_dstr($no--)) { print IDXWK $dstr,"\n"; } } print "作業用ファイル作成完了<br>\n"; # ----------------------------------------------------------------------- unless (open(MSGDB,">>$idxfile")) { print "インデックスファイルが開けませんでした。($idxfile)<br>\n"; &html_next; &foot_html; return; } if ($useflock) { flock(MSGDB, $LOCK_EX); } print "インデックスファイルへ書込中 ($idxwk -> $idxfile)<br>\n"; seek(IDXWK, 0, 0); # ファイルの先頭に移動 seek(MSGDB, 0, 0); # ファイルの先頭に移動 truncate(MSGDB, 0); # ファイルを空にする。 while (<IDXWK>) { print MSGDB; } close(MSGDB); close(IDXWK); # ----------------------------------------------------------------------- print "作成完了<br>\n"; print "</BLOCKQUOTE>\n"; print "<HR>\n"; &html_next; &foot_html; } # --------------------------------------------------------------------------- sub get_dstr { my($no)=shift; # サブルーチンの引数を unless (open(MSG,"<$file$no")) { return; } flock(MSG,$LOCK_SH) if $useflock; # 共有ロック $temp=$/; # Input Record Separator を退避 undef $/; # Input Record Separator my($dstr)=<MSG>; # 丸ごと入力 close(MSG); # <<<<<<<<< close $/=$temp; # Input Record Separator を戻す $dstr =~ s/\n//g; #改行 を取り除く $dstr =~ s/\Q$bbsname\E//g; #ボード名称 を取り除く $dstr =~ s/\Q★タイトル\E//g; #★タイトル を取り除く $dstr =~ s/\Q★内容\E//g; #★内容 を取り除く $dstr =~ s/\Q$q_char\E//g; #引用マーク を取り除く $dstr = &str_detag($dstr); #タグ を取り除く $dstr = &k2k'k2k($dstr); $dstr =~ s/\s//g; #空白文字 を取り除く return($dstr); } # 検索 --------------------------------------------------------------------- sub srch_msg { # ----------------------------------------------------------------------- # $no 指定開始位置 $no = $last_no - $per_scr +1; # $last_no 最新のメッセージ if ( $no < 1 ) { $no = 1; } $page_top = $no; # $page_top 頁で最古のメッセージ $page_bottom = $no + $per_scr -1; # $page_bottom 頁で最新のメッセージ if ( $page_bottom > $last_no ) { $page_bottom = $last_no; } # ----------------------------------------------------------------------- &html_head; &html_next; print "<HR>\n"; print "<BLOCKQUOTE>\n"; print "<H3>**** $bbsname ****</H3>\n"; print "<HR WIDTH=90%>\n"; if ( $r_mode eq "t" ) { print "<PRE>"; } $keyword = &k2k'k2k($keyword) if $usesrch; open(MSGDB,"<$idxfile"); flock(MSGDB,$LOCK_SH) if $useflock; # 共有ロック my($no) = $last_no; $db_rec = <MSGDB>; $db_no = $db_rec; $db_no =~ s/^#(\d+).*/$1/; while ( $db_no < $no ) { my($dstr) = &get_dstr($no--); # メッセージから &srch_main($dstr); } &srch_main($_); while (<MSGDB>) { chomp; &srch_main($_); # データベースから } if ( $r_mode eq "t" ) { print "</PRE><HR WIDTH=90%>\n"; } print "</BLOCKQUOTE>\n"; print "<HR>\n"; &html_next; &form_html; &foot_html; } # --------------------------------------------------------------------------- sub srch_main { my($dstr)=shift; # サブルーチンの引数を my(@words) = split(' ', $keyword); my($found) = 0; if ($s_mode eq 'OR' ) { # OR foreach $aword (@words) { if ($dstr =~ /\Q$aword\E/ ) { # $aword 中のメタ文字を無効に $found = 1; last; } } } else { # AND $found = 1; foreach $aword (@words) { unless ($dstr =~ /\Q$aword\E/ ) { # $aword 中のメタ文字を無効に $found = 0; last; } } } unless ($found) { return(0); } my($no) = $dstr; $no =~ s/^#(\d+).*/$1/; &read_main($no); return(1); } # 読む --------------------------------------------------------------------- sub read_bbs { # ----------------------------------------------------------------------- # $no 指定開始位置 if ( $c_point > 1 && $cmd =~ /n/ ) { # $c_point 未読ポインタ $no = $c_point+1; } unless ( $no ) { $no = $last_no - $per_scr +1; # $last_no 最新のメッセージ } if ( $no < 1 ) { $no = 1; } $page_top = $no; # $page_top 頁で最古のメッセージ if ( $cmd =~ /[rc]/ ) { # response or 削除 'C' $page_bottom = $no; } else { $page_bottom = $no + $per_scr -1; # $page_bottom 頁で最新のメッセージ if ( $page_bottom > $last_no ) { $page_bottom = $last_no; } } # Cookie -------------------------------------------------------------- if ( $r_mode eq 'm' && ( $c_point < $page_bottom or $c_point > $last_no )) { &set_cookie_bbs; } # --------------------------------------------------------------------- &html_head; &html_next; print "<HR>\n"; print "<BLOCKQUOTE>\n"; if ($cmd =~ /[d|c]/ ) { $del_msg_ctr =0; if ($page_top == $page_bottom ) { $r_mode = 'm'; print "<TABLE><TR>\n"; print "<TD><H3>このメッセージを削除します。</H3></TD>\n"; &next_b('z'.$page_bottom, '削除'); # 次は、削除 print "</TR></TABLE>\n"; } else { $r_mode = 't'; print "<H3>削除するメッセージの番号を選び、内容を確認してください。</H3>"; } } else { if ($cmd =~ /x/ ) { print "<H3>書きこみました。</H3>\n"; } print "<H3>**** $bbsname ****</H3>\n"; } if ($cmd =~ /w/ ) { &form_html; &foot_html; return; } if ( $r_mode eq "t" ) { print "<PRE>"; } if ( $c_point >= $last_no && $cmd =~ /n/ ) { print "新しいメッセージは、ありません。<BR>\n"; } elsif ( $o_mode eq "f" ) { # 正順 新しいものが下 print "<HR WIDTH=90%>\n"; $no = $page_top; # page_top -> $page_bottom while ( $page_bottom >= $no ) { &read_main($no); $no = $no + 1; } } else { # 逆順 新しいものが上 print "<HR WIDTH=90%>\n"; $no = $page_bottom; # page_bottom ... page_top while ( $page_top <= $no ) { &read_main($no); $no = $no - 1; } } if ( $r_mode eq "t" ) { print "</PRE><HR WIDTH=90%>\n"; } if ($cmd =~ /[d]/ ) { if ( $del_msg_ctr == 0 ) { print "<H3>削除できるメッセージがありませんでした。</H3>"; } } print "</BLOCKQUOTE>\n"; unless ( $cmd =~ /[rx]/) { unless ( $c_point >= $last_no && $cmd =~ /n/ ) { &html_next; } } print "<HR>\n"; &form_html; &foot_html; } # --------------------------------------------------------------------------- sub read_main { my($no)=$_[0]; # サブルーチンの引数を my(@temp); unless (open(MSG,"<$file$no")) { return; } flock(MSG,$LOCK_SH) if $useflock; # 共有ロック my($i)=0; while (<MSG>) { if ( /^<BR>\n/ && $i == 1 ) { # ver.006-007 データ互換 $temp[0] =~ s/\n/<BR>\n/; # ver.006-007 データ互換 } else { s/^<HR.*?>\n//; # ver.009 データ互換 $temp[$i]=$_; $i++; } } close(MSG); if ($temp[0] =~ /^<!-- /) { return; } my($dd,$tt)=($temp[1],$temp[2]); $tt =~ s/<BR>\n//; if ($d_mode and ¬_author($dd)) { return; } if ( $r_mode eq 't' ) { # タイトル表示 # ) YY/MM/DD をさがして日付だけを取出す。 $dd =~ s/^.*\)\s([\d\/]+)\s.*\n/ $1 /; if ( $d_mode eq 'd' ) { $del_msg_ctr++; print "<a href=\"$cgi_name?cmd=c$no\">$no</A>$dd$tt\n"; } else { print "<a href=\"$cgi_name?cmd=${o_mode}m$no\">$no</A>$dd$tt\n"; } } else { # 内容表示 if ($last_no) { # #123/999 最新 # を付加 if ($s_mode) { $temp[0] =~ s/^(#)(\d+)/<a href=\"$cgi_name?cmd=${o_mode}m$2\">#$2<\/A>\/$last_no/; } else { $temp[0] =~ s/^(#\d+)/$1\/$last_no/; } } print @temp; print "<DIV ALIGN=RIGHT><FONT SIZE=2>"; print "|<A HREF=\"$cgi_name?cmd=".$o_mode.$r_mode."r".$no."\">Re:#$no</A>|"; print "</FONT></DIV>\n"; print "<HR WIDTH=90%>\n"; if ( $cmd =~ /r/ ) { $tt = &str_detag($tt); $tt =~ s/^(Re:#\d+>)*//; $title = "Re:#$no>$tt"; $title =~ s/(.+) (.+)/$1/; foreach (@temp) { if (/<PRE>/) { $pre_mode="on"; &set_pre; } $_ = &str_detag($_); # tag を除去(最短一致) $comment = $comment . $q_char . $_; } } } } # --------------------------------------------------------------------- sub get_cookie { my(@cookie) = split("; ", $ENV{'HTTP_COOKIE'}); my($cname, $value); foreach (@cookie) { ($cname, $value) = split("=", $_); if ($cname eq 'NickName') { ($name,$email,$hp) = split("&",$value); # フィールド毎に分割 } if ($cname eq 'BBS') { if ($c_point <= 1) { ($c_point,$c_o_mode,$c_r_mode) = split("&",$value); # フィールド毎に分割 } } } $name = &str_decode_cookie($name); $email = &str_decode_cookie($email); $hp = &str_decode_cookie($hp); $c_point = &str_decode_cookie($c_point); $c_o_mode = &str_decode_cookie($c_o_mode); $c_r_mode = &str_decode_cookie($c_r_mode); # c_point を $pfile から読み込む -------------------------------- # 例外の user の一覧を参照する。たとえば guest は cookie だけとか if ($usepfile) { my($remote_user) = $ENV{'REMOTE_USER'}; unless (grep(/$remote_user/, @guests)) { &open_pfile; while (<PFILE>) { if (/^$remote_user:/i ) { chomp; (undef,$c_point,undef) = split(':'); # 未読ポインタ last; } } } &close_pfile; } } # Set-Cookie ----------------------------------------------------------- sub set_cookie_bbs { my($new_point); if ($last_no < $page_bottom) { $new_point = &str_encode_for_cookie($last_no); } else { $new_point = &str_encode_for_cookie($page_bottom); } $c_o_mode = &str_encode_for_cookie($o_mode); # o_mode : 'f','b' $c_r_mode = &str_encode_for_cookie($r_mode); # r_mode : 't','m' # c_point を $pfile へ書き込む ------------------------------------- if ($usepfile) { my($remote_user) = $ENV{'REMOTE_USER'}; &open_pfile; my($pos) = tell PFILE; while (<PFILE>) { if (/^$remote_user:/ ) { chomp; seek(PFILE, $pos, 0); # ファイルの途中の位置へ last; } $pos =tell PFILE; } # レコードの形式 : usrid:99999999:YY/MM/DD hh:mm\n my($sec,$min,$hour,$mday,$mon,$year)=localtime; printf PFILE "%s:%8.8d:%2.2d\/%2.2d\/%2.2d %2.2d:%2.2d:%2.2d %-20.20s\n", $remote_user, $new_point, $year%100,$mon+1,$mday,$hour,$min,$sec, $name; &close_pfile; } # Set-Cookie -------------------------------------------------- # cookie の有効期限を GMT で 1000 日後に設定 60秒*60分*24時間*1000日 my($expire) = &expire_gmt(60*60*24*1000); # path は省略値 my($cookie) ="Set-Cookie: " ."BBS=$new_point&$c_o_mode&$c_r_mode; " ."expires=$expire; " ."\n"; print $cookie; } # --------------------------------------------------------------------- sub set_cookie_name { my($t_name) = &str_encode_for_cookie($name); my($t_email) = &str_encode_for_cookie($email); my($t_hp) = &str_encode_for_cookie($hp); my($new_value) = "NickName=$t_name&$t_email&$t_hp"; # 同じ値のときは、パス! my(@cookie) = split("; ", $ENV{'HTTP_COOKIE'}); foreach (@cookie) { if ($_ eq $new_value ) { # まあ、有効期限が切れたらしょうがないよね(^^;;; return; } } # Set-Cookie -------------------------------------------------- # cookie の有効期限を GMT で 1000 日後に設定 60秒*60分*24時間*1000日 my($expire) = &expire_gmt(60*60*24*1000); my($path) ='/'; my($cookie) ="Set-Cookie: " ."$new_value; " ."expires=$expire; " ."path=$path; " ."\n"; print $cookie; } # --------------------------------------------------------------------- sub expire_gmt { my($esec)=$_[0]; # サブルーチンの引数を my($sec,$min,$hour,$day,$mon,$year,$wday)= gmtime( time+$esec ); # 10 Aug 2000 12:34:56 GMT ;RFC1123 # Wdy, 10-Aug-2000 12:34:56 GMT ;RFC822 では Wdy は省略可なのだが... my($str) =sprintf("%s, %2.2d-%s-%4.4d %2.2d:%2.2d:%2.2d GMT", &getweek($wday),$day,&getmonth($mon),$year+1900, $hour,$min,$sec); return($str); } # --------------------------------------------------------------------- sub getmonth{ my($mon) =shift; # サブルーチンの引数を my(@month) = ( "Jan","Feb","Mar","Apr","May","Jun", "Jul","Aug","Sep","Oct","Nov","Dec" ); return($month[$mon]); } # --------------------------------------------------------------------- sub getweek{ my($wday) =shift; # サブルーチンの引数を my(@week) = ( "Sun", "Mon","Tue","Wed","Thu","Fri","Sat" ); return($week[$wday]); } # --------------------------------------------------------------------- sub open_pfile { unless (open(PFILE,"+<$pfile")) { &err_html("未読ポインタにアクセスできませんでした。($pfile)"); exit; } flock(PFILE, $LOCK_EX) if $useflock; # 排他ロック } # --------------------------------------------------------------------- sub close_pfile { close(PFILE); } # --------------------------------------------------------------------- sub html_head { print "Content-type: text/html; charset=Shift_JIS\n\n"; print <<END; <HTML> <HEAD><META HTTP-EQUIV="Pragma" CONTENT="no-cache"> <TITLE>$bbsname</TITLE></HEAD> $body END if ($welcome && $name) { print "<H3>$name さん ようこそ! お待ちしていました!</H3>"; } print $head; print "<DIV ALIGN=RIGHT>$time</DIV>"; } # --------------------------------------------------------------------- sub html_next { print "<CENTER>\n<TABLE><TR>"; $back_no = $page_top - $per_scr; # $page_top 頁で最古の No. $oldest_no = $last_no - $msg_max + 1; if ( $oldest_no < 1 ) { $oldest_no = 1; } if ( $back_no < 1 ) { $back_no = 1; } if ( $back_no < $oldest_no ) { $back_no = $oldest_no; } if ( $back_no < $page_top ) { &next_b("$o_mode$r_mode$back_no", "#$back_no -"); } print <<END; <TD><FORM METHOD="GET" ACTION="$back_html"> <INPUT TYPE="submit" VALUE="終了"></FORM></TD> END if ( $r_mode eq "m" ) { &next_b( $o_mode."t".$page_top, 'タイトル一覧'); } else { &next_b( $o_mode."m".$page_top, '内容表示'); } $foword_no = $page_bottom + 1; # $page_bottom 頁で最新の No. if ( $last_no > $foword_no ) { &next_b( $o_mode.$r_mode.$foword_no, "#$foword_no -"); } &next_b( $o_mode.$r_mode, '最新の '.$per_scr.' メッセージ'); if ( $o_mode eq "b" ) { &next_b('f'.$r_mode.$page_top, '表示順変更'); } else { &next_b('b'.$r_mode.$page_top, '表示順変更'); } # dt 削除のタイトル表示 # c 削除の確認 c999 # z 削除 if ( $delmsg ) { if ($d_mode eq 'c') { } elsif ($d_mode ne 'd') { &next_b("dt", '削除'); # 次は、削除用一覧 } } my($andchked)='CHECKED'; my($orchked) =''; if ( $s_mode eq "OR" ) { $andchked =''; $orchked ='CHECKED'; } print "</TR>"; if ($usesrch) { print <<END; <TR> <TD COLSPAN=6> <FORM METHOD="$method" ACTION="$cgi_name"> <INPUT TYPE="hidden" NAME="cmd" VALUE="s$o_mode$r_mode"> <INPUT TYPE="text" SIZE=30 NAME="Keyword" VALUE="$FORM{'Keyword'}"> <INPUT TYPE="submit" VALUE="検索"> <INPUT TYPE="radio" NAME="srchmode" VALUE="AND" $andchked >AND <INPUT TYPE="radio" NAME="srchmode" VALUE="OR" $orchked >OR </FORM> </TD> </TR> END } print "</TABLE></CENTER>"; } # --------------------------------------------------------------------- sub next_b { local($arg,$msg)=@_; # サブルーチンの引数を print <<END; <TD><FORM METHOD="GET" ACTION="$cgi_name"> <INPUT TYPE="hidden" NAME="cmd" VALUE="$arg"> <INPUT TYPE="submit" VALUE="$msg"></FORM></TD> END } # --------------------------------------------------------------------- sub form_html { if ($d_mode) { return; } $title =~ s/<.*?>//ge; # tag を除去 (最短一致) $comment =~ s/<.*?>//ge; # tag を除去 (最短一致) unless ( $hp ) { $hp=$dflt_hp; } unless ( $email ) { $email=$dflt_email; } my($r); print $border; if ($cmd =~ /r/ ) { print "Response to #$r_no<BR><BR>\n"; $r="r$r_no"; } my($email_need)='(省略不可)'; unless ($need_email) { $email_need='(よろしければ)'; } if ($m_mode eq 'g') { $method = 'GET'; } else { $method = 'POST'; } my($pre_on_check,$pre_off_check); if ($pre) { $pre_on_check ='CHECKED'; } else { $pre_off_check ='CHECKED'; } print <<END; <FORM METHOD="$method" ACTION="$cgi_name"> <INPUT TYPE="hidden" NAME="cmd" VALUE="u$o_mode$r_mode$r"> おなまえ(ニックネーム)<BR> <INPUT TYPE="text" SIZE=50 NAME="Name" VALUE="$name"><BR> メールアドレス$email_need<BR> <INPUT TYPE="text" SIZE=50 NAME="E_mail" VALUE="$email"><BR> ホームページアドレス(よろしければ)<BR> <INPUT TYPE="text" SIZE=50 NAME="HomePage" VALUE="$hp"><BR><BR> ★タイトル<BR> <INPUT TYPE="text" SIZE=50 NAME="Title" VALUE="$title"><BR> ★内容<BR> <TEXTAREA NAME="Comment" ROWS="$form_rows" COLS="$form_cols" >$comment</TEXTAREA><BR> <INPUT TYPE="radio" NAME="pre_mode" VALUE="on" $pre_on_check >整形済入力(空白、改行が有効) <INPUT TYPE="radio" NAME="pre_mode" VALUE="off" $pre_off_check >未整形入力(改行のみ有効) <CENTER> <INPUT TYPE="submit" VALUE="書込"> <INPUT TYPE="reset" VALUE="取消"> </CENTER> </FORM> <HR><!-- ===================================== --> END } # --------------------------------------------------------------------- sub foot_html { print <<END; $tail <FONT SIZE=-1> <A HREF="http://www2d.biglobe.ne.jp/~gama/cgi/index.cgi">$copyright</a> </FONT> <BR><BR> </BODY></HTML> END } # --------------------------------------------------------------------- sub err_html { print "Content-type: text/html\n\n"; my($errmsg)=$_[0]; # サブルーチンの引数 my($errtit,$errback); if ($d_mode) { $errtit='削除できませんでした。'; $errback=$cmd; $errback=~ s/z/c/; } elsif ($cmd =~ /i/ ) { $errtit='エラーが発生しました。'; $errback=$cmd; $errback=~ s/i//; } else { $errtit='書き込みにエラーがありました'; $errback=$cmd; } print <<END; <HTML><HEAD><TITLE>$errtit</TITLE></HEAD> $body <H2>$errtit</H2> <HR><!-- ===================================== --> $errmsg <CENTER> <FORM METHOD="GET" ACTION="$cgi_name"> <INPUT TYPE="hidden" NAME="cmd" VALUE="$errback"> <INPUT TYPE="submit" VALUE="戻る"></FORM> </CENTER> <HR><!-- ===================================== --> END &form_html; &foot_html; } # --------------------------------------------------------------------- sub str_detag { local($str)=$_[0]; # サブルーチンの引数を $str=~ s/<.*?>//ge; # tag を除去 (最短一致) $str=~ s/&/&/g; # & $str=~ s/</</g; # < $str=~ s/>/>/g; # > return($str); } # --------------------------------------------------------------------- sub str_decode_from_form { local($str)=$_[0]; # サブルーチンの引数を $str=~ s/\+/ /g; # + を space へ $str=~ s/%(..)/pack("c",hex($1))/ge; # decode $str=~ s/\r//g; # LF を削除 return($str); } # --------------------------------------------------------------------- sub str_conv_for_html { local($str)=$_[0]; # サブルーチンの引数を $str=~ s/&/&/g; # & $str=~ s/</</g; # < $str=~ s/>/>/g; # > return($str); } # --------------------------------------------------------------------- sub str_decode_cookie { local($str)=$_[0]; # サブルーチンの引数を $str=~ s/^\w+=//; # = までを削除・・・ $str=~ s/%(..)/pack("c",hex($1))/ge; # decode return($str); } # --------------------------------------------------------------------- sub str_encode_for_cookie { local($str)=$_[0]; # サブルーチンの引数を $str=~ s/ /%20/g; # encode $str=~ s/,/%2C/g; # encode $str=~ s/;/%3B/g; # encode $str=~ s/&/%26/g; # encode return($str); } # --------------------------------------------------------------------- # check_url URL をアクセスしてチェック # エラーメッセージを返す # --------------------------------------------------------------------- sub check_url { my($url)=$_[0]; # サブルーチンの引数を unless ($chkurl) { return (0); # OK } my($r)= &chkurl'chkurl($url); if ($r =~ /\s*(301|302)\s*/ ) { $r = &chkurl'chkurl($url.'/'); } if ($r =~ /200/ ) { return 0; # OK } return $r; # NG }