use strict;
use warnings;
use threads;
use threads::shared;
use Thread::Semaphore;
#use Thread::Queue;
use warnings;
use threads;
use threads::shared;
use Thread::Semaphore;
#use Thread::Queue;
use Config::IniFiles;
use Data::Dumper;
use Net::IMAP::Simple;
use POSIX qw(strftime);
use mail_parse;
use Mail::Sender;
use File::Spec::Functions;
use Cwd;
use Win32::ChangeNotify;
use Fcntl qw/:flock/;
BEGIN{push (@INC,'.');}
$|++;
our $conf_dir = catdir(getcwd(),'conf');
our $cfg_file = catfile($conf_dir,'conf.ini');
my $cmd_file = 'list.ini';
my $pre_mails_num = 'pre mails num.ini';
my $mails_ref;
my @threads;
my $pre = 74||get_pre_mails_num($pre_mails_num);
our $cfg_ref:shared = load_from_cfg_file($cfg_file);
my $cmd_list_ref = load_cmd_list_from_file($cmd_file);
my $imap; #全局用，不传递
use Data::Dumper;
use Net::IMAP::Simple;
use POSIX qw(strftime);
use mail_parse;
use Mail::Sender;
use File::Spec::Functions;
use Cwd;
use Win32::ChangeNotify;
use Fcntl qw/:flock/;
BEGIN{push (@INC,'.');}
$|++;
our $conf_dir = catdir(getcwd(),'conf');
our $cfg_file = catfile($conf_dir,'conf.ini');
my $cmd_file = 'list.ini';
my $pre_mails_num = 'pre mails num.ini';
my $mails_ref;
my @threads;
my $pre = 74||get_pre_mails_num($pre_mails_num);
our $cfg_ref:shared = load_from_cfg_file($cfg_file);
my $cmd_list_ref = load_cmd_list_from_file($cmd_file);
my $imap; #全局用，不传递
my $tid = threads->create(\&conf_file_watcher,$cfg_file); #监视配置文件，一旦发生改变，reload
$tid->detach;
my $running_threads=Thread::Semaphore->new($cfg_ref->{max_threads});
while(1)
{
$imap = Net::IMAP::Simple->new($cfg_ref->{server}->{host}) || warn "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
my $running_threads=Thread::Semaphore->new($cfg_ref->{max_threads});
while(1)
{
$imap = Net::IMAP::Simple->new($cfg_ref->{server}->{host}) || warn "Unable to connect to IMAP: $Net::IMAP::Simple::errstr\n";
unless($imap->login($cfg_ref->{server}->{user},$cfg_ref->{server}->{pwd}))
{
err($imap->errstr);
sleep 10;
redo;
}
my $count_of_messages = $imap->select('INBOX');
if ($count_of_messages > $pre)
{
$mails_ref = get_new_mail_info($count_of_messages,$pre);
my @jobs = get_jobs(map {$mails_ref->{$_}->{subject}} sort{$a <=> $b} keys(%$mails_ref));
print "@jobs\n";
write_cmd_log($mails_ref);
$pre = $count_of_messages;
save_mail_num_to_file($pre);
while (my $job = shift @jobs)
{
$running_threads->down;
my $tid = threads->create(\&start_job,$job,$cmd_list_ref);#
{
err($imap->errstr);
sleep 10;
redo;
}
my $count_of_messages = $imap->select('INBOX');
if ($count_of_messages > $pre)
{
$mails_ref = get_new_mail_info($count_of_messages,$pre);
my @jobs = get_jobs(map {$mails_ref->{$_}->{subject}} sort{$a <=> $b} keys(%$mails_ref));
print "@jobs\n";
write_cmd_log($mails_ref);
$pre = $count_of_messages;
save_mail_num_to_file($pre);
while (my $job = shift @jobs)
{
$running_threads->down;
my $tid = threads->create(\&start_job,$job,$cmd_list_ref);#
push @threads,$tid;
}
while(my $thread = shift @threads)
{
print "ready to detach thread\n";
$thread->detach;
$running_threads->up;
}
}
else
{
print "无新邮件\n";
# <STDIN>;
}
while(my $thread = shift @threads)
{
print "ready to detach thread\n";
$thread->detach;
$running_threads->up;
}
}
else
{
print "无新邮件\n";
# <STDIN>;
# exit;
}
#$subjects_ref = get_new_mail_subject($count_of_messages);
#$subjects_ref = get_new_mail_subject($count_of_messages);
# for (sort{$b <=> $a} keys(%$mails_ref))
# {
# print "subject: $mails_ref->{$_}->{subject}\n";
# print "date: $mails_ref->{$_}->{date}\n";
# print '=' x 80,"\n";
# }
# exit;
$imap->quit;
sleep $cfg_ref->{sleep_time};
}
sleep $cfg_ref->{sleep_time};
}
sub load_from_cfg_file
{
my $file = shift;
my $ini=Config::IniFiles->new( -file => $file);
die "can't find $file:$!\n" if !$ini;
my $cfg = {};
$cfg->{$_} = $ini->val('General',$_) for qw(log_dir script_dir neRe_dir max_threads sleep_time);
$cfg->{server}->{$_} = $ini->val('IMAP SERVER',$_) for qw(host user pwd smtp);
$cfg->{neRe_mail}->{$_} = $ini->val('neRe mail',$_) for qw(from user pwd to);
# print Dumper $cfg;
{
my $file = shift;
my $ini=Config::IniFiles->new( -file => $file);
die "can't find $file:$!\n" if !$ini;
my $cfg = {};
$cfg->{$_} = $ini->val('General',$_) for qw(log_dir script_dir neRe_dir max_threads sleep_time);
$cfg->{server}->{$_} = $ini->val('IMAP SERVER',$_) for qw(host user pwd smtp);
$cfg->{neRe_mail}->{$_} = $ini->val('neRe mail',$_) for qw(from user pwd to);
# print Dumper $cfg;
return shared_clone($cfg);
}
}
sub get_pre_mails_num
{
my $file = shift;
my $mail_num_conf=Config::IniFiles->new( -file => $file);
die "can't find $file:$!\n" if !$mail_num_conf;
return $mail_num_conf->val('num', 'total mails');
}
{
my $file = shift;
my $mail_num_conf=Config::IniFiles->new( -file => $file);
die "can't find $file:$!\n" if !$mail_num_conf;
return $mail_num_conf->val('num', 'total mails');
}
sub load_cmd_list_from_file
{
my $file = shift;
my $cmd = {};
open FH,"<",catfile($conf_dir,$file);
while (<FH>)
{
next if /^#/;
{
my $file = shift;
my $cmd = {};
open FH,"<",catfile($conf_dir,$file);
while (<FH>)
{
next if /^#/;
my ($key,$value) = split /=/,$_;
$cmd->{lc $key} = $value;
}
close FH;
return $cmd;
}
sub get_new_mail_info
{
my ($total,$pre) = @_;
my $mail_info = {};
for(my $i = $total; $total - $pre < $i; $i--)
{
next if $imap->seen($i);
my $mail = mail_parse::new(\@{$imap->top($i)});
# $mail_info->{$i}->{subject} = ($mail->get('subject'))=~/[cmd]/i ? $mail->get('subject') : next;
$cmd->{lc $key} = $value;
}
close FH;
return $cmd;
}
sub get_new_mail_info
{
my ($total,$pre) = @_;
my $mail_info = {};
for(my $i = $total; $total - $pre < $i; $i--)
{
next if $imap->seen($i);
my $mail = mail_parse::new(\@{$imap->top($i)});
# $mail_info->{$i}->{subject} = ($mail->get('subject'))=~/[cmd]/i ? $mail->get('subject') : next;
$mail_info->{$i}->{subject} = $mail->get('subject');
$mail_info->{$i}->{date} = format_date($mail->get('date'),'/');
$imap->see($i) #设置已读 #这条不要注释
$mail_info->{$i}->{date} = format_date($mail->get('date'),'/');
$imap->see($i) #设置已读 #这条不要注释
}
return $mail_info;
}
return $mail_info;
}
sub format_date
{
my ($date,$cvs) = @_;
my ($day,$moon,$year,$time) = $date=~/\s*(\d+)\s+(\w+)\s+(\d+)\s+(.*?)\s+/;
my %moon=(
'Jan' => '01',
'Feb' => '02',
'Mar' => '03',
'Apr' => '04',
'May' => '05',
'Jun' => '06',
'Jul' => '07',
'Aug' => '08',
'Sep' => '09',
'Oct' => '10',
'Nov' => '11',
'Dec' => '12',
);
return join("$cvs",($year,$moon{$moon},$day))." $time";
}
{
my ($date,$cvs) = @_;
my ($day,$moon,$year,$time) = $date=~/\s*(\d+)\s+(\w+)\s+(\d+)\s+(.*?)\s+/;
my %moon=(
'Jan' => '01',
'Feb' => '02',
'Mar' => '03',
'Apr' => '04',
'May' => '05',
'Jun' => '06',
'Jul' => '07',
'Aug' => '08',
'Sep' => '09',
'Oct' => '10',
'Nov' => '11',
'Dec' => '12',
);
return join("$cvs",($year,$moon{$moon},$day))." $time";
}
sub save_mail_num_to_file
{
my $file = 'pre mails num.txt';
open F,">",$file;
print F "total mails:",shift;
close F;
}
{
my $file = 'pre mails num.txt';
open F,">",$file;
print F "total mails:",shift;
close F;
}
sub write_cmd_log
{
my $subjects_ref = shift;
open LOG,">>",catfile($cfg_ref->{log_dir},'cmd.log');
for (sort{$b <=> $a} keys(%$subjects_ref))
{
my $date_time = strftime "%y/%m/%d %H:%M:%S", localtime; #这里可以取邮件的时间作为参考
{
my $subjects_ref = shift;
open LOG,">>",catfile($cfg_ref->{log_dir},'cmd.log');
for (sort{$b <=> $a} keys(%$subjects_ref))
{
my $date_time = strftime "%y/%m/%d %H:%M:%S", localtime; #这里可以取邮件的时间作为参考
print LOG "$date_time $subjects_ref->{$_}->{subject}\n" ;
}
close LOG;
}
}
close LOG;
}
sub get_jobs
{
return my @jobs = grep {s{\[cmd\](.*)\[\\cmd\]}{$1}i} @_;
}
{
return my @jobs = grep {s{\[cmd\](.*)\[\\cmd\]}{$1}i} @_;
}
sub start_job
{
my ($job,$cmd_list) = @_;
print "job is: $job\n";
my $out_file = catfile($cfg_ref->{neRe_dir},$job.'.txt');
if ( (exists $cmd_list->{$job} && system $cmd_list->{$job}) or ($job=~/\[script\](.*)/i && system catfile($cfg_ref->{script_dir},$1),$out_file))
{
err("can't run job:$job");
}
sendMail($job,$out_file) if $job=~/neRe/; #如果有nere标记，则反馈程序执行 结果
unlink $out_file || warn "can't del $out_file:$!\n";
}
{
my ($job,$cmd_list) = @_;
print "job is: $job\n";
my $out_file = catfile($cfg_ref->{neRe_dir},$job.'.txt');
if ( (exists $cmd_list->{$job} && system $cmd_list->{$job}) or ($job=~/\[script\](.*)/i && system catfile($cfg_ref->{script_dir},$1),$out_file))
{
err("can't run job:$job");
}
sendMail($job,$out_file) if $job=~/neRe/; #如果有nere标记，则反馈程序执行 结果
unlink $out_file || warn "can't del $out_file:$!\n";
}
sub err
{
my $err_msg = shift;
open ERR,">>",catfile($cfg_ref->{log_dir},'err.log');
flock(ERR,LOCK_EX) || warn "can't get lock:$!\n";
my $date_time = strftime "%y/%m/%d %H:%M:%S", localtime;
print ERR '[',$date_time,']',$err_msg,"\n";
flock(ERR,LOCK_UN) || warn "can't unlock:$!\n";
close ERR;
}
{
my $err_msg = shift;
open ERR,">>",catfile($cfg_ref->{log_dir},'err.log');
flock(ERR,LOCK_EX) || warn "can't get lock:$!\n";
my $date_time = strftime "%y/%m/%d %H:%M:%S", localtime;
print ERR '[',$date_time,']',$err_msg,"\n";
flock(ERR,LOCK_UN) || warn "can't unlock:$!\n";
close ERR;
}
sub conf_file_watcher
{
my $conf_file = shift;
while(1)
{
my $notify = Win32::ChangeNotify->new($conf_dir,0,'LAST_WRITE'); #注意路径
{
my $conf_file = shift;
while(1)
{
my $notify = Win32::ChangeNotify->new($conf_dir,0,'LAST_WRITE'); #注意路径
$notify->wait || warn "Notify error: $!\n";
$notify->reset;
$cfg_ref = load_from_cfg_file($cfg_file);
select(undef, undef, undef, 5);
}
}
$notify->reset;
$cfg_ref = load_from_cfg_file($cfg_file);
select(undef, undef, undef, 5);
}
}
sub check_neRe_dir_full
{
opendir DH,$cfg_ref->{neRe_dir} ||die "can't open dir:$!\n";
my @files = grep{!/^\./}readdir DH;
# unlink catfile($neRe_dir,$_) for (@files) if @files > 100;
{
opendir DH,$cfg_ref->{neRe_dir} ||die "can't open dir:$!\n";
my @files = grep{!/^\./}readdir DH;
# unlink catfile($neRe_dir,$_) for (@files) if @files > 100;
}
sub sendMail
{
my ($job,$file_name) = @_;
my $msg;
open F,"<",$file_name;
$msg.=$_ while (<F>);
close F;
my $subject = 'neRe:'.$job;
my $sender;
$sender=new Mail::Sender();
# #my @protocols = $sender->QueryAuthProtocols(); 查询服务器支持的认证方式
{
my ($job,$file_name) = @_;
my $msg;
open F,"<",$file_name;
$msg.=$_ while (<F>);
close F;
my $subject = 'neRe:'.$job;
my $sender;
$sender=new Mail::Sender();
# #my @protocols = $sender->QueryAuthProtocols(); 查询服务器支持的认证方式
if ($sender->MailMsg({
smtp => $cfg_ref->{server}->{smtp},
from => $cfg_ref->{neRe_mail}->{from},
to =>$cfg_ref->{neRe_mail}->{to},
subject => $subject, #主题
smtp => $cfg_ref->{server}->{smtp},
from => $cfg_ref->{neRe_mail}->{from},
to =>$cfg_ref->{neRe_mail}->{to},
subject => $subject, #主题
msg => $msg, #内容
auth => 'LOGIN', #smtp的验证方式
authid =>$cfg_ref->{neRe_mail}->{user}, #user
authpwd => $cfg_ref->{neRe_mail}->{pwd}, #pwd
}) < 0) {
warn "$Mail::Sender::Error\n";
}
else
{
print "neRe Mail sent OK.\n";
}
}
warn "$Mail::Sender::Error\n";
}
else
{
print "neRe Mail sent OK.\n";
}
}