#!/usr/bin/perl # ↑ # Perl5 へのパス (Perl4 では動作しない) # # Ir-i-BBS - main module # ------------------------- # Copyright (c) 1999-2004 by Irao Computer System, All rights reserved. # # i-mode と PC で異なったインタフェースを提供する掲示板スクリプト # # This is free software with ABSOLUTELY NO WARRANTY. # # 実行方法 http://(設置URL)/ir-i-bbs.cgi? # # # 今回の修正内容 # 15, Jul, 2004 v1.85b: # ・過去ログを保存しない状態だと記事数が最大記録数を超えるバグを修正 # ・ageモードの場合、ageてから記事数の調整を行うように修正 my $rcsid = q$Id: ir-i-bbs.cgi/v1.85b 2004/07/15 irao Exp $; local $version = ($rcsid =~ m|/v([\d.a-zA-Z]+)|)? ("version " . $1) : 'unknown'; my $copyright = "Copyright (c) 1999-2004 by Irao All rights reserved."; # ここまで変更厳禁 #---------------------------------- ##### 設定 #---------- 設定ここから ---------- # ir-imchr.cgi へのパス(相対パスで可) $im_chr_cgi = './ir-imchr.cgi'; # ir-i-def.pl へのパス(相対パスで可) $ir_i_def_pl = './ir-i-def.pl'; # jcode.pl へのパス require './jcode.pl'; # 各サブルーチンファイルへのパス require './ir-i-sub.pl'; require './ir-i-im.pl'; require './ir-i-pc.pl'; require './ir-i-ez.pl'; require './ir-i-js.pl'; require './ir-i-uty.pl'; $init_file = './data/ir-i-bbs.ini'; $bbs_data_file = './data/ir-i-bbs.dat'; $master_key_file = './data/ir-i-bbs.pw'; $png_data_file = "./data/ir-impng.dat"; $about_data_file = './data/ir-about.txt'; $bbs_vars_file = './data/ir-i-bbs.var'; # 付加的データファイル(設定次第では参照されます) $counter_file = './data/ir-count.txt'; $bbs_log_file = './data/ir-i-log.dat'; # ファイルを作成したときのパーミッションの値(8進数) : たぶん変更不要 $permit_on_create = 0666; # 8進数指定のため、↑先頭に「0」が必要です # 排他制御に flock() を用いない設定(NFS対策) $lockArgs = { 'noFlock' => 'on' }; # Var ファイル更新間隔 (秒) $refreshInt = 3600; # DDIP 絵文字定義ファイル $iconDefAirH = './data/ir-ahchr.txt'; # imode 絵文字定義ファイル $iconDefImode = './data/ir-imchr.txt'; # ASTEL .i 絵文字定義ファイル $iconDefAstel = './data/ir-dichr.txt'; # Jsky 絵文字定義ファイル $iconDefJsky = './data/ir-jschr.txt'; # サーバー名/スクリプト名を手動設定する; # $ENV{'SERVER_NAME'} = 'www.irao.com'; # $ENV{'SCRIPT_NAME'} = '/irao/ir-i-bbs/cgi-bin/ir-i-bbs.cgi'; # 通常必要ありませんが、必要ならば上2行の先頭の#をはずして設定してください # INCM(CMT)互換ログを生成する # (INCMを使用するのに必要です; 標準設定では互換性がありません) # $compat_cmt = 't'; # 500(Internal Server Error)追跡用 # $Debug = 't'; #---------- 設定ここまで ---------- $SIG{__DIE__} = \&error if $Debug; $Term = new term(); #$jphone_method = 'GET'; #$terminal = &get_query(); $IpAddr = new ipadr($Term->{'type'}, $Term->{'subtype'}); $FORM{'action'} = '' if ($Term->{'type'} eq 'imode' and $Term->{'subtype'} eq 'ez2' and $ENV{'REQUEST_METHOD'} eq 'POST' and $FORM{'rld'} eq 't'); $terminal = $Term->{'type'}; $subtype = $Term->{'subtype'}; $jphone_method = $Term->{'method'} if $terminal eq 'jsky'; if ($FORM{'action'} eq 'logmode') { $FORM{'mode'} = 'log'; $FORM{'action'} = ''; } $bbs_data_file = $bbs_log_file if ($FORM{'mode'} =~ /^log$/io); $output_buffer = 'output_buffer_' . $terminal; $author = "authorize_" . $terminal; $initial_setup = ''; $init_exist = &load_init($init_file); &set_bbs_path(); $Variables = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $Variables->load(); if (time - $Variables->{'vars'}->{'lastRefresh'} > $refreshInt) { $Variables->refresh(); } $gzip = $gzip_program if $gzip_program and (-x $gzip_program); $accIntMail = $access_interval_mail if $access_interval_mail and $access_interval_mail > 0; $accIntPost = $access_interval_post if $access_interval_post and $access_interval_post > 0; #$age_mode = 't' if ($FORM{'age'}); if ($thread_mode) { # if (($Term->{'type'} eq 'ez' and ($FORM{'action'} or $FORM{'start'})) # or ($Term->{'type'} ne 'ez')) { if ($FORM{'thread'} =~ /^(f(alse)?|no?(ne)?)$/i) { delete $FORM{'thread'}; } elsif (not $FORM{'thread'}) { $FORM{'thread'} = 't'; } # } } else { delete $FORM{'thread'}; } $accessControl = $IpAddr->isRegisted($Variables); if ($accessControl ne 'allow') { $proxy_level = &isProxy(); &error("Proxy経由でのアクセスは禁止されています") if (($proxy_mode == 2 and $proxy_level > 0) or ($proxy_mode ==1 and $proxy_level == 2)); &error('アクセスを拒否します') if ($accessControl eq 'deny'); &error('あなたの書込みは禁止されています') if ($accessControl eq 'prohibit' and $FORM{'action'} eq 'regist'); } &error('アクセスを拒否します') if ($Variables->{'vars'}->{"lockout_$ENV{'REMOTE_ADDR'}"} > 0); &outputCmt() if ($FORM{'point'}) and $compat_cmt; if ($must_view_before_regist and not $IpAddr->{'isMobile'} and $Term->{'category'} ne 'phs') { my $adr = $ENV{'REMOTE_ADDR'}; if ($FORM{'action'} eq 'regist') { my $last = $Variables->{'vars'}->{"view_$adr"}; &error('投稿は受理されませんでした.') if not defined $last; &error('投稿する前に投稿フォームを表示してください.') if time - $last > $ttl_view_before_regist * 60; &error('投稿フォームを表示してから書き込みするまでが短かすぎます.') if time - $last < $min_view_before_regist; } else { my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{"view_$adr"} = time; $vars->save(); } } &get_cookie(); if (($enable_counter) && ($FORM{'start'} eq "") && ($FORM{'action'} eq "")) { $a_count = &increase_counter; } $master = ""; if (-e $master_key_file) { open FH, $master_key_file or &error('管理人パスワードが開けません.'); $master = ; close FH; chomp $master; } $master = '' if ($master =~ /^\s*$/); if ($restrict_ip_list) { my $newAccessList = &convertOldList($restrict_ip_list); my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); if ($restrict_mode == 1) { $v = \$vars->{'vars'}->{'prohibit'}; } elsif ($restrict_mode == 0) { $v = \$vars->{'vars'}->{'deny'}; } else { $v = \$vars->{'vars'}->{'allow'}; } $$v .= ',' if ($$v); $$v .= $newAccessList; $vars->save(); { local %FORM; $FORM{'restrict_ip_list'} = ''; &save_init($init_file, $init_exist); } } if ($IpAddr->{'isMobile'} and $FORM{'action'} eq 'authmini') { &error ('保存時に設定した暗証番号をいれてください') if ($FORM{'auth1'} ne $FORM{'auth2'}); $FORM{'action'} = $FORM{'next_act'}; $FORM{'authorize'} = $master; } if ($IpAddr->{'isMobile'} and $FORM{'action'} eq 'authsn') { if ($Term->isTerminalIdRegisted($Variables)) { $FORM{'authorize'} = $master; $FORM{'action'} = $FORM{'next_act'}; } elsif ($FORM{'action'} eq 'authsn') { my $err = 'この電話機は登録されていません. パスワードを入れてください.'; &$author($err); } } if ($FORM{'action'} eq 'authorize') { my ($cook, $exp_date_g, $salt, $crypt, $err_msg); $err_msg = 'パスワードが正しくありません. 入れ直してください.'; $crypt = &certify_pass($FORM{'pass'}, $master); my $expires; if ($limit_mode and $limit_pass !~ /^\s*$/ and $FORM{'next_act'} !~ /((ch|set)_(init|color|about|master)|set_iplist|list_ip|cleaning)/i) { my $entryp = $limit_pass; if ($cook_author_master > 0) { $ct = $cook_author_master; $exp_date_g = &get_gmt($ct*60*60); $expires = "; expires=$exp_date_g"; } if (($crypt ne $master) && ($FORM{'pass'} ne $entryp)) { &$author($err_msg); } $cook = ($FORM{'pass'} eq $entryp)? $entryp : $master; } else { if ($cook_author_enter > 0) { $ct = $cook_author_enter; $exp_date_g = &get_gmt($ct*60*60); $expires = "; expires=$exp_date_g"; } #&$author($err_msg) if ($crypt ne $master); # 管理パスワードを何回か連続して間違ったらロックアウトする if ($crypt ne $master) { if ($IpAddr->{'isMobile'}) { my $adr = $ENV{'REMOTE_ADDR'}; my $authCount = $Variables->{'vars'}->{"auth_$adr"}; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); if (not defined $authCount) { $vars->{'vars'}->{"auth_$adr"} = 1; $vars->{'vars'}->{"auth_time_$adr"} = time; } elsif ($authCount > 4) { $vars->{'vars'}->{"lockout_$adr"} = time; $vars->{'delete'}->{"auth_$adr"} = 'true'; $vars->{'delete'}->{"auth_time_$adr"} = 'true'; } else { $vars->{'vars'}->{"auth_$adr"} = $authCount + 1; } $vars->save(); } &$author($err_msg); } else { my $adr = $ENV{'REMOTE_ADDR'}; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'delete'}->{"auth_$adr"} = 'true'; $vars->{'delete'}->{"auth_time_$adr"} = 'true'; $vars->save(); } $cook = $master; } print "Set-Cookie: Authorize=$cook$expires\n" unless ($terminal eq 'jsky' or ($terminal eq 'imode' and $subtype ne 'ez2')); # unless ($terminal =~ /(imode|jsky)/); $COOKIE{'authorize'} = $cook; $FORM{'action'} = $FORM{'next_act'}; if ($terminal eq "ez") { $FORM{'start'} = $FORM{'next_start'}; } } if ($FORM{'authorize'} eq $master and ($terminal eq 'imode' or $terminal eq 'jsky') and $IpAddr->{'isMobile'} and $FORM{'sn'}) { my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); my $sn = $Term->getTerminalId(); my $key; if ($Term->{'type'} eq 'jsky') { $key = "auth_sn_jsky"; } elsif ($Term->{'type'} eq 'ez' or ($Term->{'type'} eq 'imode' and $Term->{'subtype'} eq 'ez2')) { $key = "auth_sn_ez"; } elsif ($Term->{'type'} eq 'imode') { $key = ($Term->{'subtype'} eq 'foma')? "auth_sn_foma":"auth_sn_imode"; } $vars->{'vars'}->{$key} = $sn if ($sn and $key); $vars->save(); } &set_master_mode() if ($FORM{'action'} eq 'ch_master'); &set_master() if ($FORM{'action'} eq 'set_master'); $initial_setup = 'pass'; &set_master_mode() if ($master eq ''); &set_init() if ($FORM{'action'} eq 'set_init'); $initial_setup = 'init' if ($initial_setup ne "color"); &set_init_mode() if (not $init_exist); $initial_setup = '' if ($initial_setup ne "color"); &set_init_mode() if ($FORM{'action'} eq 'ch_init'); &set_color() if ($FORM{'action'} eq 'set_color'); &set_color_mode() if ($FORM{'action'} eq 'ch_color'); &set_about() if ($FORM{'action'} eq 'set_about'); &set_about_mode() if ($FORM{'action'} eq 'ch_about'); if (($enable_counter) && ($a_count eq "")) { $a_count = &get_counter; } if ($limit_mode) { unless ($terminal eq 'ez' and not $FORM{'start'} and not $FORM{'action'} and not $FORM{'thread'}) { # unless (($terminal eq "ez") && ($FORM{'start'} eq "") # && ($FORM{'action'} eq "")) { if ($COOKIE{'authorize'} =~ /^\s*$/) { if ($FORM{'authorize'} !~ /^\s*$/) { $COOKIE{'authorize'} = $FORM{'authorize'}; } else { $FORM{'next_act'} = $FORM{'action'}; if (($terminal eq "ez") && ($FORM{'start'} ne "")) { $FORM{'next_start'} = $FORM{'start'}; } &$author('入室に認証が必要です. パスワードを入れてください.'); } } } } $view_head = 'view_' . $terminal . '_head'; $view_body = 'view_' . $terminal . '_body'; $view_foot = 'view_' . $terminal . '_foot'; $view_nums = 'view_' . $terminal . '_nums'; $delete_cmd = 'delete_' . $terminal; $search_cmd = 'search_body_' . $terminal; $search_head = 'search_' . $terminal . '_head'; $search_foot = 'search_' . $terminal . '_foot'; $select_cmd = 'select_' . $terminal; $modify_cmd = 'modify_' . $terminal; $log_cmd = 'view_log_' . $terminal; $userCustomize = 'userCustomize_' . $terminal; if ($terminal eq 'imode') { $page_max = $page_max_i; $ret_local = $ret_imode; } elsif ($terminal eq 'ez') { $page_max = $page_max_ez; &top_ez() if (not exists $FORM{'start'} and not exists $FORM{'action'}); $ret_local = $ret_ez; } elsif ($terminal eq 'pc') { $page_max = $page_max_pc; $ret_local = $ret_pc; } elsif ($terminal eq 'jsky') { $page_max = $page_max_j; $ret_local = $ret_jsky; } $start = ($FORM{'start'} ne "")? $FORM{'start'} : 0; &setIpList() if ($FORM{'action'} eq 'set_iplist' and $terminal eq 'pc'); &listIp() if ($FORM{'action'} eq 'list_ip' and $terminal eq 'pc'); if ($FORM{'mode'} =~ /^log$/i) { &$log_cmd; $page_max = $1 if ($FORM{'num'} =~ /^(\d+)$/); &error("過去ログに対しては閲覧と検索しかできません. ") if ($FORM{'action'} =~ /(regist|write|remove|delete|select|modify|change|certify|reply)/); } if ($FORM{'action'} eq 'regist') { ®ist_mes(); &reloadPage(); } elsif ($FORM{'action'} eq 'write') { unless ($terminal eq "pc") { my $dispatcher = 'write_' . $terminal . '_body'; &$dispatcher(); } } elsif ($FORM{'action'} eq 'delete') { $start = 0 if ($start < 0); $page_max = $page_max_ez_ce if ($terminal eq "ez"); &$delete_cmd; } elsif ($FORM{'action'} eq 'remove') { &remove(); &reloadPage(); } elsif ($FORM{'action'} eq 'find') { &$search_cmd(); } elsif ($FORM{'action'} eq 'select') { $page_max = $page_max_ez_ce if ($terminal eq "ez"); &$select_cmd(); } elsif ($FORM{'action'} eq 'modify') { &$modify_cmd(); #&reloadPage(); } elsif ($FORM{'action'} eq 'change') { &change_ez_body(); # EZweb 専用 } elsif ($FORM{'action'} eq 'logmenu') { &logmenu_ez_body(); # EZweb 専用 } elsif ($FORM{'action'} eq 'certify') { &certify_ez_body(); # EZweb 専用 } elsif ($FORM{'action'} eq 'reload') { &reload_ez(); # EZweb 専用 } elsif ($FORM{'action'} eq 'about') { my $dispatcher = 'about_' . $terminal; &$dispatcher(); } elsif ($FORM{'action'} eq 'cleaning') { &cleaning(); } elsif ($FORM{'action'} eq 'mail') { &displayMailAddress(); #} elsif ($FORM{'action'} eq 'isproxy') { # my $l = &isProxy; # &error("proxy 判定レベルは $l (/2) でした."); } elsif ($FORM{'action'} eq 'reply') { &reply(); } elsif ($FORM{'action'} eq 'invalidate') { $start = 0 if ($start < 0); $page_max = $page_max_ez_ce if ($terminal eq "ez"); &invalidate(); } elsif ($FORM{'action'} eq 'switch_gzip') { &isGzipSupported_pc() if ($FORM{'gzip'} eq 'enable' and $FORM{'certified'} ne 'yes'); $COOKIE{'gzip'} = ($FORM{'gzip'} eq 'enable')? 'yes' : ''; $SIG{__DIE__} = \&error; my $dateg = &getDateCookie(); my $cook = &escapeCookie(join ',' => (map { $_.':'.&escapeCammaCoron($COOKIE{$_}) } ('name', 'email', 'webpage', 'seed', 'gzip'))); print "Set-Cookie: $bbs_id=$cook; expires=$dateg\n"; if ($ENV{'HTTP_USER_AGENT'} =~ /MSIE (\d+)/ and $1 >= 6) { print "P3P: CP='ONL UNI CUR PUBi'\n"; } } elsif ($FORM{'action'} eq 'set_notify_mail') { &setNotifyMail; } elsif ($FORM{'action'} eq 'user_customize') { &$userCustomize if &isGzipAcceptable or &isMailUsersAllowed; } &view; sub displayMailAddress { &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FHI, $bbs_data_file and $lock->lock(*FHI, 2) or &errorUnlock("ファイルが開けません", $lock); my $name; my $mail; my $num; while ($line = ) { my $log = new logfile; $log->split($line); ($name, $mail, $num) = @$log{'name', 'mail', 'id'}; if ($FORM{'key'} eq $num) { last; } undef $name; } &error ('指定記事は見つかりませんでした') if (not defined $name); close FHI and $lock->unlock; # if (&checkIp()) { if ($IpAddr->{'isMobile'}) { # IP帯域検査 : 携帯電話 if ($terminal eq 'ez') { $mail =~ s/^\s+//; $mail =~ s/\s+$//; $menc = &ez_mail_encode($mail); $mail = qq|$mail|; } else { $mail = qq|$mail|; } } else { my $adr = $ENV{'REMOTE_ADDR'}; # &error('IPv4で接続してください') # if ($adr !~ /^\d+\.\d+\.\d+\.\d+$/); my $lastAccess = $Variables->{'vars'}->{"mail_$adr"}; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{"mail_$adr"} = time; $vars->save(); undef $vars; if (defined $lastAccess and time - $lastAccess < $accIntMail) { &error('アクセス間隔が短かすぎます'); } my $huag = $ENV{'HTTP_USER_AGENT'}; if ($huag eq 'Mozilla/4.0 (compatible; MSIE 6.0; Windows 98)' and not defined $ENV{'HTTP_ACCEPT'} and $ENV{'SERVER_PROTOCOL'} eq 'HTTP/1.0') { # 典型的な spam-bot print "Status: 403 Forbidden\n\n"; exit; } if ($huag =~ /^Microsoft URL Control\b/) { # Microsoft のブラウザエンジン (spam-bot などに多い) &error('このブラウザにはメールアドレスを表示できません'); } if ($terminal eq 'pc' and $huag =~ /MSIE/ and $huag !~ /Windows CE/ and $huag !~ /pda/i) { # MSIE のくせに Referer を返してこないのはおかしい my $ref = $ENV{'HTTP_REFERER'}; $ref =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; if (not defined $ref or $ref =~ /^\s*$/ or ($ref !~ /^$bbs_url/ and $bbs_url !~ /^$ref/)) { &error('このブラウザにはメールアドレスを表示できません'); } } $mail =~ s/\@/@<\/span>/g; $mail =~ s/\././g; } print "Cache-Control: max-age=120\n"; &error("$nameさんのメールアドレスは$mailです"); } sub reply { my $parent = $FORM{'pkey'}; my $log = new logfile; &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FHI, $bbs_data_file and $lock->lock(*FHI, 2) or &errorUnlock("ファイルが開けません", $lock); # while ($s = ) { # $log->split($s); # last if ($log->{'id'} eq $parent); # } my @mes = ; close FHI and $lock->unlock; my $self = $parent; my $root; my $childs = {}; for ($i = 0; $i <= $#mes; $i++) { my $log2 = new logfile; $log2->split($mes[$i]); $log = $log2 if $log2->{'id'} eq $parent; if ($reply_mode == 1 and $log2->{'id'} eq $self) { # my $c = $childs->{$self}; push @{$childs->{$log2->{'pkey'}}}, $log2; # $childs->{$self} = $c; $self = $log2->{'pkey'}; if (not $self) { $root = $log2; last; } } elsif ($reply_mode == 0) { if ($log2->{'pkey'} eq $self) { # my $c = $childs->{$self}; unshift @{$childs->{$self}}, $log2; # $childs->{$self} = $c; } elsif ($log2->{'id'} eq $self) { $root = $log2; last; } } } &error("返信元の記事がありません") if ($log->{'id'} ne $parent); my $subj = $log->{'subject'}; $c = 0; $c++ while ($subj =~ /Re:/ig); while ($subj =~ /Re[\^*#](\d+):/ig) { $c+=$1; } $subj =~ s/Re([\^*#]\d+)?://; $subj =~ s/^\s+//; my $res = 'Re'; my $nor = $c + 1; $res .= "^$nor" if $c > 0; $res .= ':'; # $subj = 'Re' . ($c? ('^'.$c+1) : '') . ': ' . $subj; $subj = $res . $subj; if ($terminal eq 'pc' or $terminal eq 'pda') { &view_pc_head(undef, $subj); &view_pc_body_thread($root, $childs); } else { local (@rewrite_array) = (undef, undef, undef, $subj, undef, undef); $launch = 'write_' . $terminal . '_body'; &$launch; } &$output_buffer; exit; } sub view { my (@mes, $next, $end); my ($findList, $data) = &search(); if (not defined $findList) { &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FHI, $bbs_data_file and $lock->lock(*FHI, 2) or &errorUnlock("ファイルが開けません", $lock); @mes = ; close FHI and $lock->unlock; if ($terminal eq 'pc' or $terminal eq 'pda' or ($terminal eq 'imode' and $subtype eq 'ez2')) { my $hifm; my @cacheDate; if ($hifm = $ENV{'HTTP_IF_MODIFIED_SINCE'}) { @cacheDate = &parseDateHttp($hifm); } my $mtime = $Variables->{'vars'}->{'lastModified'}; $mtime = 0 if (not defined $mtime); my ($mdate, @logDate) = &getDateRfc1123($mtime); if (defined @cacheDate and &cmpDateArray(\@cacheDate, \@logDate) >= 0) { print "Status: 304 Not Modified\n\n"; exit; } print "Last-Modified: $mdate\n"; print "Cache-Control: max-age=10\n"; } } else { my $firstArticle = $findList->[0]; foreach $log (@$findList) { push @mes, $log->join; if ($firstArticle->{'pkey'} and $firstArticle->{'pkey'} eq $log->{'id'}) { $firstArticle = $log; } } $FORM{'thread'} = $firstArticle->{'id'} if $Term->{'type'} ne 'pc' and $thread_mode and (not $FORM{'thread'} or ($FORM{'thread'} eq 't' and not exists $FORM{'pos:0'})); # delete $FORM{'thread'} if $FORM{'thread'} ne 'pc'; } $page_max = $page_max_ez_ce if $Term->{'type'} eq 'ez' and $FORM{'thread'} eq 't'; if ($#mes < 0) { &$view_head(0); &$view_body(""); $next = 0; } else { $end = $page_max - 1 + $start; $end = $#mes if ($#mes < $page_max - 1 + $start); my $num = $#mes + 1; if (defined $findList) { &$search_head($num, $data); } else { &$view_head($num); } if (not $FORM{'thread'}) { my $autoSize = ($Term->{'type'} ne "pc" and ${"${terminal}_auto"}); local $i; for ($i = $start; $i <= $end; $i++) { local $force; if ($autoSize) { $force = ($i == $start)? 1 : 0; } $char_count = 0; my $k = &$view_body($mes[$i]); if ($autoSize and $k > 0) { $end = $i - 1; $page_max = $end + 1 - $start; last; } elsif ($k < 0) { $end++; } } $next = ($#mes > $end)? 1 : 0; } else { # if ($FORM{'thread'}) { $i = 0; $c = 0; my $thread; my $prev; # my $next; my $k = 0; my $p; my $noc = {}; # Number of Children my $childs = {}; my $threadLastModified = {}; local $posThread = 0; local $sizeThread = 0; while ($i <= $#mes) { my $log = new logfile; $log->split($mes[$i]); if ($log->{'extras'} =~ /\bDelete\b/) { $i++; next; } if ($FORM{'thread'} eq $log->{'id'}) { $thread = $log; $p = $c; my $parent = $log->{'pkey'}; if ($parent) { $prev = $childs->{$parent}->[0]->{'id'} if $childs->{$parent}->[0]; } else { $prev = $rootThread[$c - 1] if $c > 0; $k = $c + 1; } } if ($log->{'pkey'}) { my $parent = $log->{'pkey'}; my @ctree = @{$childs->{$parent}}; unshift @ctree, $log; $childs->{$parent} = \@ctree; if (not exists $noc->{$parent}) { $noc->{$parent} = 0; } $noc->{$parent}++; my $x = $noc->{$log->{'id'}}; $noc->{$parent} += $x if $x > 0; if ($thread->{'pkey'} eq $parent) { $k++; } # if ($age_mode) { # my $a = $threadLastModified->{$log->{'id'}}; # if ($log->{'mail'} !~ /sage/) { # my $b = $log->{'date'}; # $a = $b if (not $a or &cmpLogDate($a, $b) < 0); # } # my $c = $threadLastModified->{$parent}; # $threadLastModified->{$parent} = $a # if $a and not $c or &cmpLogDate($a, $c) > 0; # } } else { push @roots, $log if $c >= $start and $c <= $end; $rootThread[$c] = $log->{'id'}; $log->{'TempNoC'} = $noc->{$log->{'id'}} + 1; # if ($age_mode) { # if (not exists $threadLastModified->{$log->{'id'}}) { # $threadLastModified->{$log->{'id'}} = $log->{'date'}; # } # } $c++; } $i++; } # if ($age_mode) { # @roots = sort { # &cmpLogDate($threadLastModified->{$b->{'id'}}, # $threadLastModified->{$a->{'id'}}) # } @roots; # } if ($thread and $thread->{'pkey'}) { $next = $childs->{$thread->{'pkey'}}->[$k - 2]->{'id'} if $k > 1 and $childs->{$thread->{'pkey'}}->[$k - 2]; } else { $next = $rootThread[$k]; } my $r; $end = $c - 1 if ($c < $end); $num = $c; @roots = ($thread) if $FORM{'thread'} ne 't'; $view_body_thread = "view_${terminal}_body_thread"; $view_foot_thread = "view_${terminal}_foot_thread"; foreach (@roots) { $r = &$view_body_thread($_, $childs); } $r = $posThread if $r; if ($FORM{'thread'} ne 't') { &$view_foot_thread($p, $prev, $next, $r); exit; } $next = ($end < $c - 1); =cut } else { local($i); for ($i = $start; $i <= $end; $i++) { $char_count = 0; my $k = &$view_body($mes[$i]); $end++ if ($k < 0); } } =cut } # $next = ($#mes > $end)? 1 : 0; &$view_nums($start + 1, $end + 1, $num); } &$view_foot($next); exit; } sub ageThread { # 指定のレコードが属するスレッドをageる my $list = shift; # my $num = shift; my $refKey = shift; my $childs = shift; my $roots = shift; return if ref $list ne 'ARRAY'; # or $num > $#$list; return if not $age_mode; # $num = 0 if not defined $num; # my $this = new logfile; # $this->split($list->[$num]); # return if $this->{'mail'} =~ /sage/; my $theThread = []; foreach $n (sort { $b <=> $a } @{$childs->{$refKey}}, $roots->{$refKey}) { next if not defined $n; my $log = new logfile; $log->split($list->[$n]); unshift @$theThread, (splice @$list, $n, 1); } unshift @{$list}, @{$theThread}; return $list; } sub getChildList { my $list = shift; my $refKey = shift; my $childs = {}; my $roots = {}; for (my $i = 0; $i < @$list; $i++) { my $l = $list->[$i]; my $log = new logfile; $log->split($l); if ($log->{'pkey'}) { unshift @{$childs->{$log->{'pkey'}}}, $i; if (scalar(@{$childs->{$log->{'id'}}}) > 0) { push @{$childs->{$log->{'pkey'}}}, @{$childs->{$log->{'id'}}}; } $refKey = $log->{'pkey'} if $refKey eq $log->{'id'}; } else { $roots->{$log->{'id'}} = $i; } } return $refKey, $childs, $roots; } sub remove { my @ng; &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FH, "+< $bbs_data_file" and $lock->lock(*FH, 2) or &errorUnlock("ファイルが開けません", $lock); @mes = ; unless ($#mes < 0) { my %listRemove; foreach (@remove_queue) { next if (/^\s*$/ or /[^0-9A-Za-z]/); $listRemove{$_} = 'true'; } my %haveChild; for (my $i = $#mes; $i >= 0; $i--) { my $log = new logfile; $log->split($mes[$i]); my $num = $log->{'id'}; my $pass = $log->{'pass'}; my $parent = $log->{'pkey'}; if (exists $listRemove{$parent}) { $listRemove{$num} = 'true'; $haveChild{$parent} = 'true'; } next if not exists $listRemove{$num}; my $pass1 = &certify_pass($FORM{'pass'}, $pass); my $pass2 = &certify_pass($FORM{'pass'}, $master); if ($pass2 ne $master and ($pass eq 'x' or $pass1 ne $pass)) { push @ng, $log; } else { $del{$i} = $log; } } foreach $i (sort {$b <=> $a} keys %del) { my $log = $del{$i}; if (exists $haveChild{$log->{'id'}} and $delete_parent_admin == 1 and &certify_pass($FORM{'pass'}, $master) ne $master) { push @ng, $log; } else { splice @mes, $i, 1; } } seek FH, 0, 0; print FH @mes; truncate FH, tell(FH); } close FH and $lock->unlock; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{'lastModified'} = time; my @deleted = @del{sort {$a <=> $b} keys %del}; my $list; if ($list = &canSendMail($name, $mail)) { &sendMail(\@deleted, 'delete', $list); $vars->{'vars'}->{'lastSentMail'} = time; } $vars->save(); undef $vars; &error('削除できない記事がありました. 管理人に削除してもらってください.') if @ng; } sub editMessage { my $log = shift; my $method = $ENV{'REQUEST_METHOD'}; my $referer = $ENV{'HTTP_REFERER'}; &error('POSTメソッドを使ってください') if ($method ne "POST" and $terminal ne "jsky"); # i モード Refererが返ってこない # EZweb Refererの処理がうまくいかない(謎, 相対パスで返ってくるため # J-skyweb こいつが返してくるはずがない(苦笑 # PocketIE 返さないのは仕様らしい(笑 # if ($referer_check) { # if ($terminal eq 'pc' or ($terminal eq 'ez' and $send_referer_ez)) { # まずあり得ない # $bbs_url =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # $bbs_local =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; # 環境変数をエスケープする意味はないはず if (&is_check_referer()) { my $flag = 0; $referer =~ s/\?.*$// if ($subtype eq "astel"); $referer =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; my $ref_url = ($referer =~ m|^http://|i)? $bbs_url : $bbs_local; if (($referer eq '.') || ($ref_url =~ /^$referer/i)) { $flag = 1; } $flag = 1 if ($subtype eq 'astel' and $referer eq 'x-avefront://---.push/savepage' and $allow_astel_savepage); &error(qq/"$referer"からの投稿はできません/) unless ($flag || ($referer =~ /$ref_url/i)); # } # } } &error ("名前を入力してください") if ($log->{'name'} eq ''); $log->{'subject'} = '無題' if ($log->{'subject'} eq ''); if ($log->{'pass'} =~ /\W/ || $log->{'pass'} eq ''){ if ($del_pass_mode == 3) { $log->{'pass'} = 'x'; } elsif ($terminal =~ /(imode|jsky)/) { if ($del_pass_mode == 0) { &req_rewrite(@$log{'name', 'mail', 'uri', 'subject', 'message'}); #&req_rewrite($name, $mail, $web, $subject, $message); } elsif ($del_pass_mode == 1) { $pass_made = "true"; $made_pass = &make_random_pass; $log->{'pass'} = $made_pass; } elsif ($del_pass_mode == 2) { &error ("パスワードを入力してください,削除する際に必要です"); } } else { &error ("パスワードを入力してください,削除する際に必要です"); } } if ($log->{'message'} eq '') { if ($FORM{'saveform'} eq 'true' and ($terminal eq 'imode' or $terminal eq 'jsky')) { &req_rewrite(@$log{'name', 'mail', 'uri'}, undef, undef); #&req_rewrite($name, $mail, $web, undef, undef); } else { &error ("本文を入力してください"); } } # &jcode::sjis2euc(\$mail); # &string::toAscii(\$mail); # &jcode::euc2sjis(\$mail); # &jcode::sjis2euc(\$web); # &string::toAscii(\$web); # &jcode::euc2sjis(\$web); &jc::z2h(\$log->{'mail'}); &jc::z2h(\$log->{'uri'}); $log->{'name'} =~ tr/\r\n//d; $log->{'mail'} =~ tr/\r\n//d; $log->{'uri'} =~ tr/\r\n//d; $log->{'subject'} =~ tr/\r\n//d; my $mail = $log->{'mail'}; undef $age_mode if $log->{'mail'} =~ s/("sage"|'sage'|\(sage\)|\[sage\]|[,;]sage[,;])//g; my $crypted = &encode_pass($log->{'pass'}); $log->{'message'} =~ s/\n/
/g; $log->{'mail'} = &mail_escape($log->{'mail'}) if ($log->{'mail'}); if ($log->{'uri'}) { $log->{'uri'} =~ s/^\s+//; $log->{'uri'} =~ s/\s+$//; $log->{'uri'} = &uri_escape($log->{'uri'}); if ($log->{'uri'} !~ m|^https?://|) { $log->{'uri'} = 'http://' . $log->{'uri'}; } } $log->{'pkey'} = $FORM{'pkey'} if ($FORM{'pkey'}); $log->{'pass'} = $crypted; my $mes = $log->join(); $mes .= "\n"; $mes =~ s/(\x1b\x24[EFGOPQ][\x21-\x7a]*)\&([gl])t;([\x21-\x7a]*(\x0f|\t))/$1.(($2 eq 'g')? '>' : '<').$3;/ego; $log->{'mail'} = $mail; return $mes; } sub form2Log { my $log = shift; my %f2l = ('name' => 'name', 'email' => 'mail', 'webpage' => 'uri', 'subject' => 'subject', 'message' => 'message'); foreach $k (keys %f2l) { my $v = $f2l{$k}; $log->{$v} = $FORM{$k}; } } sub escapeCammaCoron { local $_ = shift; s/([:,])/'%'.unpack('H2', $1)/eg; return $_; } sub regist_mes { my $log = new logfile; &form2Log($log); # local ($name) = ($FORM{'name'}); # local ($mail, $web) = ($FORM{'email'}, $FORM{'webpage'}); # local ($subject, $message) = ($FORM{'subject'}, $FORM{'message'}); $log->{'host'} = $ENV{'REMOTE_HOST'}; $log->{'ip'} = $ENV{'REMOTE_ADDR'}; $log->{'ua'} = $ENV{'HTTP_USER_AGENT'}; $log->{'pass'} = $FORM{'pass'}; # my ($host, $addr) = ($ENV{'REMOTE_HOST'}, $ENV{'REMOTE_ADDR'}); # my ($agent, $pass) = ($ENV{'HTTP_USER_AGENT'}, $FORM{'pass'}); if ($compat_cmt) { $log->{'id'} = sprintf "%10d", $Variables->{'vars'}->{'grossCount'}+1; } else { $log->{'id'} = &make_unique_key(); } $log->{'date'} = &get_date(); # my $ukey = &make_unique_key(); # my $date = &get_date(); if ($terminal eq 'pc' or $terminal eq 'pda') { # my $adr = $ENV{'REMOTE_ADDR'}; my $adr = $log->{'ip'}; if ($adr =~ /^\d+\.\d+\.\d+\.\d+$/) { my $lastAccess = $Variables->{'vars'}->{"post_$adr"}; if (defined $lastAccess and time - $lastAccess < $accIntPost) { &error('アクセス間隔が短かすぎます'); } } } if ($restricted_words ne '') { my @word_list = split /\s+/, $restricted_words; @word_list = map { "\Q$_\E"; } @word_list; local $_ = join "" => @$log{'name', 'mail', 'uri', 'subject', 'message'}; my $code = &build_or(@word_list); $result = &$code; &error('禁止語句がありますので投稿を拒否しました.') if ($result); } if ($write_limit eq 'master') { my $result = &certify_pass($log->{'pass'}, $master); &error('管理者でないと投稿できません. ') if ($result ne $master); } if ($restrict_size and $restrict_size > 0) { my $count = length(join "" => @$log{'name', 'mail', 'uri', 'subject', 'message'}); # my $count = length($name) + length($mail) + length($web); # $count += length($subject) + length($message); if ($count > $restrict_size * 1024) { &error("投稿記事が制限サイズを超えました. "); } } if ($restrict_newline and $restrict_newline > 0) { my $s = join "" => @$log{'name', 'mail', 'uri', 'subject', 'message'}; my $count = $s =~ tr/\n/\n/; # my $count = $name =~ tr/\n/\n/; # $count += $mail =~ tr/\n/\n/; # $count += $web =~ tr/\n/\n/; # $count += $subject =~ tr/\n/\n/; # $count += $message =~ tr/\n/\n/; if ($count > $restrict_newline) { &error("記事の改行が多すぎます. "); } } if ($terminal eq "jsky") { $xjmsn = $ENV{'HTTP_X_JPHONE_MSNAME'}; $xjcol = $ENV{'HTTP_X_JPHONE_COLOR'}; $xjdsp = $ENV{'HTTP_X_JPHONE_DISPLAY'}; $xjsnd = $ENV{'HTTP_X_JPHONE_SOUND'}; if ($log->{'ua'} =~ /^\s*$/) { $log->{'ua'} = "J-PHONE/1.0/$xjmsn ($xjdsp; $xjcol; $xjsnd; pseudo)"; } else { $log->{'ua'} .= "($xjdsp; $xjcol; $xjsnd)"; } } # メールアドレスの補完?ezとjskyは要チェック if ($log->{'mail'} !~ /(\@|@|\bsage\b|^\s*$)/ and ($terminal eq 'imode' or $terminal eq 'jsky' or $terminal eq 'ez')) { my $mail = $log->{'mail'}; if ($terminal eq 'imode' and ($subtype eq 'imode' or $subtype eq 'paldio' or $subtype eq 'foma')) { $mail .= '@docomo.ne.jp'; } else { my $h = $log->{'host'}; if ($h eq $log->{'ip'}) { $h = gethostbyaddr(pack('C4', split(/\./, $h)),2) || $log->{'ip'}; } $h =~ /(([^.]+)\.)?([^.]+)\.([^.]+)\.([a-zA-Z]+)\.?$/; $domain = "$3.$4.$5"; $low_domain = $1; if ($terminal eq "jsky") { $mail .= '@' . $domain; } elsif ($terminal eq "ez" or ($terminal eq 'imode' and $subtype eq 'ez2')) { $low_domain =~ s/^(.+)proxy.*$/$1/; $mail .= '@' . $low_domain . $domain; } } $log->{'mail'} = $mail; } if ($FORM{'pnum'} and $compat_cmt) { # my ($id, $mes) = &convertKeyToNum; $log->{'pkey'} = $FORM{'pnum'}; # $mes->[$FORM{'pnum'}]->{'id'}; } my $mes = &editMessage($log); # my $mes = &edit_mes_line ($host, $addr, $agent, $date, $pass, $ukey); &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FH, "+< $bbs_data_file" and $lock->lock(*FH, 2) or &errorUnlock("ファイルが開けません", $lock); =cut my $i = 1; my @new = ""; my @to_save; if ($save_log) { foreach() { if ($i < $regist_max) { $i++; push @new, $_; } else { push @to_save, $_; } } } else { foreach() { last if ($i >= $regist_max); $i++; push @new, $_; } } =cut @new = ; if (&check_double_post($new[1], $mes)) { close FH; &errorUnlock("投稿内容が同一です. 二重投稿はできません.", $lock); } unshift @new, $mes; my @toLog; my ($theKey, $childs, $roots) = &getChildList(\@new, $log->{'pkey'}); @new = @{&ageThread(\@new, $theKey, $childs, $roots)} if $age_mode; my $mod = scalar(@new) - $regist_max; my $x = $#new; my $out = []; while($mod > 0) { my $log = new logfile; $log->split($new[$x--]); my $id = $log->{'id'}; my @tmp; push @tmp, @{$childs->{$id}} if exists $childs->{$id} and defined @{$childs->{$id}}; push @tmp, $roots->{$id} if exists $roots->{$id}; push @$out, @tmp if (scalar(@tmp) > 0); $mod -= scalar(@tmp); } if ($save_log) { foreach $n (sort { $b <=> $a } @$out) { unshift @toLog, (splice @new, $n, 1); } } seek FH, 0, 0; print FH @new; truncate FH, tell(FH); close FH and $lock->unlock; &saveLogFile(@toLog) if $save_log and scalar(@toLog) > 0; # my $lsmDate = &get_date($Variables->{'vars'}->{'lastSentMail'}); # my @mailArray; # foreach $l (@new) { # my $log = new logfile; # $log->split($l); # my $d = $log->{'date'}; # push @mailArray, $log if &cmpLogDate($lsmDate, $d) < 0; # } my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); my $adr = $log->{'ip'}; #$ENV{'REMOTE_ADDR'}; $vars->{'vars'}->{"post_$adr"} = time; $vars->{'vars'}->{'lastModified'} = time; # &file_unlock("$bbs_data_file"); # &send_mail(&combine_data()) if (&can_send($name, $mail)); =cut if (&can_send($log->{'name'}, $log->{'mail'})){ &send_mail(&combineData($log)); $vars->{'vars'}->{'lastSentMail'} = time; } =cut my $list; if ($list = &canSendMail($log->{'name'}, $log->{'mail'})) { &sendMail($log, 'regist', $list); $vars->{'vars'}->{'lastSentMail'} = time; } my $gCount = $#new - 1; $gCount = $Variables->{'vars'}->{'grossCount'} if exists $Variables->{'vars'}->{'grossCount'}; $vars->{'vars'}->{'grossCount'} = ++$gCount; $vars->save(); undef $vars; # &save_log_file(@to_save) if ($#to_save >= 0 and $save_log); $isGzip = $COOKIE{'gzip'}; %COOKIE = ('name' => $log->{'name'}, 'email' => $log->{'mail'}, 'webpage' => $log->{'uri'}, 'seed' => $FORM{'pass'}); $COOKIE{'gzip'} = $isGzip if $isGzip; #$name = &url_encode($name); #$mail = &url_encode($mail); #$web = &url_encode($web); $dateg = &getDateCookie(); # $dateg = &get_date_cookie(); # クッキー削除には過去の日付を指定 # $dateg = "Sun, 01-Jan-1995 01:00:00 GMT"; # EZweb搭載のUP.Browserはカンマ区切りクッキーをうまく受け付けない # ...エスケープしましょう my $cook = &escapeCookie(join ',' => (map { $_.':'.&escapeCammaCoron($COOKIE{$_}) } keys %COOKIE)); # i-modeはクッキーをセットできないのでパケットの無駄 if ($terminal ne 'jsky' and ($terminal ne 'imode' or $subtype eq 'ez2')) { print "Set-Cookie: $bbs_id=$cook; expires=$dateg\n" } # unless ($terminal =~ /(imode|jsky)/); if ($terminal eq 'pc' and $ENV{'HTTP_USER_AGENT'} =~ /MSIE (\d+)/ and $1 >= 6) { # Privacy policy for IE6 or higher print "P3P: CP='ONL UNI CUR PUBi'\n"; } # $COOKIE{'name'} = &unescape($name); # $COOKIE{'email'} = &unescape($mail); # $COOKIE{'webpage'} = &unescape($web); # $COOKIE{'seed'} = $pass; # 告知方法を考える $announce =<<"EOA"; 削除パスは$made_passです.
[了解]
EOA $announce =~ s/(]+)directkey="([\d\*\#])">/$2\.${1}accesskey="$2">/; &error("$announce") if ($pass_made eq "true"); $start = 0; if ($FORM{'saveform'} eq 'true' and ($terminal eq 'imode' or $terminal eq 'jsky')) { # my $name = &unescape($name); # my $mail = &unescape($mail); # my $web = &unescape($web); &req_rewrite(@$log{'name', 'mail', 'uri'}, undef, undef); # &req_rewrite($name, $mail, $web, undef, undef); } #&view; } sub req_rewrite { local (@rewrite_array) = @_; $launch = 'write_' . $terminal . '_body'; wait if $canFork and $ChildPid; &$launch; } sub changeLine { my $log = shift; # my $mesArray = shift; &form2Log($log); $log->{'pass'} = $FORM{'pnew'}; $log->{'date'} = &get_date(); my $mes = &editMessage($log); # my $lsmDate = &get_date($Variables->{'vars'}->{'lastSentMail'}); # my @mailArray = ($log); # foreach $l (@$mesArray) { # my $log = new logfile; # $log->split($l); # my $d = $log->{'date'}; # push @mailArray, $log if &cmpLogDate($lsmDate, $d) < 0; # } my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{'lastModified'} = time; =cut if (&can_send($name, $mail)){ &send_mail(&combine_data(), 1); $vars->{'vars'}->{'lastSentMail'} = time; } =cut my $list; if ($list = &canSendMail($name, $mail)) { &sendMail($log, 'change', $list); $vars->{'vars'}->{'lastSentMail'} = time; } $vars->save(); undef $vars; return ($mes); } sub modify { &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FH, "+< $bbs_data_file" and $lock->lock(*FH, 2) or &errorUnlock("ファイルが開けません", $lock); @mes = ; my $pkey; unless ($#mes < 0) { for ($i = 0; $i < scalar(@mes); $i++) { my $log = new logfile; $log->split($mes[$i]); close FH and &errorUnlock("この記事は修正できません.", $lock) if ($log->{'pass'} eq 'x'); if ($FORM{'mod'} eq $log->{'id'}) { my $pass1 = &certify_pass($FORM{'pass'}, $log->{'pass'}); my $pass2 = &certify_pass($FORM{'pass'}, $master); close FH and &errorUnlock("パスワードの認証に失敗しました", $lock) if (($pass1 ne $log->{'pass'}) && ($pass2 ne $master)); if ($FORM{'name'} and $FORM{'message'}) { $mes[$i] = &changeLine($log); #($mes[$i], \@mes); $pkey = $log->{'pkey'}; } else { $log->{'pass'} = $FORM{'pass'}; return @$log{'subject', 'name', 'mail', 'uri', 'message', 'pass', 'id'}; } } } my ($theKey, $childs, $roots) = &getChildList(\@mes, $pkey); @mes = @{&ageThread(\@mes, $theKey, $childs, $roots)} if $age_mode; seek FH, 0, 0; print FH @mes; truncate FH, tell(FH); close FH and $lock->unlock; #&view; &reloadPage(); } } sub found { my ($str, $logic, @keys) = @_; my ($sc, $wc); $sc = '[\x00-\x7F]'; $wc = '[\x81-\x9F\xE0-\xFA][\x40-\x7E\x80-\xFB]'; my $match; if ($logic) { $match = 0; foreach $k (@keys) { $match = 1 if ($str =~ /^(?:$sc|$wc)*?$k/i); } } else { $match = 1; foreach $k (@keys) { $match = 0 unless ($str =~ /^(?:$sc|$wc)*?$k/i); } } return ($match); } sub search { #my (@new, @mes, $logic, $query, $key, $data, $logic_str, @keys); return undef if not $FORM{'q'}; my $logic = ($FORM{'l'} eq "or")? 1 : 0; my $query = $FORM{'q'}; $query =~ s/ / /go; my $key = $query; $key =~ s//>/go; $key =~ s/\"/"/go; $key =~ s/\&/&/go; $query =~ s/(\W)/\\$1/go; my @keys = split(/\\\s+/o, $query); my $logic_str = ($logic)? "OR" : "AND"; my $data; ($data = $key) =~ s/ /$logic_str/go; $global_logic_formula = $data; &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FHI, $bbs_data_file and $lock->lock(*FHI, 2) or &errorUnlock("ファイルが開けません", $lock); my @extractList; my %parentList; while ($_ = ) { my $log = new logfile; $log->split($_); my $str = join "\t" => @$log{'subject', 'name', 'mail', 'uri', 'message'}; next if $log->{'extras'} =~ /\bDelete\b/; if (&found($str, $logic, @keys) or $parentList{$log->{'id'}}) { push @extractList, $log; $parentList{$log->{'pkey'}} = 1 if $log->{'pkey'}; } } close FHI and $lock->unlock; if ($#extractList < 0) { if ($terminal ne "pc") { $data = $key; } &error("$data は発見できませんでした."); } return \@extractList, $data; } sub make_new { my $outfile = "$bbs_data_file.$$"; open FHO, "> $outfile" or &error("ファイルが開けません"); truncate FHO, 0; close FHO; if (not rename $outfile, $bbs_data_file) { unlink $outfile; } else { chmod $permit_on_create, "$bbs_data_file"; } } sub set_master_mode { if ($COOKIE{'authorize'} =~ /^\s*$/) { if ($FORM{'authorize'} !~ /^\s*$/) { $COOKIE{'authorize'} = $FORM{'authorize'}; } else { $FORM{'next_act'} = "ch_master"; &$author if ($master); # if(($terminal =~ /(pc|imode|jsky|ez)/) && ($master ne "")); } } if ($limit_mode && ($COOKIE{'authorize'} ne $master)) { $FORM{'next_act'} = "ch_master"; &$author("管理人モードに入るには管理パスワードが必要です. "); } my $dispatcher = 'set_master_mode_' . $terminal; &$dispatcher(); } sub set_master { my $salt = ($master =~ /^\$1\$/)? 3 : 0; if ($FORM{'new1'} eq '' && $FORM{'new2'} eq '') { &error('入力してください'); } elsif ($master eq '' && ($FORM{'new1'} eq '' || $FORM{'new2'} eq '')) { &error('新パスワードは確認も含めて2回入力してください'); } elsif ($FORM{'new1'} ne $FORM{'new2'}) { &error('確認のために入力したパスワードが一致しません'); } elsif ($FORM{'new1'} =~ /\s/ || $FORM{'new1'} =~ /\W/) { &error('半角英数字で入力してください'); } elsif (length "$FORM{'new1'}" > 8 || length "$FORM{'new1'}" < 4) { &error('4文字から8文字で入力してください'); } elsif ($master ne '') { if ($terminal !~ /(pc|imode|jsky|ez)/) { $authorize = &certify_pass($FORM{'old'}, $master); } else { $authorize = ($FORM{'authorize'})? $FORM{'authorize'} : $COOKIE{'authorize'}; } if ($authorize ne $master) { if ($terminal =~ /(pc|imode|jsky|ez)/) { $FORM{'next_act'} = "ch_master"; &$author('パスワードの認証に失敗しました. ' . 'パスワードを入れ直してください.'); } &error('旧パスワードが認証されませんでした'); } } my $crypted = &encode_pass($FORM{'new1'}); $master = $crypted; my $exist_file = -e $master_key_file; =cut &file_lock("$master_key_file"); open (MKEY, "> $master_key_file") || &error('管理パスワードを記録できません.', $master_key_file); print MKEY $crypted; close MKEY; chmod $permit_on_create, $master_key_file unless ($exist_file); &file_unlock("$master_key_file"); =cut if (not -e $master_key_file) { my $outfile = "$master_key_file.$$"; open FHO, "> $outfile" or &error("ファイルが開けません"); truncate FHO, 0; close FHO; if (not rename $outfile, $master_key_file) { unlink $outfile; } else { chmod $permit_on_create, "$master_key_file"; } } my $lock = new locker($master_key_file, $lockArgs); open FH, "+< $master_key_file" and $lock->lock(*FH, 2) or &errorUnlock("管理パスワードを記録できません. ", $lock); seek FH, 0, 0; print FH $crypted; truncate FH, tell(FH); close FH and $lock->unlock; my $expires; if ($cook_initial > 0) { $ct = $cook_initial if ($cook_initial); my $exp_date_g = &get_gmt($ct*60*60); $expires = "; expires=$exp_date_g"; } print "Set-Cookie: Authorize=$master$expires\n" unless ($terminal =~ /(imode|jsky)/); $COOKIE{'authorize'} = $master; } sub set_init_mode { if ($COOKIE{'authorize'} =~ /^\s*$/) { if ($FORM{'authorize'} !~ /^\s*$/) { $COOKIE{'authorize'} = $FORM{'authorize'}; } else { $FORM{'next_act'} = "ch_init"; &$author();# if ($terminal =~ /(pc|imode|jsky|ez)/); } } if ($limit_mode && ($COOKIE{'authorize'} ne $master)) { $FORM{'next_act'} = "ch_init"; &$author("管理人モードに入るには管理パスワードが必要です. "); } $launch = "set_init_mode_" . $terminal; &$launch;# if ($terminal =~ /(pc|imode|jsky|ez)/); &error('各種設定はPCから行ってください.'); } sub set_init { my ($email_send_flag) = $FORM{'email_send'}; unless ($FORM{'authorize'}) { $FORM{'authorize'} = $COOKIE{'authorize'}; } if ($FORM{'authorize'} ne $master) { $FORM{'next_act'} = "ch_init"; &$author('パスワードの認証に失敗しました. ' . 'パスワードを入れ直してください.'); } $FORM{'ac_mark'} = 0 unless (defined $FORM{'ac_mark'}); $FORM{'ac_public'} = 0 unless (defined $FORM{'ac_public'}); my $exist_file = -e $init_file; &file_lock("$init_file"); &save_init($init_file, $init_exist); chmod $permit_on_create, $init_file unless ($exist_file); &file_unlock("$init_file"); $init_exist = &load_init($init_file); my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); if ($must_view_before_regist and $Term->{'type'} eq 'pc') { my $adr = $ENV{'REMOTE_ADDR'}; $vars->{'vars'}->{"view_$adr"} = time; } $vars->{'vars'}->{'lastModified'} = time; $vars->save(); if ($thread_mode and $FORM{'thread'} !~ /^(f(alse)?|no?(ne)?)$/i) { $FORM{'thread'} = 't'; } elsif (not $thread_mode) { delete $FORM{'thread'}; } $launch = "set_init_mode_${terminal}2"; &$launch if (($terminal =~ /(imode|jsky)/) && ($email_send_flag)); } sub set_color_mode { if ($COOKIE{'authorize'} =~ /^\s*$/) { if ($FORM{'authorize'} !~ /^\s*$/) { $COOKIE{'authorize'} = $FORM{'authorize'}; } else { $FORM{'next_act'} = "ch_color"; &$author if(($terminal =~ /pc/) && ($master ne "")); } } if ($limit_mode && ($COOKIE{'authorize'} ne $master)) { $FORM{'next_act'} = "ch_color"; &$author("管理人モードに入るには管理パスワードが必要です. "); } &set_color_mode_pc() if ($terminal =~ /pc/); &error('各種設定はPCから行ってください.'); } sub set_color { unless ($FORM{'authorize'}) { $FORM{'authorize'} = $COOKIE{'authorize'}; } if ($FORM{'authorize'} ne $master) { $FORM{'next_act'} = "ch_color"; &$author('パスワードの認証に失敗しました. ' . 'パスワードを入れ直してください.'); } my $exist_file = -e $init_file; &file_lock("$init_file"); &save_color($init_file, $init_exist); chmod $permit_on_create, $init_file unless ($exist_file); &file_unlock("$init_file"); $init_exist = &load_init($init_file); } sub set_about_mode { if ($COOKIE{'authorize'} =~ /^\s*$/) { if ($FORM{'authorize'} !~ /^\s*$/) { $COOKIE{'authorize'} = $FORM{'authorize'}; } else { $FORM{'next_act'} = "ch_about"; &$author if(($terminal =~ /pc/) && ($master ne "")); } } if ($limit_mode && ($COOKIE{'authorize'} ne $master)) { $FORM{'next_act'} = "ch_about"; &$author("管理人モードに入るには管理パスワードが必要です. "); } &set_about_pc() if ($terminal =~ /pc/); &error('概要設定はPCから行ってください.'); } sub set_about { unless ($FORM{'authorize'}) { $FORM{'authorize'} = $COOKIE{'authorize'}; } if ($FORM{'authorize'} ne $master) { $FORM{'next_act'} = "ch_about"; &$author('パスワードの認証に失敗しました. ' . 'パスワードを入れ直してください.'); } my $exist_file = -e $about_data_file; &file_lock("$about_data_file"); &save_about($about_data_file); chmod $permit_on_create, $about_data_file unless ($exist_file); &file_unlock("$about_data_file"); } sub get_counter { my $count = 0; my $lock = new locker($counter_file, $lockArgs); if (-e $counter_file) { open FH, $counter_file and $lock->lock(*FH, 1) or return undef; $count = ; close FH and $lock->unlock; chomp $count; } return $count; } sub increase_counter { my $count; my $lock = new locker($counter_file, $lockArgs); if (-e $counter_file) { open FH, "+< $counter_file" and $lock->lock(*FH, 2) or return undef; $count = ; seek(FH, 0, 0); } else { open FH, "> $counter_file" and $lock->lock(*FH, 2) or return undef; $count = 0; } $count++; print FH $count; close FH and $lock->unlock; chmod $permit_on_create, $counter_file if ($count == 1); return $count; } sub errorUnlock { my $str = shift; my $lock = shift; $lock->unlock; &error($str); } sub error_unlock_dat { my ($string) = @_; &error($string, "$bbs_data_file"); } sub error { my ($str, $filename) = @_; my $err_func = 'error_' . $terminal; &$err_func($str); unlink $filename . ".lock" if ((defined $filename) && (-e "$filename.lock")); wait if $canFork and $ChildPid; exit; } sub checkAuth { my $next = shift; if ($COOKIE{'authorize'} =~ /^\s*$/) { if ($FORM{'authorize'} !~ /^\s*$/) { $COOKIE{'authorize'} = $FORM{'authorize'}; } else { $FORM{'next_act'} = $next; &$author(); } } if ($COOKIE{'authorize'} ne $master) { $FORM{'next_act'} = $next; return undef; } return 1; } sub cleaning { my $c = 0; my $x = 0; my @ok; my @ng; my @dl; &$author("管理者権限が必要です. ") if (not &checkAuth('cleaning')); &error('処理対象の記事がありません.') unless (-e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FHI, "+< $bbs_data_file" and $lock->lock(*FHI, 2) or &errorUnlock('ファイルが開けません', $lock); my $result = open FHO, "> $bbs_data_file.bak"; while () { print FHO $_ if $result; my $log = new logfile; $log->split($_); my $v = $log->isValid; if (not $v) { $c++; push @ng, $_; next; } elsif ($log->{'extras'} =~ /\bDelete\b/) { $x++; push @dl, $_; next; } push @ok, $_; } seek FHI, 0, 0; print FHI @ok; truncate FHI, tell(FHI) or &error('ファイルの操作に失敗しました. truncate()が実装されていません.'); close FHI and $lock->unlock; close FHO if $result; if ($c > 0 or $x > 0) { if ($c > 0) { &error($c.'個の正常でない記事を削除しました
削除した記事は以下の通り
'.(join "\n" => @ng)); } if ($x > 0) { &error($x.'個の削除予約記事を削除しました
削除した記事は以下の通り
'.(join "\n" => @dl)); } } else { &error('削除対象は発見されませんでした.'); } } # 投稿直後の再投稿を防ぐ sub reloadPage { return if ($terminal eq 'ez'); my $arg; if ($subtype eq 'ez2') { $arg = "rld=t"; } if ($FORM{'thread'}) { $arg .= '&' if $arg; $arg .= "thread=t"; } print "Status: 302 Found\n"; my $loc = 'http://'.$ENV{'SERVER_NAME'}.$ENV{'SCRIPT_NAME'}.'?'.$arg; print "Location: $loc\n"; print "URI-header: $loc\n\n"; wait if $canFork and $ChildPid; exit; } sub editAccessList { my @ip = @_; my $str; my %v = ('allow' => 'allow', 'deny' => 'deny', 'deny_write' => 'prohibit'); my $k = $v{$FORM{'mode'}}; print "Content-Type: text/plain\n\n"; my @list = split /,/, $Variables->{'vars'}->{$k}; foreach $adr (@ip) { $adr =~ s/^\s+//; $adr =~ s/\s+$//; if ($adr =~ /\s/) { push @list, (split /\s/, $adr); } else { push @list, $adr; } print $adr, "\n"; } $str = join ',' => @list; print $str; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{$k} = $str; $vars->save(); } sub setIpList { &$author("管理者権限が必要です. ") if (not &checkAuth('set_iplist')); my @iplist = @{$FORM{'ip'}}; &editAccessList(@iplist) if ($#iplist >= 0); &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FHI, $bbs_data_file and $lock->lock(*FHI, 2) or &errorUnlock("ファイルが開けません", $lock); @mes = ; close FHI and $lock->unlock; if ($#mes < 0) { &iplist_head(); &$view_body(undef, 'iplist'); $next = 0; } else { $end = $page_max - 1 + $start; $end = $#mes if ($#mes < $page_max - 1 + $start); my $num = $#mes + 1; &iplist_head(); for (my $i = $start; $i <= $end; $i++) { &$view_body($mes[$i], 'iplist'); } $next = ($#mes > $end)? 1 : 0; } &iplist_foot($next); exit; } sub deleteAccessList { my @ip = @_; my $str; foreach $adr (@ip) { $adr =~ /^(a|d|p):(.*)$/; $del_ip{$1}->{$2} = 'true'; } my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); foreach $k ('allow', 'deny', 'prohibit') { my @list = split /,/, $Variables->{'vars'}->{$k}; my $cap = substr($k, 0, 1); my @new; foreach (@list) { if ($del_ip{$cap}->{$_} eq 'true') { next; } push @new, $_; } $str = join ',' => @new; $vars->{'vars'}->{$k} = $str; $Variables->{'vars'}->{$k} = $vars->{'vars'}->{$k}; } $vars->save(); } sub listIp { &$author("管理者権限が必要です. ") if (not &checkAuth('list_ip')); my @iplist = @{$FORM{'ip'}}; &deleteAccessList(@iplist) if (defined @iplist); &list_pc_ip(); exit; } sub markInvalidate { &make_new() if (not -e $bbs_data_file); my $lock = new locker($bbs_data_file, $lockArgs); open FH, "+< $bbs_data_file" and $lock->lock(*FH, 2) or &errorUnlock("ファイルが開けません", $lock); @mes = ; unless ($#mes < 0) { my %listRemove; foreach (@remove_queue) { next if (/^\s*$/ or /[^0-9A-Za-z]/); $listRemove{$_} = 'true'; } foreach (@mes) { my $log = new logfile; $log->split($_); my $id = $log->{'id'}; next if not exists $listRemove{$id}; my $e = \$log->{'extras'}; if ($$e) { $$e .= ',Delete'; } else { $$e = 'Delete'; } $_ = $log->join . "\n"; } seek FH, 0, 0; print FH @mes; truncate FH, tell(FH); } close FH and $lock->unlock; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{'lastModified'} = time; $vars->save(); undef $vars; } sub invalidate { &$author("管理者権限が必要です. ") if (not &checkAuth('invalidate')); &markInvalidate(@remove_queue) if ($#remove_queue >= 0); my $launch = "invalidate_$terminal"; &$launch; } sub setNotifyMail { my $strPass = ($terminal eq 'pc')? 'パスワード' : '暗証番号'; my $email = $FORM{'email'}; if ($FORM{'mode'} eq 'add') { my $msg = qq|入力されたメールアドレス$email|; my $set = $Variables->{'vars'}->{$email}; &error ("$msgはすでに登録されています。") if $set; &$userCustomize("$msgは正しいメールアドレスではありません。入力し直してください。") if $email =~ /^\s*$/ or $email !~ /^[a-z0-9\-\._]+\@[a-z0-9\-\._]+\.[a-z]{2,3}$/i; my $id = &make_unique_key; my $pass = &encode_pass($FORM{'pass'}); &$userCustomize($strPass.'を入れてください。配信を解除したり、設定を変更するのに必要です。') if not $FORM{'pass'}; my $name = $FORM{'name'}; my $mail = $FORM{'mail'}; $name =~ tr/ /;/; $mail =~ tr/ /;/; my $tzs = $FORM{'tz_begin'}; my $tze = $FORM{'tz_end'}; &$userCustomize('配信時間帯には数字を入れるか、空白にしてください') if $tzs =~ /[^0-9]/ or $tze =~ /[^0-9]/; my $vbs = $FORM{'verbose'}; if (&sendCheckMail($email, $id)){ my $userMailList = $Variables->{'vars'}->{'userMailList'}; my @adrs = split /,/, $userMailList; push @adrs, $FORM{'email'}; $userMailList = join ',' => @adrs; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{$email} = join ',' => ($id, $pass, $name, $mail, $tzs, $tze, $vbs); $vars->{'vars'}->{'userMailList'} = $userMailList; $vars->save(); &error('確認メールを送信しました。メールに書かれたURLへアクセスして配信を開始してください。') } &error('確認メールが送れませんでした。'); } elsif ($FORM{'mode'} eq 'change') { my $set = $Variables->{'vars'}->{$email}; ($id, $pass) = (split /,/, $set)[0,1]; &error('入力されたメールアドレスは登録されていないか、配信開始されていません') if not $set or $id ne 'true'; my $pass1 = &certify_pass($FORM{'pass'}, $pass); &error($strPass.'が違います') if $pass1 ne $pass; my $name = $FORM{'name'}; my $mail = $FORM{'mail'}; $name =~ tr/ /;/; $mail =~ tr/ /;/; my $tzs = $FORM{'tz_begin'}; my $tze = $FORM{'tz_end'}; &$userCustomize('配信時間帯には数字を入れるか、空白にしてください') if $tzs =~ /[^0-9]/ or $tze =~ /[^0-9]/; my $vbs = $FORM{'verbose'}; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{$email} = join ',' => ($id, $pass, $name, $mail, $tzs, $tze, $vbs); $vars->save(); &error('設定は変更されました'); } elsif ($FORM{'mode'} eq 'delete') { my $set = $Variables->{'vars'}->{$email}; ($id, $pass) = (split /,/, $set)[0,1]; &error('入力されたメールアドレスは登録されていません') if not $set or $id ne 'true'; my $pass1 = &certify_pass($FORM{'pass'}, $pass); &error($strPass.'が違います') if $pass1 ne $pass; my $userMailList = $Variables->{'vars'}->{'userMailList'}; my @adrs = split /,/, $userMailList; for ($i = 0; $i < scalar(@adrs); $i++) { splice @adrs, $i, 1 if $adrs[$i] eq $FORM{'email'}; } $userMailList = join ',' => @adrs; undef $userMailList if $userMailList =~ /^(\s|,)*$/; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'delete'}->{$email}; $vars->{'vars'}->{'userMailList'} = $userMailList; $vars->save(); &error('配信を解除しました'); } else { my $email = $FORM{'email'}; my $key = $FORM{'key'}; my $set = $Variables->{'vars'}->{$email}; ($id, $pass,@sets) = split /,/, $set; &error('メールアドレスが登録されていないか、登録情報が一致しません') if not $set or not $key or $id ne $key; $id = 'true'; my $vars = new vars($bbs_vars_file, $permit_on_create, $lockArgs); $vars->{'vars'}->{$email} = join ',' => ($id, $pass, @sets); $vars->save(); &error('配信を開始しました'); } }