#!/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"; #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 &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 = "°Ê²¼¤Î¥³¥á¥ó¥È¤¬Åê¹Æ¤µ¤ì¤Æ¤¤¤Þ¤¹¡£

    \n
      $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_";

    $form_query (´°Á´¤Ëºï½ü½ÐÍè¤Ê¤¤¾ì¹ç¤â¤¢¤ê¤Þ¤¹¡£)

    _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 '
      '; my($list_order); foreach $data (@nums) { my($no,$res,$lx,$tn,$title,$name,$email,$date,$act,$pwd,$rhost,$ipad,$comment) = ÷_data($data); $list_order++; print "

    • $list_order: µ­»öNo.$no

      \n"; print &kiji_view($data); print<<"_EOF_";

      ¥³¥á¥ó¥È¤òÅê¹Æ / ¥»¥Ã¥È¤Çɽ¼¨

      • _EOF_ } print '
    '; } # [ Åê¹Æ¥Õ¥©¡¼¥à¤òɽ¼¨ ] # 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_";


    $form_query

    _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 '
      '; while (($name, $value) = each(%nazo)){ push(@env, "$name = $value"); } foreach (sort(@env)){ print "

    • $_

      • "; } 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; }