#!/usr/bin/perl --
#↑perlのパスを自分の環境に合わせて書き直します。
#大抵は、「#!/usr/bin/perl」 か 「#!/usr/local/bin/perl」です。
#解らない場合はサーバー管理者(もしくはプロバイダー)に
#確認してください。
$ver="2.08";
################################################################
# Yomi-Mailer Ver2.08 [メールフォーム] (Since:1999/12/27)
# (C) 1999-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(
CGI エラー
エラーメッセージ:
$mes
$back
);
}
$main::SIG{__DIE__}=\&main::DIE_CGI_ERROR;
};
require './ym_lib/jcode.pl';
require './ym_data/cfg.cgi';
&form_decode;
require './ym_lib/ym_lib.pl';
if($FORM{mode} eq "kanri"){&kanri;}
elsif($FORM{mode} eq "kanri_user"){&kanri_user;}
elsif($FORM{mode} eq "kanri_admin"){&kanri_admin;}
elsif($FORM{mode} eq "send"){&send;}
else{ #送信画面&ログイン画面
if(!$FORM{id}){
print $HTTP_HEADER_CONTENT_TYPE;
require "./ym_template/login.html";
exit;
}
elsif(-f "./ym_data/u_$FORM{id}.cgi"){require "./ym_data/u_$FORM{id}.cgi";}
else{&mes("指定されたメールフォームはありません$FORM{id}","エラー","java");}
if($FORM{mode} eq "preview"){
local($PRlog)=&PRlog_preview; #確認用ログ
print $HTTP_HEADER_CONTENT_TYPE;
require "./ym_template/ym_preview.html";
}
else{
print $HTTP_HEADER_CONTENT_TYPE;
require "./ym_template/ym.html";
}
}
exit;
#項目を表示
sub PRlog{
local($line,$st);
foreach $line(@koumoku){
my @arg=split(/<>/,$line);
my($class)="ST_" . $arg[4];
my $st=$class->new($line);
$st->as_html;
}
}
sub PRlog_preview{
local($line,$st,@lines,$PR_html);
foreach $line(@koumoku){
my @arg=split(/<>/,$line);
my($class)="ST_" . $arg[4];
my $st=$class->new($line);
if(my $error=$st->check($arg[0])){&mes($error,"エラー","java");}
$PR_html .=$st->as_preview_html;
}
return $PR_html;
}
#メール送信
sub send{
if(-f "./ym_data/u_$FORM{id}.cgi"){require "./ym_data/u_$FORM{id}.cgi";}
else{&mes("指定されたメールフォームはありません$FORM{id}","エラー","java");}
local($koumoku,$kenmei,$from_email,$to_email,$to_bcc);
foreach $line(@koumoku){
my @arg=split(/<>/,$line);
my($class)="ST_" . $arg[4];
my $st=$class->new($line);
if(my $error=$st->check($arg[0])){&mes($error,"エラー","java");}
$koumoku.=$st->as_email;
if($st->{email}){
if($FORM{"f$st->{id}"}){
$from_email=$FORM{"f$st->{id}"};
if($FORM{copy}){$to_bcc=$FORM{"f$st->{id}"};}
}
}
if($st->{ken}){$kenmei=$FORM{"f$st->{id}"};}
}
if(!$kenmei){$kenmei="(no-subject)";}
if(!$from_email){$from_email=$EST_u{email};}
if(!$ENV{'REMOTE_HOST'}){$ENV{'REMOTE_HOST'}=gethostbyaddr(pack("C4", split(/\./,$ENV{'REMOTE_ADDR'})), 2);}
my $date=&get_time("",1);
$to_email=$EST_u{email};
$honbun=<<"EOM";
このメールは「Yomi-Mailer」より送信されたメールです。
--------------------------------------------------------
********************************************************
[送信日時]:$date
[送信者のIPアドレス]:$ENV{'REMOTE_ADDR'}
[送信者のホスト名]:$ENV{'REMOTE_HOST'}
********************************************************
$koumoku
--------------------------------------------------------
EOM
$head=<<"EOM";
From: $from_email
To: $to_email
Bcc: $to_bcc
Subject: $kenmei
X-Mailer: Yomi-Mailer $ver
X-REMOTE-ADDR: $ENV{'REMOTE_ADDR'}
Content-Transfer-Encoding: 7bit
Content-Type: text/plain; charset="ISO-2022-JP"
EOM
if(!$EST{debug}){
require "./ym_lib/mimew.pl";
if(!open(OUT,"| $EST{sendmail} -t")){&mes("メール送信に失敗しました","エラー","java");}
print OUT &mimeencode($head);
$honbun=~s/\n\.\n/\n\.\.\n/g;
&jcode'convert(*honbun,"jis");
print OUT $honbun;
close(OUT);
}
print $HTTP_HEADER_CONTENT_TYPE;
require "./ym_template/ym_end.html";
exit;
}
#メッセージ出力
sub mes{
local($MES,$Munlock=$_[3],$BACK_URL);
if($Munlock eq "unlock"){&unlock($FORM{id});}
print $HTTP_HEADER_CONTENT_TYPE;
$MES=$_[0];
if($_[1]){$TITLE=$_[1];}
else{$TITLE="メッセージ画面";}
if($_[2] eq "java"){
$BACK_URL='';
}
elsif($_[2] eq "env"){
$BACK_URL=qq(【戻る】);
}
elsif(!$_[2]){$BACK_URL="";}
else{$BACK_URL="【戻る】";}
require "./ym_template/mes.html";
exit;
}
#フォームデータのデコード(&form_decode)
sub form_decode{
if($ENV{'REQUEST_METHOD'} eq "POST"){ read(STDIN,$form,$ENV{'CONTENT_LENGTH'}); }
else{ $form=$ENV{'QUERY_STRING'}; }
my @pairs = split(/&/,$form);
foreach $pair(@pairs){
my($name,$value)=split(/=/,$pair);
$value=~tr/+/ /;
$value=~s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
$name=~s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('H2', $1)/eg;
$value=~s/>/>/g;
$value=~s/</g;
$value=~s/\t/ /g;
$value=~s/\n/\t/g;
$value=~s/\r//g;
&jcode::convert(\$value,'sjis');
&jcode::convert(\$name,'sjis');
$FORM{$name}=$value;
}
}
#著作権表示(削除・変更をしないでください。ただし、中寄せ・左寄せは可)
sub cr{
print "- Yomi-Mailer 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 "./ym_data/u_${user_name}.cgi"){require "./ym_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},"ym");}
$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"};
}
}
if(!$EST{debug}){
&lock($FORM{id});
open(OUT,">./ym_data/u_$FORM{id}.cgi") || &mes("./ym_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock");
#$FORM{mode3}がdesignならテンプレートデザインに戻す
require "./ym_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,">./ym_data/u_$FORM{id}.cgi") || &mes("./ym_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock");
require "./ym_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,">./ym_data/u_$FORM{id}.cgi") || &mes("./ym_data/u_$FORM{id}.cgi に書き込めません","エラー","java","unlock");
require "./ym_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_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 "./ym_data/u_$FORM{user_id}.cgi"){&mes("指定したユーザは存在しません","エラー","java");}
$FORM{"id"}=$FORM{"user_id"};
&lock($FORM{"id"});
require "./ym_data/acount.cgi";
open(OUT,">./ym_data/acount.cgi") || &mes("./ym_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("./ym_data/u_$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 "./ym_data/u_$FORM{user_id}.cgi"){&mes("そのユーザ名はすでに使用されています:$FORM{user_id}","エラー","java");}
if($EST{crypt}){$FORM{user_pass}=crypt($FORM{user_pass},"ym");}
require "./$EST{template_path}defo_user_data.cgi";
open(OUT,">./ym_data/u_$FORM{user_id}.cgi") || &mes("./ym_data/u_$FORM{user_id}.cgi に書き込めません","エラー","java",);
require "./ym_lib/cfg_user_lib.cgi";
close(OUT);
require "./ym_data/acount.cgi";
push(@acount,$FORM{user_id});
open(OUT,">./ym_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},"ym");}
while(my($key,$value)=each %EST){
if(defined $FORM{"F$key"}){
$EST{$key}=$FORM{"F$key"};
}
}
#&mes($EST{debug});
open(OUT,">./ym_data/cfg.cgi") || &mes("./ym_data/cfg.cgi に書き込めません","エラー","java");
require "./ym_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 "./ym_data/u_$FORM{user_id}.cgi"){require "./ym_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},"ym");}
$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,">./ym_data/u_$FORM{user_id}.cgi") || &mes("./ym_data/u_$FORM{user_id}.cgi に書き込めません","エラー","java","unlock");
require "./ym_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}ym_$id"){
$times=time();
($PRE_TIME) = (stat("$EST{lock_path}ym_$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}ym_$id"))[9];
$TIME_FLAG = $times - $PRE_TIME;
$i=1;
while(1){
if (mkdir("$EST{lock_path}ym_$id", 0755)) { $RET=1; last; } #ロック成功
if ($i==1) {
if($TIME_FLAG > 180){ #ロックの強制解除
rmdir("$EST{lock_path}ym_$id");
}
}
elsif ($i < 6) { sleep(1); }
else { $RET=0; last; } #ロック失敗
$i++;
}
}
else{ #symlinkロック
local($retry) = 5;
while (!symlink("./","$EST{lock_path}ym_$id")) {
if (--$retry <= 0) {
&mes("タイムアウトエラーです。
もう一度「戻る」ボタンで戻ってからやり直してください。
Lockmode:symlinkロック","タイムアウトエラー","java");
}
sleep(1);
}
$RET=1;
}
if(!$RET){
&mes("タイムアウトエラーです。
もう一度「戻る」ボタンで戻ってからやり直してください。
Lockmode:ディレクトリロック","タイムアウトエラー","java");
}
}
sub unlock{
#(lock2.1)ロック解除(&unlock_key)
local($id=$_[0]);
if(!$EST{lock_method}){
rmdir("$EST{lock_path}ym_$id");
}
else{
unlink("$EST{lock_path}ym_$id");
}
}
#メタ文字をクオート
sub quote_str{
my $ret=shift;
if(substr($ret,-1,1) eq "\\"){$ret.="\\";}
$ret=~s/'/\\'/g;
return $ret;
}
##-- end of y_mail.cgi --##