#!/usr/local/bin/perl #----------------------- # 設定読み込み $password = 'tonboku'; $ini_file = 'us.ini'; $Build = "#022"; # build #022 perl4に完全対応。 #----------------------- # 最初にすること &load_lib( $ini_file ); # フォーム値取得。get/post両用 read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'} ); $buffer = $ENV{'QUERY_STRING'} if( !$buffer ); if( length($buffer) > $MaxBufSize ){ &SetMessage("書き込みサイズが大きすぎます。"); &putMainWindow; exit; } if($buffer){ &getCookie; if( $buffer =~ /^res(\d+)$/ ){ &putResWindow($1); exit; } # nextAct is 'wRes656' << データロード? if( $buffer =~ /^del(\d+)$/ ){ &putDelWindow($1); exit; } # nextAct is 'wDel656' &ioBufDecode; &putCookie if( $F{'act'} =~ /^(wParent|wRes)/); if( $F{'act'} =~ /^wParent$/ ){ &ioDataWrite(); &putMainWindow; exit; } if( $F{'act'} =~ /^wRes(\d+)$/ ){ &ioDataWrite($1); &putResultWindow; exit; } if( $F{'act'} =~ /^wDel(\d+)$/ ){ &ioDataDelete($1); &putResultWindow; exit; } # << pass check! &putMainWindow; exit; } else{ &getCookie; &putMainWindow; } 1; #--- # decode.pl #--- sub ioBufDecode{ #------------------------ # フォーム値のデコード &load_lib( $Jcode ); &load_lib( $NtcPL ) if( $ArrowTags || $AutoLink ); local(@pairs); @pairs = split(/&/,$buffer); foreach(@pairs){ ($name, $value) = split(/=/); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/\r\r/\n/go; $value =~ s/\r\n/\n/go; $value =~ s/\n/
/go; #------------------- # 文字コード変換 if( $CodeEUC ){ &jcode'h2z_euc(*value); &jcode'convert(*value,'euc'); } else{ &jcode'h2z_sjis(*value); &jcode'convert(*value,'sjis'); } $value =~ s/\,/,/g; #------------------- # タグの処理 if( $ArrowTags ){ &ntc'tag(*value,$CheckTags,$CheckScript, 0) if( $name ne 'value' ); #リンクしない &ntc'tag(*value,$CheckTags,$CheckScript,$AutoLink) if( $name eq 'value' ); #リンクする } else{ $value =~ s/
/\t/igo; $value =~ s/\/>/go; $value =~ s/\t/
/go; &ntc'tag(*value,$CheckTags,$CheackScript,$AutoLink) if( $name eq 'value' && $AutoLink ); } #------------------- # ハッシュ代入 $F{$name} = $value; } # グローバル変数 $F{'name'} = $F{'name'} || $NoName; $F{'title'} = $F{'title'} || $NoTitle; $F{'web'} = '' if ( $F{'web'} !~ m|^http://(.+)\.(.+)$| ); $F{'email'} = '' if ( $F{'email'} !~ m|^(.+)@(.+)\.(.+)$| ); } 1; #--- # error.pl #--- sub SetMessage{ $Message .= shift(@_); $Message .= "
\n"; $C{'title'} = $F{'title'}; $C{'value'} = $F{'value'}; $C{'value'} =~ s/
/\n/ig; } sub FE{ local($FileName) = shift(@_); &error("ファイルのオープンに失敗しました。($FileName: $!)" ); } sub error{ $Build = '#---' if(!$Build); print "Content-type: text/html\n\n"; print "\n"; print " エラーが発生しました \n\n"; print "
\n". "
Mimic Board $Build
\n". "(c) 1999 Nobutaka Makino
"; print ""; exit; } 1; #--- # cookie.pl #--- # フォーマットがおかしかったのを修正。 # %Fの値をそのまま使っていたのを修正。 # (参考) http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt sub getCookie{ #------------------------ # クッキーの解析 / @Cookiesに値を返す return if( $CookieSet ); # 既に[%C]がセットされている local( $cooks, $CookValue, @Cooks ); $cooks = $ENV{'HTTP_COOKIE'}; $cooks =~ s/; /;/g; foreach ( split(/;/,$cooks) ){ if( /^$CookName=(.+)$/ ){ $CookValue = $1; $CookValue =~ s/%3B/;/g; ( @Cooks ) = split( /::/,$CookValue ); last; } } $C{'name'} = $Cooks[0]; $C{'email'} = $Cooks[1]; $C{'web'} = $Cooks[2] || 'http://'; } sub putCookie{ #------------------------ # クッキーを焼く local($CookValue,$date); local(@values) = ($F{'name'},$F{'email'},$F{'web'}); $CookLimit = '-999' if( !@values ); local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time + $CookLimit); $year = sprintf( "%04d", $year + 1900 ); # 2000年問題対応(2) $sec = sprintf( "%02d", $sec ); $min = sprintf( "%02d", $min ); $hour = sprintf( "%02d", $hour ); $mday = sprintf( "%02d", $mday ); $wday = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat') [$wday]; $mon = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec')[$mon]; $date = "$wday, $mday\-$mon\-$year $hour:$min:$sec GMT"; # セパレータ[;][::]をエンコードしておく for( @values ){ s/;/%3B/g; s/\::/::/g; } $CookValue = join('::',@values); print "Set-Cookie: $CookName=$CookValue; expires=$date\n"; $C{'name'} = $values[0]; $C{'email'} = $values[1]; $C{'web'} = $values[2] || 'http://'; $CookieSet = 1; } 1; #--- # loadlib.pl #--- sub load_lib{ local( $filename ) = shift(@_); eval{ require $filename; }; if( $@ ){ &error("ライブラリのロードに失敗しました。($filename: $@) "); } } 1; #--- # lock.pl #--- sub Lock{ local( $handle ) = shift(@_); return if(!$UseLock ); eval{ flock( $handle, 2); }; if( $@ ){ &error("ロック処理に失敗しました。($handle: $@) "); } } 1; #--- # html.pl #--- # 固定値の置換には s///o オプションを追加。 sub LoadFile{ local( $file ); local( @Lines ); $file = shift(@_); open( FH, $file ) || &FE($file); @Lines = ; close(FH); return @Lines; # 値渡し } sub PutFile{ local( $file ); $file = shift(@_); open( FH, $file ) || &FE($file); for( ){ if( !/\$/o ){ print; next; } s/\$C{'name'}/$C{'name'}/g; s/\$C{'email'}/$C{'email'}/g; s/\$C{'web'}/$C{'web'}/g; s/\$C{'title'}/$C{'title'}/g; s/\$C{'value'}/$C{'value'}/g; s/\$OpWinWidth/$OpWinWidth/go; s/\$OpWinHeight/$OpWinHeight/go; s/\$ss_size/$ss_size/go; s/\$s_size/$s_size/go; s/\$m_size/$m_size/go; s/\$l_size/$l_size/go; s/\$ResMid/$ResMid/g; s/\$title/$title/g; s/\$Width/$Width/go; s/\$CgiUrl/$CgiUrl/go; s/\$BackUrl/$BackUrl/go; s/\$Method/$Method/go; s/\$PageCtrl/$PageCtrl/g; s/\$Message/$Message/g; s/\$Build/$Build/go; print; } close(FH); } 1; #--- # pwMain.pl #--- sub putMainWindow{ local( $cnt ); print "Expires: 01/01/70 00:00:00 GMT\n"; print "Content-type: text/html\n\n"; open( DAT, $DataFile) || &FE($DataFile); &Lock(DAT); @Data = ; close(DAT); $title = $MainTitle || $F{'title'} || $title; &PutFile( "$HtmlDir/$HeadHtml" ); @MainFmt = &LoadFile( "$HtmlDir/$DataFmtMain" ); @ResFmt = &LoadFile( "$HtmlDir/$DataFmtRes" ); &PageInit; shift(@Data); # remove header # --- データ表示 --- while( $this = shift(@Data) ){ next if( $this =~ /^\t/ ); # res data $cnt++; if( $cnt < $StartCnt ){ $PreSkip++; next; } if( $cnt > $LastCnt ){ $EndSkip++; last; } &getResData; ($mid,$name,$email,$web,$title,$value,$date,$host,$time) = split (/,/,$this); if( $email){ $name = eval $TopEmailFmt; } if( $web ){ $name = eval $TopWebFmt; } &putMainData; } &PutFile( "$HtmlDir/$NoMsgHtml") if(!$EndSkip); if( $PreSkip ){ $PageCtrl = eval $PageCtrlPrev; } if( $EndSkip ){ $PageCtrl .= eval $PageCtrlNext; } &PutFile( "$HtmlDir/$FootHtml" ); } #=============================== sub PageInit{ $CurPage = $F{'page'} || 1; # $pageが無ければ 1; $NextPage = $CurPage+1; $PrevPage = $CurPage-1; $LastCnt = $CurPage * $Args; $StartCnt = $LastCnt - $Args + 1; } 1; #--- # pwMainRes.pl #--- sub getResData{ # --- レスの抽出 --- undef $ResData; while( $Data[0] && $Data[0] =~ /^\t/ ){ $res = shift(@Data); $res =~ s/^\t//; ($mid,$name,$email,$web,$title,$value,$date,$host,$time) = split (/,/,$res); if( $email){ $name = eval $ResEmailFmt; } if( $web ){ $name = eval $ResWebFmt; } @temp = @ResFmt; for( @temp ){ s/\$mid/$mid/g; s/\$name/$name/; s/\$date/$date/; s/\$host/$host/; # 追加 s/\$title/$title/; s/\$value/$value/; s/\$Width/$Width/; $ResData .= $_; } } } 2; #--- # pwMainMain.pl #--- sub putMainData{ @temp = @MainFmt; for( @temp ){ s/\$mid/$mid/g; s/\$name/$name/; s/\$date/$date/; s/\$host/$host/; # 追加 s/\$title/$title/; s/\$value/$value/; s/\$Width/$Width/; s/\$ResData/$ResData/; print; } } 1; #--- # ioWrite.pl #--- # なんか汚い。 sub ioDataWrite{ # データ編集中 if( $DataFreeze ){ &SetMessage( $FreezeMessage ); return; } # 書き込み無し if(!$F{'value'}){ &SetMessage( "なにか書き込んで下さい。"); return; } local( @DataBuf, @NewData, @Data, $Head, $new, $rest ); local( $ResMid ) = shift(@_); #-------------------- # ファイル処理 open(DAT,"+<$DataFile") || &FE($DataFile); &Lock(DAT); $Head = ; chop($Head); @Data = ; # 前回の書込情報 local($pHost,$pMid,$pTime,$pValue) = split(/\,/, $Head ); # 色々取得 $F{'mid'} = $pMid + 1; $F{'time'} = time; $F{'date'} = &getDate(); $F{'host'} = &getHost(); # リロード?チェック if( $F{'value'} eq $pValue ){ &SetMessage("2重書き込みです"); close(DAT); return; } # 間をおいたリロードでフォームデータを再投稿した場合。 # ただ、違う人が全く同じ内容をpostできなくなってしまう。 # ホストチェック if( ($F{'host'} eq $pHost) && ( $F{'time'} < $WWriteChk + $pTime ) ){ $rest = int( $pTime + $WWriteChk - $F{'time'} ); &SetMessage("2重書き込みの可能\性があります。$rest秒待って再送信してください。"); close(DAT); return; } # 同じリモートホストからの連続書き込みを$WWriteChk秒間阻止。 # 新データ。 $new = join( ',', $F{'mid'}, $F{'name'}, $F{'email'}, $F{'web'}, $F{'title'}, $F{'value'}, $F{'date'}, $F{'host'}, $F{'time'} ) . "\n"; #-------------------- # 追加処理 local( $cnt ); # 親記事の追加 if( !$ResMid ){ # 件数調整とデータ追加 while( @Data && $cnt < $ArgMax ){ $cnt++ if( $Data[0] !~ /^\t/ ); # 親記事カウント push( @NewData, shift(@Data) ); # 追加。 } unshift( @Data, pop( @NewData ) ) if($cnt == $ArgMax ); unshift( @NewData,$new); } # とりあえず、$ArgMax分の親記事とレスを取り出す。 # ループは、余分に1つ親記事を取り出した状態で抜ける。 # その場合は、余計なものを取り除き、新しいのを追加。 # レス記事の追加 else{ # レスをつけるとき、件数は増えない # 対象のカキコまでコピー while( $Data[0] && $Data[0] !~ /^$ResMid,/ ){ push( @NewData, shift(@Data) ); } # 対象のカキコを取り出す push( @DataBuf, shift(@Data) ); # レス部分も取り出す while( $Data[0] && $Data[0] =~ /^\t/ ){ push( @DataBuf, shift(@Data) ); } # レスの最後に追加 if( $DataBuf[0] ){ push( @DataBuf, "\t$new" ); } else { push( @DataBuf, "$new" ); } # 無いとき親記事として追加 # 残りを追加。 if( $ResUp ){ unshift( @NewData, @DataBuf); } else { push ( @NewData, @DataBuf); } push( @NewData, @Data ); &SetMessage( 'レスを追加しました。ウィンドウを閉じて下さい。
'. '今の書き込みを見るならリロードボタンを押しましょう。' ); @Data = (); } # 新しいヘッダを追加。 unshift(@NewData,"$F{'host'},$F{'mid'},$F{'time'},$F{'value'}\n"); seek(DAT,0,0); truncate(DAT,0); print DAT @NewData; close(DAT); # ここであふれたデータを書き出す if( $Data[0] && $store_mode ){ &mv_store( @Data ); } } 1; #--- # pwRes.pl #--- # @Data/($mid,..,$time) のローカル化? sub putResWindow{ print "Expires: 01/01/70 00:00:00 GMT\n"; print "Content-type: text/html\n\n"; local( $cnt ); local( $ResMid ) = shift(@_); open( DAT, $DataFile) || &FE($DataFile); &Lock(DAT); @Data = ; close(DAT); # レス記事検索 for(;;$cnt++){ if( $Data[$cnt] =~ /(^|^\t)$ResMid,/ ){ $Data[$cnt] =~ s/^\t//; last; } if(!$Data[$cnt]){ &SetMessage( "ID $ResMid は見つかりませんでした。
". "すでに削除されているか、不正な利用です。" ); &PutFile( "$HtmlDir/$OpMsgHtml" ); exit; } } ($mid,$name,$email,$web,$title,$value,$date,$host,$time) = split (/,/, $Data[$cnt] ); # タイトル修正。 $title =~ s/^($ResTitleHead)+//i; &ToShortStr(*title,$ResTitleSize); $C{'title'} = $ResTitleHead. $title; &PutFile( "$HtmlDir/$OpResHtml" ); } 1; #--- # pwDel.pl #--- sub putDelWindow{ print "Expires: 01/01/70 00:00:00 GMT\n"; print "Content-type: text/html\n\n"; local( $cnt ); local( $ResMid ) = shift(@_); open( DAT, $DataFile) || &FE($DataFile); &Lock(DAT); @Data = ; close(DAT); # 削除記事検索 for(;;$cnt++){ if( $Data[$cnt] =~ /(^|^\t)$ResMid,/ ){ $Data[$cnt] =~ s/^\t//; last; } if(!$Data[$cnt]){ &SetMessage( "ID $ResMid は見つかりませんでした。
". "すでに削除されているか、不正な利用です。" ); &PutFile( "$HtmlDir/$OpMsgHtml" ); exit; } } ($mid,$name,$email,$web,$title,$value,$date,$host,$time) = split (/,/, $Data[$cnt] ); &PutFile( "$HtmlDir/$OpDelHtml" ); } 1; #--- # ioDelete.pl #--- sub ioDataDelete{ local( $cnt, $Head, @Data ); local( $ResMid ) = shift( @_); if( !$password || $password ne $F{'passwd'} ){ &SetMessage("パスワードが違います。"); return ; } #--------------------- # ファイル処理。 open(DAT,"+<$DataFile") || &FE($DataFile); &Lock(DAT); @Data = ; $Head = shift(@Data); #--------------------- # データ削除。 # 対象のカキコまで進める while( $Data[$cnt] && $Data[$cnt] !~ /(^|^\t)$ResMid,/ ){ $cnt++; } if( $Data[$cnt] !~ /^\t/ ){ # 親記事の削除 $Data[$cnt++] = ''; # レス記事の削除 if( $DelTree ){ while( $Data[$cnt] && $Data[$cnt] =~ /^\t/ ){ $Data[$cnt++] = ''; } } else{ $Data[$cnt] =~ s/^\t//; } } else{ # 対象のレスのみ取り除く $Data[$cnt] = ''; } unshift(@Data, $Head); seek(DAT,0,0); truncate(DAT,0); print DAT @Data; close(DAT); &SetMessage("データを削除しました。"); } 1; #--- # pwResult.pl #--- sub putResultWindow{ print "Expires: 01/01/70 00:00:00 GMT\n"; print "Content-type: text/html\n\n"; &PutFile( "$HtmlDir/$OpMsgHtml" ); } 1; #--- # util.pl #--- sub ToShortStr{ local( $len,$n,$char,$is2byte,$tmp,$new,$size ); (*str,$size) = @_; $len = length($str); return if(!$size); return if( $size > $len ); &load_lib( $Jcode ); while( $n != $len && $n < $size ){ $char = substr($str,$n,2); ($is2byte,$tmp) = &jcode'getcode(*char); if( $is2byte){ $n +=2; } else{ $char = substr($str,$n++,1); } $new .= $char; } $str = $new . "..."; } #--- sub getDate{ #--------------------- # 書き込み時間の取得 local($week); local($sec,$min,$hour,$mday,$mon,$year,$wday) = localtime(time + $TimeDiff ); $mon++; $year = sprintf("%02d", $year%100 ); # 2000年問題ってか。 $min = sprintf("%02d", $min ); $hour = sprintf("%2d", $hour ); $week = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat")[$wday]; # $week = ('日','月','火','水','木','金','土')[$wday]; return "$year/$mon/$mday($week) $hour:$min"; } #--- sub getHost{ #--------------------- # ホスト/IPの取得 local( $host, $addr, $padd ); $host = $ENV{'REMOTE_HOST'}; $addr = $ENV{'REMOTE_ADDR'}; if( $host eq $addr || $host eq ""){ $padd = pack('C4', split(/\./,$addr) ); ($host) = gethostbyaddr($padd,2) if(!$OffLine); } return $host || $addr; } 1; #--- # mv_store.pl #--- # パッケージ化? # ファイルの拡張子? # 変数の競合に注意。 # 値渡し? # package mv_store; #---------------------------- sub mv_store{ local(@data) = @_; local(@part); &st_lock; while( @data ){ push( @part, shift( @data ) ); while( $data[0] =~ /^\t/ ){ push( @part, shift( @data ) ); } &mv_store_print; @part = (); } &st_unlock; } #--- sub mv_store_print{ # @part 引継 local( $idx,$file ); $idx = &get_idx; $file = "$data_dir/$idx"; open( MSP, ">>$file" ) || &FE("$file"); if( $store_mode == 1 ){ print MSP @part; } else{ select(MSP); &makeHtml( @part ); select(STDOUT); } close(MSP); } #--- sub st_lock{ return if(!$UseLock); open( LOCK, ">$data_dir/$idx_lock" ) || &FE("$data_dir/$idx_lock"); &Lock( LOCK ); } #--- sub st_unlock{ close( LOCK ); } #--- sub get_idx{ local( $idx,$size,$file,$n ); $file = "$data_dir/$idx_file"; $n = $idx_order; # create idx file. if(!-e $file ){ open( IDX, ">$file" ) || &FE($file); print IDX 1; close( IDX ); } # get index. open( IDX, "+<$file" ) || &FE($file); $idx = sprintf("%0${n}d",); $size = (stat("$data_dir/$idx"))[7]; if( $size > $max_size ){ seek(IDX,0,0); truncate(IDX,0); print IDX ++$idx; } close(IDX); return sprintf("%0${n}d", $idx); } #--- sub makeHtml{ # html形式の書き出し処理 local(@Data) = @_; @MainFmt = &LoadFile( "$HtmlDir/$DataFmtMain" ); @ResFmt = &LoadFile( "$HtmlDir/$DataFmtRes" ); ($mid,$name,$email,$web,$title,$value,$date,$host,$time); # --- データ表示 --- while( $this = shift(@Data) ){ next if( $this =~ /^\t/ ); # res data &getResData; ($mid,$name,$email,$web,$title,$value,$date,$host,$time) = split (/,/,$this ); if( $email){ $name = eval $TopEmailFmt; } if( $web ){ $name = eval $TopWebFmt; } &putMainData; } } 1; #---