#!/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 "";
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("２重書き込みです");
close(DAT);
return;
}
# 間をおいたリロードでフォームデータを再投稿した場合。
# ただ、違う人が全く同じ内容をpostできなくなってしまう。
# ホストチェック
if( ($F{'host'} eq $pHost) && ( $F{'time'} < $WWriteChk + $pTime ) ){
$rest = int( $pTime + $WWriteChk - $F{'time'} );
&SetMessage("２重書き込みの可能\性があります。$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分の親記事とレスを取り出す。
# ループは、余分に１つ親記事を取り出した状態で抜ける。
# その場合は、余計なものを取り除き、新しいのを追加。
# レス記事の追加
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;
#---