Suppressing system output from Perl code.
This code works fine functionally until I run into a hostname that can't resolved and want to suppress the output of a unresolvable domain.
If in the lists.hosts file there is a domain that can't be resolved, the screen output will contain: "ping: cannot resolve XXX.com: Unknown host"
my $ip;
open(HOSTLIST, "lists.hosts"); # Load domains
#hosts = <HOSTLIST>;
chomp($host);
foreach $host (#hosts) {
$results = `ping -c 1 $host`;
$record++;
my $pos = index($results, $find);
if (($results =~ /ttl=/) || ($results =~ /data bytes/)) {
#$count++;
chomp($host);
if (($results =~ /(?<=bytes from)(.*)(?=:)/) != 0) {
($ip) = ($results =~ /(?<=bytes from)(.*)(?=:)/);
}
elsif (($results =~ /(?<=\()(.*)(?=\))/) != 0) {
($ip) = ($results =~ /(?<=\()(.*)(?=\))/);
}
print "Record: $record Host: $host IP:$ip Status: Passed";
print "\n";
#print ("*** Record# $record: Ping Test Succeeded for Server: $host ***\n");
#print ("$results\n");
}
else {
$count++;
chomp($host);
#print ("*** Record# $record: Ping Test Failed for Server: $host ***\n");
print "Record: $record Host: $host Status: Failed\n";
#print ("$results\n");
}
}
close(HOSTLIST);
exit($errorcode);
Your invocation of ping needs to capture stderr:
ping -c 1 $host 2>&1
Also, you're not checking the return of your open, which you should do always. Finally, you should be using use warnings; and use strict; at the top.
Related
I have a Perl script that is executed from Nagios XI.
It has two subroutines: SendEmail and SendTraps.
The script works fine when executed manually by passing the required parameters, but it doesn't work when triggered from Nagios. The script gets executed but the subroutines are skipped.
echo is working, but the two subroutines are not working even if the condition is met.
if ( ( $hoststatetype =~ m/HARD/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
sendMail();
send_trap();
}
Full script here:
use strict;
use warnings;
use Text::CSV;
# Declared all the variables here
# Parsing input arguments
if ( $#ARGV > -1 ) {
if ( $ARGV[0] eq "-nagiosxi_trigger" ) {
$prihost = $ARGV[1];
$hoststate = $ARGV[2];
$hoststatetype = $ARGV[3];
$hostoutput = $ARGV[4];
}
elsif ( $ARGV[0] eq "-manual_trigger" ) {
$comment = $ARGV[1];
$userid = $ARGV[2];
$flag = "Failover-Trigger_Manual";
print "Maunal Failover triggered with comment: $comment by $userid\n";
$error_desc = "Maunal Failover triggered with comment: $comment by $userid";
send_trap();
sendMail();
exit 0;
}
else {
print STDERR "Invalid parameter $ARGV[0] \n";
exit 1;
}
}
else {
print STDERR "ERROR:No Arguments Passed.\n";
exit 1
}
# Check if Host or Service is in Hard/down state
if ( ( $hoststatetype =~ m/HARD/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
sendMail();
send_trap();
}
elsif ( ( $hoststatetype =~ m/SOFT/ ) && ( $hoststate =~ m/DOWN/ ) ) {
`echo "HOST::$prihost $hostoutput">>/tmp/failover_log.txt`;
}
else {
`echo "HOST Good, $prihost $hostoutput">>/tmp/failover_log.txt`;
}
# Sub-Routines
sub failover {
my $csv = Text::CSV->new({ sep_char => ',' }) or die "Cannot use CSV: ".Text::CSV->error_diag ();;
my $file = "myxilist";
my $primary;
my $secondary;
#my $xienv;
my $host = `hostname`;
chomp $host;
open( my $data, '<', $file ) or die "Could not open '$file' $!\n";
while ( my $xi = <$data> ) {
chomp $xi;
if ( $csv->parse($xi) ) {
my #fields = $csv->fields();
if ( $fields[0] =~ m/$host/ ) {
$primary = $fields[1];
$secondary = $fields[0];
$xienv = $fields[2];
}
elsif ( $fields[1] =~ m/$host/ ) {
$primary = $fields[0];
$secondary = $fields[1];
$xienv = $fields[2];
}
}
else {
warn "Line could not be parsed: $xi\n";
exit 1;
}
}
my $failovermsg="failover successful from $primary to $secondary server";
return $failovermsg;
}
sub sendMail {
# Build the list for mailing out results
my $mailSubject;
my $mailID = "test\#mail.com";
my #results = failover();
$mailSubject = "Failover Successful on $xienv instance";
print "Sending email to $mailID \n";
`echo "sending Email">>/tmp/failover_log.txt`;
open MAILX, "|/usr/bin/mailx -s \"$mailSubject\" $mailID " or die $!;
print MAILX "#results";
close MAILX;
return;
}
sub send_trap {
# Sending SNMP traps
my #results = failover();
my $trap = `/usr/bin/snmptrap -v 2c -c public tcp:server:1010 '' MIB::Event Hostname s "$xienv" nSvcDesc s "$flag" nSvcStateID i 2 nSvcOutput s "#results"`;
return;
}
Any thoughts what could be missing?
Issue was in the failover() SubRoutine. I was calling a file "myxilist" that was present in the same directory as the script.
So, the script was working fine when called manually, but when it is triggered from application, script is getting executed from some other directory and the failover sub exits, as it's not able to open the file.
I've provided the full path of the file and the script works fine.
Thank you all for your help.
I am trying to ping 2 IP's using fork in PERL. I am pushing IP's that are reachable and non reachable in different arrays. At the end of program I am printing arrays but i am not getting output
Below is the code
use strict;
use warnings;
my (#up, #down, #child, #test);
sub prog1 {
my $ip = $_[0];
print "Started testing IP : $ip \n";
my $resp = `ping $ip`;
if ( $resp =~ /reply/) {
push (#up, $ip);
}
else {
push (#down, $ip);
}
push (#test, $ip);
print "Ended with testing of ip $ip \n";
}
my #list = qw /192.168.1.1 192.168.2.1/;
foreach (#list) {
my $pid = fork();
if ( !$pid ) {
prog1($_);
exit 0;
}
else {
push (#child, $pid);
}
}
foreach (#child) {
waitpid ($_, 0);
print "Done with pid $_ \n";
}
print "\n\n up is #up";
print "\n\n down is #down\n";
print "test is #test";
Output i am getting is
$ perl fork_ping.pl
Started testing IP : 192.168.1.1
Started testing IP : 192.168.2.1
Ended with testing of ip 192.168.1.1
Done with pid 99804
Ended with testing of ip 192.168.2.1
Done with pid 81456
up is
down is
test is
As you can see #up and #down arrays are empty. Any clue why it is not populating any IP there
Dear all I am trying to get a script working and have no clue where to start with the error being produced
sh: 1: Syntax error: redirection unexpected
My script is below and if anyone can help I would be very grateful
Tony
ebay.pl
#!/usr/bin/perl -w
system("/usr/local/bin/ebaycurl.sh");
open (ITEMS, "/usr/local/data/eBaystuff") or die "stuff $!";
while (<ITEMS>) {
chomp;
next unless /ViewItem\&/;
s/Item not relisted/Item_not_relisted/g;
s/Item relisted/Item_relisted/g;
#words = split;
$relist = "";
foreach $word (#words) {
if ($word =~ /ViewItem\&/) {
print "\n";
$print_it = 1;
$link = $word;
($junk, $link) = split /f=/, $word;
$link =~ s/&/&/g;
#system("/usr/local/bin/ebaycurlitem.sh $link >/dev/null 2>/dev/null");
system("/usr/local/bin/ebaycurlitem.sh $link");
open (ITEM, "/usr/local/data/eBayitem") or die "item $!";
$relist = "";
while (<ITEM>) {
next unless /Relist/;
$relist = 'relist';
}
#($junk, $itemid) = split /item=/, $link;
#$itemid =~ s/\"//;
print "$relist\t";
next;
}
if (defined $print_it) {
if ($word =~ /\>/) {
$print_it = undef;
($rem, $junk) = split />/, $word;
print "$rem";
} else {
$word =~ s/title=//;
print "$word ";
}
}
if ($word =~ /Item_not_relisted/ and $relist =~ /relist/) {print "\t\t\t\tNOT RELISTED";}
}
print "\n";
}
ebaycurl.sh
#!/bin/bash
$(COOKIE_DIR)="cat /usr/local/etc/ebay_cookie_dir)
(/usr/bin/curl --cookie "COOKIE_DIR"/cookies.txt 'http://k2b-bulk.ebay.co.uk/ws/eBayISAPI.dll?SalesRecordConsole¤tpage=SCSold&ssPageName=STRK:ME:LNLK; -o /usr/local/data/eBaystuff)"
There's a lot wrong with the bash script you posted. I recommend reading up on bash syntax cause it looks like you just threw parentheses and quotes in at random. Rather than explain each correction I'm just gonna post this and hope it's self-explanatory...
#!/bin/bash
COOKIE_DIR=$(cat /usr/local/etc/ebay_cookie_dir)
curl --cookie "$COOKIE_DIR"/cookies.txt -o /usr/local/data/eBaystuff \
'http://k2b-bulk.ebay.co.uk/ws/eBayISAPI.dll?SalesRecordConsole¤tpage=SCSold&ssPageName=STRK:ME:LNLK'
Im trying to code a "service" script based on "ps".
my code:
#!/usr/bin/perl
use strict;
use warnings;
die "usage: $0 <service name>\n" unless $ARGV[0];
my $service = $ARGV[0];
open(my $ps, "ps -aux |") || die "Uknown command\n";
my #A = <$ps>;
close $ps;
foreach my $i(grep /$service/, #A){
chomp $i;
if($i=~ /root/){
next
}
print "$i\n";
}
My problem: When running the script against undef arg like:
$0 blablabla
I want to return an output if there is no such service appears/when returns 0
Thanks
I assume what you are asking is: How to give a proper message when no matching lines are found?
Well, just store the result in an array instead:
my #lines = grep { !/root/ && /$service/ } #A;
if (#lines) { # if any lines are found
for my $line (#lines) {
...
}
} else {
print "No match for '$service'!\n";
}
Or you can print the number of matches regardless of their number:
my $found = #lines;
print "Matched found: $found\n";
Note also that you can add the check for root in your grep.
As a side note, this part:
die "usage: $0 <service name>\n" unless $ARGV[0];
my $service = $ARGV[0];
Is perhaps better written
my $service = shift;
die "usage ...." unless defined $service;
Which specifically checks if the argument is defined or not, as opposed to true or not.
If I understand you correctly, you want to inform the user if no such service was found? If so, you can modify the script as follows:
my $printed; # Will be used as a flag.
foreach my $i(grep /$service/, #A){
chomp $i;
if($i=~ /root/){
next
}
$printed = print "$i\n"; # Set the flag if the service was found.
}
warn "No service found\n" unless $printed;
You can try something like this:
my #processes = grep /$service/, #A;
if ( scalar #processes ) {
foreach my $i( #processes ){
chomp $i;
if($i=~ /root/){
next;
}
print "$i\n";
}
}
else {
print 'your message';
}
You could check the result of the grep command before traversing it in the for loop, like:
...
my #services = grep { m/$service/ } #A;
# Filter the perl process running this script and...
if ( ! #services ) {
print "No service found\n";
exit 0;
}
foreach my $i( #services ){
...
}
Take into account that the grep command will never give a false return because it is including the perl process, so you will have to filter it, but I hope you get the idea.
Error:
Syntax error: end of file unexpected
Below is the Code
I changed.
"#!/usr/local/bin/perl"
The actual program is
#!/local/perl5/bin/perl5.003
use Socket;
$sockaddr = 'S n a4 x8';
$host = $ARGV[0];
$them = $host;
$port = 79;
print "Finger $host: \n";
$hostname = ``;
`nslookup $host |grep Name: >> $test`;
print $test;
#($name, $aliases, $proto) = getprotobyname('tcp');
($name, $aliases, $port) = getservbyname($port, 'tcp') unless $port =~ /^\d+$/;
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
$n1 = $name;
($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);
$this = pack($sockaddr, &AF_INET, 0, $thisaddr);
$that = pack($sockaddr, &AF_INET, $port, $thataddr);
socket(S, &PF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
bind(S, $this) || die "bind: $!";
connect(S, $that);
select(S); $| = 1; select(stdout);
print S "\n\n";
while (<S>) {print $_;};
Here:
`nslookup $host |grep Name: >> $test`;
$test is undefined at that point, so you're asking the shell to execute nslookup whatever.com |grep Name: >>. Where is the shell supposed to redirect the output to?
If you set $test to be something, like a filename.. or even $test = "$host.txt"; it will get you further.
Nothing to do with your Perl version, although being able to use strict;use warnings does help, as it would've caught the above error.