#!/usr/bin/perl

##=======================================================##
##  AmigoNavigator [サーチエンジン]                      ##
##  Copyright(C)2000 cgi-amigo.com All Rights Reserved   ##
##  http://www.cgi-amigo.com/                            ##
##  webmaster@cgi-amigo.com                              ##
##=======================================================##

# このスクリプトは無料でご利用頂けますが著作権は放棄していません。
# 利用規定ファイル及びhttp://www.cgi-amigo.com/kitei.htmlの利用規定を厳守してご利用下さい。
# 更新の都合で両規定に違いがある場合はより新しい方の規定をご覧下さい。

$Ver='AmigoNavigator Ver3.10'; # ─バージョン情報(修正不可)

###########################################################

# ■基本ディレクトリ(http://から)
$BaseDir='http://www.townnavi.ne.jp/cgi/navi';

# ■設置サイトの最短URL
@MyUrl=(
);

# ■データディレクトリ
$DataDir='./data';

# ■ロックディレクトリ
$LockDir='./lock';

# ■ロックタイプ(1=flock式/2=rename式/3=symlink式/4=mkdir式/5=open式)
$LockType=4;

# ■画像ディレクトリ
$ImageDir='./image';

# ■アップファイル用ディレクトリ
$UpDir='./file';

# ■バックアップファイル名(拡張子は必ず.tar.gz)
$BkupFile='data.tar.gz';

# ■リンク制限(ON=1/OFF=0)
$LinkFlag=0;

# ■method形式チェック(ON=1/OFF=0)
$MethodFlag=1;

# ■保存パスワードの暗号化(ON=1/OFF=0)
$CryptFlag=1;

# ■時差修正(日本は+9)
$TimeZone=+9;

# ■ジャンプタイプ(Locatino=0/META=1)
$LocationType=0;

# ■gzipのパス
$GzipPass='/usr/bin/gzip';

###########################################################

eval{ require'./lib/jcode.pl' } or &Die('jcode.pl を呼び出せません。');
eval{ require"$DataDir/config/navi-conf.cgi" } or &Die('navi-conf.cgiを呼び出せません。');
eval{ require"$DataDir/config/navi-ca.cgi" } or &Die('navi-ca.cgiを呼び出せません。');
eval{ require'./lib/navi-html.cgi' } or &Die('navi-html.cgiを呼び出せません。');
srand(time()^($$+($$<<15)));
$PID=$$?$$:int(rand(10000)+1);
$NowTime=time;
#$Copyright=qq(<CENTER><TABLE height="10"><TBODY><TR><TD></TD></TR></TBODY></TABLE><TABLE border="1" bgcolor="#ffffff"><TBODY><TR><TD align=middle><FONT style="FONT-SIZE: 10pt" face=verdana,arial,serif,tahoma>&nbsp;- <A href="http://www.cgi-amigo.com/" style="color : blue;">$Ver</A> -&nbsp;</FONT></TD></TR></TBODY></TABLE></CENTER>);
$SIG{PIPE}=$SIG{INT}=$SIG{HUP}=$SIG{QUIT}=$SIG{TERM}=\&SIGExit;
$DomainName=!$ENV{REMOTE_HOST}||$ENV{REMOTE_HOST} eq $ENV{REMOTE_ADDR}?gethostbyaddr(pack('C4',split(/\./,$ENV{REMOTE_ADDR})),2)||$ENV{REMOTE_ADDR}:$ENV{REMOTE_HOST};
%REC=(
'ALL' =>{ 'Pass'=>0,'Mark1'=>1,'Mark2'=>2,'Name'=>3,'Email'=>4,'Title'=>'5','Url'=>6,'Rtime'=>7,'UPtime'=>8,'Comment'=>9,'Keyword'=>10,'RegistCa'=>11,'Burl'=>12,'BsizeW'=>13,'BsizeH'=>14 },
'Clog'=>{ 'Mark1'=>0,'Mark2'=>1,'Name'=>2,'Email'=>3,'Title'=>'4','Url'=>5,'Rtime'=>6,'UPtime'=>7,'Comment'=>8,'Keyword'=>9,'Burl'=>10,'BsizeW'=>11,'BsizeH'=>12 });
&GetFormData(',');
@cmd{'tv','cv','uv','mv','rv','rva','s','ms','mes','dr','dra','dec','dep',
'dea','dda','ac','ar','c','ca','aj','aja','ce','cca','cea','cexa',
'cdexa','cdca','cdda','j','r','bk','bkd','mc','md','dt','td','rs','rsa','lr','lra','lc','lca','lcd','lcc','lcu','lt'}='';
$FORM{cmd} eq '' and $FORM{cmd}='tv';
if(-e"$LockDir/mente.loc"){
    @mente{'ac','ar','c','ca','ce','cca','cea','cexa','cdexa',
    'cdca','cdda','bk','bkd','mc','md','rs','rsa','lc','lca','lcd','lcc','lcu'}='';
    exists$mente{$FORM{cmd}} or &Error('現在メンテナンス中です。<BR>ご迷惑をお掛けしますがしばらくお待ち下さい。');
}!exists$cmd{$FORM{cmd}}?&Error('コマンドが不正です。'):&{$FORM{cmd}};
sub tv   { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &TopView }
sub cv   { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &CategoryView }
sub uv   { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &UpdateView }
sub mv   { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &MarkView }
sub rv   { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &RankView }
sub rva  { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &RankViewAct }
sub s    { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &Search }
sub ms   { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &MoreSearch }
sub mes  { eval{ require'./lib/navi-view.cgi' } or &Die('navi-view.cgiを呼び出せません。'); &MetaSearch }
sub dr   { eval{ require'./lib/navi-data-edit.cgi' } or &Die('navi-data-edit.cgiを呼び出せません。'); &DataRegist }
sub dra  { eval{ require'./lib/navi-data-edit.cgi' } or &Die('navi-data-edit.cgiを呼び出せません。'); &DataRegistAct }
sub dec  { eval{ require'./lib/navi-data-edit.cgi' } or &Die('navi-data-edit.cgiを呼び出せません。'); &DataEditCertify }
sub dep  { eval{ require'./lib/navi-data-edit.cgi' } or &Die('navi-data-edit.cgiを呼び出せません。'); &DataEditPart }
sub dea  { eval{ require'./lib/navi-data-edit.cgi' } or &Die('navi-data-edit.cgiを呼び出せません。'); &DataEditAct }
sub dda  { eval{ require'./lib/navi-data-edit.cgi' } or &Die('navi-data-edit.cgiを呼び出せません。'); &DataDeleteAct }
sub lr   { eval{ require'./lib/navi-data-edit.cgi' } or &Die('navi-data-edit.cgiを呼び出せません。'); &LinkReport }
sub lra  { eval{ require'./lib/navi-data-edit.cgi' } or &Die('navi-data-edit.cgiを呼び出せません。'); &LinkReportAct }
sub ac   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &AdminCertify }
sub ar   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &AdminRoom }
sub dt   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &Dbm_Text }
sub td   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &Text_Dbm }
sub c    { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &Config }
sub ca   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &ConfigAct }
sub aj   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &AdminJudge }
sub aja  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &AdminJudgeAct }
sub ce   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &CaEdit }
sub cca  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &CaCreateAct }
sub cea  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &CaEditAct }
sub cexa { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &CaExchangeAct }
sub cdexa{ eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &CaDataExchangeAct }
sub cdca { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &CaDataCopyAct }
sub cdda { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &CaDataDeleteAct }
sub bk   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &Backup }
sub bkd  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &BackupDelete }
sub mc   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &MenteCreate }
sub md   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &MenteDelete }
sub rs   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &ResetSet }
sub rsa  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &ResetSetAct }
sub lc   { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &LinkCheck }
sub lca  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &LinkCheckAct }
sub lcd  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &LinkCheckDl }
sub lcu  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &LinkCheckUp }
sub lcc  { eval{ require'./lib/navi-admin.cgi' } or &Die('navi-admin.cgiを呼び出せません。'); &LinkCheckComment }
sub j    { eval{ require'./lib/navi-jump.cgi' } or &Die('navi-jump.cgiを呼び出せません。'); &Jump }
sub r    { eval{ require'./lib/navi-ref.cgi' } or &Die('navi-ref.cgiを呼び出せません。'); &Ref }
sub lt   { &LockTest }

###########################################################

############
#   Html   #
############
sub Html{ my$file=shift;
print"Content-Type: text/html\n";
if(-x$GzipPass and $ENV{HTTP_ACCEPT_ENCODING}=~/((?:x-)?gzip)/){ $|=1;
    print"Content-encoding: $1\n\n";
    open(GZIP,"| $GzipPass -1c");
    select(GZIP);
}else{ print"\n" }
eval{ require"./lib/template/$file" } or &Die("$file を呼び出せません。",1);
print$Copyright;exit;}

#############
#   Error   #
#############
sub Error{ $msg=shift;
foreach(@UpFile){ unlink"$MultipartDir/$_" }
&Unlock('ALL');
&Html('error.html');}

###########
#   Die   #
###########
sub Die{ ($msg,$NoHead)=@_;
$NoHead or print"Content-type: text/html\n\n";
print$msg;exit;}

################
#   Location   #
################
sub Location{ my$url=shift;
if(!$LocationType){ print"Location: $url\n\n" }
else{ print"Content-type: text/html\n\n";
print<<EOM;
<HTML><HEAD><TITLE></TITLE>
<META HTTP-EQUIV="REFRESH" CONTENT="0;URL=$url">
</HEAD><BODY></BODY></HTML>
EOM
}exit;}

###########################################################

############
#   Lock   #
############
sub Lock{ my($n,$lax)=@_;
my$lock="$LockDir/$n.loc";
if($LockType==1){
    open($n,">$lock");
    for($_=5; $_>=0; $_--){
        if(flock($n,6)){ $LockFile{$n}=1; return(1); }
        sleep(1) if$_;
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}elsif($LockType==2){
    my$locking="$LockDir/$n.now";
    if(-e$locking and $NowTime-(stat(_))[9]>180){ rename($locking,$lock) }
    for($_=5; $_>=0; $_--){
        if(rename($lock,$locking)){
            utime($NowTime,$NowTime,$locking);
            $LockFile{$n}=1; return(1);
        }sleep(1) if$_;
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}elsif($LockType==3){
    if(-e$lock and $NowTime-(lstat(_))[9]>180){ unlink$lock }
    for($_=5; $_>=0; $_--){
        if(symlink(".",$lock)){ $LockFile{$n}=1; return(1); }
        sleep(1) if$_;
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}elsif($LockType==4){
    my$ldir="$LockDir/$n";
    my$ldir2="$LockDir/del";
    for($_=5; $_>=0; $_--){
        if(mkdir($ldir,0755)){ $LockFile{$n}=1; return(1); }
        if($_==0){
            if(mkdir($ldir2,0755)){
                if((-M$ldir)*86400 > 180){
                    if(rename($ldir2,$ldir)){ $LockFile{$n}=1; return(1); }
                    else{ rmdir($ldir2) }
                }else{ rmdir($ldir2) }
            }
        }else{ sleep(1) }
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}elsif($LockType==5){
    for($_=5; $_>=0; $_--){
        if(!-e$lock){
            open(LOCK,">$lock");
            close(LOCK);
            $LockFile{$n}=1; return(1);
        }if($_){ sleep(1) }
        else{
            if((-M$lock)*86400 > 180){
                open(LOCK,">$lock");
                close(LOCK);
                $LockFile{$n}=1; return(1);
            }
        }
    }$lax?return(0):&Error('只今ビジー状態です。<BR>しばらく待ってから再度実行して下さい。');
}}

##############
#   Unlock   #
##############
sub Unlock{ my$n=shift;
if($n eq 'ALL'){
    foreach(keys%LockFile){
        $LockFile{$_}!=1 and next;
        if($LockType==1){ close($_) }
        elsif($LockType==2){ rename("$LockDir/$_.now","$LockDir/$_.loc") }
        elsif($LockType==3){ unlink("$LockDir/$_.loc") }
        elsif($LockType==4){ rmdir("$LockDir/$_") }
        elsif($LockType==5){ unlink("$LockDir/$_.loc") }
        delete($LockFile{$_});
    }
}else{
    if($LockFile{$n}==1){
        if($LockType==1){ close($n) }
        elsif($LockType==2){ rename("$LockDir/$n.now","$LockDir/$n.loc") }
        elsif($LockType==3){ unlink("$LockDir/$n.loc") }
        elsif($LockType==4){ rmdir("$LockDir/$n") }
        elsif($LockType==5){ unlink("$LockDir/$n.loc") }
        delete($LockFile{$n});
    }
}}

################
#   LockTest   #
################
sub LockTest{ my$type;
eval{ open(TEST,">$LockDir/test.loc");
    flock(TEST,6);
    close(TEST);
    unlink("$LockDir/test.loc");
} and $type.='flock式ロックが利用できます。<BR>';
eval{ open(TEST,">$LockDir/test.loc");
    close(TEST);
    rename("$LockDir/test.loc","$LockDir/test2.loc");
    unlink("$LockDir/test2.loc");
} and $type.='rename式ロックが利用できます。<BR>';
eval{ symlink(".","$LockDir/test.loc");
    unlink("$LockDir/test.loc");
} and $type.='symlink式ロックが利用できます。<BR>';
eval{ mkdir("$LockDir/test",0755);
    rename("$LockDir/test","$LockDir/test2");
    rmdir("$LockDir/test2");
} and $type.='mkdir式ロックが利用できます。<BR>';
$type.='open式ロックが利用できます。<BR>';
&Die($type);}

###########################################################

################
#   FileRead   #
################
sub FileRead{ local($file,$filename,*line,$type)=@_;
open(FILE,$file) or &Error("$filenameが開けません。");
$type?@line=<FILE>:$line=<FILE>;close(FILE);}

#################
#   FileWrite   #
#################
sub FileWrite{ my($file,$data,$filename)=@_;
if($filename){ open(FILE,">>$file") or &Error("$filenameが開けません。") }
else{ open(FILE,">$file") }
if(ref$data eq 'ARRAY'){ print FILE @{$data} }
elsif(ref$data eq 'HASH'){ foreach(values%{$data}){ print FILE $_ } }
else{ print FILE $data }close(FILE);}

##############
#   Secure   #
##############
sub Secure{ my($ref,$method,$admin,$sid,$proxy,$domain,$lax)=@_;
my($chkpass,$perror,$derror);
if($ref){
    if(!$ENV{HTTP_USER_AGENT}=~/^DoCoMo/){ undef$found;
        $ENV{HTTP_REFERER} eq '' and $lax?return(0):&Error('設置サイト外からの呼び出しです。');
        foreach(@MyUrl){ if($ENV{HTTP_REFERER}=~/^\Q$_\E/){ $found=1; last } }
        !$found and $lax?return(0):&Error('設置サイト外からの呼び出しです。');
    }
}$method and $ENV{REQUEST_METHOD} ne 'POST'
    and $lax?return(0):&Error('METHODが不正です。');
if($admin ne '' and $CNF{AdminPass} ne ''){
    $chkpass=$CryptFlag?crypt($FORM{AdminPass},$CNF{AdminPass}):$FORM{AdminPass};
    $chkpass eq $CNF{AdminPass} or $lax?return(0):&Error('管理用パスワードが違います。');
}if($sid){ local(*id);
    &FileRead("$sid/submit.dat",'二重送信防止ファイル',*id);
    $id eq $FORM{SID} and $lax?return(0):&Error('同一内容の二重送信です。');
}$proxy and ($DomainName=~/squid|proxy|cache|delegate|keeper|dummy|smtp|w3|^web|^news|^firewall|^dns|^mail|^www|^gw|^fw|^ns\d{0,2}\.|us$|uk$|au$|fi$|ca$|de$|kr$|tw$|it$|edu$|com$|org$|net$/i or
$ENV{HTTP_USER_AGENT}=~/squid|proxy|cache|delegate|via|httpd|gateway|www|Turing|ANONYM/i or
!$ENV{REMOTE_ADDR} or
defined $ENV{HTTP_X_FORWARDED_FOR} or
defined $ENV{HTTP_FORWARDED} or
defined $ENV{HTTP_PROXY_CONNECTION} or
defined $ENV{HTTP_XROXY_CONNECTION} or
defined $ENV{HTTP_XONNECTION} or
defined $ENV{HTTP_VIA} or
defined $ENV{HTTP_CLIENT_IP} or
defined $ENV{HTTP_X_LOCKING} or
defined $ENV{HTTP_SP_HOST} or
defined $ENV{HTTP_CACHE_INFO} or
defined $ENV{HTTP_CACHE_CONTROL}) and $perror=1;
if($domain){
    !$perror and !&DomainCheck('out') and $derror=1;
    ($perror or $derror) and !&DomainCheck('vip') and $derror=$perror='';
}$perror and $lax?return(0):&Error('プロキシ経由でのアクセスは禁止されています。');
$derror and $lax?return(0):&Error('ご使用のホストからのアクセスは禁止されています。');
return(1);}

###################
#   DomainCheck   #
###################
sub DomainCheck{ my$type=shift;
my@DomainList=$type eq 'out'?@{$CNF{OutDomain}}:@{$CNF{VipDomain}};
foreach(@DomainList){ $_ eq '' and return(1);
    if(/(\d\.)/){ $ENV{REMOTE_ADDR}=~/^$_/ and return(0) }
    else{ index($DomainName,$_) >=0 and return(0) }
}return(1);}

#################
#   GetCookie   #
#################
sub GetCookie{ my$name=shift; my($value,$key,$val);
foreach(split(/;\s*/,$ENV{HTTP_COOKIE})){
    if(/^$name=(.*)$/){ $value=&UrlDecode($1);
        foreach(split/,/,$value){ ($key,$val)=split(/<>/); $COOKIE{$key}=$val }
        last;
    }
}}

#################
#   SetCookie   #
#################
sub SetCookie{ my($name,$val,$exday)=@_;
$val=&UrlEncode($val);
my$expires=&GetTime($NowTime+$exday*86400,'{w}, {dd}-{mmm}-{yyyy} 00:00:00 GMT');
print"Set-Cookie: $name=$val; expires=$expires\n";}

#################
#   DbmDelete   #
#################
sub DbmDelete{ my($dbm,$num)=@_;
dbmopen(%DBM,$dbm,0666);
delete$DBM{$num};
dbmclose(%DBM);}

################
#   DbmWrite   #
################
sub DbmWrite{ my($dbm,$num,$data)=@_;
dbmopen(%DBM,$dbm,0666);
$DBM{$num}=$data;
dbmclose(%DBM);}

###############
#   DbmPick   #
###############
sub DbmPick{ my($dbm,$num)=@_;
dbmopen(%DBM,$dbm,0644);
my$buff=$DBM{$num};
dbmclose(%DBM);$buff;}

###############
#   GetTime   #
###############
sub GetTime{ my($time,$format)=@_;
($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime($time+$TimeZone*3600);
my@mon=qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my@jwday=qw(日 月 火 水 木 金 土);
my@ewday=qw(Sun Mon Tue Wed Thu Fri Sat);
$year+=1900; $mon++;
if($format ne ''){
    $format=~s/{yyyy}/$year/ or
        $format=~s/{yy}/substr($year,2,4)/e or
        $format=~s/{y}/'平成'.($year-1988)/e;
    $format=~s/{mmm}/$mon[$mon-1]/ or
        $format=~s/{mm}/sprintf('%02d',$mon)/e or
        $format=~s/{m}/$mon/;
    $format=~s/{dd}/sprintf('%02d',$mday)/e or
        $format=~s/{d}/$mday/;
    $format=~s/{ww}/$jwday[$wday]/ or
        $format=~s/{w}/$ewday[$wday]/;
    $format=~s/{HH}/$hour<12?'午前':'午後'/e or
        $format=~s/{H}/$hour<12?'AM':'PM'/e;
    $format=~s/{hhhh}/sprintf('%02d',$hour)/e or
        $format=~s/{hhh}/$hour/ or
        $format=~s/{hh}/sprintf('%02d',($hour>11?$hour-12:$hour))/e or
        $format=~s/{h}/($hour>11?$hour-12:$hour)/e;
    $format=~s/{nn}/sprintf('%02d',$min)/e or
        $format=~s/{n}/$min/;
    $format=~s/{ss}/sprintf('%02d',$sec)/e or
        $format=~s/{s}/$sec/;
}$format;}

###################
#   GetFormData   #
###################
sub GetFormData{ my$divided=shift; my$buff;
if($ENV{REQUEST_METHOD} eq 'POST'){
    if($ENV{CONTENT_TYPE}=~/^multipart\/form-data/){
        &Multipart(16384,$UpDir,100,500000,500000,10,1,\%enable);
        return(1);
    }else{ ($ENV{CONTENT_LENGTH} > 50000) and &Error('送信データが大きすぎます。');
        read(STDIN,$buff,$ENV{CONTENT_LENGTH});
    }
}else{ $buff=$ENV{QUERY_STRING} }
foreach(split(/&/,$buff)){ ($key,$val)=split(/=/);
    $val=&UrlDecode($val);
    $val=~s/\t//g;
    $val=~s/(?:\r\n|\r)/\n/g;
    jcode::convert(*val,'sjis');
    if($FORM{$key} ne '' and $val ne ''){ $FORM{$key}.=$divided }
    else{ push(@keys,$key) }
    $FORM{$key}.=$val;
}}

#################
#   Multipart   #
#################
sub Multipart{
my($bufsize,$dir,$maxbound,$sizemax,$tsizemax,$fnmax,$filemax,$enable)=@_;
$MultipartDir=$dir;
%enable=qw(dat 1);# TEST
&Secure(scalar@MyUrl,undef,undef,undef,$CNF{ProxyFlag},$CNF{DomainFlag});
$ENV{CONTENT_LENGTH} > $sizemax*($filemax+1) and &Error('データ量が極端に大きい為処理を中断しました。');
stat($dir); &Error('保存ディレクトリが不正です。') unless -d _ && -w _;
$serveros=$^O;
$serveros eq '' and $serveros=$ENV{OS};
$ENV{SERVER_SOFTWARE}=~/AnWeb|Omni|IIS\//i and $serveros='win';
$ENV{WINDIR} ne '' and $serveros='win';
$serveros=~/win/i and binmode(STDIN);
($boundary)=$ENV{CONTENT_TYPE}=~/boundary="([^"]+)"/;
($boundary)=$ENV{CONTENT_TYPE}=~/boundary=(\S+)/ unless$boundary;
!$boundary and &Error('バウンダリがありません。');
$boundary="--".$boundary;
$blen=length$boundary;
$left=$ENV{CONTENT_LENGTH};
$loop=0;
MAIN:while(1){
    $read=($left > $bufsize+$maxbound-length($buf)) ? $bufsize+$maxbound-length($buf) : $left;
    read(STDIN,$buf,$read,length($buf))!=$read and &Error('データの読み取りに失敗しました。(1)');
    $left-=$read;
    while(($bpos=index($buf,$boundary))==-1){
        ($left==0 and $buf eq '') and &Error('不正なデータです。(1)');
	    if($name ne ''){
            if($file ne ''){
                if($macie){ print UPFILE substr($buf,128,$bufsize); undef$macie; }
                else{ print UPFILE substr($buf,0,$bufsize) }
            }else{ $FORM{$name}.=substr($buf,0,$bufsize) }
        }$buf=substr($buf,$bufsize);
        $read=($left > $bufsize) ? $bufsize : $left;
        read(STDIN,$buf,$read,length($buf))!=$read and &Error('データの読み取りに失敗しました。(2)');
        $left-=$read;
    }$left-=read(STDIN,$buf,2,length($buf));
    if($name ne ''){
        if($file ne ''){
            if($macie){ print UPFILE substr($buf,128,$bpos-2); undef$macie; }
            else{ print UPFILE substr($buf,0,$bpos-2) }
            undef$file;
        }else{ $FORM{$name}.=substr($buf,0,$bpos-2) }
    }close(UPFILE);
    undef$name;
    last MAIN if substr($buf,$bpos+$blen,2) eq "--";
    substr($buf,0,$bpos+$blen+2)='';
    $read=$left > $bufsize+$maxbound-length($buf) ? $bufsize+$maxbound-length($buf) : $left;
    read(STDIN,$buf,$read,length$buf)!=$read and &Error('データの読み取りに失敗しました。(3)');
    $left-=$read;
    undef$head;
    while(($lpos=index($buf,"\r\n\r\n"))==-1){
        ($left==0 and $buf eq '') and &Error('不正なデータです。(2)');
	    $head.=substr($buf,0,$bufsize);
        $buf=substr($buf,$bufsize);
        $read=$left > $bufsize ? $bufsize : $left;
        read(STDIN,$buf,$read,length$buf)!=$read and &Error('データの読み取りに失敗しました。(4)');
        $left-=$read;
    }$head.=substr($buf,0,$lpos+2);
    @head=split("\r\n",$head);
    $cd=(grep(/^\s*Content-Disposition:/i,@head))[0];
    $ct=(grep(/^\s*Content-Type:/i,@head))[0];
    $ct=~/application\/x-macbinary/i and $macie=1;
    ($name)=$cd=~/\bname="?([^"]+)"?/i;
    ($file)=$cd=~/\bfilename="?([^"]+)"?/i;
    $file=~s|.*[:/\\](.*)|$1|;
    if($file ne ''){
        $filelen=length$file;
        ($filelen > $fnmax) and &Error("$fileのファイル名が長すぎます。<BR>(現在：$filelen文字 最大：$fnmax文字)");
        $file=~/\.\./ and &Error('ファイル名が不正です。');
        $file=~/[^\-_0-9A-Za-z\.]/ and &Error('ファイル名に使用出来ない文字が含まれています。');
        $file!~/^(.*)\.(\w+)$/ and &Error('ファイルに拡張子がありません。');
        my$type=lc($2);
        ${$enable}{$type} or &Error('この種類のファイルはアップロードが禁止されています。');
        if(-e"$dir/$file"){
            my($name1,$name2)=($1,2);
            while(-e$dir."/$name1($name2).$type"){ $name2++ }
            $file="$name1($name2).$type";
        }if($file){
            open(UPFILE,">$dir/$file") or &Error('添付ファイルを書き込めませんでした。');
            $serveros=~/win/i and binmode(UPFILE);
        }push(@UpFile,$file);
        $filesu=@UpFile;
        ($filesu > $filemax) and &Error("添付ファイル数が多すぎます。<BR>(現在：$filesuファイル 最大：$filemaxファイル)");
    }(length$name and exists$FORM{$name}) and $FORM{$name}.="\t";
    substr($buf,0,$lpos+4)='';
    $loop++; $loop >= 1000 and &Error('ループエラー');
}foreach(@UpFile){
    $size=-s"$dir/".$_;
    ($size >= $sizemax) and &Error("$_が1ファイルの最大サイズを超えています。<BR>(現在：$size\Bytes 最大：$sizemax\Bytes)");
    $tsize+=$size;
}($tsize >= $tsizemax) and &Error("添付ファイルの総サイズの上限を超えています。<BR>(現在：$tsize\Bytes 最大：$tsizemax\Bytes)");
foreach(($key,$val)=each%FORM){
    $val=&UrlDecode($val);
    $val=~s/(?:\r\n|\r)/\n/g;
    jcode::convert(*val,'sjis');
    $FORM{$key}=$val;
}}

#################
#   UrlDecode   #
#################
sub UrlDecode{ my$buff=shift;
$buff=~tr/+/ /;
$buff=~s/%([0-9a-fA-F]{2})/chr(hex($1))/eg; $buff;}

#################
#   UrlEncode   #
#################
sub UrlEncode{ my$buff=shift;
$buff=~s/([^ ])/sprintf('%%%02X',ord($1))/eg;
$buff=~tr/ /+/; $buff;}

###############
#   SIGExit   #
###############
sub SIGExit{ &Unlock('ALL'); exit(1)}

##############
#   AcsLog   #
##############
sub AcsLog{ my($dir,$action)=@_;
local(*AcsLogLines);
my(@Files,$FileSu,$DeleteSu,$NewName);
&FileRead("$dir/access.log",'アクセスログファイル',*AcsLogLines,'array');
if(@AcsLogLines>=$CNF{AcsLogMax}){
    if($CNF{AcsFileMax}){
        @Files=glob("$dir\/*.dat");
        $FileSu=@Files+1;
        if(@Files>=$CNF{AcsFileMax}){
            $DeleteSu=$FileSu-$CNF{AcsFileMax};
            foreach(1..$DeleteSu){ unlink"$dir\/$_\.dat" }
            $NewName=0;
            foreach($DeleteSu+1..@Files){ $NewName++;
                rename("$dir\/$_\.dat","$dir\/$NewName\.dat");
            }$FileSu=$NewName+1;
        }&FileWrite("$dir/$FileSu.dat",\@AcsLogLines);
    }undef@AcsLogLines;
}my$Date=&GetTime($NowTime,'{yy}/{mm}/{dd}({w}) {hhhh}:{nn}:{ss}');
unshift(@AcsLogLines,"[$Date] - $DomainName - $ENV{REMOTE_ADDR} - $ENV{HTTP_USER_AGENT} - $ENV{HTTP_X_FORWARDED_FOR} - $action\n");
&FileWrite("$dir/access.log",\@AcsLogLines);}

######################
#   NecessaryCheck   #
######################
sub NecessaryCheck{ my$check=shift;
foreach(@{$check}){ $FORM{$_} ne '' or &Error("$DataName{$_}が入力されていません。") }}

###############
#   Encrypt   #
###############
sub Encrypt{ my$buff=shift;
return crypt($buff,join("",('.','/',0..9,'A'..'Z','a'..'z')[rand(64),rand(64)])); }

##################
#   _KanriMenu   #
##################
sub _KanriMenu{
&FileRead("$DataDir/main/temp.cgi",'審査待ちファイル',*TempLines,'array');
$TempSu=@TempLines;
print qq(<OPTION value="aj" selected>管理者審査($TempSu件)</OPTION>
<OPTION value="dr">管理者代行サイト登録</OPTION>
<OPTION value="ce">カテゴリ編集</OPTION>
<OPTION value="c">環境設定</OPTION>
<OPTION value="bk">バックアップファイル作成</OPTION>
<OPTION value="bkd">バックアップファイル消去</OPTION>
<OPTION value="mc">メンテナンスモードON</OPTION>
<OPTION value="md">メンテナンスモードOFF</OPTION>
<OPTION value="rs">カウントリセット日時設定</OPTION>
<OPTION value="lc">デッドリンクチェック</OPTION>
<OPTION value="dt">データテキスト化</OPTION>
<OPTION value="td">データDBM化</OPTION>
);}

#################
#   GetCaList   #
#################
sub GetCaList{
foreach(sort{ $CATEGORY{$a}{Sort}cmp$CATEGORY{$b}{Sort} }keys%CATEGORY){
    $CaListA.=qq(<OPTION value="$_">$CATEGORY{$_}{ListName}</OPTION>);
}}

##################
#   SpaceErase   #
##################
sub SpaceErase{ my$buff=shift;
$buff=~s/^(?:\s|　)+//;
$buff=~s/(?:\s|　)+$//;
$buff=~s/\n{5,}/\n\n\n\n/g;
$buff;}

#################
#   TagDecode   #
#################
sub TagDecode{ my$buff=shift;
$buff=~s/&lt;/</g;
$buff=~s/&gt;/>/g;
$buff;}

#################
#   TagEncode   #
#################
sub TagEncode{ my$buff=shift;
$buff=~s/</&lt;/g;
$buff=~s/>/&gt;/g;
$buff;}

###################
#   MojisuCheck   #
###################
sub MojisuCheck{ my$check=shift;
foreach(keys%{$check}){ my$len=length$FORM{$_};
    $len > ${$check}{$_} and &Error("$DataName{$_}が最大文字数を超えています。<BR>(最大：${$check}{$_}文字 現在：$len文字)");
}}

################
#   AutoLink   #
################
sub AutoLink{ my$buff=shift;
my$url='[\w#%&\+\-\./:;=\?@~]+';
my$mail='[\w\*\+\-\./=\?~]+';
$buff=~s/((?:s?https?|ftp):\/\/$url\.$url)/<A href=\"$1\" target=\"$CNF{Target}\">$1<\/A>/g;
$buff=~s/($mail\@$mail\.$mail)/<A href="mailto:$1">$1<\/A>/g;
$buff;}

##################
#   UnAutoLink   #
##################
sub UnAutoLink{ my$buff=shift;
$buff=~s/<A href="(?:mailto:)?([^"]+)"(?: target="$CNF{Target}")?>\1<\/A>/$1/gi;
$buff;}

################
#   SendMail   #
################
sub SendMail{ local($type,$to,$from,$cc,$bcc)=@_;
local($subject,$body)=&$type;
&jcode::convert(*subject,'jis');
&jcode::convert(*body,'jis');
open(MAIL,"| $CNF{Mail}{SendMail} -t -oi");
# open(MAIL,">$DataDir/main/$type.txt");# TEST
print MAIL "MIME-Version: 1.0\n";
print MAIL "X-Mailer: $Ver\n";
print MAIL "X-Http-Referer: $BaseDir/navi.cgi\n";
if($type=~/_Admin$/){
    print MAIL "X-User-Agent: $ENV{HTTP_USER_AGENT}\n";
    print MAIL "X-Host: $ENV{REMOTE_ADDR}\n";
}print MAIL "To: $to\n";
print MAIL "Cc: $cc\n" if($cc);
print MAIL "Bcc: $bcc\n" if($bcc);
print MAIL "From: $from\n";
print MAIL "Replay-To: $from\n";
print MAIL "Subject: $subject\n";
print MAIL "Content-Transfer-Encoding: 7bit\n";
print MAIL "Content-type: text/plain; charset=ISO-2022-JP\n\n";
print MAIL $body;
close(MAIL);}

###########################################################