#!/usr/bin/perl

##======================================================##
##  AmigoDatabase [汎用データベース]                    ##
##  Copyright(C)2000 cgi-amigo.com All Rights Reserved  ##
##  http://www.cgi-amigo.com/                           ##
##  mail:webmaster@cgi-amigo.com                        ##
##======================================================##

# このスクリプトは無料でご利用頂けますが著作権は放棄していません。
# 同梱の利用規定ファイル(kitei.txt)の利用規定を厳守の上ご利用下さい。
# ファイルを紛失した場合はhttp://www.cgi-amigo.com/kitei.htmlよりご確認下さい。
# 最新バージョンもhttp://www.cgi-amigo.com/よりご確認頂けます。

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

$Ver='9.14';
&Lrequire('./lib/jcode.pl');
&Lrequire('./db-setup.cgi');
&Lrequire("$DataDir/config/db-config.cgi");
&Lrequire('./lib/db-html.cgi');
&Lrequire('./lib/db-mail.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;">AmigoDatabase</A> -&nbsp;</FONT></TD></TR></TBODY></TABLE></CENTER>);
$SIG{INT}=$SIG{HUP}=$SIG{QUIT}=$SIG{TERM}=$SIG{__WARN__}=\&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=(
'User'=>{ 'UserNum'=>0,'UserType'=>1,'Pass'=>2,'Mail'=>3,'Rtime'=>4,'UpTime'=>5 },
'Data'=>{ 'DataNum'=>0,'UserNum'=>1,'Count'=>2,'Mark1'=>3,'Mark2'=>4,'Rtime'=>5,'UpTime'=>6,'Ip'=>7 },
'UJudge'=>{ 'JudgeNum'=>0,'JudgeType'=>1,'UserNum'=>2,'UserType'=>3,'Pass'=>4,'Mail'=>5,'JDate'=>6,'UpFlag'=>7 },
'DJudge'=>{ 'JudgeNum'=>0,'JudgeType'=>1,'DataNum'=>2,'UserNum'=>3,'JDate'=>4,'UpFlag'=>5 });
$i=5; foreach(sort keys%{$CNF{UserItem}{Save}}){ $i++; $REC{User}{$_}=$i; $REC{UJudge}{$_}=$i+2; }
$i=7; foreach(sort keys%{$CNF{DataItem}{Save}}){ $i++; $REC{Data}{$_}=$i; $REC{DJudge}{$_}=$i-2; }
&GetFormData;
@cmd{'ac','ar','c','ca','uj','uja','dj','dja','ia','iaa','id','ida','ur','ura','uc','uro','pc',
'pca','ue','uea','uda','dr','dra','de','dep','dea','dda','j','v','s','dp','fm','fma','pr','pra',
'js','b','bd','lt','rs','rsa','cr','cra','ci','cia'}='';
$FORM{cmd} eq '' and $FORM{cmd}='ur';
!exists$cmd{$FORM{cmd}}?&Error('コマンドが不正です。'):&{$FORM{cmd}};
sub ac { &Lrequire('./lib/db-admin.cgi'); &AdminCertify }
sub ar { &Lrequire('./lib/db-admin.cgi'); &AdminRoom }
sub hs { &Lrequire('./lib/db-admin.cgi'); &HtmlSet }
sub hsa{ &Lrequire('./lib/db-admin.cgi'); &HtmlSetAct }
sub c  { &Lrequire('./lib/db-admin.cgi'); &Config }
sub ca { &Lrequire('./lib/db-admin.cgi'); &ConfigAct }
sub uj { &Lrequire('./lib/db-admin.cgi'); &UserJudge }
sub uja{ &Lrequire('./lib/db-admin.cgi'); &UserJudgeAct }
sub dj { &Lrequire('./lib/db-admin.cgi'); &DataJudge }
sub dja{ &Lrequire('./lib/db-admin.cgi'); &DataJudgeAct }
sub ia { &Lrequire('./lib/db-admin.cgi'); &ItemAdd }
sub iaa{ &Lrequire('./lib/db-admin.cgi'); &ItemAddAct }
sub id { &Lrequire('./lib/db-admin.cgi'); &ItemDelete }
sub ida{ &Lrequire('./lib/db-admin.cgi'); &ItemDeleteAct }
sub js { &Lrequire('./lib/db-admin.cgi'); &JsSet }
sub b  { &Lrequire('./lib/db-admin.cgi'); &Backup }
sub bd { &Lrequire('./lib/db-admin.cgi'); &BackupDelete }
sub rs { &Lrequire('./lib/db-admin.cgi'); &ResetSet }
sub rsa{ &Lrequire('./lib/db-admin.cgi'); &ResetSetAct }
sub cr { &Lrequire('./lib/db-admin.cgi'); &CountReset }
sub cra{ &Lrequire('./lib/db-admin.cgi'); &CountResetAct }
sub ci { &Lrequire('./lib/db-admin.cgi'); &CsvImport }
sub cia{ &Lrequire('./lib/db-admin.cgi'); &CsvImportAct }
sub ur { &Lrequire('./lib/db-data.cgi'); &UserRegist }
sub ura{ &Lrequire('./lib/db-data.cgi'); &UserRegistAct }
sub uc { &Lrequire('./lib/db-data.cgi'); &UserCertify }
sub uro{ &Lrequire('./lib/db-data.cgi'); &UserRoom }
sub pc { &Lrequire('./lib/db-data.cgi'); &PassChange }
sub pca{ &Lrequire('./lib/db-data.cgi'); &PassChangeAct }
sub ue { &Lrequire('./lib/db-data.cgi'); &UserEdit }
sub uea{ &Lrequire('./lib/db-data.cgi'); &UserEditAct }
sub uda{ &Lrequire('./lib/db-data.cgi'); &UserDeleteAct }
sub dr { &Lrequire('./lib/db-data.cgi'); &DataRegist }
sub dra{ &Lrequire('./lib/db-data.cgi'); &DataRegistAct }
sub de { &Lrequire('./lib/db-data.cgi'); &DataEdit }
sub dep{ &Lrequire('./lib/db-data.cgi'); &DataEditPart }
sub dea{ &Lrequire('./lib/db-data.cgi'); &DataEditAct }
sub dda{ &Lrequire('./lib/db-data.cgi'); &DataDeleteAct }
sub j  { &Lrequire('./lib/db-data.cgi'); &Jump }
sub v  { &Lrequire('./lib/db-data.cgi'); &Vote }
sub pr { &Lrequire('./lib/db-data.cgi'); &PassReissue }
sub pra{ &Lrequire('./lib/db-data.cgi'); &PassReissueAct }
sub s  { &Lrequire('./lib/db-view.cgi'); &Search }
sub dp { &Lrequire('./lib/db-view.cgi'); &DataPart }
sub fm { &Lrequire('./lib/db-fm.cgi'); &FormMail }
sub fma{ &Lrequire('./lib/db-fm.cgi'); &FormMailAct }
sub lt { &LockTest }

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

################
#   Lrequire   #
################
sub Lrequire{ my$lib=shift;
eval{ require"$lib" } or &Die("$libを呼び出せません。");}

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

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

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

##############
#   Myglob   #
##############
sub Myglob{ my($dir,$type)=@_;
my($file,@list);
opendir(DIR,$dir) or &Error('ディレクトリOPENに失敗しました。');
while(defined($file=readdir DIR)){
    ($file=~/$type$/) and push(@list,$file);
}closedir(DIR);
return@list;}

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

################
#   FileRead   #
################
sub FileRead{ local($file,*line,$type,$name)=@_;
if(!open(FILE,$file)){
    ($name eq '') and $name=(split/\//,$file)[-1];
    &Error("$nameが開けません。");
}if($type){ $line=<FILE> }
else{ @line=<FILE> }
close(FILE);}

#################
#   FileWrite   #
#################
sub FileWrite{ my($file,$data,$open,$name)=@_;
if($open){
    if(!open(FILE,">>$file")){
        ($name eq '') and $name=(split/\//,$file)[-1];
        &Error("$nameが開けません。");
    }
}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);}

################
#   SidCheck   #
################
sub SidCheck{ my$dir=shift; local(*id);
&FileRead("$dir/submit.dat",*id,1);
($id eq $FORM{SID}) and &Error('同一内容の２重送信です。<BR>送信ボタンは１度だけ押すようにして下さい。'); 1;}

############
#   Html   #
############
sub Html{ my$file=shift;
print"Content-Type: text/html\n\n";
eval{ require"./lib/template/$file" } or &Die("$fileを呼び出せません。",1);
print$Copyright;exit;}

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

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

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

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

###################
#   GetFormData   #
###################
sub GetFormData{ my$divided=shift; my$buff;
if($ENV{REQUEST_METHOD} eq 'POST'){
    if($ENV{CONTENT_TYPE}=~/^multipart\/form-data/){
        my$lenmax=$ClenMax;
        foreach(values%{$CNF{Upload}{FileSize}}){ $lenmax+=$_*1024 }
        &Multipart(16384,$UpDir,100,20);
        return(1);
    }else{ ($ENV{CONTENT_LENGTH} > $ClenMax) and &Error('送信データが大きすぎます。');
        read(STDIN,$buff,$ENV{CONTENT_LENGTH});
    }
}else{ $buff=$ENV{QUERY_STRING} }
foreach(split(/&/,$buff)){
    ($key,$val)=split(/=/,$_,2);
    $key=&UrlDecode($key);
    $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}.="\0";
        $divided{$key}=1;
    }else{ push(@keys,$key) }
    $FORM{$key}.=$val;
}foreach(keys%divided){
    $FORM{$_}=~s/,/，/g;
    $FORM{$_}=~s/\0/,/g;
}}

#################
#   Multipart   #
#################
sub Multipart{ my($bufsize,$dir,$maxbound,$fnmax)=@_;
&Secure(scalar@MyUrl,undef,undef,undef,$CNF{Check}{Proxy},$CNF{Check}{Domain},$CNF{Check}{Vip});
stat($dir); &Error('保存ディレクトリが不正です。') unless -d _ && -w _;
binmode(STDIN);
my($boundary)=$ENV{CONTENT_TYPE}=~/boundary="([^"]+)"/;
($boundary)=$ENV{CONTENT_TYPE}=~/boundary=(\S+)/ unless$boundary;
(!$boundary) and &Error('バウンダリがありません。');
$boundary="--".$boundary;
my$blen=length$boundary;
my($buf,$bpos,$name,$macie,$head,$lpos,@head,$cd,$ct,$file);
my$left=$ENV{CONTENT_LENGTH};
my$loop=0;
MAIN:while(1){
    my$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);
    ($ct)=grep(/^\s*Content-Type:/i,@head);
    ($ct=~/application\/x-macbinary/i) and $macie=1;
    ($name)=$cd=~/\bname="?([^"]+)"?/i;
    ($file)=$cd=~/\bfilename="?([^"]+)"?/i;
    if($file ne ''){
        ($file)=$file=~/([^:\/\\]+)$/;
        my$flen=length$file;
        ($flen > $fnmax) and &Error("$fileのファイル名が長すぎます。<BR>(現在：$flen文字 最大：$fnmax文字)");
        $file=~/\.\./ and &Error('ファイル名が不正です。');
        $file=~/[^\-_0-9A-Za-z\.]/ and &Error('ファイル名に使用出来ない文字が含まれています。');
        $file!~/^(.*)\.(\w+)$/ and &Error('ファイルに拡張子がありません。');
        my$type=lc($2);
        $CNF{Upload}{FileType}{$name}{$type} or &Error('この種類のファイルは<BR>アップロードが禁止されています。');
        if(-e"$dir/$file"){
            my($nm1,$nm2,$nm3)=($1,2,$2);
            while(-e$dir."/$nm1($nm2).$nm3"){ $nm2++ }
            $file="$nm1($nm2).$nm3";
        }$SizeMax{$file}=$CNF{Upload}{FileSize}{$name};
        open(UPFILE,">$dir/$file") or &Error('添付ファイルを書き込めませんでした。');
        binmode(UPFILE);
        push(@UpFile,$file);
        $FORM{$name}=$file;
    }elsif(length$name and exists$FORM{$name}){
        $FORM{$name}.="\0";
        $divided{$name}=1;
    }substr($buf,0,$lpos+4)='';
    $loop++; ($loop>=1000) and &Error('ループエラー');
}foreach(@UpFile){
    $size=-s"$dir/".$_;
    $size=eval{ $size/1024 };
    $size=sprintf("%.2f",$size);
    ($size > $SizeMax{$_}) and &Error("$_が最大サイズを超えています。<BR>(現在：$size\KB 最大：$SizeMax{$_}\KB)");
}foreach$key(keys%FORM){
    $val=$FORM{$key};
    $val=~s/\t//g;
    $val=~s/(?:\r\n|\r)/\n/g;
    jcode::convert(*val,'sjis');
    $FORM{$key}=$val;
}foreach(keys%divided){
    $FORM{$_}=~s/,/，/g;
    $FORM{$_}=~s/\0/,/g;
}if($FORM{Preview}){ foreach(@UpFile){ unlink"$UpDir/$_" } }}

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

#################
#   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;}

###############
#   GetDate   #
###############
sub GetDate{ 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;}

############
#   Lock   #
############
sub Lock{ my($n,$lax)=@_;
my$lock="$LockDir/$n.loc";
if($LockType==1){
    open($n,">$lock");
    flock($n,2);
    $LockFile{$n}=1; return(1);
}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,2);
    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);}

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

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

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

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

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

#################
#   SetCookie   #
#################
sub SetCookie{ my($cookname,$cookval,$cookexp)=@_;
my@Month=(Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec);
my@Week=(Sun,Mon,Tue,Wed,Thu,Fri,Sat);
my($sec,$min,$hour,$mday,$mon,$year,$wday)=gmtime(time+$cookexp*86400);
my$expires=sprintf("%s, %02d-%s-%04d %02d:%02d:%02d GMT",$Week[$wday],$mday,$Month[$mon],$year+1900,00,00,00);
$cookname=&UrlEncode($cookname);
$cookval=&UrlEncode($cookval);
print"Set-Cookie: $cookname=$cookval; expires=$expires\n"; 1;}

#################
#   GetCookie   #
#################
sub GetCookie{ my$cookname=shift;
foreach(split(/;/,$ENV{HTTP_COOKIE})){
    $_=&UrlDecode($_);
    my($key,$val)=split(/=/);
    $key=~s/\s//g;
    $buff{$key}=$val;
}foreach(split(/\,/,$buff{$cookname})){
    my($key,$val)=split(/<>/);
    $COOKIE{$key}=$val;
}1;}

##############
#   Secure   #
##############
sub Secure{ my($ref,$method,$admin,$sid,$proxy,$domain,$vip,$lax)=@_;
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('設置サイト外からの呼び出しです。');
    }
}&MethodCheck if($method);
&AdminCheck if($admin ne '');
&SidCheck($sid) if($sid and $SidChkMode);
&ProxyCheck($proxy,$domain,$vip); 1;}

###################
#   MethodCheck   #
###################
sub MethodCheck{ &Error('METHOD形式が不正です。<BR>POST形式でのみ送信できます。') if($ENV{REQUEST_METHOD} !~ /POST/i); 1;}

##################
#   AdminCheck   #
##################
sub AdminCheck{
if($CNF{AdminPass} ne ''){
    if($CryptMode){ &Error('管理用パスワードが違います。') if(crypt($FORM{AdminPass},$CNF{AdminPass}) ne $CNF{AdminPass}) }
    else{ &Error('管理用パスワードが違います。') if($FORM{AdminPass} ne $CNF{AdminPass}) }
}1;}

##################
#   ProxyCheck   #
##################
sub ProxyCheck{ my($proxy,$domain,$vip,$error,$perror)=@_;
if($proxy){
    if($DomainName=~/squid|proxy|cache|delegate|keeper|^firewall|^dns|^mail|^www|^ns\d{0,2}\.|us$|uk$|au$|fi$|ca$|de$|kr$|tw$|it$|edu$|com$|org$|net$/i || 
    $ENV{HTTP_USER_AGENT} =~ /squid|via|delegate|httpd|proxy|cache|Turing|ANONYM/i || !$ENV{REMOTE_ADDR} ||
    defined $ENV{HTTP_X_FORWARDED_FOR} || defined $ENV{HTTP_FORWARDED} || defined $ENV{HTTP_PROXY_CONNECTION} || defined $ENV{HTTP_XROXY_CONNECTION} || defined $ENV{HTTP_XONNECTION} || 
    defined $ENV{HTTP_VIA} || defined $ENV{HTTP_CLIENT_IP} || defined $ENV{HTTP_X_LOCKING} || defined $ENV{HTTP_SP_HOST} || defined $ENV{HTTP_CACHE_INFO} || defined $ENV{HTTP_CACHE_CONTROL}
    ){ $error=1; $perror=1; }
}if(!$error and $domain){ unless(&DomainCheck('out')){ $error=1 } }
if($error  and $vip){ unless(&DomainCheck('vip')){ $error=0 } }
if($error){ if($perror){ &Error('只今、プロキシ経由の更新を制限しております。<BR>ブラウザ設定でプロキシを使用しないドメイン欄に<BR>ここのURLのドメインを設定してください。<BR>ご迷惑をおかけして申し訳ありませんが<BR>ご理解の程よろしくお願い致します。') }
    &Error('只今、あなたが使用しているホストからの<BR>データ更新を制限しております。<BR>可能でしたら他のホストを使用して<BR>もう一度アクセスしてください。');
}1;}

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

#################
#   AccessLog   #
#################
sub AccessLog{ my($dir,$action)=@_; local(*AccessLogLines);
&FileRead("$dir/access.log",*AccessLogLines);
if(@AccessLogLines >= $CNF{AcsLog}{Max}){
    if($CNF{AcsLog}{File}){ &Backup(\@AccessLogLines,$CNF{AcsLog}{File},$dir,'dat') }
    @AccessLogLines=();
}unshift(@AccessLogLines,"[$Date] - $DomainName - $ENV{REMOTE_ADDR} - $ENV{HTTP_USER_AGENT} - $ENV{HTTP_X_FORWARDED_FOR} - $action\n");
&FileWrite("$dir/access.log",\@AccessLogLines); 1;}

##############
#   Backup   #
##############
sub Backup{ my($line,$max,$dir,$type)=@_;
my@Files=&Myglob($dir,$type);
my$FileSu=@Files+1;
if(@Files >= $max){
    my$DeleteSu=$FileSu-$max;
    foreach(1..$DeleteSu){ unlink"$dir\/$_\.$type" }
    my$NewName=0;
    foreach($DeleteSu+1..@Files){ $NewName++; rename("$dir\/$_\.$type","$dir\/$NewName\.$type") }
    $FileSu=$NewName+1;
}&FileWrite("$dir/$FileSu.$type",\@{$line}); 1;}

##################
#   TagConvert   #
##################
sub TagConvert{ my($buff,$item,$permit,$link)=@_;
my(@buff,$tag,$text,$TagTmp,$TagName,$property,@OpenTag,$PropertyTmp,$pname,$pval,$found,$CloseTag);
@buff=split(/(<[^>]*>)/,$buff,-1);
$buff=&TagEncode(shift@buff);
$buff=&AutoLink($buff) if($link);
while(($tag,$text)=splice(@buff,0,2)){
    $text=&TagEncode($text);
    $TagTmp=$tag;
    $tag=~s/\n//g;
    if($tag=~/^<(\w+)\s*([^>]*)>$/){
        $TagName=uc$1;
        $property=$2;
        if(exists${${$permit}{$item}}{$TagName}){
            push(@OpenTag,$TagName) if($CNF{Tag}{Close}{$TagName});
            undef$PropertyTmp;
            $property=~s/\'/\"/g;
            while($property=~/[\s]*?([^=\W]+)(=[\s]*?(?:"([^"]*)"|([^ ]+)))?/g){
                if($2 ne ''){ $pname=$1;
                    $pval=$3 ne ''?$3:$4;
                    next if($pname !~ /^[\s]*?(?:$CNF{Tag}{Property}{$TagName})[\s]*?$/i);
                    $pval=~s/"//g;
                    $PropertyTmp.=qq( $pname="$pval");
                }
            }$tag="<$TagName$PropertyTmp>";
        }else{ $tag=&TagEncode($TagTmp) }
    }elsif($tag=~/^<\/(\w+)>$/){
        $TagName=uc$1;
        undef$tag;
        undef$found;
        foreach(@OpenTag){ if($TagName eq $_){ $found=1; last } }
        if($found){
            while($CloseTag=pop(@OpenTag)){
                $tag.="</$CloseTag>";
                last if($TagName eq $CloseTag);
            }
        }else{ $tag=&TagEncode($TagTmp) }
    }else{ $tag=&TagEncode($TagTmp) }
    if($link){ undef$found;
        foreach(@OpenTag){ if($_ eq 'A'){ $found=1; last } }
        $text=&AutoLink($text) unless($found);
    }$buff.="$tag$text";
}foreach(@OpenTag){ $buff.="</$_>" } $buff;}

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

#####################
#   UserCookieGet   #
#####################
sub UserCookieGet{
return 1 if($FORM{AdminPass} ne '');
&GetCookie("$CNF{Cookie}{Name}(User)");
$FORM{UserNum}=$COOKIE{UserNum} if($FORM{UserNum} eq '');
$FORM{Pass}=$COOKIE{Pass} if($FORM{Pass} eq '') }

#######################
#   DataRegistCheck   #
#######################
sub DataRegistCheck{ my($edit)=@_;
&Error('管理者以外の方のデータ登録・編集はできません。') if($CNF{Check}{DataRegist} && $FORM{AdminPass} eq '');
if($edit){ &DataNumCheck }
&UserCheck;
($TargetUser[$REC{User}{UserType}]=~/^h/ and $FORM{AdminPass} eq '') and &Error('ユーザータイプがデータ登録不可となっている為<BR>データ登録や編集はできません。'); }

####################
#   DataNumCheck   #
####################
sub DataNumCheck{
&FileRead("$DataDir/data/data.cgi",*DataLines);
undef$found;
foreach(0..$#DataLines){
    @SplitData=split(/<>/,$DataLines[$_]);
    if($FORM{DataNum} eq $SplitData[0]){
        $found=1; $LineNum2=$_; @TargetData=@SplitData;
        if($FORM{AdminPass} ne ''){ $FORM{UserNum}=$SplitData[1]; return 1; }
        &Error('データ登録者以外は編集はできません。') if($FORM{UserNum} ne $SplitData[1]); last;
    }
}&Error('データ番号が不正です。') unless($found) }

#################
#   UserCheck   #
#################
sub UserCheck{
&FileRead("$UserDir/user.cgi",*UserLines);
$i=5; foreach(sort keys%{$CNF{UserItem}{Save}}){ $i++; $Usave{$_}=$i; }
undef$found;
foreach(0..$#UserLines){
    my@tmp=split(/<>/,$UserLines[$_]);
    if($FORM{UserNum} eq $tmp[$REC{User}{UserNum}]){
        $found=1; $LineNum=$_; @TargetUser=@tmp;
        return(1) if($FORM{AdminPass} ne '');
        if($CryptMode){
            if(crypt($FORM{Pass},$tmp[$REC{User}{Pass}]) ne $tmp[$REC{User}{Pass}]){
                if($Usave{TempPass} ne '' and $tmp[$Usave{TempPass}] ne ''){
                    if(crypt($FORM{Pass},$tmp[$Usave{TempPass}]) ne $tmp[$Usave{TempPass}]){ &Error('ユーザー番号又はパスワードに誤りがあります。') }
                }else{ &Error('ユーザー番号又はパスワードに誤りがあります。') }
            }
        }else{
            if($FORM{Pass} ne $tmp[$REC{User}{Pass}]){
                if($Usave{TempPass} ne '' and $tmp[$Usave{TempPass}] ne ''){
                    if($FORM{Pass} ne $tmp[$Usave{TempPass}]){ &Error('ユーザー番号又はパスワードに誤りがあります。') }
                }else{ &Error('ユーザー番号又はパスワードに誤りがあります。') }
            }
        }last;
    }
}&Error('ユーザー番号又はパスワードに誤りがあります。') unless($found) }

###################
#   ViewConvert   #
###################
sub ViewConvert{ my($all,$save,$target)=@_; $i=-1;
foreach(@{$save}){ $i++;
    if(${${$all}{Link}}{$_}){ ${$target}[$i]=&UnAutoLink(${$target}[$i]) }
    if(${${$all}{Lines}}{$_}){ ${$target}[$i]=~s/<BR>/\n/g }
    if(${${$all}{Select}}{$_}){ foreach$a(split/,/,${$target}[$i]){ $Select{$_}{${${$all}{Select}}{$_}{$a}}='selected' } }
    if(${${$all}{CheckBox}}{$_}){ foreach$a(split/,/,${$target}[$i]){ $CheckBox{$_}{${${$all}{CheckBox}}{$_}{$a}}='checked' } }
    ${$target}[$i]=~s/"/&quot;/g;
    $DATA{$_}=${$target}[$i];
}}

###################
#   MailConvert   #
###################
sub MailConvert{ my($all,$save,$target)=@_; $i=-1;
foreach(@{$save}){ $i++;
    if(${${$all}{Link}}{$_}){ ${$target}[$i]=&UnAutoLink(${$target}[$i]) }
    if(${${$all}{Lines}}{$_}){ ${$target}[$i]=~s/<BR>/\n/g }
}}

#######################
#   RegistDataCheck   #
#######################
sub RegistDataCheck{ my($all,$nopass)=@_;
foreach(@{${$all}{Necessary}}){
    next if(($_ eq '') or ($_ eq 'Pass' and $nopass));
    if($FORM{$_} eq ''){ $item=${$all}{DataName}{$_}; &Error("$itemが入力されていません。"); }
}while(($a,$b)=each(%{${$all}{Same}})){
    next if(($a eq '' or $b eq '') or (($a eq 'Pass' or $b eq 'Pass') and $nopass));
    if($FORM{$a} ne $FORM{$b}){ ($a,$b)=(${$all}{DataName}{$a},${$all}{DataName}{$b}); &Error("$aと$bの入力が違います。"); }
}while(($item,$maxlen)=each(%{${$all}{Mojisu}})){
    next if(($item eq '') or ($item eq 'Pass' and $nopass));
    $len=length($FORM{$item});
    if($len > $maxlen){ $item=${$all}{DataName}{$item}; &Error("$itemが最大文字数を越えています。<BR>(最大：$maxlen文字 現在：$len文字)"); }
}while(($item,$pattern)=each(%{${$all}{Valid}})){
    next if($item eq '' or $FORM{$item} eq '' or ($item eq 'Pass' and $nopass));
    if($FORM{$item} !~ /$pattern/i){ $item=${$all}{DataName}{$item}; &Error("$itemの入力が不正です。"); }
}while(($item,$pattern)=each(%{${$all}{Invalid}})){
    next if($item eq '' or $FORM{$item} eq '' or ($item eq 'Pass' and $nopass));
    if($FORM{$item} =~ /$pattern/i){ $item=${$all}{DataName}{$item}; &Error("$itemの入力が不正です。"); }
}while(($item,$maxnum)=each(%{${$all}{NumMax}})){
    next if(($item eq '') or ($item eq 'Pass' and $nopass));
    $FORM{$item} eq '' and next;
    if($FORM{$item} > $maxnum){ $item=${$all}{DataName}{$item}; &Error("$itemの数値が大きすぎます。(最大：$maxnum)"); }
}while(($item,$mininum)=each(%{${$all}{NumMini}})){
    next if(($item eq '') or ($item eq 'Pass' and $nopass));
    $FORM{$item} eq '' and next;
    if($FORM{$item} < $mininum){ $item=${$all}{DataName}{$item}; &Error("$itemの数値が小さすぎます。(最小：$mininum)"); }
} }

#########################
#   RegistDataConvert   #
#########################
sub RegistDataConvert{ my($all)=@_;
foreach(@{${$all}{All}}){
    $FORM{$_}=&TagConvert($FORM{$_},$_,\%{${$all}{Tag}},${${$all}{Link}}{$_});
    $FORM{$_}=~s/<>/&lt;&gt;/g;
    ${${$all}{Lines}}{$_} ? $FORM{$_}=~s/\n/<BR>/g : $FORM{$_}=~s/\n//g;
}}

#####################
#   RegistPreview   #
#####################
sub RegistPreview{ local($file,$all,$nopass)=@_;
foreach(@{${$all}{All}}){
    $PREFORM{$_}=&TagConvert($PREFORM{$_},$_,\%{${$all}{Tag}},${${$all}{PreLink}}{$_});
    ${${$all}{Lines}}{$_} ? $PREFORM{$_}=~s/\n/<BR>/g : $PREFORM{$_}=~s/\n//g;
}&Html($file);}

##################
#   _PreHidden   #
##################
sub _PreHidden{
foreach(@{${$all}{All}}){
    (($_ eq 'Pass' or $_ eq 'Pass2') and $nopass) and next;
    ${${$all}{Upload}}{$_} and next;
    $HIDDENFORM{$_}=~s/"/&quot;/g;
    print qq(<INPUT type="hidden" name="$_" value="$HIDDENFORM{$_}">\n);
}}

################
#   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/$type.txt");# ─TEST
print MAIL "MIME-Version: 1.0\n";
print MAIL "X-Mailer: $Ver\n";
print MAIL "X-Http-Referer: $BaseDir/$MainCGI\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);}

##################
#   _KanriMenu   #
##################
sub _KanriMenu{ my$sel=shift;
&FileRead("$UserDir/wait.cgi",*UTempLines);
&FileRead("$DataDir/data/wait.cgi",*DTempLines);
$UtempSu=@UTempLines;
$DtempSu=@DTempLines;
$select{$sel}='selected';
print qq(<OPTION value="ur" $select{ur}>管理者ユーザ登録</OPTION>
<OPTION value="dr" $select{dr}>管理者データ登録</OPTION>
<OPTION value="uj" $select{uj}>ユーザ申\請審査 [$UtempSu件]</OPTION>
<OPTION value="dj" $select{dj}>データ申\請審査 [$DtempSu件]</OPTION>
<OPTION value="c" $select{c}>環境設定</OPTION>
<OPTION value="ia" $select{ia}>データ種類追加</OPTION>
<OPTION value="id" $select{id}>データ種類削除</OPTION>
<OPTION value="js" $select{js}>登録数ファイル更新</OPTION>
<OPTION value="b" $select{b}>バックアップ作成</OPTION>
<OPTION value="bd" $select{bd}>バックアップ削除</OPTION>
<OPTION value="ci" $select{ci}>CSVファイル読み込み</OPTION>
<OPTION value="rs" $select{rs}>カウントリセット日時設定</OPTION>
<OPTION value="cr" $select{cr}>カウントリセット実行</OPTION>);}

#################
#   _UserMenu   #
#################
sub _UserMenu{ my$sel=shift;
$select{$sel}='selected';
print qq(<OPTION value="pc" $select{pc}>パスワード変更</OPTION>
<OPTION value="ue" $select{ue}>ユーザー情報編集</OPTION>);}

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