Optimization Perl script - perl

Is it possible to make this script faster ?
#!/usr/bin/perl -w
use strict;
use CGI;
package SwitchGUI;
sub new {
my ($classe, $nom, $nbports, $gio) = #_;
my $this = {
"nom" => $nom,
"nbports" => $nbports,
"gio" => $gio
};
bless($this, $classe);
$this->afficher();
return $this;
}
sub afficher {
my ($this) = #_;
my #tab = ( 1 .. $this->{nbports} );
my #odd = grep { $_ % 2 } #tab;
my #even = grep { not $_ % 2 } #tab;
my $cgi = new CGI;
my $i;
my $j;
print "<div id=\"$this->{nom}\" class=\"switch\">\n";
print $cgi->h2("$this->{nom}");
print "<div class=\"ports\">";
for my $port (#odd) {
my $res = `perl ifname-index.pl -h $this->{nom} -i FastEthernet0/$port -c reseau`;
if ($res =~ /^Erreur /) {
print $cgi->img({
src => 'ressources/interface_haut_down.png',
alt => "port n°$port",
}), "\n",
}
else {
print $cgi->a({class=>"tooltip", title=>$res},$cgi->img({
src => 'ressources/interface_haut_up.png',
alt => "port n°$port",
}), "\n",)
}
}
print "<br/>";
for my $port (#even) {
my $res = `perl ifname-index.pl -h $this->{nom} -i FastEthernet0/$port -c reseau`;
if ($res =~ /^Erreur/) {
print $cgi->img({
src => 'ressources/interface_bas_down.png',
alt => "port n°$port",
}), "\n",
}
else {
if ($this->getDuplex($res)!="Full") {
print $cgi->a({class=>"tooltip", title=>$res},$cgi->img({
src => 'ressources/interface_bas_duplex.png',
alt => "port n°$port",
}), "\n",)
}
elsif ($this->getVitesse($res)!="100"){
print $cgi->a({class=>"tooltip", title=>$res},$cgi->img({
src => 'ressources/interface_bas_speed.png',
alt => "port n°$port",
}), "\n",)
}
else {
print $cgi->a({class=>"tooltip", title=>$res},$cgi->img({
src => 'ressources/interface_bas_up.png',
alt => "port n°$port",
}), "\n",)
}
}
}
print "</div>";
print "<div class=\"gio\">";
for ($j=0;$j<$this->{gio};$j++) {
my $req = system("perl ifname-index.pl -h $this->{nom} -i GigabitEthernet0/$j -c reseau &");
print $cgi->img({
src => 'ressources/interface_bas_down.png',
alt => "port",
});
}
print "</div>\n";
print "</div>\n";
}
1;
It executes a perl script (which uses SNMP to query network equipment), and depending of the return of this script, it displays an appropriate image and description. This script is used for ajax call, from another cgi script.
My question is: can I execute multiple script by adding & or something similar
at the end of the following line?
my $res = `perl ifname-index.pl -h $this->{nom} -i FastEthernet0/$port -c reseau`;

While i don't want comment much things like using CGI and "print" (in 2011 is really archaic), I will comment two lines:
my $res = `perl ifname-index.pl -h $this->{nom} -i FastEthernet0/$port -c reseau`;
...
my $req = system("perl ifname-index.pl -h $this->{nom} -i GigabitEthernet0/$j -c reseau &");
Starting another perl-processes really slowing speed down.
You're making package for displaying HTML, but not for polling?
Re-factor ifname-index.pl to subroutine. So,
my $res = get_request_interface(name => $this->{nom}, interface => "FastEthernet0/$port");
or to an package (the right way) - something like...
my $interface = My::Interface::Handler->new();
my $res = $interface->get_request;
...
my $another_result = $interface->get_request;
#etc
And ofc, it is possible start more (multiple) processes and communicate with them, but the solution will be probably more complicated than refactoring ifname-index.pl to subroutine. (read this: http://faq.perl.org/perlfaq8.html#How_do_I_start_a_pro)
Summarization for a "cool" app - based on comments:
build a web page where you list the interfaces, for example N-status lines for N ports
the page will send N ajax (parallel) requests to the server for the status with javascript
the server will execute N parallel SNMP requests, and send N ajax responses
the page will get responses from the server and update the correct divs
With above way:
the user get immediately an web page
the page has a feedback for user - "wait, i'm working on getting status"
the server executing N parallel requests to snmp
ajax responses updating the page as they come from the server
For the web part is the best to use PGSI-type server. Check CPAN, several one exists.
Tatsuhiko Miyagawa is "The Perl Hero" for these days :)
Ps:
http://www.perlcritic.org
http://onyxneon.com/books/modern_perl/

Related

Reading and Concat'ing lines until specific value found in Perl

Morning SO,
I'm working on redesigning a Perl script designed by an external software vendor. It uses Perl, which I've never written in before. Basically all it does is read a line in, and then send a syslog packet to the a destination host containing that line. I need to modify it so Perl will keep reading and concat'ing until it reaches "". The problem is, it loops on the first line of a given file, and therefore never reaches the send stage. Any guidance on this? I went back and read the original script again, and it doesn't look to have a mechanism for iterating through each line.
Edit: OK - so apparently I've gone stupid and can't understand basic iterative logic. Fixed the looping problem, now to fix the syslog sending problem. It reads the data in correctly, but never executes the syslog send request, which implies it's not getting into the if statements.
Program should eventually enter here: if($lineRead eq $check){//do something;}
#!/usr/bin/perl -w
use strict;
use warnings;
use lib qw(.);
use lib qw(<removed>);
use Syslog;
use Time::HiRes qw( time sleep usleep );
use Getopt::Std;
# create log entries at a fixed rate (n per sec)
# Option defautls
my $me = $0;
$me =~ s|.*/||;
my %options = (
d => "127.0.0.1", # host
p => 514, # port
f => "readme.syslog", # filename
b => 0, # burst
v => 0, # verbose
t => 0, # tcp vs. udp
l => 0, # loop option
# u => "127.0.0.2", # new IP to send
);
my $theProto='tcp';
# Help
sub HELP_MESSAGE {
print <<EOF;
$me [-d <host>] [-p <port>] [-f filename] [-u <IP>] [-l] [-t] [-b] [-n NAME] [-v] <messages per second>
Options:
-d : destination syslog host (default 127.0.0.1)
-p : destination port (default 514)
-f : filename to read (default readme.syslog)
-b : burst the same message for 20% of the delay time
-t : use TCP instead of UDP for sending syslogs
-v : verbose, display lines read in from file
-n : use NAME for object name in syslog header
-l : loop indefinately
-u : use this IP as spoofed sender (default is NOT to send IP header)
EOF
}
getopts('vbtlu:d:p:n:f:', \%options);
unless (#ARGV) {
print STDERR "Need an event rate.\n";
HELP_MESSAGE;
exit 1;
}
my $nmsg = shift #ARGV;
if (!($nmsg =~ /^\d+$/)) {
print "Invalid number of messages per second.\n";
HELP_MESSAGE;
exit 1;
}
if ($options{t}) { $theProto='tcp'; }
my $syslog = new Syslog(
name => $options{n}, # prog name for syslog header
facility => 'local6',
priority => 'info',
loghost => $options{d},
port => $options{p},
proto => $theProto,
);
sub doitall() { # for purpose of infinate looping
open(F,$options{f}) or die("Unable to open file: $options{f}\n");
print STDERR "generating $nmsg messages per second to $options{d}:$options{p}\n";
print STDERR "Ctrl-c to stop\n";
# delay in milliseconds
my $delay = 1.0/$nmsg;
my $resolution = 0.2;
my $burst = $nmsg * $resolution;
my $check = "</Event>";
my $lineRead;
my $payload="a";
if ($options{b}) {
print "Sending $burst messages every ", int ($delay * 1000), "ms\n";
}
while (<F>) {
#print $lineRead;
if ($options{v}) {
print "Read in: $_\n";
}
$lineRead=$_;
if($lineRead eq $check){
$payload = join $payload, $lineRead;
if ($options{b}) {
for (my $i = 0 ; $i < $burst; $i++) {
if ($options{u}) { print $payload; $syslog->send($payload, host=> $options{u}); }
else { print $payload; $syslog->send($payload); }
}
} else {
if ($options{u}) { print $payload; $syslog->send($payload, host=> $options{u}); }
else { print $payload; $syslog->send($payload); }
}
if ($delay > 0) {
if ($options{v}) {
print "waiting for ", int($delay * 1000), "ms ...\n";
}
usleep (1000000*$delay);
}
$lineRead = "a";
$payload = "a";
}
else{
$payload = join $payload, $lineRead;
}
}
close(F);
} # end of the subroutine
if ($options{l}) {
while (1) { doitall(); }
} else { doitall(); }
exit 0;

Perl Getopt::Declare parameter action not invoked

I use Getopt::Declare in a script but invoking the script and passing -get_ip "test" doesn't do anything i.e. the script executes the "my" statements and getFirstAvailableIP doesn't get called.
use Getopt::Declare;
use lib "/home/vtsingaras/NicTool/client/lib/";
use NicToolServerAPI;
use strict;
use warnings;
#debug remove
use Data::Dumper;
#NicToolServer settings, edit
my $ntconf = {
ntuser => 'censored',
ntpass => 'censored',
nthost => 'censored',
ntport => 8082,
};
my ( $zone, $fqdn, $ip, $comment );
my $options_spec = q(+g[et_ip] <zone> Get the first available IP from the provided reverse <zone>.
{getFirstAvailableIP($::zone);}
+s[et_dns] <fqdn> <ip> <comment> Create an A record for <fqdn> that points to <ip> and the associated PTR record.
{createFwdAndPtr($::fqdn, $::ip, $::comment);}
);
my $args = Getopt::Declare->new($options_spec);
#Setup NicTool
my $nt = new NicToolServerAPI;
$NicToolServerAPI::server_host = $ntconf->{nthost};
$NicToolServerAPI::server_port = $ntconf->{ntport};
$NicToolServerAPI::data_protocol = "soap";
#$NicToolServerAPI::use_https_authentication = 0;
sub nt_login {
#Login to NicTool Server
my $ntuser = $nt->send_request(
action => "login",
username => $ntconf->{ntuser},
password => $ntconf->{ntpass},
);
if ( $ntuser->{error_code} ) {
print( "Unable to log in: " . $ntuser->{error_code} . " " . $ntuser->{error_msg} . "\n" );
exit 1;
} else {
print( "Logged in as " . $ntuser->{first_name} . " " . $ntuser->{last_name} . "\n" );
}
}
sub getFirstAvailableIP {
my $fqdn = $_[0];
print $fqdn;
die "blah";
}
The problem is that you specified + instead of - in $options_spec for get_ip.
Here is a self-contained runnable example which calls getFirstAvailableIP:
use strict;
use warnings;
use Getopt::Declare;
my $zone;
my $args = Getopt::Declare->new(<<'END_OPTS');
# tab
# ||||
# vvvv
-g[et_ip] <zone> Get the first available IP from the provided reverse <zone>.
{ getFirstAvailableIP($zone); }
END_OPTS
print "hello world\n";
exit;
sub getFirstAvailableIP {
print "blah - #_\n";
}
__END__
And executed:
$ perl declare_test.pl -get_ip test
blah - test
hello world
Note that this module requires a tab character in its specification; this makes it difficult to copy'n'paste correctly.

How to make Apache "sleep" for a few seconds

I want my server to stop for a few seconds and then start again.
I am trying to use sleep(5).
Will this help?
I've tried with a Perl script containing:
if($mech=~ m/(Connection refused)/) {print "SLEEPING\n";sleep(5);redo;}
A server hosts web pages. A client connects to a server. A Perl script using WWW::Mechanize is a client.
I suspect you're trying to do the following:
my $retries = 3;
my $resp; # response goes here
while ( $retries-- > 0 ) {
$resp = $ua->get( "http://www.google.com/" );
if ( ! $resp->is_success ) {
warn( "Failed to get webpage: " . $resp->status_line );
sleep( 5 );
next; # continue the while loop
}
last; # success!
}
if ( $retries == 0 ) {
die( "Too many retries!" );
}
# old versions of LWP::UserAgent didn't have decoded_content()
my $content = $resp->can('decoded_content') ?
$resp->decoded_content : $resp->content;
print( $content );
UPDATE
Here is the code you supplied in a comment:
use WWW::Mechanize;
my $mech = new WWW::Mechanize;
eval {
$mech->get($url);
};
if($#) {
print STDERR "Burst\n";
print STDERR Dumper($mech);
# my $var=$mech;
# print STDERR "var $var\n";
# if($mech=~ m/(Connection refused)/)
# {
# print "SLEEPING\n";
# sleep(5);
# redo;
# }
From perdoc -f redo:
The "redo" command restarts the loop block without evaluating the conditional again. The "continue" block, if any, is not executed. If the LABEL is omitted, the command refers to the innermost enclosing loop.
Seeing as you haven't put your code in a loop the call to redo doesn't have any effect.

Perl SNMP trap generator for scale testing?

I've hacked the script below together to let me generate traps to a test server. What I really need is something that will generate traps at a large scale so that I can check my tools on the receiving end to find out where the bottleneck is, such as UDP, Net::SNMP, Perl, etc.
I had hoped this script would let me generate something like 10k events/second but I am sadly mistaken.
Does anyone know if I can do this in Perl or have a suggestion of another way to do it?
#! /usr/bin/perl
use strict;
use warnings;
use Log::Fast;
use FindBin;
use Getopt::Long;
use File::Basename;
use Cwd qw(abs_path);
my $ROOT_DIR = abs_path("$FindBin::Bin/..");
use POSIX qw/strftime/;
use Net::SNMP qw(:ALL);
use Time::HiRes qw( time sleep );
#FIXME - I had to add below for Perl 5.10 users.
# on Perl 5.10, I would get the following when running:
# perl -e"autoflush STDOUT, 1;"
# Can't locate object method "autoflush" via package "IO::Handle" at -e line 1.
use FileHandle;
# Create default logger, will reconfigure it as soon as we read configuration from database
my $log = Log::Fast->global();
my $myname = $0;
$myname =~ s{.*/}{}; # leave just program name without path
# Command line options
my $options = {
debug => 0,
verbose => 0,
logfile => "./$myname.log",
help => 0,
community => "public",
trapsource => "127.0.0.1",
timelimit => 1,
};
sub usage_and_exit {
my ($exit_code) = #_;
print STDERR qq{
This program is used to generate SNMP traps to a specified host at a specified rate
Usage: $myname [-o --option]
-h : this (help) message
-d : debug level (0-5) (0 = disabled [default])
-v : Also print results to STDERR
-l : log file (defaults to local dir
-r : Rate (events/sec)
-ts : host to generate messages FROM
-td : host to generate messages TO
-tl : Run for this many seconds (default 1)
-c : community
Example: $myname -td 192.168.28.29 -r 1 -tl 5 -v
};
exit($exit_code);
}
GetOptions(
'debug|d=i' => \$options->{debug},
'help|h!' => \$options->{help},
'verbose|v!' => \$options->{verbose},
'logfile|l=s' => \$options->{logfile},
'rate|r=i' => \$options->{rate},
'trapsource|ts=s' => \$options->{trapsource},
'trapdest|td=s' => \$options->{trapdest},
'community|c=s' => \$options->{community},
'timelimit|tl=i' => \$options->{timelimit},
) or usage_and_exit(1); # got some invalid options
if ( $options->{help} ) {
usage_and_exit(0);
}
# Reconfigure log to use logfile (as we finally got it from $settings), also
# set proper level and output based on $options{verbose} and $options{debug}
setup_log();
# Finally we are initialized, announce this to the world :-)
$log->INFO("Program initialized successfully");
my $date = strftime "%Y-%m-%d %H:%M:%S", localtime;
# start func
my $period = 1 / $options->{rate};
my $start = time();
my $limit = time() + $options->{timelimit};
my $total = $options->{rate} * $options->{timelimit};
$log->INFO("Generating $options->{rate} trap(s) every second for $options->{timelimit} seconds (1 every $period seconds, $total total events)");
while($start < $limit) {
my $elapsed = time() - $start;
if ($elapsed < $period) {
sleep($period - $elapsed);
my ($session, $error) = Net::SNMP->session(
-hostname => $options->{trapdest},
-community => $options->{community},
-port => SNMP_TRAP_PORT, # Need to use port 162
-version => 'snmpv2c'
);
if (!defined($session)) {
$log->INFO("ERROR: %s.", $error);
exit 1;
}
my $result = $session->snmpv2_trap(
-varbindlist => [
'1.3.6.1.2.1.1.3.0', TIMETICKS, 600,
'1.3.6.1.6.3.1.1.4.1.0', OBJECT_IDENTIFIER, '1.3.6.1.4.1.326',
'1.3.6.1.6.3.18.1.3.0', IPADDRESS, $options->{trapsource}
]
);
if (!defined($result)) {
$log->INFO("ERROR: %s.", $session->error());
} else {
$log->INFO("SNMPv2-Trap-PDU sent from $options->{trapsource} to $options->{trapdest}.");
}
} else {
$start = time();
}
}
#-------------------------------------------
# There should only be subs from here down
#-------------------------------------------
# =================================================================================================
# Helper functions
# =================================================================================================
# commify not used yet
sub commify {
my $text = reverse $_[0];
$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
return scalar reverse $text;
}
sub setup_log {
my $log_dir = dirname($options->{logfile});
# Create log dir, and build log path if not provided by command line option
if ( !-d $log_dir ) {
mkdir( $log_dir, 0755 ) or die("mkdir $log_dir: $!");
}
if ( !$options->{logfile} ) {
$options->{logfile} = $log_dir . "/" . basename( $0, '.pl' ) . '.log';
}
my $log_options = {};
# Set up output to file or both file and stderr
if ( $options->{verbose} ) {
# make multiplexer FH sending data both to file and STDERR
open( my $fh, '>>:tee', $options->{logfile}, \*STDERR )
or die("$options->{logfile}: $!");
$fh->autoflush(1);
$log_options->{fh} = $fh;
}
else {
open( my $fh, '>>', $options->{logfile} ) or die("$options->{logfile}: $!");
$log_options->{fh} = $fh;
}
# Setup extra information to put in every log line, depending on debug level
if ( $options->{debug} > 1 ) {
$log_options->{prefix} = "%D %T %S [%L] ";
}
else {
$log_options->{prefix} = "%D %T [%L] ";
}
$log_options->{level} = $options->{debug} > 0 ? 'DEBUG' : 'INFO';
$log->config($log_options);
$SIG{__WARN__} = sub {
my $msg = shift;
$msg =~ s/\n//;
$log->WARN($msg);
};
$log->INFO("Starting logging to $options->{logfile} with pid $$");
}
sub DEBUG {
my ( $level, #log_args ) = #_;
if ( $options->{debug} >= $level ) {
$log->DEBUG(#log_args);
}
}
Perhaps use something like Parallel::ForkManager ? In addition, with specific regard to testing scalability of your SNMP collector, you'll probably be interested in the use case of receiving the traps from many HOSTS, not just a single host sending traps at a high rate. For that, you might want to look at using pssh.
One problem might be the slowness of Net::SNMP in pure-perl - perhaps exectuting snmptest or snmptrap via the shell might be faster ? Worth a try.

Web Server with HTTP::Daemon, HTML not rendering

I figured out a way to create a quick web server in Perl:
#!/usr/bin/env perl -s -wl
use strict;
use HTTP::Daemon;
use HTTP::Headers;
use HTTP::Response;
sub help {
print "$0 -port=<port-number>";
}
our $port;
our $addr = "localhost";
$port = 9000 unless defined $port;
my $server = HTTP::Daemon->new(
LocalAddr => $addr,
LocalPort => $port,
Listen => 1,
Reuse => 1,
);
die "$0: Could not setup server" unless $server;
print "$0: http://$addr:$port Accepting clients";
while (my $client = $server->accept()) {
print "$0: Client received";
$client->autoflush(1);
my $request = $client->get_request;
print "$0: Client's Request Received";
print "$0: Request: " . $request->method;
if ($request->method eq 'GET') {
my $header = HTTP::Headers->new;
$header->date( time );
$header->server("$0");
$header->content_type('text/html');
my $content = "<!doctype html><html><head><title>Hello World</title></head><body><h1>Hello World!</h1></body></html>";
my $response = HTTP::Response->new(200);
$response->content($content);
$response->header("Content-Type" => "text/html");
$client->send_response($response);
}
print "$0: Closed";
$client->close;
undef($client);
}
But for some reason, every time I access localhost:9000 it displays part of the HTTP Header - date, server, content-length and content-type - and the content. It doesn't render it as an HTML page. Is there something I'm missing?
This is caused by the -l switch:
#!/usr/bin/env perl -s -wl
^
It sets the output record separator to the value of the input record separator (a newline), which results in additional newlines being added to HTTP server output, and a broken HTTP response.