I have written a perl script that connects using Soap::Lite and collect data from a web-service and update a database. This works well, until the password gets locked out and I get a server 500 error which is where my question comes in. How do I let the Soap::Lite query die when it does not make a successful connection, so it does not continue with the rest of the script?
.....
my $host = "hostname";
my $user = "user";
my $pass = "pass";
$soap_proxy = "https://" . $user . ":" . $pass . "#" . $host . ":8090/services/ApiService";
$uri = "http://api.config.common.com";
$client = new SOAP::Lite
uri => $uri,
proxy => $soap_proxy,
autotype => 0;
my $soap_respons = $client->getSomething();
....
I have tried the usual or die $! but that does not die like other queries do and still continues with the remaining script.
according to the SOAP::Lite examples on CPAN, you could use:
if ($#) {
die $#;
}
But I do not know where to put this. I tried directly under my $soap_respons but still it does not die.
SOAP::Lite queries will give a fault with a faultstring result if errors occur, something like this should work.
die $soap_respons->faultstring if ($soap_respons->fault);
print $soap_respons->result, "\n";
You could set the on_fault callback. This way you wouldn't have to check every response.
$client->on_fault(sub { die($_[1]) });
Related
I am attempting top virtualise an old system for a client. This uses SOAP to pass data from the front end to the back end and back again. All the code has been copied across and the relevant Perl modules installed from CPAN. Most of the front end system works however when a SOAP call is made the system crashes, with this error in the API logs:
Illegal field name 'APR::Table=HASH(0x7fe19a0c41e0)' at /usr/lib/perl5/site_perl/5.20.1/SOAP/Transport/HTTP2.pm line 103.
Looking at the module in question the section that is erroring is this one, with Line 103 being the do {} block:
my $cl = ($self->{'MOD_PERL_VERSION'} == 1) ?
$r->header_in('Content-length') : $r->headers_in->{'Content-length'};
$self->request(HTTP::Request->new(
$r->method() => $r->uri,
HTTP::Headers->new($r->headers_in),
do { my ($c,$buf); while ($r->read($buf,$cl)) { $c.=$buf; } $c; }
));
$self->SUPER::handle;
I struggle a bit with OO Perl (I think in procedural ways) but as far as I can tell it's building an object where the method is the URI and then constructing headers in the do{} loop, appending them to $c and finally adding $c to the object. I'm assuming it doesn't like one or more of the field names that the loop is returning, but when I tried to add debug to print the $buf variable to a file in /tmp as it looped it didn't generate any output.
In attempting to resolve this I came across this advice (though this relates to Transport::HTTP not the Transport::HTTP2 we are using): https://www.tnpi.net/support/forums/index.php?topic=1037.0 I've downgraded HTTP::Message to version 6.04, however the error remains.
So I'm wondering a) how to get some debug output to see what the problem actually is, and b) any suggestions as to how to get it to work?
Update 1 (responding to first reply):
Thanks for that!
It didn't seem to like that my $data = do{} section, so I went with this:
use Data::Dumper;
my ($data);
open (L1, ">>/tmp/testlog1.txt");
print L1 "Starting to dump data...\n";
my $method = $r->method();
print L1 "Dumping \$r\n" . Dumper($r);
print L1 "Dumping \$method\n" . Dumper($method);
my $uri = $r->uri;
print L1 "\$method = $method => $uri\n";
my $headers = HTTP::Headers->new($r->headers_in);
print L1 "Dumping headers\n" . Dumper($headers);
Which produced the output below.
Starting to dump data...
Dumping $r
$VAR1 = bless( do{\(my $o = '140277572968608')}, 'Apache2::RequestRec' );
Dumping $method
$VAR1 = 'POST';
$method = POST => /
Dumping headers
$VAR1 = bless( {}, 'HTTP::Headers' );
Should a variable really contain that "bless" construct?
To debug this further try to debug what values you are sending to $self->request, and what command is actually causing the error.
I would try something like this (replacing the $self->request statement):
use Data::Dumper;
my $method = $r->method();
my $uri = $r->uri;
warn "$method => $uri";
my $headers = HTTP::Headers->new($r->headers_in);
warn Dumper($headers);
my $data;
{
my ($buf);
while ($r->read($buf,$cl)) { $data.=$buf; }
}
warn "data: $data";
my $req = HTTP::Request->new(
$method => $uri,
$headers,
$data
);
warn Dumper($req);
$self->request($req);
I have got this error when i try to connect to my switch !
use Net::OpenSSH;
use warnings;
use Expect;
my $password = 'admin';
my $enable = '';
my $ip = '192.16.25.39';
my $username='user';
my $ssh = Net::OpenSSH->new("$username:$password\#$ip", timeout => 200) ;
$ssh->error and die "unable to connect to remote host: ". $ssh->error;
my $output = $ssh->capture({stdin_data => "enable\n"."admin%\n"."show vlan"."\n"});
if ($output) {print $output . ' ';}
my $line;
print "\n";
# closes the ssh connection
$ssh->close();
I have tried this with the Expect module:
use Net::OpenSSH;
if ($output) {
print $output . ' ';
my $expect = Expect->init($output);
$expect->raw_pty(1);
#$expect->debug(2);
my $debug and $expect->log_stdout(1);
while(<$pty>) {
print "$. $_ "
}
}
which produces this error:
Can't bless non-reference value at /usr/local/share/perl5/Expect.pm line 202 (#1) (F) Only hard references may be blessed. This is how Perl "enforces" encapsulation of objects. See perlobj. Uncaught exception from user code: Can't bless non-reference value at /usr/local/share/perl5/Expect.pm line 202. at /usr/local/share/perl5/Expect.pm line 202. Expect::exp_init("Expect", "\x{d}\x{a}witch>enable\x{d}\x{a}password:\x{d}\x{a}switch#show vlan\x{d}\x{a}\x{d}\x{a}VLA"...) called at b.pl line 19 "
This might be a better approach to your problem. There is a Net::Telnet::Cisco module that simplifies a lot of the interaction with the remote router. Apparently you can first set up an encrypted SSH connection with Net::OpenSSH and then use the filehandle from that connection to start a Net::Telnet::Cisco session.
So I think something like this would be more promising than trying to use Net::OpenSSH directly:
use Net::OpenSSH;
use Net::Telnet::Cisco;
my $password = 'admin';
my $enable = '';
my $ip = '192.16.25.39';
my $username='user';
my $ssh = Net::OpenSSH->new("$username:$password\#$ip", timeout => 200) ;
my ($pty, $pid) = $ssh->open2pty({stderr_to_stdout => 1})
or die "unable to start remote shell: " . $ssh->error;
my $cisco = Net::Telnet::Cisco->new(
-fhopen => $pty,
-telnetmode => 0,
-cmd_remove_mode => 1,
-output_record_separator => "\r");
my #vlan = $cisco->cmd("show vlan");
I am not familiar with the ins and outs of configuring Cisco routers, so you'll have to take it up from here, but this looks to me like a much easier route to get what you need.
I'm running into a bit of an issue when it comes to how Perl handles POSIX signals. Namely, Perl seems to ignore the signals unless they're received during a call to sleep().
For example, the following code works fine:
#/usr/bin/perl
$SIG{PIPE} = sub { print STDERR "WARNING: Received SIGPIPE"; exit(1); };
while (1) { print "Waiting on signal...\n"; sleep(10); }
When using the above SIGPIPE handler in another script which reads from an Oracle database, the subroutine never seems to get called.
#/usr/bin/perl
use DBI;
$SIG{PIPE} = sub { print STDERR "WARNING: Received SIGPIPE"; exit(1); };
my $db = "redacted";
my $user = "redacted";
my $pass = "redacted";
my $table = "redacted";
my $ora = DBI->connect("dbi:Oracle:" . $db, $user, $pass);
my $sql = "SELECT * FROM " . $table;
my $query = $ora->prepare($sql);
$query->execute();
while (my #row = $query->fetchrow_array()) {
print(join('|', #row) . "\n");
}
if ( $DBI::err ) { print STDERR "ERROR: Unload terminated due to error"; }
I'm sending the SIGPIPE signal to both scripts in the same manner (kill -sPIPE pid), but only the first script responds to it. The second script simply carries on. No message, no exit, nothing.
How can I rectify this situation?
Setting up the signal handler before the DBI calls somehow leads it to being ignored after some of the DBI methods are called. The solution was to move the signal handler subroutine to just before the processing loop, but after the call to execute:
#/usr/bin/perl
use DBI;
# SIGPIPE handler used to be here
my $db = "redacted";
my $user = "redacted";
my $pass = "redacted";
my $table = "redacted";
my $ora = DBI->connect("dbi:Oracle:" . $db, $user, $pass);
my $sql = "SELECT * FROM " . $table;
my $query = $ora->prepare($sql);
$query->execute();
$SIG{PIPE} = sub { print STDERR "WARNING: Received SIGPIPE"; exit(1); };
while (my #row = $query->fetchrow_array()) {
print(join('|', #row) . "\n");
}
if ( $DBI::err ) { print STDERR "ERROR: Unload terminated due to error"; }
I'm not exactly sure why it fixes the issue, but it does.
It is likely that the DBI driver being used to communicate with the database is written in XS code. XS code that is going to block for a long time has to be carefully written to cope with signals and perl's "safe signals" delivery system. It is possible that the DB driver you are using doesn't take account of this, and therefore won't work.
Recently, I've found plot.ly site and am trying to use it.
But, When I use Perl API, I can't success.
My steps are same below.
I sign up plot.ly with google account
Installed Perl module(WebService::Plotly)
Type basic example("https://plot.ly/api/perl/docs/line-scatter")
..skip..
use WebService::Plotly;
use v5.10;
use utf8;
my $user = "MYID";
my $key = "MYKEY";
my $py= WebService::Plotly->new( un => $user, key => $key );
say __LINE__; # first say
my $x0 = [1,2,3,4];
my $y0 = [10,15,13,17];
my $x1 = [2,3,4,5];
my $y1 = [16,5,11,9];
my $response = $py->plot($x0, $y0, $x1, $y1);
say __LINE__ ; # second say
..skip...
Then, Execute example perl code
=>> But, In this step, $py->plot always returned "HTTP::Response=HASH(0x7fd1a4236918)"
and second say is not exeucted
( I used Perl version 5.16.2 and 5.19.1, OS is MacOS X)
On the hands, python example("https://plot.ly/api/python/docs/line-scatter") is always succeed.
Please, let me know this problem.
Thanks a lot!
After fast look at source code of this module I can suggest to use it like in example below. Because any method may raise exception. On http error this will be HTTP::Response object
eval {
my $response = $py->plot($x0, $y0, $x1, $y1);
};
if (my $err = $#) {
if (!ref $err) {
die "Plotly error: ", $err;
}
elsif ($err->isa('HTTP::Response')) {
die "HTTP error: ", $err->status_line;
}
else {
die "Unknown error: ", ref($err), " ($err)"
}
}
Have you looked at $py->content or any of the other attributes to the HTTP::Response object?
You have't told us anything other than that you've tried to print the value of an object reference, the output that you have provided from that, is the output one would expect.
Is there anything wrong the script bewlow, because I just can't login.....
And I'm sure I'm using the right username and password.
(Cannot login Login incorrect.)
sub UploadToFTPServer()
{
my $filename = shift;
$ftp = Net::FTP->new($FTPSERVER, Debug => 0) ;
if ($ftp) {
eval {
$ftp->login($USERNAME,$PASSWORD) or warn "Cannot login ", $ftp->message;
$ftp->binary();
$ftp->putfile($filename) or warn "Cannot upload ($filename)", $ftp->message;
$ftp->quit();
};
}
else {
warn "Cannot connect to $FTPSERVER: $#";
}
}
Start your script off with this:
use strict;
use warnings;
Then make sure that perl doesn't try to interpolate anything in your un/pw.
my $USERNAME = 'myname#gmail.com'; ## notice the single quotes
my $PASSWORD = 'mypass';
Given your error, it should work with those changes. It would have been easier to catch if the strict and warnings pragmas were used from the start.
Are you sure your testing from the same IP?
Also, try printing the username & password with quotes around them, as gpojd suggested.
Use the module "Net::FTP::Simple"
#send = Net::FTP::Simple->send_files({
username => $user,
password => $pass,
server => $host,
remote_dir => $path,
debug_ftp => 0,
files => [
$file,
],
});
print "The following files were retrieved successfully:\n\t",
join("\n\t", #send), "\n"
if #send;
Try $ftp->put instead of $ftp->putfile. I don't see putfile in the documentation.