#!/usr/bin/perl ## This file is euc-jisx0213 encoding. #use Suika::CGI; $myvesion = '1.00 (2001-08-22)'; $about_perl = <<"EOH";

FlasH BBS Pro v1.41 [�Shigeto Nakazawa] をベースに水無月ばけらが改造 + 若葉の quick hack $myversion

EOH ## h12-05-06 水無月ばけら ## h09-01-17 じゃわ@中澤重人 ## FlasH BBS Pro 1.41 #一般設定 $max_size = 512 * 1024; $max_msg = 2000; $admin_email = 'blue-oceans@suika.fam.cx'; $this_name = 'board'; $gif_allnews = ''; $gif_news = ''; $gif_new_news = ''; $gif_width = 20; $gif_height = 14; $default_title = '題名を入れて下さい'; $default_name = 'お名前をどうぞ'; $default_email = '電子メイルアドレスをどうぞ。(省略可能)'; $default_comment = '本文をどうぞ'; $arc_dir = './log/'; $log_dir = './log/'; $base_url = "http://suika.fam.cx/~okuchuu/blue-oceans/"; $rfc_base_uri = 'http://dnsbalance.ring.gr.jp/pub/doc/RFC'; $logfile = $log_dir.'bo.log'; #ロックファイル検出時のリトライ回数 $retry = 3; #文字コード $mojicode = "euc"; require 'jcode.pl'; #NN2 で charset=EUC-JP を送ると化けるらしい。 if( $ENV{'HTTP_USER_AGENT'} =~ /compatible/ ){ $charset = ';charset=EUC-JP'; }elsif( $ENV{'HTTP_USER_AGENT'} =~ /Mozilla\/2.0/ ){ $charset = ''; }else{ $charset = ';charset=EUC-JP'; } &read_form; #パラメータの処理 #デフォルト $uri_mode = 'all'; $tree = 0; $new_kiji = 10; $max_tree = 10; $nazo = ''; $indent = 'ul'; $max_depth = 40; $margin = 3; $ID = $OPT{'id'}; $uri_query = "id=$ID"; $form_query = ""; if($OPT{'link'}){ $uri_mode = $OPT{'link'}; &add_query('link', $uri_mode); } if($OPT{'tree'}){ $tree = $OPT{'tree'}; &add_query('tree', $tree); } if($OPT{'new_kiji'}){ $new_kiji = $OPT{'new_kiji'}; &add_query('new_kiji', $new_kiji); } if($OPT{'tmp_new_kiji'}){ $new_kiji = $OPT{'tmp_new_kiji'}; #このパラメータはクエリーに反映しない。 } if($OPT{'max_tree'}){ $max_tree = $OPT{'max_tree'}; &add_query('max_tree',$max_tree); } if($OPT{'nazo'}){ $nazo = $OPT{'nazo'}; &add_query('nazo', $nazo) if ( $nazo ne 'only' ); } if($OPT{'indent'}){ $indent = $OPT{'indent'}; &add_query('indent', $indent); } if($OPT{'max_depth'}){ $max_depth = $OPT{'max_depth'}; &add_query('max_depth', $max_depth); } if($OPT{'margin'}){ $margin = $OPT{'margin'}; &add_query('margin', $margin); } $cookie_name = 'board'; $title = 'ブルーオーシャンズ掲示板'; $backurl = '../top'; $back_name = '目次'; $html_info = ''; $link_element = ''; ## Administrator $address_element = "

"; $defhead = <<"EOH"; $title

$title

EOH $def_header_http = < EOH $navi_usage = '

['; $navi_ichiran = "一覧表示"; $navi_num = " / 最新記事"; $navi_new = " / 新規投稿"; $navi_back = " / $back_name ]

"; $html_navi = "

$navi_usage$navi_ichiran$navi_num$navi_new$navi_back

"; ## &get_cookie; if ($nazo eq 'only') {&nazo_only; } elsif ($OPT{'md'} eq 'reg') {®ist; } elsif ($OPT{'md'} eq 'del') {&delete; } elsif ($OPT{'md'} eq 'viw') {&view; } elsif ($OPT{'md'} eq 'new') { $html_navi = "

$navi_usage$navi_ichiran$navi_num$navi_back"; &html_form('root'); } elsif ($OPT{'md'} eq 'set') { &set; } elsif ($OPT{'md'} eq 'num') { $html_navi = "

$navi_usage$navi_ichiran$navi_new$navi_back"; &number; } else { $html_navi = "

$navi_usage$navi_num$navi_new$navi_back"; &ichiran; } &html_footer; exit 0; # [ ヘッダー部分表示 ] # sub html_header { my($sub_title) = @_; my $s; if ($sub_title) { $s = <<"_EOF_"; Content-Type: text/html; charset=euc-jisx0213 Content-Language: ja Content-Style-Type: text/css Content-Script-Type: text/javascript $link_element $title ($sub_title) _EOF_ if($indent eq 'css'){ my($i, $tmp_margin); $s .= ''; } $s .= <<"_EOF_";

$title

$html_navi

$sub_title

_EOF_ return $s; } print $s; } sub html_footer { print<<"_EOF_"; $deffoot _EOF_ } # [ 一覧表示 ] # sub ichiran { &set_cookie; local($s) = &html_header('記事一覧'); #ログ読み出し open(LOG, $logfile) or die qq(open: $logfile: $!); #&Suika::CGI::Error::die('open', file => $logfile); print $s; my($count, $last_nj); $count = ;chop($count); $last_nj = ;chop($last_nj); if( $indent eq 'css' || $indent eq 'ul' ){ $prt_elm = 'ul'; $cld_elm = 'li'; }else{ $prt_elm = 'div'; $cld_elm = 'p'; } print $html_info; print '

'; print "

([全]を選択すると関連記事も含めて一括表示できます。)

\n"; $tree = int($tree/$max_tree) * $max_tree; $end_tree = $tree + $max_tree; my($tree_count) = 0; while () { my($last_lx) = -1; $tree_count++; next if $tree_count <= $tree; next if $tree_count > $end_tree; print "\n

\n<$prt_elm class=\"tree\">"; @datas = ÷_log($_); foreach (@datas) { my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_data($_); if ( $indent eq 'ul' && $last_lx > -1 ){ my($l_diff) = $last_lx - $lx; if( $l_diff < 0 ){ print "<$prt_elm>"; }elsif( $l_diff > 0){ my($i); print ""; for($i = 1; $i <= $l_diff; $i++){ print ""; } }else{ print ""; } } if($indent eq 'css'){ print "<$cld_elm class=\"lv$lx\">"; }else{ print "<$cld_elm>"; } if ($res eq 'root') { print "[全]"; } elsif ($indent eq 'space') { my($space_width) = $lx * 2 + 2; print ' ' x $space_width; } print ""; if ($no > $count - $new_kiji) { print "[新]"; } else { print "[・]"; } print " $title : "; if ($COOKIE{'name'} eq $name) { print "$name"; #自分の記事を強調表示 } else { print $name; } print " ($date)"; $last_lx = $lx; } if ( $indent eq 'ul' ){ # print ""; my($i); for($i = 1; $i <= $last_lx; $i++){ print ""; } } print ""; } close(LOG); print"

\n"; &navi_form($tree_count); } # [ 個別で記事の内容を表示する ] # sub view { local($s) = $def_header_http.$defhead.$html_navi."

記事$OPT{'no'}

"; my(@kiji_datas) = ÷_log(&search_tree); my($kiji_data) = &search_data(@kiji_datas); $s .= &kiji_view($kiji_data); $s .= "

"; my($no,$rq_res,$lx,$tn,$title,$name,$email,$date,$rq_act,$file_pwd,$rhost,$ipad,$comment) = ÷_data($kiji_data); foreach (@kiji_datas) { my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = ÷_data($_); if ($rq_res == $no) { $parent = "この記事は「$title」へのコメントです。"; } if (($res == $OPT{'no'}) && ($res ne 'root')) { $children .= "

「$title」$name($date)

"; } } if ($rq_res eq 'root') { $parent = 'ルート記事です。'; } elsif (!$parent) { $parent = '元になった記事はみつかりませんでした。'; } if (!$children) { $children = 'コメントは投稿されていません。

'; } else{$children = "以下のコメントが投稿されています。

$children";} $s .= <<"_EOF_";

$parent $children

_EOF_ if ($rq_act > 6) { $s .= '

この記事に対してコメントを投稿することは出来ません。

'; return 0; }elsif( $nazo eq 'no' ){ $s .= ''; return 0; } if ($title =~ /^[Rr][Ee]\^\d+\:(.*)/) {$title = "Re: $1";} elsif ($title =~ /^[Rr][Ee]\[\d+\]\:(.*)/) {$title = "Re: $1";} elsif ($title =~ /^[Rr][Ee]\:(.*)/) {$title = "Re: $1";} else {$title = "Re: $title"; } $comment = "
$comment"; $comment =~ s/
((>)+)/\n$1>/ig; $comment =~ s/
/\n> /ig; $comment =~ s/\n//; $s .= '

この記事に関するコメントを投稿する場合は以下の投稿欄に書き込んで下さい。

'; $s .= &html_form($OPT{'no'},$title,$comment,$OPT{'tn'},$lx,1); #投稿者削除 if (crypt($COOKIE{'pwd'},$file_pwd) eq $file_pwd) { $s .= <<"_EOF_";

_EOF_ } print ($s.$deffoot); exit; } # [ セット表示 ] # sub set { my($last_lx) = -1; print &html_header('セット表示'); if( $indent eq 'css' || $indent eq 'ul' ){ $prt_elm = 'ul'; $cld_elm = 'li'; }else{ $prt_elm = 'div'; $cld_elm = 'p'; } print<<"_EOF_";

記事一覧

<$prt_elm class="tree"> _EOF_ @kiji_datas = ÷_log(&search_tree); foreach (@kiji_datas) { my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_data($_); my($num_no) = int($no); $reply[$res] .= "$num_no-"; if ( $indent eq 'ul' && $last_lx > -1 ){ my($l_diff) = $last_lx - $lx; if( $l_diff < 0 ){ print "<$prt_elm>"; }elsif( $l_diff > 0){ my($i); print ""; for($i = 1; $i <= $l_diff; $i++){ print ""; } }else{ print ""; } } if($indent eq 'css'){ print "<$cld_elm class=\"lv$lx\">"; }else{ print "<$cld_elm>"; } $last_lx = $lx; if ($res ne 'root' && $indent eq 'space') { my($space_width) = $lx * 2 + 2; print '　' x $space_width; } print "・ $title : $name ($date)"; print "\n" unless ($indent eq 'ul'); } if ( $indent eq 'ul' ){ # print ""; my($i); for($i = 1; $i <= $last_lx; $i++){ print ""; } }else{ print ""; } print"

\n"; foreach $data (@kiji_datas) { my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = ÷_data($data); my($num_no) = int($no); print "

No.$num_no"; if ($res eq 'root') { print '(親記事)'; } else { $res = int($res); print "▲[$res]"; } if (!$reply[$no]) { print ' / (注釈なし)'; } else { chop($reply[$no]); my(@replys) = split(/-/,$reply[$no]); foreach (@replys) { print " / ▼[$_]"; } } print "

\n"; print &kiji_view($data); if( $nazo eq 'no' ){ print ''; }else{ print "

コメントを投稿 / "; } print "記事一覧

"; } } # [ 最新記事一括機能 ] sub number { print &html_header("最新記事"); print "

最近の記事 $new_kiji 件を表示しています。

"; print '

['; my($i,$j,$tmp); for ( $i = 1; $i <= 10; $i++ ){ $j = $i * 10; unless ($new_kiji == $j){ if($tmp){ print ' / ' ; }else{ $tmp = 1; } print "$j 件"; } } print ' ]

'; open(LOG,$logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。'); my($count, $last_nj); $count = ;chop($count); $last_nj = ;chop($last_nj); while () { @datas = ÷_log($_); foreach $data (@datas) { my($no,$res,$lx,$tn,$title,$name,$email,$date,$act) = ÷_data($data); if ($no > $count - $new_kiji) { push(@nums,$data); } } last if @nums >= $new_kiji; } close(LOG); @nums = reverse(sort(@nums)); print '

$list_order: 記事No.$no
\n"; print &kiji_view($data); print<<"_EOF_";
コメントを投稿 / セットで表示

'; } # [ 投稿フォームを表示 ] # sub html_form { my($no,$title,$comment,$tn,$lx,$c) = (@_); local($s); $s = $def_header_http.$defhead if $c != 1; $s .= '

記事の投稿

'; if ($no eq '') { $no = 'root'; } $title = "($default_title)" unless $title; $comment = "($default_comment)" unless $comment; if($COOKIE{'name'}){ $my_name = $COOKIE{'name'}; }else{ $my_name = "($default_name)"; } if($COOKIE{'email'}){ $my_email = $COOKIE{'email'}; }else{ $my_email = "($default_email)"; } $nj = time() . '-' . &random_string(8); $s .= <<"_EOF_"; _EOF_ if ($c == 1) { $s; } else { print ($s); } } # [ 記事内容を表示 ] sub kiji_view { my($data) = @_; my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$tm_pwd,$rhost,$ipad,$comment) = ÷_data($data); # &jcode'convert(*comment,'euc'); $comment = &squelch($comment) if $nazo; $comment =~ s/(
|\s|　)+$//g; $comment =~ s/^(>|>)([^<]*)/>$2<\/q>/g; $comment =~ s/
(>|>)([^<]*)/
>$2<\/q>/g; #URL にアンカーを設定する if( $uri_mode eq 'uri' || $uri_mode eq 'all' ){ $comment =~ s/(https?|ftp|gopher|telnet|nntp|news)\:([\w|\:\!\#\$\%\=\&\-\^\`\\\|\@\~\[\{\]\}\;\+\*\,\.\?\/]+)/$1\:$2<\/a>/ig; } if( $uri_mode eq 'rfc' || $uri_mode eq 'all' ){ $comment =~ s/(\W)([Rr][Ff][Cc]\s?)([1-9]\d*)(\W)/$1 $2$3<\/a>$4/g; } # &jcode'convert(*comment,$mojicode); if ($email) { $name = "$name"; } local($s) = <<"_EOF_";

$title

$name ($date)

$comment

_EOF_ $s; } # [ 記事登録処理 ] sub regist { my($title,$name,$email,$comment,$lx,$tn,$pwd,$ref_url) = ($OPT{'title'},$OPT{'name'},$OPT{'email'},$OPT{'comment'},$OPT{'lx'},$OPT{'tn'},$OPT{'pwd'},$ENV{'HTTP_REFERER'}); $title =~ s/^$$default_title$//; $title =~ s/\r\n//g; $title =~ s/[\r\n]//g; $name =~ s/^$$default_name$//; $name =~ s/\r\n//g; $name =~ s/[\r\n]//g; $email =~ s/^$$default_email$//; $email =~ s/\r\n//g; $email =~ s/[\r\n]//g; $comment =~ s/^$$default_comment$//; $comment =~ s/^\s+//g; $comment =~ s/(\s|　)+$//g; $comment =~ s/\r\n/
/g; $comment =~ s/[\r\n]/
/g; $lx++; $pwd =~ s/\r\n//g; $pwd =~ s/\r|\n//g; $ref_url =~ s/\?(.|\n)*//g; s/\%7E/\~/g; #投稿チェック if($ENV{'REQUEST_METHOD'} ne "POST"){ &method_error(); # }elsif($base_url && ($ref_url !~ $base_url)){ # &error('不正投稿','アクセスは受け入れられませんでした。外部からの不正な投稿が行われた可能性があります。正しい投稿でもこのエラーが出る場合は、ブラウザが Referer を送出する設定になっているか確認してください。'); }elsif (length($title) > 80) { $_ = length($title) - 80; &error('題名入力エラー',"題名が長すぎます。$_ バイト削減してください。"); }elsif (!$title) { &error('題名入力エラー','題名が入力されていません。'); }elsif (!$name) { &error('投稿者名入力エラー','投稿者名が入力されていません。'); }elsif (length($name) > 42) { $_ = length($name) - 42; &error('投稿者名入力エラー',"投稿者名が長すぎます。$_ バイト削減してください。"); }elsif ($email && $email !~ /\w[\w\.\-]*\@\w[\w\.\-]*\.\w+/){ &error('メールアドレス入力エラー','メールアドレスの書式が不正です。全角文字を使っていないか、空白を含めていないか確認してください。'); }elsif (length($email) > 120) { $_ = length($email) - 120; &error('メールアドレス入力エラー',"メールアドレスが長すぎます。$_ バイト削減してください。"); }elsif (!$comment) { &error('本文入力エラー','本文が入力されていません。空白のみの投稿は出来ません。'); }elsif (length($comment) > $max_msg) { $_ = length($comment) - $max_msg; &error('本文入力エラー',"本文が長すぎます。$_ バイト削減してください。"); }elsif ((!$pwd) || (length($pwd) > 8)) { $pwd = &random_string(8); } my($salt) = &random_string(2); $file_pwd = crypt($pwd,$salt); &get_date; open(LOG,$logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。'); my($count, $last_nj); $count = ;chop($count); $last_nj = ;chop($last_nj); my(@all_log) = ; close(LOG); $this_nj = $OPT{'nj'}; if (++$count > 9999) { &error('記事カウンタのオーバーフロー','登録記事数が 10,000 に達したため、投稿を受け付けることが出来ません。投稿を受け付けるには、既存の記事を再編成して掲示板の最適化を行う必要があります。管理者に連絡してください。'); # }elsif ($this_nj eq $last_nj){ # &error('二重投稿','二重投稿です。投稿ボタンが連打されてしまった可能性があります。一覧表示をリロードして記事が投稿されたか確認してください。再投稿の際は、投稿フォームをリロードして投稿をやり直してください。'); } my($kiji_no) = substr("0000",length($count)).$count; $rhost = $ENV{'REMOTE_HOST'}; $ipad = $ENV{'REMOTE_ADDR'}; if ($OPT{'no'} eq 'root') { $kiji_data = "$kiji_no<>root<>0<>$kiji_no<>$title<>$name<>$email<>$date_now<>0<>$file_pwd<>$rhost<>$ipad<>$comment\n"; unshift(@all_log,$kiji_data); } else { foreach $tree (@all_log) { if ($tn == (split(/<>/,$tree))[0]) { @datas = ÷_log($tree); $flag1 = 0; $flag2 = 0; $kiji_data = "$kiji_no<>$OPT{'no'}<>$lx<>$tn<>$title<>$name<>$email<>$date_now<>0<>$file_pwd<>$rhost<>$ipad<>$comment"; foreach $data (@datas) { if (($flag2 == 1) && ($temp_lx >= (split(/<>/,$data))[2])){ $tree_data = "$tree_data<#>$kiji_data"; $flag2 = 2; } if ($flag1) { $tree_data = "$tree_data<#>$data"; } else { $tree_data = $data; $flag1 = 1; } if (($OPT{'no'} == (split(/<>/,$data))[0]) && (!$flag2)) { $flag2 = 1; $temp_lx = (split(/<>/,$data))[2]; } } if ($flag2 == 1){ $tree_data = "$tree_data<#>$kiji_data"; } unshift (@new,"$tree_data\n"); } else { push (@new,$tree); } } @all_log = @new; } #容量オーバーした記事を削除 if ($max_size < 1500) { $max_size = 1500; } $size = -s $logfile; while ($size > $max_size){ my($delete) = pop(@all_log); $size -= length($delete); &delete_log($delete); } &write_file($count, $this_nj, @all_log); $COOKIE{'name'} = $name; $COOKIE{'email'} = $email; $COOKIE{'pwd'} = $pwd; &set_cookie; local($s) = $def_header_http.$defhead.$html_navi.'

投稿の受理

'; $s .= <<"_EOF_";

御投稿有難うございます。以下の内容を受理しました。

_EOF_ $s .= &kiji_view($kiji_data); print ($s.$deffoot); exit; } # [ 投稿者削除処理 ] sub delete { my(@kiji_datas) = ÷_log(&search_tree); my($kiji_data) = &search_data(@kiji_datas); my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$file_pwd,$rhost,$ipad,$comment) = ÷_data($kiji_data); if (crypt($COOKIE{'pwd'},$file_pwd) ne $file_pwd) { &error('削除エラー','指定した記事の削除はできません。既に削除されていないか確認してください。どうしても削除したい場合は管理者に連絡してください。'); } &get_date; #証拠を残しておく。 &delete_log($kiji_data); open(LOG,$logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。'); my($count, $last_nj); $count = ;chop($count); $last_nj = ;chop($last_nj); my($delete_notice); if (@kiji_datas == 1) { while () { unless (/^$OPT{'no'}/) { push(@new,$_); } } $delete_notice = '

記事はツリーを構成していなかったため、完全に消滅しています。

'; } else { my($kiji_data) = "$no<>$res<>$lx<>$tn<>~~$title~~(投稿者削除)<>$name<><>$date<>8<>Null<>$rhost<>$ipad<>投稿者によって削除されました。(削除: $date_now)"; my($flag) = 0; my($tree_data); foreach (@kiji_datas) { if ($flag) { $tree_data .= "<#>"; } else { $flag = 1; } if (/^$OPT{'no'}/) { $tree_data .= $kiji_data; } else { $tree_data .= $_; } } $tree_data =~ s/\n//; while () { if (!/^$OPT{'tn'}/) { push(@new,$_); } else { push(@new,"$tree_data\n"); } } $delete_notice = '

記事はツリーの一部を構成していたため、(投稿者削除) という記事に差し替えられています。

'; } close(LOG); &write_file($count, $this_nj, @new); print &html_header("投稿者削除"); print<<"_EOF_";

記事 No.$OPT{'tn'}「$title」を削除しました。

$delete_notice

一覧表示をリロードして、記事が削除されたことを確認してください。

_EOF_ } # [ データ処理関連汎用サブ ] sub divide_log { my($data) = @_; chop($data); return split(/<#>/,$data); } sub divide_data { my $data = @_; return split(/<>/,$_[0]); } sub search_data { my(@kiji_datas) = @_; my($search_data_no) = $OPT{'no'}; my($hit_data); foreach(@kiji_datas){ if ( /^$search_data_no/ ) { $hit_data = $_; last; } } return $hit_data; } sub search_tree { my($search_tree_no) = $OPT{'tn'}; my($hit_data); open(LOG,$logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。'); my($count, $last_nj); $count = ;chop($count); $last_nj = ;chop($last_nj); while () { if ( /^$search_tree_no/ ){ $hit_data = $_; last; } } close(LOG); return $hit_data; } # [ フォームからデータ取得 ] sub read_form { # %OPT = %Suika::CGI::param; # return; my($pair,$buffer); if ($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); } else { $buffer = $ENV{'QUERY_STRING'}; } my(@pairs) = split(/[&;]/,$buffer); #パラメータ区切りに ; を使えるように改造。 foreach $pair (@pairs) { my($name,$value) = split(/=/,$pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; $OPT{$name} = &change_code($value); } } # [ クッキー処理 ] sub get_cookie { my($pair,%DUMMY); my($cookies) = $ENV{'HTTP_COOKIE'}; my(@pairs) = split(/;/,$cookies); foreach $pair (@pairs) { my($name,$value) = split(/=/,$pair); $name =~ s/ //g; $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack("C", hex($1))/eg; $DUMMY{$name} = $value; } @pairs = split(/,/,$DUMMY{$cookie_name}); foreach $pair (@pairs) { my($name,$value) = split(/:/,$pair); $COOKIE{$name} = &change_code($value); } } sub set_cookie { my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time + 30*24*60*60); $year += 100 if $year < 99; $year += 1900; $sec = "0$sec" if $sec < 10; $min = "0$min" if $min < 10; $hour = "0$hour" if $hour < 10; $mday = "0$mday" if $mday < 10; $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon]; $youbi = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday')[$wday]; $date_gmt = "$youbi, $mday\-$mon\-$year $hour:$min:$sec GMT"; my($cook); foreach $valname ('name','email','pwd'){ my($tmp) = $COOKIE{$valname}; $tmp =~ s/(\W)/sprintf("%%%02X", unpack("C", $1))/eg; $cook .= "$valname:$tmp,"; } print "Set-Cookie: $cookie_name=$cook; expires=$date_gmt\n"; } # [ 文字コード関連 ] sub change_code { my($text)=$_[0]; &jcode'convert(*text,$mojicode); $text =~ s/&/&/g; $text =~ s//>/g; return $text; } # [ 日付取得 ] sub get_date { $ENV{'TZ'} = "JST-9"; # TimeZone (日本時間 = 国際標準時(JST) - 9時間) my($sec,$min,$hour,$day,$mon,$year) = localtime(); if ($year < 99) { $year += 100; } $year += 1900; $mon++; $sec = "0$sec" if $sec < 10; $min = "0$min" if $min < 10; $hour = "0$hour" if $hour < 10; $mon = "0$mon" if $mon < 10; $day = "0$day" if $day < 10; $date_now = "$year/$mon/$day $hour:$min:$sec"; $datetime = "$year-$mon-${day}T$hour:$min:$sec+09:00"; } # [ 記録ファイルの処理 ] sub write_file { my($count,$this_nj,@lines) = @_; #プロセスID からテンポラリファイル名を生成 $pros = $$; $pros = time unless $pros; $tmp_file = "$ID$pros.tmp"; #他のテンポラリファイルを検索 opendir(DIR,$log_dir) or &error('システムエラー','作業ディレクトリのオープンに失敗しました。管理者が何かを忘れている可能性があります。'); @list = readdir(DIR); closedir(DIR); unless (@list) { &error('システムエラー','作業ディレクトリが完全に空です。'); } @lists = grep(/$ID.*\.tmp/,@list); #テンポラリファイルがある場合 my($retry_counter) = $retry; while (@lists) { if (--$retry_counter <= 0) { #しびれを切らした foreach (@lists) { #テンポラリファイルを抹殺 unlink("$log_dir$_") if (-e "$log_dir$_"); } &error('ビジー','ただ今混雑しています。時間をおいて再度実行してください。'); } sleep(1); opendir(DIR,"$log_dir"); @list = readdir(DIR); closedir(DIR); @lists = grep(/$ID.*\.tmp/,@list); } #テンポラリファイルに書き込む open(WRITE,">$log_dir$tmp_file") or &error('書き込みエラー','記録ファイルの書き込みが出来ません。管理者に連絡してください。'); print WRITE "$count\n"; print WRITE "$this_nj\n"; print WRITE @lines; close(WRITE); #もう一度他のテンポラリファイルを検索 opendir(DIR,$log_dir); @list = readdir(DIR); closedir(DIR); @lists = grep(/$ID.*\.tmp/,@list); @lists = grep(!/$tmp_file/,@lists);#自分自身は除外 if (@lists) {#他で書き込み中であれば書き込みを中止して終了 unlink("$log_dir$tmp_file") if (-e "$log_dir$tmp_file"); &error('書き込みの競合','別の書き込みの処理中です。すこし時間をおいてから、再度ご利用下さい。'); } rename("$log_dir$tmp_file",$logfile) or &error('書き込みの競合','書き込みに失敗しました。再度実行してください。'); chmod 0666, $logfile; } sub delete_log{ my($delete) = @_; open(WRITE,">> $arc_dir${ID}.txt") or &error('エラー','削除ログのシステムエラーです。管理者に連絡してください。'); @datas = ÷_log($delete); @datas = sort(@datas); foreach $data (@datas) { my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = ÷_data($data); print WRITE "No:$no $title\n"; print WRITE "$date"; print WRITE "$res へのコメント" unless ($res eq 'root'); print WRITE "\n"; $comment =~ s/
/\n/g; $comment =~ s/>/>/g; $comment =~ s/</ $link_element (エラー報告)

エラー

$err_msg

$err_description

_EOF_ &html_footer; exit; } sub method_error{ print<<"_EOF_"; Status: 405 Method Not Allowed Allow: POST Content-type: text/html; $charset_code Content-Language: ja (エラー報告)

エラー

不正投稿

アクセスは受け入れられませんでした。外部からの不正な投稿が行われた可能性があります。

_EOF_ &html_footer; exit; } sub navi_form{ my($tree_count) = @_; my($this_page,$page_navi); my($tmp_query) = $uri_query; $tmp_query =~ s/;tree=\d+//; if($tree_count){ for ($i = 0; $i < $tree_count; $i += $max_tree) { $j = $i / $max_tree + 1; if ($tree == $i) { $this_page = $j; } else { $page_navi .= "/ $jページ\n" } } } $page_navi .= "( $this_page / $j ページ )" if $j > 1; print<<"_EOF_";

新規投稿 $page_navi

_EOF_ } sub nazo_only{ my(%nazo); my(@env); my($name, $value); open(LOG, $logfile) or &error('読み込みエラー','ログの読み込みが出来ません。管理者に連絡してください。'); while(){ while( m|(【.+?】)|g ){ $nazo{"$1"} ++; } } close(LOG); print &html_header("謎統計情報"); if(%nazo){ print '

'; }else{ print '

Not Found.

'; } &html_footer; exit; } sub location{ my($location) = @_; print <<"_EndOfText_"; Status: 302 Found Location: $location Content-Type: text/html; charset=EUC-JP Content-Language: ja _EndOfText_ print &html_header("$location"); print "

$location を参照してください。

"; &html_footer; exit; } sub add_query{ my($name, $value) = @_; $uri_query .= ";$name=$value"; $form_query .= ""; } sub squelch{ my($data) = @_; #謎をスケルチする if( $nazo eq 'no' ){ $data =~ s/(【[^<]+?】)/~~$1<\/del>/g; } return $data; }~~