Perl Script

因为流量镜像分析的功能还没有做好，目前要统计全站的应用的响应时间就比较麻烦。我直接把做代理的nginx的日志都拷贝出来，然后跑脚本。由于日志是压缩过的，本来直接perl里面可以使用cpan里的一个gunzip的模块，但是测试后发现性能实在烂的不行，连gunzip速度的1/4都不到。后来直接换成调用pigz多线程解压，虽然pigz在解压时不如在压缩时能体现出多线程优势，但是相对直接gunzip还是快了些，反正机器有的是CPU，主要是磁盘性能不行。[perl]#!/usr/bin/perluse warnings; use strict; use IO::Uncompress::Gunzip qw(gunzip $GunzipError); my %dtimes; my %dseconds; my $DEBUG=1; my @logs; my $PRE="/home/test/temp"; my $tempfile="$PRE/gunziptemp"; my @time=(1,2,3,4,5,6,7,8,9,10); opendir my $DIR,"$PRE" or die "open dirctory failed"; while(my $dir=readdir $DIR) {push @logs,$dir if $dir =~/log.gz/ ; }close $DIR; foreach my $log(@logs) {print STDERR "analysis $log\n" if ($DEBUG ==1 ); # open my $logfd,"<$PRE/$log" or die "open $log failed\n"; # open my $unziplog,">$tempfile" or die "open unzip file failed\n"; # gunzip $logfd => $unziplog or die "unzip $log failed\n"; `pigz -d -k -c $PRE/$log >$tempfile ` or "unzip $log failed\n"; print STDERR "unzip $log ok \n" if ($DEBUG ==1 ); # close $unziplog; open my $unziplog,"<$tempfile" or die "open2 unzip file failed\n"; print STDERR "start analysis log\n" if ($DEBUG ==1 ); while(my $line=<$unziplog>) {my @temp; my ($domain,$restime); if($line=~/xxxx.com/) {@temp=split(/\s+/,$line); $domain=$temp[7]; $restime=$temp[-1]; next if( $restime !~ /\d+/); next if( $domain !~ /xxxx.com/ ); $domain=~s/:\d+//; }if(defined $domain && defined $restime ){$dtimes{$domain}++; my @t=grep { $_ – $restime <0} @time; foreach my $k(@t){$dseconds{$domain}{$k}++; } } ...

以前现用perl为我们的首页系统写个daemon进程来做更新首页的事情，其实简单的说就是前端的同事把新的页眉放到存储里面。我的脚本去定期检测一下md5值，然后取出来。取出来后会对指定的字段进行替换。但是在做的时候就遇到点问题，日志一直不打出来。后来简单测试了一下perl #!/usr/bin/perluse strict; use warnings; open LOG,">test.out" or die "open file failed\n"; foreach my $k (0..25){ print LOG ($k,"\n"); sleep(1); } 运行这个的时候你会发现只有程序结束了才会写到文件。后来咨询了一下学了这样搞```perl #!/usr/bin/perluse strict; use warnings; use IO::Handle; open LOG,">test.out" or die “open file failed\n”; LOG->autoflush(); foreach my $k (0..25){ print LOG ($k,"\n"); sleep(1); } 当然也可以选择这样做```perl #!/usr/bin/perluse strict; use warnings; open LOG,">test.out" or die "open file failed\n"; foreach my $k (0..25){syswrite(LOG,"$k\n",1024); sleep(1); }

这个是去年管理测试环境的时候，直接用脚本批量操作数据库```perl #!/usr/bin/perl -wuse DBI;use strict;my $dbh;my $INFILE=$ARGV[0];open LIST ,"<$INFILE" or die "can’t open $INFILE\n";my $table="table_appinfo";$dbh=&connect();my $qurey=qq{insert into $table (ip,name,manage,dev,location) values(?,?,?,?,?) };my $sth=$dbh->prepare($qurey) || die $dbh->errstr;my $dev="lab";my $manage="namexxx";my $location=’location’;while(my $line=){my ($ip,$name)=split /\s+/,$line;$sth->execute($ip,$name,$manage,$dev,$location);print "insert $ip $name\n";}$dbh->disconnect();

如果是登陆到远程smtp服务器上发送的话可以使用```perl #!/usr/bin/perl -wuse Mail::Sender; use strict; printf("please input your passwd:\n"); system "stty -echo"; my $pass; chomp($pass=); system "stty echo"; my $sender= new Mail::Sender{smtp=> ‘smtp.126.com’,from=>’[email protected]’,auth=>’LOGIN’,authid=>’user’,authpwd=> $pass,debug=>’./perllog’}; $sender->MailMsg({to=>’[email protected]’,subject=>’perl send mail’,msg=>’中文测试’,debug=>’./perllog’}) or die "failed"; $sender->Close(); 再提供一个可以发送附件的版本，直接使用内部的邮件服务器发送一些小文件。如果想使用远程服务器可以根据前面的脚本修改。#!/usr/bin/perl -wuse Mail::Sender; my $txt; $txt="hi,all :\n\t xxxx!"; &sendmsg($ARGV[0],$txt,$ARGV[1]); sub sendmsg(){my $add=$_[0]; #email addressmy $msg="$_[1]"; #email txtmy $file=$_[2]; #fileopen my $LOG ,">/tmp/mail.log"; my $sender =new Mail::Sender{ $sender->MailFile({to=>$add,subject=>“hello”,msg=>"$msg",debug=>$LOG,file => $file,charset => ‘gb2312’}) or die “$Mail::Sender::Error\n”;close($LOG);$sender->Close;}

用了个老的RHEL 4.X的机器，蛋疼无比。。bash不支持hash，自带的很多perl的库bug一堆。今天准备写个脚本又遇到个问题。自带的LWP库太老了，搞出段错误了。。 后来把IO::Socket::SSL升级完才算能用 不过现在跑个脚本多会跑出一端报警，LWP Agent里面好像又没有参数可以传进去设置这个，而且以前的很多脚本还地改，然后我就直接把这段警告消息给注释了。实在不想折腾这个老东西。/usr/lib/perl5/site_perl/5.8.5/IO/Socket/SSL.pm

今天突然想起把自己之前写的一个脚本换成多线程的模式改写一下，因为之前的模式很多时间都阻塞住了，每次批量搞几千个机器太费时。先是使用老的Thread模块把脚本改写的一遍，都把脚本写好了验证OK才发现这个是老的模块，不推荐使用，肺都气炸了。还好新的threads模块也类似，简单修改了一下也OK，而且新模块的功能强大很多，可靠性也好。测试一下 #!/usr/bin/perl use strict; use warnings; use threads; my @test=(1...988); srand(); &muti_work; sub muti_work(){ my $JOBN=30; my $jobs=0; while(@test){ if($jobs<$JOBN && $jobs>=0) { my $pid=threads->create(\&echon,shift @test); $jobs++; } elsif($jobs>=$JOBN) { my @actlist=threads->list(threads::joinable); foreach my $t (@actlist) { $t->join; $jobs--; } sleep 0.1; } } while($jobs>0) { my @actlist=threads->list(threads::joinable); foreach my $t(@actlist){ $t->join; $jobs--; } sleep 0.5; } } sub echon(){ my $num=shift; my $t=int(rand(8)); sleep $t; my $thr = threads->self(); print "i am working $num sleep $t\n"; threads->exit(0); } print "ok\n"; 如果涉及到每个线程都有一个返回值的话，可以在函数里面直接运行return就行。使用my $vat=$t->join的形式进行返回值的获取。如果返回的是一个数组，也是可以直接return @list的，但是thread->create的时候需要加参数。详细的看cpan的文档。 ...

因为公司的业务原因，所以基本上全站都是使用https。然后又因为各种各样的问题造成有的域名不能使用通配符证书，只能使用单独的证书，这样就造成了网络配置上同一个应用要配置多个公网IP以便绑定不同的证书(很多浏览器不支持SNI，所以只能配置多个IP了)。今天简单写了一个脚本，测试了一下可以把某个机房全站应用的公网IP对于的证书都检查一遍。 脚本如下： #!/usr/bin/env perl#===============================================================================## FILE: comcheck.pl## USAGE: perl comcheck.pl host_list## DESCRIPTION: test ssl cert## OPTIONS: —# REQUIREMENTS: —# BUGS: —# NOTES: —# AUTHOR: @GNUer ); if ( !( ref $sock eq "IO::Socket::SSL" ) ) {print "connect $hostname failed\n"; return 1; }if ( $sock->verify_hostname( $hostname, ‘http’ ) ) {print "$hostname verification ok\n"; return 0; }else {print STDERR "$hostname verify failed\n"; }my $comname = $sock->peer_certificate("commonName"); my $tname = $hostname; my $tcom = $comname; $tname =~ s/\.xxx.com//g; $tcom =~ s/\.xxx.com//g; if ( $tcom eq "*" && $tname !~ /\./ ) {; print "$hostname $comname\n"; }elsif ( $tname eq $tcom ) {; # print "$hostname eq $comname\n"; }else { } ...

1. Net::Ping,perl的ping模块，范例： #!/usr/bin/perl -wuse strict; use Net::Ping; sub ping_check{my $dest=shift; my $mp = Net::Ping->new("icmp"); if($mp->ping($dest,2)){print "$dest is alive\n"; }else {print "$dest is dead\n"; } } 2.File::Copy 主要提供了copy和move函数 #!/usr/bin/perluse strict; use warnings; use File::Copy; my $filein=$ARGV[0]; my $fileout=$ARGV[1]; copy($filein,$fileout) or die "copy $filein to $fileout failed\n"; move($fileout,"$fileout.test") or die "mv $fileout to $fileout.txt failed\n"; 3.File::Rsync; #!/usr/bin/perluse strict; use warnings; use File::Rsync; my $filein=$ARGV[0]; my $fileout=$ARGV[1]; &rsync_file($filein,$fileout); sub rsync_file{my $localdir=shift; my $remotedir=shift; print "rsync file from $localdir to $remotedir\n"; my $obj = File::Rsync->new( { archive => 1, compress => 1 ,del=>1} ); $obj->exec( { src => $localdir, dest => $remotedir } ) or warn "rsync failed\n"; } ...

perl的正则匹配里有几个有用的匹配方式 1．非捕获型匹配 [perl]#!/usr/bin/perluse warnings; use strict; my $line="123d4f5g7h8"; if($line=~/(?:5)(\w)/){print "match $1\n"; }[/perl] 这样就表示捕获５后面的一个字母或者数字，由于(?:5)是不占用空间的，所以我们还是用$1对捕获的字符串进行引用． 2．命名捕获 #!/usr/bin/perluse warnings; use strict; my $line="123d4f5g7h8"; if($line=~/(?:5)(?\w)/){print "match $+{var1}\n"; } 我们可以使用(?xxx)来把保存匹配的字符串存放在制定的变量里面．引用的时候需要使用$+{NAME}来进行引用． 3.顺序环视 (?=xxx) *******|xxx******** (?=xxx)匹配xxx前面的位置。而(?!xxx)就是匹配除了xxx前面位置的其他所有地方。 4.逆序环视 ```perl (?<=xxx) 匹配 *xxx|,也就是xxx以后的那个位置，同理(?另外，在匹配时可以指定的几个常用选项是/i 忽略字母的大小写/x 忽略中间的空格 /\d{2} ([\W]) \d{2} \1 \d{2}/x等价于/\d{2}([\W])\d{2}\1\d{2}//s 将串视为单行，”.”可以匹配换行符 。 /a.*bc/s匹配字符串axxxxx \nxxxxbc，但/a.*bc/则不匹配该字符串。/m 多行匹配。 在此情况下，^符号匹配字符串的起始或新的一行的起始；$符号匹配任意行的末尾。/o 只编译一次，注意有内插变量的时候谨慎使用/g 匹配所有可能的模式 另外，在匹配时可以指定的几个常用选项是 /i 忽略字母的大小写 /x 忽略中间的空格 /\d{2} ([\W]) \d{2} \1 \d{2}/x等价于/\d{2}([\W])\d{2}\1\d{2}/ /s 将串视为单行，”.”可以匹配换行符 。 /a.*bc/s匹配字符串axxxxx \nxxxxbc，但/a.*bc/则不匹配该字符串。 /m 多行匹配。 在此情况下，^符号匹配字符串的起始或新的一行的起始；$符号匹配任意行的末尾。 /o 只编译一次，注意有内插变量的时候谨慎使用 /g 匹配所有可能的模式