#!/usr/bin/perl #↑perlのパスを自分の環境に合わせて書き直します。 #大抵は、「#!/usr/bin/perl」 か 「#!/usr/local/bin/perl」です。 #解らない場合はサーバー管理者(もしくはプロバイダー)に #確認してください。 $ver="1.12"; ################################################################ # WL-Enq [ウェブアンケート] (Since:2001/06/26) # (C) 2001-2003 by yomi # Eメール: yomi@pekori.to # ホームページ: http://yomi.pekori.to/ ################################################################ ## ---[利用規約]------------------------------------------------------------+ ## 1. このスクリプトはフリーソフトです。このスクリプトを使用した ## いかなる損害に対して作者は一切の責任を負いません。 ## 2. このスクリプトを使用した時点で利用規約(http://yomi.pekori.to/kiyaku.html) ## に同意したものとみなさせていただきます。 ## ご使用になる前に必ずお読みください。 ## -------------------------------------------------------------------------+ $HTTP_HEADER_CONTENT_TYPE = "Content-type: text/html; charset=Shift_JIS\n\n"; BEGIN{ #サーバエラーをトラップ $DIE_CGI_ERROR_FL=undef; sub main::DIE_CGI_ERROR{ my $mes=shift; my $back=$ENV{'HTTP_REFERER'}?qq([戻る]): "
"; print $HTTP_HEADER_CONTENT_TYPE unless $DIE_CGI_ERROR_FL; $DIE_CGI_ERROR_FL=1; print qq(- WL-Enq Ver$ver -
"; } sub get_time{ my ($PR_data,$time_fl); $time=$_[0]; $time_fl=$_[1]; $ENV{'TZ'}='JST-9'; if(!$time){$time=time();} my ($min,$hour,$day,$mon,$year,$week)=(localtime($time))[1 .. 6]; $year+=1900; ++$mon; $week=('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$week]; if(!$time_fl){$PR_data=sprintf("$year/%02d/%02d",$mon,$day);} else{$PR_data=sprintf("$year/%02d/%02d($week) %02d:%02d",$mon,$day,$hour,$min);} return $PR_data; } #管理室(&kanri) sub kanri{ if(&pass_check($FORM{pass},$FORM{id}) eq "admin"){ #メイン管理室 print $HTTP_HEADER_CONTENT_TYPE; require "./$EST{template_path}kanri_admin.html"; } else{ #ユーザ管理室 print $HTTP_HEADER_CONTENT_TYPE; require "./$EST{template_path}kanri_user.html"; } } #パスワードチェック&環境設定ロード sub pass_check{ my($in_pass,$user_name)=@_; my $ret; if($user_name eq "admin"){ my $cr_pass=$EST{pass}; my $fl=0; if($EST{pass} ne "setup"){ if($EST{crypt}){ if(crypt($in_pass,$cr_pass) ne $cr_pass){$fl=1;} } else{ if($in_pass ne $cr_pass){$fl=1;} } if($fl){&mes("パスワードが違います","エラー","java");} } $ret="admin"; } else{ if(-f "./we_data/u_${user_name}.cgi"){require "./we_data/u_${user_name}.cgi";} else{&mes("指定されたアンケートフォームはありません${user_name}","エラー","java");} my $cr_pass=$EST_u{pass}; my $fl=0; if($EST{crypt}){ if(crypt($in_pass,$cr_pass) ne $cr_pass){$fl=1;} } else{ if($in_pass ne $cr_pass){$fl=1;} } if($fl){&mes("パスワードが違います","エラー","java");} $ret="user"; } return $ret; } #ユーザ管理室メニュー実行(&kanri_user) sub kanri_user{ if(&pass_check($FORM{pass},$FORM{id}) eq "admin"){&mes("パスワードが違います","エラー","java");} #mode2で分岐 if($FORM{mode2} eq "u_make_cfg"){&u_make_cfg;} elsif($FORM{mode2} eq "u_make_cfg"){&u_make_cfg;} elsif($FORM{mode2} eq "u_make_koumoku"){&u_make_koumoku;} elsif($FORM{mode2} eq "u_mente_koumoku"){&u_mente_koumoku;} else{&mes("指定されたモードは存在しません:$FORM{mode2}","エラー","java");} } #(u1)環境設定実行 sub u_make_cfg{ my($bf_pass)=$FORM{pass}; if($FORM{Fpass}){$bf_pass=$FORM{Fpass};} if($EST{crypt} && $FORM{Fpass}){$bf_pass=$FORM{Fpass}; $FORM{Fpass}=crypt($FORM{Fpass},"we");} $FORM{Fuser_id}=$FORM{Fkigen}=""; #フォームチェック $FORM{Fip_check}=~s/[^\d\-]//g; if(!$FORM{Fip_check}){$FORM{Fip_check}=0;} my(%copy_EST_u); while(my($key,$value)=each %EST_u){ if(defined $FORM{"F$key"}){ if($key eq "end_mes" || $key eq "css"){$FORM{"F$key"}=~s/\t/\n/g; chomp $FORM{"F$key"};} else{ $copy_EST_u{$key}=$FORM{"F$key"}; $FORM{"F$key"}="e_str($FORM{"F$key"}); } $EST_u{$key}=$FORM{"F$key"}; } } if(!$EST{debug}){ &lock($FORM{id}); open(OUT,">./we_data/u_$FORM{id}.cgi") || &mes("./we_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock"); #$FORM{mode3}がdesignならテンプレートデザインに戻す require "./we_lib/cfg_user_lib.cgi"; close(OUT); &unlock($FORM{id}); } while(my($key,$value)=each %copy_EST_u){$EST_u{$key}=$copy_EST_u{$key};} %FORM=(id=>$FORM{id},pass=>$bf_pass,mode=>"kanri"); &kanri; } #(u2)新規項目作成実行 sub u_make_koumoku{ if(!$FORM{Fform}){&mes("形式が指定されていません","エラー","java");} elsif(!$FORM{Ftitle}){&mes("項目名が記入されていません","エラー","java");} elsif(!$FORM{Fjyunjyo}){&mes("何番目に作成するかが指定されていません","エラー","java");} my $line="$FORM{Fjyunjyo}<>$FORM{Ftitle}<><><>$FORM{Fform}<>:<>0<>"; my @af_koumoku; my($i,$fl)=(1,0); foreach(@koumoku){ my(@arg)=split(/<>/,$_); if($FORM{Fjyunjyo} eq $arg[0]){ push(@af_koumoku,$line); $i++; $fl=1; } $arg[0]=$i; my($log)=join("<>",@arg); push(@af_koumoku,$log); $i++; } if(!$fl && $FORM{Fjyunjyo} eq $#koumoku+2){push(@af_koumoku,$line);} elsif($#koumoku<0){push(@af_koumoku,$line);} @koumoku=@af_koumoku; if(!$EST{debug}){ &lock($FORM{id}); open(OUT,">./we_data/u_$FORM{id}.cgi") || &mes("./we_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock"); require "./we_lib/cfg_user_lib.cgi"; close(OUT); &unlock($FORM{id}); } %FORM=(id=>$FORM{id},pass=>$FORM{pass},mode=>"kanri"); &kanri; } #(u3)項目の内容変更 sub u_mente_koumoku{ if($FORM{set} eq "削除" && $FORM{del} ne "on"){&mes("削除確認のチェックを入れてから削除ボタンを押してください","エラー","java");} if(!$EST{debug}){ &lock($FORM{id}); my($i,$j)=(0,1); my(@af_koumoku); foreach $line(@koumoku){ my(@arg)=split(/<>/,$line); if($FORM{Fid} eq $arg[0]){ my($class)="ST_" . $arg[4]; my $st=$class->new($line); if($FORM{set} eq "変更"){$st->mente;} #内容変更用の修正 elsif($FORM{set} eq "形式変更"){$st->ch_form;} #形式変更 elsif($FORM{set} eq "順序変更"){ #順序変更 $arg[0]=$FORM{Fjyunjyo}; $line=join("<>",@arg); push(@af_koumoku,$line); } elsif($FORM{set} eq "削除"){ } #削除 else{&mes("指定したセットは存在しません:$FORM{set}","エラー","java","unlock");} $koumoku[$i]=$st->as_mente_log; } elsif($FORM{set} eq "順序変更"){ if($j eq $FORM{Fjyunjyo}){$j++;} $arg[0]=$j; $line=join("<>",@arg); push(@af_koumoku,$line); $j++; } elsif($FORM{set} eq "削除"){ $arg[0]=$j; push(@af_koumoku,join("<>",@arg)); $j++; } $i++; } if($FORM{set} eq "順序変更"){ @koumoku=sort{(split(/<>/,$a,2))[0] <=> (split(/<>/,$b,2))[0]}@af_koumoku; } elsif($FORM{set} eq "削除"){ @koumoku=@af_koumoku; } open(OUT,">./we_data/u_$FORM{id}.cgi") || &mes("./we_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock"); require "./we_lib/cfg_user_lib.cgi"; close(OUT); &unlock($FORM{id}); } %FORM=(id=>$FORM{id},pass=>$FORM{pass},mode=>"kanri"); &kanri; } #メイン管理室メニュー実行(&kanri_admin) sub kanri_admin{ if(&pass_check($FORM{pass},$FORM{id}) ne "admin"){&mes("パスワードが違います","エラー","java");} #mode2で分岐 if($FORM{mode2} eq "a_del_koumoku"){&a_del_koumoku;} #ユーザ削除 elsif($FORM{mode2} eq "a_make_koumoku"){&a_make_koumoku;} #新規ユーザ作成 elsif($FORM{mode2} eq "a_copy_koumoku"){&a_copy_koumoku;} #新規ユーザ作成(コピー) elsif($FORM{mode2} eq "a_make_cfg"){&a_make_cfg;} #環境設定 elsif($FORM{mode2} eq "a_ch_user_pass"){&a_ch_user_pass;} #ユーザ環境設定 else{&mes("指定されたモードは存在しません:$FORM{mode2}","エラー","java");} } #(a1)ユーザ削除 sub a_del_koumoku{ if($FORM{del} ne "on"){&mes("削除チェックがしてありません","エラー","java");} unless(-f "./we_data/u_$FORM{user_id}.cgi"){&mes("指定したユーザは存在しません","エラー","java");} $FORM{"id"}=$FORM{"user_id"}; &lock($FORM{"id"}); require "./we_data/acount.cgi"; open(OUT,">./we_data/acount.cgi") || &mes("./we_data/acount.cgi に書き込めません","エラー","java","unlock"); print OUT "\@acount=(\n"; my(@af_acount); foreach(@acount){ if($FORM{user_id} ne $_){print OUT "'" . $_ . "',\n"; push(@af_acount,$_);} } print OUT ");\n1;\n"; close(OUT); @acount=@af_acount; unlink("./we_data/u_$FORM{user_id}.cgi"); unlink("./we_data/d_$FORM{user_id}.cgi"); &unlock($FORM{"id"}); %FORM=(id=>"admin",pass=>$FORM{pass},mode=>"kanri"); &kanri; } #(a2)新規ユーザ作成 sub a_make_koumoku{ if($FORM{user_id} eq "admin"){&mes("ユーザ名: admin は作成できません","エラー","java");} if(-f "./we_data/u_$FORM{user_id}.cgi"){&mes("そのユーザ名はすでに使用されています:$FORM{user_id}","エラー","java");} if(!$FORM{user_pass}){&mes("パスワードが未記入です","エラー","java");} if($EST{crypt}){$FORM{user_pass}=crypt($FORM{user_pass},"we");} require "./$EST{template_path}defo_user_data.cgi"; open(OUT,">./we_data/u_$FORM{user_id}.cgi") || &mes("./we_data/u_$FORM{user_id}.cgi に書き込めません","エラー","java",); require "./we_lib/cfg_user_lib.cgi"; close(OUT); open(OUT,">./we_data/d_$FORM{user_id}.cgi") || &mes("./we_data/d_$FORM{user_id}.cgi に書き込めません","エラー","java",); print OUT<<'EOM'; @result=( ); @ip_list=( ); 1; EOM close(OUT); require "./we_data/acount.cgi"; push(@acount,$FORM{user_id}); open(OUT,">./we_data/acount.cgi"); print OUT "\@acount=(\n"; foreach(@acount){ print OUT "'" . $_ . "',\n"; } print OUT ");\n1;\n"; close(OUT); %FORM=(id=>"admin",pass=>$FORM{pass},mode=>"kanri"); &kanri; } #(a2.1)新規ユーザ作成(コピー) sub a_copy_koumoku{ if($FORM{new_id} eq "admin"){&mes("ユーザ名: admin は作成できません","エラー","java");} if(-f "./we_data/u_$FORM{new_id}.cgi"){&mes("そのユーザ名はすでに使用されています:$FORM{new_id}","エラー","java");} if(!$FORM{user_pass}){&mes("パスワードが未記入です","エラー","java");} if($EST{crypt}){$FORM{user_pass}=crypt($FORM{user_pass},"we");} unless(-f "./we_data/u_$FORM{old_id}.cgi"){&mes("コピー元の設定ファイルが読み込めません:$FORM{old_id}","エラー","java");} require "./we_data/u_$FORM{old_id}.cgi"; $EST_u{user_id}=$FORM{new_id}; #ユーザID $EST_u{pass}=$FORM{user_pass}; #パスワード unless(-f "./we_data/d_$FORM{old_id}.cgi"){&mes("コピー元の設定ファイルが読み込めません:$FORM{old_id}","エラー","java");} require "./we_data/d_$FORM{old_id}.cgi"; open(OUT,">./we_data/u_$FORM{new_id}.cgi") || &mes("./we_data/u_$FORM{user_id}.cgi に書き込めません","エラー","java",); require "./we_lib/cfg_user_lib.cgi"; close(OUT); open(OUT,">./we_data/d_$FORM{new_id}.cgi") || &mes("./we_data/d_$FORM{user_id}.cgi に書き込めません","エラー","java",); print OUT qq|\@result=(\n|; foreach(@result){ print OUT "'" . $_ . "',\n"; } print OUT ");\n"; print OUT "\@ip_list=(\n"; foreach(@ip_list){ print OUT "'" . $_ . "',\n"; } print OUT ");\n1;\n"; close(OUT); require "./we_data/acount.cgi"; push(@acount,$FORM{new_id}); open(OUT,">./we_data/acount.cgi"); print OUT "\@acount=(\n"; foreach(@acount){ print OUT "'" . $_ . "',\n"; } print OUT ");\n1;\n"; close(OUT); %FORM=(id=>"admin",pass=>$FORM{pass},mode=>"kanri"); &kanri; } #(a3)メイン環境設定変更 sub a_make_cfg{ my($bf_pass)=$FORM{pass}; if($FORM{Fpass}){$bf_pass=$FORM{Fpass};} if($EST{crypt} && $FORM{Fpass}){$bf_pass=$FORM{Fpass}; $FORM{Fpass}=crypt($FORM{Fpass},"we");} while(my($key,$value)=each %EST){ if(defined $FORM{"F$key"}){ $EST{$key}=$FORM{"F$key"}; } } #&mes($EST{debug}); open(OUT,">./we_data/cfg.cgi") || &mes("./we_data/cfg.cgi に書き込めません","エラー","java"); require "./we_lib/cfg_admin_lib.cgi"; close(OUT); %FORM=(id=>$FORM{id},pass=>$bf_pass,mode=>"kanri"); &kanri; } #(a4)ユーザ環境設定実行 sub a_ch_user_pass{ if(-f "./we_data/u_$FORM{user_id}.cgi"){require "./we_data/u_$FORM{user_id}.cgi";} else{&mes("指定されたユーザは存在しません$FORM{user_id}","エラー","java");} if(!$FORM{Fpass}){&mes("ユーザパスワードを設定してください","エラー","java");} if($EST{crypt}){$FORM{Fpass}=crypt($FORM{Fpass},"we");} $FORM{Fuser_id}=$FORM{Fkigen}=""; my(%copy_EST_u); while(my($key,$value)=each %EST_u){ if($FORM{"F$key"}){ if($key eq "end_mes" || $key eq "css"){$FORM{"F$key"}=~s/\t/\n/g; chomp $FORM{"F$key"};} else{ $copy_EST_u{$key}=$FORM{"F$key"}; $FORM{"F$key"}="e_str($FORM{"F$key"}); } $EST_u{$key}=$FORM{"F$key"}; } } &lock($FORM{user_id}); open(OUT,">./we_data/u_$FORM{user_id}.cgi") || &mes("./we_data/u_$FORM{user_id}.cgi に書き込めません","エラー","java","unlock"); require "./we_lib/cfg_user_lib.cgi"; close(OUT); &unlock($FORM{user_id}); while(my($key,$value)=each %copy_EST_u){$EST_u{$key}=$copy_EST_u{$key};} %FORM=(id=>"admin",pass=>$FORM{pass},mode=>"kanri"); &kanri; } sub lock{ #(lock1.1)ロック(&lock) local($PRE_TIME,$TIME_FLAG,$RET,$i,$times,$lockfile,$retry,$id=$_[0]); if(-e "$EST{lock_path}we_$id"){ $times=time(); ($PRE_TIME) = (stat("$EST{lock_path}we_$id"))[9]; $TIME_FLAG = $times - $PRE_TIME; if($TIME_FLAG > 60){ #ロックの強制解除 &unlock($id); } } if(!$EST{lock_method}){ #ディレクトリロック $times=time(); ($PRE_TIME) = (stat("$EST{lock_path}we_$id"))[9]; $TIME_FLAG = $times - $PRE_TIME; $i=1; while(1){ if (mkdir("$EST{lock_path}we_$id", 0755)) { $RET=1; last; } #ロック成功 if ($i==1) { if($TIME_FLAG > 180){ #ロックの強制解除 rmdir("$EST{lock_path}we_$id"); } } elsif ($i < 6) { sleep(1); } else { $RET=0; last; } #ロック失敗 $i++; } } else{ #symlinkロック local($retry) = 5; while (!symlink("./","$EST{lock_path}we_$id")) { if (--$retry <= 0) { &mes("タイムアウトエラーです。