Archive

Archive for the ‘Perl’ Category

remove entries in perl array with specified value

December 30th, 2014 Comments off

Assume that in array @array_filtered:

my @array_filtered = ("your", "array", "here", 1, 3, 8, "here", 2, 5, 9, "sit", "here",3, 4, 7,"yes","now",8,1,7,6); #or my @array_filtered=qw(your array here 1 3 8 here 2 5 9 sit here 3 4 7 yes now 8 1 7 6) which uses Alternative Quotes(q, qq, qw, qx)

You want to remove entries that have value "here" or "now" and it's following 3 entries, you can use splice:

#!/usr/bin/perl
my @array_filtered = ("your", "array", "here", 1, 3, 8, "here", 2, 5, 9, "sit", "here",3, 4, 7,"yes","now",8,1,7,6);
my @search_for = ("here","now");
#return keys that have specified value, =~/!~ for regular expression, eq/ne for string, ==/!= for number. or use unless()/if(not()). use m{} instead of // if there's too much / in the expression and you're tired of using \/ to escape them.

$search_for_s=join('|',@search_for);
@index_all = grep { $array_filtered[$_] =~ /$search_for_s/ } 0..$#array_filtered;

for($i=0;$i<=$#index_all;$i++) {
@index_all_one = grep { $array_filtered[$_] =~ /$search_for_s/ } 0..$#array_filtered;
splice(@array_filtered,$index_all_one[0],4);
#print $indexone."\n"
}

print "@array_filtered"."\n";

The output is "your array sit yes 6".

PS:

  • For more info about perl regular expression(such as operators<m, s, tr> and their modifiers, complex regular expression cheat sheet<.\s\S\d\D\w\W[aeiou][^aeiou](foo|bar), \G, $, $&, $`, $'> and more), you can refer to this article.
  • The following is about perl alternative quotes:

q// is generally the same thing as using single quotes - meaning it doesn't interpolate values inside the delimiters.
qq// is the same as double quoting a string. It interpolates.
qw// return a list of white space delimited words. @q = qw/this is a test/ is functionally the same as @q = ('this', 'is', 'a', 'test')
qx// is the same thing as using the backtick operators.

Categories: IT Architecture, Perl, Programming Tags:

perl tips

April 2nd, 2014 Comments off
##system value
$count=`wc -l space_mail_info.txt | sed 's/ space_mail_info.txt//'`;
if ($count >= 1) {
system('cat space_mail_info.txt | /bin/mailx -s "SAs - Space Warning - please work with component owners to free space" test@example.com');
}
##arrays
#!/usr/bin/perl -w
my @animals = ("dog", "pig", "cat");
print "The last element of array \$animals is : ".$animals[$#animals]."\n";
print "@animals"."\n"; #will print values of array, delimitered by space
print $#animals."\n"; #the last key number of array, $#animals+1 is the number of array
if(@animals>2){
print "more than 2 animals found\n";
}
else{
print "less than 2 animals found\n"
}
foreach(@animals){
print $_."\n";
}
##hashes
my %fruit_color=("apple", "red", "banana", "yellow");
print "Color of banana is : ".$fruit_color{"banana"}."\n";

for $char (keys %fruit_color)
{
print("$char => $fruit_color{$char}\n");
}

##references
my $variables = {
scalar  =>  {
description => "single item",
sigil => '$',
},
array   =>  {
description => "ordered list of items",
sigil => '@',
},
hash    =>  {
description => "key/value pairs",
sigil => '%',
},
};
print "Scalars begin with a $variables->{'scalar'}->{'sigil'}\n";

##Files and I/O
open (my $passwd, "<", "/etc/passwd2") or die ("can  a not open");
while (<$passwd>) {
print $_ if $_ =~ "test";
}
close $passwd or die "$passwd: $!";
my $next = "doing a first";
$next =~ s/first/second/;
print $next."\n";

my $email = "testaccount\@doxer.org";
if ($email =~ /([^@]+)@(.+)/) {
print "Username is : $1\n";
print "Hostname is : $2\n";
}

##Subroutines
sub multiply{
my ($num1, $num2) = @_;
my $result = $num1 * $num2;
return $result;
}

my $result2 = multiply(3, 5);
print "3 * 5 = $result2\n";

##or
! system('date') or die("failed it"); #if a subroutine returns ok, it'll return 0
PS:
Categories: IT Architecture, Perl, Programming Tags:

Resolved – print() on closed filehandle $fh at ./perl.pl line 6.

March 19th, 2014 Comments off

You may find that print sometimes won't work as expected in perl, for example:

[root@centos-doxer test]# cat perl.pl
#!/usr/bin/perl
use warnings;
open($fh,"test.txt");
select $fh;
close $fh;
print "test";

You may expect "test" to be printed, but actually you got error message:

print() on closed filehandle $fh at ./perl.pl line 6.

So how's this happened? Please see my explanation:

[root@centos-doxer test]# cat perl.pl
#!/usr/bin/perl
use warnings;
open($fh,"test.txt");
select $fh;
close $fh; #here you closed $fh filehandle, but you should now reset filehandle to STDOUT
print "test";

Now here's the updated script:

#!/usr/bin/perl
use warnings;
open($fh,"test.txt");
select $fh;
close $fh;
select STDOUT;
print "test";

This way, you'll get "test" as expected!

 

Categories: IT Architecture, Perl, Programming Tags:

Oracle BI Publisher reports – send mail when filesystems getting full

March 17th, 2014 Comments off

Let's assume you have one Oracle BI Publisher report for filesystem checking. And now you want to write script for checking that report page and send mail to system admins when filesystems are getting full. As the default output of Oracle BI Publisher report needs javascript to work, and as you may know javascript is evil that wget/curl can not get them, so after log on, the next step you need to do is to find the html version's url of that report for you to use in your script(and the html page has all records when javascript one has only part of them):

BI_report_login

BI_export_html

 

Let's assume that the html's url is "http://www.example.com:9703/report.html", and the display of it was like the following:

bi report

Then here goes the script that will check this page for hosts that has less than 10% available space and send mail to system admins:

#!/usr/bin/perl
use HTML::Strip;
#hosts that do not need reporting
my @remove_list = qw(host1.example.com host2.example.com);
system("rm -f spacereport.html");
system("wget -q --no-proxy --no-check-certificate --post-data 'id=admin&passwd=password' 'http://www.example.com:9703/report.html' -O spacereport.html");
open($fh,"spacereport.html");

#or just @spacereport=<$fh>;
foreach(<$fh>){
push(@spacereport,$_);
}

#change array to hash
$index=0;
map {$pos{$index++}=$_} @spacereport;

#get location of <table> and </table>
#sort numerically ascending
for $char (sort {$a<=>$b} (keys %pos))
{
if($pos{$char} =~ /<table class="c27">/)
{
$table_start=$char;
}

if($pos{$char} =~ /<\/table>/)
{
$table_end=$char;
}

}

#get contents between <table> and </table>
for($i=$table_start;$i<=$table_end;$i++){
push(@table_array,$spacereport[$i]);
}

$table_htmlstr=join("",@table_array);

#get clear text between <table> and </table>
my $hs=HTML::Strip->new();
my $clean_text = $hs->parse($table_htmlstr);
$hs->eof;

@array_filtered=split("\n",$clean_text);

#remove empty array element
@array_filtered=grep { !/^\s+$/ } @array_filtered;

#remove entries from showing
$remove_list_s=join('|',@remove_list);
@index_all = grep { $array_filtered[$_] =~ /$remove_list_s/ } 0..$#array_filtered;

for($i=0;$i<=$#index_all;$i++) {
@index_all_one = grep { $array_filtered[$_] =~ /$remove_list_s/ } 0..$#array_filtered;
splice(@array_filtered,$index_all_one[0],4);
}

system("rm -f space_mail_warning.txt");
open($fh_mail_warning,">","space_mail_warning.txt");
select $fh_mail_warning;
for($j=4;$j<=$#array_filtered;$j=$j+4){
#put lines that has free space lower than 10% to space_mail_warning.txt
if($array_filtered[$j+2] <= 10){
print "Host: ".$array_filtered[$j]."\n";
print "Part: ".$array_filtered[$j+1]."\n";
print "Free(%): ".$array_filtered[$j+2]."\n";
print "Free(GB): ".$array_filtered[$j+3]."\n";
print "============\n\n";
}
}
close $fh_mail_warning;

system("rm -f space_mail_info.txt");
open($fh_mail_info,">","space_mail_info.txt");
select $fh_mail_info;
for($j=4;$j<=$#array_filtered;$j=$j+4){
#put lines that has free space lower than 15% to space_mail_info.txt
if($array_filtered[$j+2] <= 15){
print "Host: ".$array_filtered[$j]."\n";
print "Part: ".$array_filtered[$j+1]."\n";
print "Free(%): ".$array_filtered[$j+2]."\n";
print "Free(GB): ".$array_filtered[$j+3]."\n";
print "============\n\n";
}
}
close $fh_mail_info;

#send mail
#select STDOUT;
if(-s "space_mail_warning.txt"){
system('cat space_mail_warning.txt | /bin/mailx -s "Space Warning - please work with component owners to free space" sysadmins@example.com');
} elsif(-s "space_mail_info.txt"){
system('cat space_mail_info.txt | /bin/mailx -s "Space Info - Space checking mail" sysadmins@example.com');
}

Categories: IT Architecture, Perl, Programming Tags:

Oracle VM operations – poweron, poweroff, status, stat -r

January 27th, 2014 Comments off

Here's the script:
#!/usr/bin/perl
#1.OVM must be running before operations
#2.run ovm_vm_operation.pl status before running ovm_vm_operation.pl poweroff or poweron
use Net::SSH::Perl;
$host = $ARGV[0];
$operation = $ARGV[1];
$user = 'root';
$password = 'password';

$newname=$ARGV[2];
$newcpu=$ARGV[3];
$newmemory=$ARGV[4];
$newpool=$ARGV[5];
$newtmpl=$ARGV[6];
$newbridge=$ARGV[7];
$newbridge2=$ARGV[8];
$newvif='vif0';
$newvif2='VIF1';

if($host eq "help") {
print "$0 OVM-name status|poweron|poweroff|reboot|stat-r|stat-r-all|pool|new vmname 1 4096 poolname tmplname FE BE\n";
exit;
}

$ssh = Net::SSH::Perl->new($host);
$ssh->login($user,$password);

if($operation eq "status") {
($stdout,$stderr,$exit) = $ssh->cmd("ovm -uadmin -ppassword vm ls|grep -v VM_test");
open($host_fd,'>',"/var/tmp/${host}.status");
select $host_fd;
print $stdout;
close $host_fd;
} elsif($operation eq "poweroff") {
open($poweroff_fd,'<',"/var/tmp/${host}.status");
foreach(<$poweroff_fd>){
if($_ =~ "Server_Pool|OVM|Powered") {
next;
}
if($_ =~ /(.*?)\s+([0-9]{1,})\s+([0-9]{1,})\s+([0-9]{1,})\s+([a-zA-Z]{1,})\s+(.*)/){
$ssh->cmd("ovm -uadmin -ppassword vm poweroff -n $1 -s $6 -f");
sleep 12;
}
}
} elsif($operation eq "reboot") {
open($poweroff_fd,'<',"/var/tmp/${host}.status");
foreach(<$poweroff_fd>){
if($_ =~ "Server_Pool|OVM|Powered") {
next;
}
if($_ =~ /(.*?)\s+([0-9]{1,})\s+([0-9]{1,})\s+([0-9]{1,})\s+([a-zA-Z]{1,})\s+(.*)/){
$ssh->cmd("ovm -uadmin -ppassword vm reboot -n $1 -s $6");
sleep 12;
}
}
} elsif($operation eq "poweron") {
open($poweron_fd,'<',"/var/tmp/${host}.status");
foreach(<$poweron_fd>){
if($_ =~ "Server_Pool|OVM|Running|used|poweroff") {
next;
}
if($_ =~ /(.*?)\s+([0-9]{1,})\s+([0-9]{1,})\s+([0-9]{1,})\s+([a-zA-Z]{1,})\s+Off(.*)/){
$ssh->cmd("ovm -uadmin -ppassword vm poweron -n $1 -s $6");
#print "ovm -uadmin -ppassword vm poweron -n $1 -s $6";
sleep 15;
}
}
} elsif($operation eq "stat-r") {
open($poweroff_fd,'<',"/var/tmp/${host}.status");
foreach(<$poweroff_fd>){
if($_ =~ /(.*?)\s+([0-9]{1,})\s+([0-9]{1,})\s+([0-9]{1,})\s+(Shutting\sDown|Initializing|Error|Unknown|Rebooting|Deleting)\s+(.*)/){
#print "ovm -uadmin -ppassword vm stat -r -n $1 -s $6";
$ssh->cmd("ovm -uadmin -ppassword vm stat -r -n $1 -s $6");
sleep 1;
}
}
} elsif($operation eq "stat-r-all") {
open($poweroff_fd,'<',"/var/tmp/${host}.status");
foreach(<$poweroff_fd>){
$ssh->cmd("ovm -uadmin -ppassword vm stat -r -n $1 -s $6");
sleep 1;
}
} elsif($operation eq "pool") {
($stdoutp,$stderrp,$exitp) = $ssh->cmd("ovm -uadmin -ppassword svrp ls|grep Inactive");
open($host_fdp,'>',"/var/tmp/${host}-poolstatus");
select $host_fdp;
print $stdoutp;
close $host_fdp;
} elsif($operation eq "new") {
($stdoutp,$stderrp,$exitp) = $ssh->cmd("ovm -uadmin -ppassword tmpl ls -s $newpool | grep $newtmpl");
if($stdoutp =~ /$newtmpl/){
($stdoutp2,$stderrp2,$exitp2) = $ssh->cmd("ovm -uadmin -ppassword vm new -m template -s $newpool -t $newtmpl -n $newname -c password");
if($stdoutp2 =~ /is being created/){
print "Creating VM $newname in pool $newpool on OVMM $host now!"."\n";
while(1){
($stdoutp3,$stderrp3,$exitp3) = $ssh->cmd("ovm -uadmin -ppassword vm stat -n $newname -s $newpool");
if($stdoutp3 =~ /Powered Off/){
print "Done VM creation."."\n";
last;
}
sleep 300
}

print "Setting Cpu/Memory now."."\n";
($stdoutp32,$stderrp32,$exitp32) = $ssh->cmd("ovm -uadmin -ppassword vm conf -n $newname -s $newpool -x $newmemory -m $newmemory -c $newcpu -P");
sleep 2;

print "Creating NICs now."."\n";
($stdoutp4,$stderrp4,$exitp4) = $ssh->cmd("ovm -uadmin -ppassword vm nic conf -n $newname -s $newpool -N $newvif -i VIF0 -b $newbridge");
sleep 2;
($stdoutp5,$stderrp5,$exitp5) = $ssh->cmd("ovm -uadmin -ppassword vm nic add -n $newname -s $newpool -N $newvif2 -b $newbridge2");
sleep 2;

print "Powering on VM now."."\n";
($stdoutp6,$stderrp6,$exitp6) = $ssh->cmd("ovm -uadmin -ppassword vm poweron -n $newname -s $newpool");
sleep 30;

while(1){
($stdoutp7,$stderrp7,$exitp7) = $ssh->cmd("ovm -uadmin -ppassword vm info -n $newname -s $newpool");
if($stdoutp7 =~ /Running on: sl/){
print "VM is now Running, you can configure VM on hypervisor now:"."\n";
print $stdoutp7."\n";
last;
}
sleep 30;
}

#($stdoutp8,$stderrp8,$exitp8) = $ssh->cmd("ovm -uadmin -ppassword vm ls -l | grep $newname");
#print "You can configure VM on hypervisor now:"."\n";
#print $stdoutp8."\n";
} else {
print $stdoutp2."\n";
exit;
}
} else {
print "No template named $newtmpl in pool $newpool\n";
exit;
}
}

You can use the following to make the script run in parallel:

for i in <all OVMs>;do (./ovm_vm_operation.pl $i status &);done

parallel execution of script using perl fork()

July 3rd, 2013 Comments off

Let's assume that we want to test 100 hosts to see whether they're pingable or not. You may think of bash style for ... do ... done loop, but as that is executed one by one, so it's not efficient. And in this article, I'm going to create parallel execution of this task using perl's fork().

Firstly, here's one script to get whether one host is pingable or not:

[root@centos-doxer pping_doxer]# cat script.sh
#!/usr/bin/expect
log_user 0
match_max -d 2000000
set host [lindex [lrange $argv 0 0] 0]
spawn -noecho ping $host
set timeout 2
expect "bytes from" {exit 0} default {puts "not pingable from $host";exit 1}

Let's run it and see the result:

[root@centos-doxer pping_doxer]# ./script.sh test-host
not pingable from test-host

So now, let's write one perl script to wrapper this expect script, and also add parallel run to it:

#!/usr/bin/perl
our @hosts=("testhost0001","testhost00022","testhost00033","testhost0007");
#you can read a file to perl array too
#open($fh,"/doxer/projects/pping_doxer/servers.txt");
#our @hosts=<$fh>;
our $zombies = 0;
our $kid_proc_num = 0;

$SIG{CHLD} = sub { $zombies++ };
for(my $i=0; $i<@hosts; $i++) {
my $pid = fork();
if( !defined($pid) ) { exit 1; }
unless($pid) {
system("/doxer/projects/pping_doxer/script.sh $hosts[$i]"); #change the path according to your env
exit 0;
}
$kid_proc_num++;
}

while (1) {
if($zombies > 0) {
$zombies = 0;
my $collect;
while(($collect = waitpid(-1, WNOHANG)) > 0) {
$kid_proc_num--;
}
}
if($kid_proc_num==0) { last; }
else { next; }
}

And now let's have a test:

[root@centos-doxer pping_doxer]# ./pping_doxer
not pingable from testhost0001
not pingable from testhost00033
not pingable from testhost0007
not pingable from testhost00022

You can modify script.sh to fulfill your own aim except for ping of course.

That's it, enjoy!

PS:

1.I've wrote an updated version of pping_doxer, which allows you to specify a maximum number of parallel running processes and also puts hosts in a file. I've put the package in http://www.doxer.org/projects-doxer/, the package name is pping_doxer.

2.Thanks very much to http://www.ibm.com/developerworks/cn/linux/l-cn-perlmp/.

Categories: IT Architecture, Perl, Programming Tags: ,

understanding perl fork

July 2nd, 2013 Comments off

Let's go through perl fork() by example:

#!/usr/bin/perl -w
use strict;

defined(my $pid=fork()) or die "Fork process failured:$!\n";  #two processes are running now, one parent and child process($pid is zero)
unless($pid)
{
# This is the child process.
system "date";
sleep(3);
print ("Exit child after 3 seconds wait!\n");
exit();
}
# This is the parent process.
waitpid($pid,0);
system "date";
print ("exit parent!\n");

Here's the result:

Tue Jul 2 18:29:33 CST 2013
Exit child after 3 seconds wait!
Tue Jul 2 18:29:36 CST 2013
exit parent!

And now let's test when waitpid() is commented out:

#!/usr/bin/perl -w
use strict;

defined(my $pid=fork()) or die "Fork process failured:$!\n";
unless($pid)
{
# This is the child process.
system "date";
sleep(3);
print ("Exit child after 3 seconds wait!\n");
exit();
}
# This is the parent process.
#waitpid($pid,0);  #parent no longer wait until child process exit
system "date";
print ("exit parent!\n");

And here's the result:

[root@centos-doxer test]# ./perl.test
Tue Jul 2 18:30:05 CST 2013
Tue Jul 2 18:30:05 CST 2013
exit parent!

Categories: IT Architecture, Perl, Programming Tags:

perl tips – most useful perl command line options switches

June 9th, 2013 Comments off

Here's all perl command line options, red ones are the most useful ones from me:

[root@centos-doxer test]# perl --help
Usage: perl [switches] [--] [programfile] [arguments]

-c check syntax only (runs BEGIN and CHECK blocks) #perl -c ./perl.pl

-e program one line of program (several -e's allowed, omit programfile) #e.g. perl -e 'print "hi\n";print "hi again\n";'

-n assume "while (<>) { ... }" loop around program #like -p, but do not print

-p assume loop like -n but print line also, like sed #perl -p -e "tr/[a-z]/[A-Z]/" a.txt

-i[extension] edit <> files in place (makes backup if extension supplied) #perl -pi.bak -e "tr/[a-z]/[A-Z]/" a.txt

-[mM][-]module execute "use/no module..." before executing program #perl -MCPAN -e 'install xxx:xxx'

-l[octal] enable line ending processing, specifies line terminator #man ascii to see all ascii - octal mapping

-F/pattern/ split() pattern for -a switch (//'s are optional)

-a autosplit mode with -n or -p (splits $_ into @F) #perl -n -l072 -a -F/:/ -e 'print $F[0]' a.txt

 

-s enable rudimentary parsing for switches after programfile 

[root@centos-doxer test]# cat perl.test
#!/usr/bin/perl -s
print "yes\n" if defined($r);
print "no\n" unless defined($r);

[root@centos-doxer test]# ./perl.test -a
no
[root@centos-doxer test]# ./perl.test test
no
[root@centos-doxer test]# ./perl.test -r
yes

xm list|awk '{print $1}'|perl -p -e "s/^.*(slce.*?)_.*/\1/g" #will return slce09vm001

ovm vm ls|awk '{print $1}'|perl -p -e "s/^[0-9]{2,}_(.*)/\1/g"|perl -p -e "s/^.*(slc.*?)[_-].*/\1/g"|egrep -v 'wlsaas|virt'|grep slc|sort #will return slce09vm001

-C[number/list] enables the listed Unicode features
-0[octal] specify record separator (\0, if no argument)
-d[:debugger] run program under debugger
-D[number/list] set debugging flags (argument is a bit mask or alphabets)
-f don't do $sitelib/sitecustomize.pl at startup
-Idirectory specify @INC/#include directory (several -I's allowed)
-P run program through C preprocessor before compilation

-S look for programfile using PATH environment variable
-t enable tainting warnings
-T enable tainting checks
-u dump core after parsing program
-U allow unsafe operations
-v print version, subversion (includes VERY IMPORTANT perl info)
-V[:variable] print configuration summary (or a single Config.pm variable)
-w enable many useful warnings (RECOMMENDED)
-W enable all warnings
-x[directory] strip off text before #!perl line and perhaps cd to directory
-X disable all warnings

Categories: IT Architecture, Perl, Programming Tags:

perl – match fixed number of spaces or other characters

June 6th, 2013 Comments off

Sometimes you want to match lines beginning with exactly four spaces("<space><space><space><space>") :

<space><space><space><space><space>Line1

<space><space><space><space>Line2  --only this line!

<space><space>Line3

So here's the perl script to fulfill this:

#!/usr/bin/perl
open($fdme, '/doxer/test/a.txt');
foreach(<$fdme>){
if($_ =~ /^\s{4}\w+.*/){
print $_."\n";
}
}

Categories: IT Architecture, Perl, Programming Tags:

install perl module using tarball or cpan

June 2nd, 2013 Comments off
To install a perl module using cpan:
Method 1:
PERL_MM_USE_DEFAULT=1
export PERL_MM_USE_DEFAULT=1
cpan> o conf prerequisites_policy follow
cpan> o conf build_requires_install_policy yes
cpan> o conf commit
cpan > o conf init /proxy/
cpan> force install Net::SSH::Perl
Method 2:
PERL_MM_USE_DEFAULT=1
perl -MCPAN -e 'install Net::SSH::Perl'
To install a perl module using yum in Linux:
yum install -y "perl(X11::Protocol)"
To manually install a Perl module:
1. Download the Perl module from CPAN or other site.
2. Extract the tarball.
3. Run perl Makefile.PL
4. Run make
5. Run make test
6. Run make install

 

To test whether the module has been installed or not, run this:

perl -e 'use Module::Metadata', if nothing returned, then it's ok

PS:
  • yum install perl-CPAN if you found that cpan was not installed by default with perl
  • Here's help message for cpan:
cpan> help #o conf init to reconfigure cpan
Display Information
 command  argument          description
 a,b,d,m  WORD or /REGEXP/  about authors, bundles, distributions, modules
 i        WORD or /REGEXP/  about anything of above
 r        NONE              reinstall recommendations
 ls       AUTHOR            about files in the author's directory
 
Download, Test, Make, Install...
 get                        download
 make                       make (implies get)
 test      MODULES,         make test (implies make)
 install   DISTS, BUNDLES   make install (implies test)
 clean                      make clean
 look                       open subshell in these dists' directories
 readme                     display these dists' README files
 
Other
 h,?           display this menu       ! perl-code   eval a perl command
 o conf [opt]  set and query options   q             quit the cpan shell
 reload cpan   load CPAN.pm again      reload index  load newer indices
 autobundle    Snapshot                force cmd     unconditionally do cmd
Categories: IT Architecture, Perl, Programming Tags:

resolved – perl get only package/file names and not including package version number using regular expression

May 9th, 2013 Comments off

I got a list of packages installed on my centos linux box via:

rpm -qa|sort|uniq|sort

The result is like:

acl-2.2.39-8.el5
acpid-1.0.4-12.el5
alacarte-0.10.0-1.fc6
alsa-lib-1.0.17-1.el5
alsa-lib-devel-1.0.17-1.el5
amtu-1.0.6-2.el5
anacron-2.3-45.el5.centos
apr-1.2.7-11.el5_6.5
apr-util-1.2.7-11.el5_5.2

But now I only want the package names without version number, that is like:

acl
acpid
alacarte
alsa-lib
alsa-lib-devel
amtu
anacron
apr
apr-util

Here's the perl script to fulfill this:

#!/usr/bin/perl
open($temp1,"<","/doxer/test/package-names.txt") or die("error opening");
while(<$temp1>){
if($_ =~ /([a-zA-Z].*?)\-[0-9]{1,}\.[0-9]{1,}.*/){
print $1."\n";
}
}

Categories: IT Architecture, Perl, Programming Tags:

perl script for getting sun zfs head project and share usage info

April 26th, 2013 Comments off

Sometimes you would like to know on sun zfs head, which project occupies most of the space, and which shares of that occupies most space of that project.

Here's a perl script to fulfill this(it's a little cumbersome, but it works anyway)

#!/usr/bin/perl
use strict;
use warnings;
use Net::SSH::Perl;
use List::Util qw/sum/;
my $host = 'test-zfs-host';
my $user = 'root';
my $password = 'password';

my $ssh = Net::SSH::Perl->new($host);
$ssh->login($user,$password);
my ($stdout,$stderr,$exit) = $ssh->cmd("shares show");
my @std_arr=split(/:/,$stdout);
my @projects_arr = split(/\n/, $std_arr[2]);

foreach(@projects_arr){
$_ =~ s/^\s+|\s+$//g;
}
shift @projects_arr;
pop @projects_arr;
pop @projects_arr;

my @space_projects;
foreach(@projects_arr){
my ($stdout2,$stderr2,$exit2) = $ssh->cmd("shares select $_ get");
my @stdout_arr=split(/\n/,$stdout2);
my $space_temp=join("\n",grep(/space_total/,@stdout_arr));
my @space_total_project = "project ".$_.$space_temp;
push(@space_projects,@space_total_project);
}
my @space_projects3;
foreach(@projects_arr){
my ($stdout3,$stderr3,$exit3) = $ssh->cmd("shares select $_ ls");
my @stdout_arr3=split(/\n/,$stdout3);
my @space_temp3=grep(/\/export\//,@stdout_arr3);
my @space_temp4=grep(!/mountpoint/,@space_temp3);
push(@space_projects3,@space_temp4);
}
open(my $temp1,'>','/var/tmp/temp1') or die("cannot open file temp1");
open(my $temp2,'>','/var/tmp/temp2') or die("cannot open file temp2");
open(my $temp3,'>','/var/tmp/temp3') or die("cannot open file temp3");
open(my $temp4,'>','/var/tmp/temp4') or die("cannot open file temp4");
my @var_T;
my @var_G;
my @var_M;
my @var_K;

foreach(@space_projects){
if($_ =~ /.+space_total\s+(.*)K/){
push(@var_K,$_);
}
elsif($_ =~ /.+space_total\s+(.*)M/){
push(@var_M,$_);
}
elsif($_ =~ /.+space_total\s+(.*)G/){
push(@var_G,$_);
}
elsif($_ =~ /.+space_total\s+(.*)T/){
push(@var_T,$_);
}
}

select $temp1;
foreach(@var_T){
print $_."\n";
}
close $temp1;

select $temp2;
foreach(@var_G){
print $_."\n";
}
close $temp2;
select $temp3;
foreach(@var_M){
print $_."\n";
}
close $temp3;
select $temp4;
foreach(@var_K){
print $_."\n";
}
close $temp4;

system("echo \"======zfs project usage info(Descending)======\"");
system("sort -r -n -k 5 /var/tmp/temp1;sort -r -n -k 5 /var/tmp/temp2;sort -r -n -k 5 /var/tmp/temp3;sort -r -n -k 5 /var/tmp/temp4");
open(my $temp5,'>','/var/tmp/temp5') or die("cannot open file temp5");
open(my $temp6,'>','/var/tmp/temp6') or die("cannot open file temp6");
open(my $temp7,'>','/var/tmp/temp7') or die("cannot open file temp7");
open(my $temp8,'>','/var/tmp/temp8') or die("cannot open file temp8");
my @var_T_2;
my @var_G_2;
my @var_M_2;
my @var_K_2;

foreach(@space_projects3){
if($_ =~ /\s+.*K\s+.*/){
push(@var_K_2,$_);
}
elsif($_ =~ /\s+.*M\s+.*/){
push(@var_M_2,$_);
}
elsif($_ =~ /\s+.*G\s+.*/){
push(@var_G_2,$_);
}
elsif($_ =~ /\s+.*T\s+.*/){
push(@var_T_2,$_);
}
}

select $temp5;
foreach(@var_T_2){
print $_."\n";
}
close $temp5;

select $temp6;
foreach(@var_G_2){
print $_."\n";
}
close $temp6;
select $temp7;
foreach(@var_M_2){
print $_."\n";
}
close $temp7;
select $temp8;
foreach(@var_K_2){
print $_."\n";
}
close $temp8;

system("echo \"\n\n\n======zfs share usage info(Descending)======\"");
system("sort -r -n -k 2 /var/tmp/temp5;sort -r -n -k 2 /var/tmp/temp6;sort -r -n -k 2 /var/tmp/temp7;sort -r -n -k 2 /var/tmp/temp8");

The output would be like:

======zfs project usage info(Descending)======
project DC2_DMZ space_total = 7.68T
project dc2_c9testga space_total = 1.10T
project fa_trialadcf space_total = 277G
project fa_rehydration space_total = 266G
project common space_total = 10.0G
project NODE_8 space_total = 93K
project default space_total = 31K

 

======zfs share usage info(Descending)======
Service_Mid-2 1.44T /export/DC2_DMZ/Service_Mid-2
Service_Web 1.22T /export/DC2_DMZ/Service_Web
dc2_shared_idm 743G /export/DC2_DMZ/dc2_shared_idm
Infra_Web 400G /export/DC2_DMZ/Infra_Web
nuviaq_local02 988M /export/DC2_DMZ/nuviaq_local02
sftp_staging 127M /export/DC2_DMZ/sftp_staging
sftp_local03 14.8M /export/DC2_DMZ/sftp_local03
sftp_manager_local01 85K /export/DC2_DMZ/sftp_manager_local01

a perl script to get all projects space usage in sun zfs heads

January 23rd, 2013 Comments off

#!/usr/bin/perl
use strict;
use warnings;
use Net::SSH::Perl;
use List::Util qw/sum/;
my $host = 'zfs-host';
my $user = 'root';
my $password = 'test';

my $ssh = Net::SSH::Perl->new($host);
$ssh->login($user,$password);
my ($stdout,$stderr,$exit) = $ssh->cmd("shares show");
my @std_arr=split(/:/,$stdout);
my @projects_arr = split(/\n/, $std_arr[2]);

foreach(@projects_arr){
$_ =~ s/^\s+|\s+$//g;
}
shift @projects_arr;
pop @projects_arr;
pop @projects_arr;

my @space_projects;
foreach(@projects_arr){
my ($stdout2,$stderr2,$exit2) = $ssh->cmd("shares select $_ get");
my @stdout_arr=split(/\n/,$stdout2);
my @space_total_project = grep(/space_total/,@stdout_arr);
push(@space_projects,@space_total_project);
}

foreach(@space_projects){
if ($_ =~ /.+=\s+(.+)M/){
$_=0;
}
elsif($_ =~ /.+=\s+(.+)G/){
$_=$1/1024;
}
elsif($_ =~ /.+=\s+(.+)K/){
$_=0;
}
elsif($_ =~ /.+=\s+(.+)T/){
$_=$1;
}
}
my $space_used_sum=sum(@space_projects);

print $space_used_sum."\n";

Categories: IT Architecture, Perl, Programming Tags:

snmptrapd traphandle configuration example

January 16th, 2013 1 comment

This article is going to show the basic configuration of snmptrapd and it's traphandle command.

Assumptions:
snmptrapd is running on a linux host named "test-centos";
The host sending snmptrap messages in this example is named "test-zfs-host"

Now first we're going to set snmptrapd up on the snmptrap server side:

###Server side
[root@test-centos snmp]# cat /etc/snmp/snmptrapd.conf
#traphandle default /bin/mail -s "snmpdtrapd messages" <put your mail address here>
traphandle default /root/lognotify
authCommunity log,execute,net public

[root@test-centos snmp]# service snmptrapd restart

[root@test-centos snmp]# cat /root/lognotify
#!/bin/bash
read host
read ip
vars=

while read oid val
do
if [ "$vars" = "" ]
then
vars="$oid = $val"
else
vars="$vars, $oid = $val"
fi
done
echo trap: $host $ip $vars >/var/tmp/snmptrap.out

And to test whether snmptrapd is working as expected:

###On client side
snmptrap -v2c -c public test-centos:162 "" SNMPv2-MIB::sysDescr SNMPv2-MIB::sysDescr.0 s "test-zfs-host test-zfs-host.ip this is a test snmptrap string"

And after running this command, you can have a check of /var/tmp/snmptrap.out on the snmptrapd server side(test-centos):

[root@test-centos ~]# cat /var/tmp/snmptrap.out

PS:
If you're using sun zfs head, you can set snmptrap destinations in zfs BUI(configuration -> SNMP), here's the snapshot(click to see the larger image):

perl script for monitoring sun zfs memory usage

January 16th, 2013 Comments off

On zfs's aksh, I can check memory usage with the following:

test-zfs:> status memory show
Memory:
Cache 719M bytes
Unused 15.0G bytes
Mgmt 210M bytes
Other 332M bytes
Kernel 7.79G bytes

So now I want to collect this memory usae information automatically for SNMP's use. Here's the steps:

cpan> o conf prerequisites_policy follow
cpan> o conf commit

Since the host is using proxy to get on the internet, so in /etc/wgetrc:

http_proxy = http://www-proxy.us.example.com:80/
ftp_proxy = http://www-proxy.us.example.com:80/
use_proxy = on

Now install the Net::SSH::Perl perl module:

PERL_MM_USE_DEFAULT=1 perl -MCPAN -e 'install Net::SSH::Perl'

And to confirm that Net::SSH::Perl was installed, run the following command:

perl -e 'use Net::SSH::Perl' #no output is good, as it means the package was installed successfully

Now here goes the perl script to get the memory usage of sun zfs head:

[root@test-centos ~]# cat /var/tmp/mrtg/zfs-test-zfs-memory.pl
#!/usr/bin/perl
use strict;
use warnings;
use Net::SSH::Perl;
my $host = 'test-zfs';
my $user = 'root';
my $password = 'password';

my $ssh = Net::SSH::Perl->new($host);
$ssh->login($user,$password);
my ($stdout,$stderr,$exit) = $ssh->cmd("status memory show");
$ssh->cmd("exit");
if($stderr){
print "ErrorCode:$exit\n";
print "ErrorMsg:$stderr";
} else {
my @std_arr = split(/\n/, $stdout);
shift @std_arr;
foreach(@std_arr) {
if ($_ =~ /.+\b\s+(.+)M\sbytes/){
$_=$1/1024;
}
elsif($_ =~ /.+\b\s+(.+)G\sbytes/){
$_=$1;
}
else{}
}
foreach(@std_arr) {
print $_."\n";
}
}
exit $exit;

PS:
If you get the following error messages during installation of a perl module:

[root@test-centos ~]# perl -MCPAN -e 'install SOAP::Lite'
CPAN: Storable loaded ok
CPAN: LWP::UserAgent loaded ok
Fetching with LWP:
ftp://ftp.perl.org/pub/CPAN/authors/01mailrc.txt.gz
LWP failed with code[500] message[LWP::Protocol::MyFTP: connect: Connection timed out]
Fetching with Net::FTP:
ftp://ftp.perl.org/pub/CPAN/authors/01mailrc.txt.gz

Trying with "/usr/bin/links -source" to get
ftp://ftp.perl.org/pub/CPAN/authors/01mailrc.txt.gz
ELinks: Connection timed out

Then you may have a check of whether you're using proxy to get on the internet(run cpan > o conf init to re-configure cpan; later you should set /etc/wgetrc: http_proxy, ftp_proxy, use_proxy).