I am using Openssh module to connect to hosts using the (async => 1) option.
How is it possible to trap connection errors for those hosts that are not able to connect.I do not want the error to appear in the terminal but instead be stored in a data structure, since I want to finally format all the data as a cgi script.When I run the script the hosts that has a connection problem throw error in the terminal.The code executes further and try to run commands on disconnected hosts.I want to isolate the disconnected hosts.
my (%ssh, %ls); #Code copied from CPAN Net::OpenSSH
my #hosts = qw(host1 host2 host3 host4 );
# multiple connections are stablished in parallel:
for my $host (#hosts) {
$ssh{$host} = Net::OpenSSH->new($host, async => 1);
$ssh{$host}->error and die "no remote connection "; <--- doesn't work here! :-(
}
# then to run some command in all the hosts (sequentially):
for my $host (#hosts) {
$ssh{$host}->system('ls /');
}
$ssh{$host}->error and die "no remote connection doesn't work".
Any help will be appreciated.
Thanks
You run async connections. So program continue work and dont wait when connection is establised.
After new with async option you try to check error but it is not defined because connection in progress and no information about error.
As i understand you need wait after first loop until connection process got results.
Try to use ->wait_for_master(0);
If a false value is given, it will finalize the connection process and wait until the multiplexing socket is available.
It returns a true value after the connection has been succesfully established. False is returned if the connection process fails or if it has not yet completed (then, the "error" method can be used to distinguish between both cases).
for my $host (#hosts) {
$ssh{$host} = Net::OpenSSH->new($host, async => 1);
}
for my $host (#hosts) {
unless ($ssh{$host}->wait_for_master(0)) {
# check $ssh{$host}->error here. For example delete $ssh{$host}
}
}
# Do work here
I don't check this code.
PS: Sorry for my English. Hope it helps you.
Related
I try to download huge file which takes a lot of time downloading from ftp link using perl.
I got:
Timeout at C:/Strawberry/perl/lib/Net/FTP.pm
what does this means and how to solve it?
Thanks
Solution:
Thanks #Chris Doyle
I change the timeout value in my perl file "not ftp.pm file"
Thanks
You can increase the timeout, but it is important that if the timeout is reached again and your server/client are out of sync, it might throw the same error you got the first time, again.
It seems that the issue is due a lack of error handling in your Perl Script instead.
Surely you have something like this at your perl script:
my $ftp = Net::FTP->new( $myhost, Timeout => 10, Debug => 1 );
...
$ftp->get($myfile) or print "Got an error";
$ftp->quit();
Please notice this is out of .../perl/lib/Net/FTP.pm, since the
FTP.pm is the third party module (Kind of library) you are using to
reach the ftp, I suggest you to not touch it to avoid portability
issues later on.
Normally the timeout is reached inside the FTP.pm and it goes to the or print "Got an error" condition, but there are some cases, that the Server/Client just get out of sync and the FTP.pm just throws an unhandled exception.
This exception will NOT go to the or print "Got an error" condition, therefore you need to catch it and handle it as any other languages.
Here you can use eval to wrap it up the code, catch the exception and handle it as you need.
For example:
my $ftp = Net::FTP->new( $myhost, Timeout => 10, Debug => 1 );
...
eval {$ftp->get($myfile) or print("Can't get file $myfile") };
if ($# =~ /Timeout/) {
print "Got a timeout Issue: $#";
}
$ftp->quit();
I am beginner to Perl and I have to write a script which could change the IP address after every 1 hour.
I want to change it because I receive some data from a dongle from a website and that website has some time limit to receive that data, so currently we need to unplug the connecting device and use another to
change IP address. (I mean I have to request DHCP for another IP.)
But currently I am asked to write a script using Perl. Could someone please help me how to do that?
My try to do it is :
#!/usr/bin/perl
# Simple DHCP client - sending a broadcasted DHCP Discover request
use IO::Socket::INET;
use Net::DHCP::Packet;
use Net::DHCP::Constants;
use POSIX qw(setsid strftime);
# sample logger
sub logger{
my $str = shift;
print STDOUT strftime "[%d/%b/%Y:%H:%M:%S] ", localtime;
print STDOUT "$str\n";
}
logger("DHCPd tester - dummy client");
logger("Opening socket");
$handle = IO::Socket::INET->new(Proto => 'udp',
Broadcast => 1,
PeerPort => '67',
LocalPort => '68',
PeerAddr => '255.255.255.255',
)
|| die "Socket creation error: $#\n"; # yes, it uses $# here
# create DHCP Packet DISCOVER
$discover = Net::DHCP::Packet->new(
Xid => 0x12345678,
DHO_DHCP_MESSAGE_TYPE() => DHCPDISCOVER(),
DHO_VENDOR_CLASS_IDENTIFIER() => 'foo',
);
logger("Sending DISCOVER to 127.0.0.1:67");
logger($discover->toString());
$handle->send($discover->serialize())
or die "Error sending:$!\n";
logger("Waiting for response from server");
$handle->recv($buf, 4096) || die("recv:$!");
logger("Got response");
$response = new Net::DHCP::Packet($buf);
logger($response->toString());
# create DHCP Packet REQUEST
$request = Net::DHCP::Packet->new(
Xid => 0x12345678,
Ciaddr => $response->yiaddr(),
DHO_DHCP_MESSAGE_TYPE() => DHCPREQUEST(),
DHO_VENDOR_CLASS_IDENTIFIER() => 'foo',
DHO_DHCP_REQUESTED_ADDRESS() => $response->yiaddr(),
);
logger("Sending REQUEST to 127.0.0.1:67");
logger($request->toString());
$handle->send($request->serialize())
or die "Error sending:$!\n";
logger("Waiting for response from server");
$handle->recv($buf, 4096) || die("recv:$!");
logger("Got response");
$response = new Net::DHCP::Packet($buf);
logger($response->toString());
It's output on terminal is :
C:\shekhar_Axestrack_Intern\IpAddressChangeScripts>test6.pl
[08/Jan/2015:18:01:01] DHCPd tester - dummy client
[08/Jan/2015:18:01:01] Opening socket
[08/Jan/2015:18:01:01] Sending DISCOVER to 127.0.0.1:67
[08/Jan/2015:18:01:01] op = BOOTREQUEST
htype = HTYPE_ETHER
hlen = 6
hops = 0
xid = 12345678
secs = 0
flags = 0
ciaddr = 0.0.0.0
yiaddr = 0.0.0.0
siaddr = 0.0.0.0
giaddr = 0.0.0.0
chaddr =
sname =
file =
Options :
DHO_DHCP_MESSAGE_TYPE(53) = DHCPDISCOVER
DHO_VENDOR_CLASS_IDENTIFIER(60) = foo
padding [0] =
[08/Jan/2015:18:01:01] Waiting for response from server
//And it is stuck here since last 45 minutes....
My idea to do it is:
I will send a request to server (DHCP) (I think DHCPREQUEST() do that)that please provide me new IP adress.
Could some one please let me know if my last line will print ID adress or not ? I mean :
$response = new Net::DHCP::Packet($buf);
logger($response->toString());
EDIT:
I also tried this on suggestion by the experienced guys below but it still do not change IP adress (even i tried to run this perl code 4 times without success in IP change-Even i tried to run manually ipconfig /renew but still the IP is same all the time).
my $ipconfig = `ipconfig /renew`;
my $ipcfg_success = $?;
print $ipconfig;
if ($ipcfg_success == 0) {
do print "n succesfully runned \n";
} else {
do "\n succesfully NOT sunned \n";
}
Writing a DHCP client isn't going to change your system's IP address. You need to use the system's client.
system('ipconfig /release & ipconfig /renew');
You're not guaranteed to get a new address, though. It causes less headaches if machines always have the same IP address, so DHCP servers tend to always give the same address to a machine.
This more of a comment but it grew too long.
Just have your script call ipconfig /release and ipconfig /renew with a few seconds in between. That will request a new IP from the DHCP server, just as your script apparently tries to do.
Of course you are not exactly guaranteed a new IP that way, that depends on the configuration of the DHCP server but you are dependent on that either way. If the possible range of addresses is very small and you are afraid you might get the old IP by bad luck, check and renew again if it happened. If you get the same IP every time, it most likely means that the server recognizes you (by MAC or hostname) and assigns your static IP to you. In that case all you can do is talk to your network adminstrator (a course of action i would suggest anyways).
If you really need a guarantee, then you have to ditch DHCP and set your own IP. That however requires that you have some range of IPs reserved just for you. Otherwise your network administrator might hunt you down with their crossbow.
Be aware that depending on what that dongle is for and who set up that time limit, they may do anyways.
I've got a perl script using Net::FTP to transfer a file to several different servers. I am able to transfer to all about one server. The one that's failing gives the error "Unable to build data connection: Connection timed out" when I try to PUT a file. The remote file exists, but is 0 bytes. I can connect to this server and successfully put the file from my Windows machine in a different location, so I know the remote host is working.
Source code snippet from my script:
sub sendfeed_ftp {
my $feed = shift;
#send the feed file first, since it's the most import part and the images will be slow
print "Sending $feed->{feedfilename} to $feed->{ftpserver}...\n";
if (
not $ftp = Net::FTP->new( Host => $feed->{ftpserver} ),
Timeout => 360,
Passive => 1,
Debug => 1
)
{
print "Can't open $feed->{ftpserver}\t", $ftp->message;
} else {
if ( not $ftp->login( $feed->{ftpuser}, $feed->{ftppassword} ) ) {
print "Can't log $feed->{ftpuser} in\t", $ftp->message;
} else {
#$ftp->binary();
if ( not $ftp->put( $workdir . $feed->{feedfilename} ) ) {
print "Can't put $workdir$feed->{feedfilename}\t",
$ftp->message;
} else {
$ftp->quit;
print "Feed file $workdir$feed->{feedfilename} sent\n";
}
}
}
}
Here's what happens when I try to transfer the file manually from the same server running the perl script:
> ftp -p <HOSTNAME>
Connected to <HOSTNAME>.
220 FTP Server Ready
Name (<HOSTNAME>:dimports): <USERNAME>
331 Password required for <USERNAME>
Password:
230-***************************************************************************
NOTICE TO USERS
This computer system is private property. It is for authorized use only.
Users (authorized or unauthorized) have no explicit or implicit
expectation of privacy.
Any or all uses of this system and all files on this system may be
intercepted, monitored, recorded, copied, audited, inspected, and
disclosed to your employer, to authorized site, government, and law
enforcement personnel, as well as authorized officials of government
agencies, both domestic and foreign.
By using this system, the user consents to such interception, monitoring,
recording, copying, auditing, inspection, and disclosure at the
discretion of such personnel or officials. Unauthorized or improper use
of this system may result in civil and criminal penalties and
administrative or disciplinary action, as appropriate. By continuing to
use this system you indicate your awareness of and consent to these terms
and conditions of use. LOG OFF IMMEDIATELY if you do not agree to the
conditions stated in this warning.
****************************************************************************
230 User <USERNAME> logged in
Remote system type is UNIX.
Using binary mode to transfer files.
ftp> lcd outgoing/
Local directory now: /usr/home/dimports/upload/outgoing
ftp> put diamonds.csv
local: diamonds.csv remote: diamonds.csv
229 Entering Extended Passive Mode (|||50044|)
ftp: Can't connect to `<HOSTNAME>:50044': Connection timed out
if (
not $ftp = Net::FTP->new( Host => $feed->{ftpserver} ),
Timeout => 360,
Passive => 1,
Debug => 1
)
should be more like:
if (
not $ftp = Net::FTP->new(
Host => $feed->{ftpserver},
Timeout => 360,
Passive => 1,
Debug => 1
)
)
I'm writing a small script to monitor if certain ports are attempted to be accessed on my Linux box (Centos 6) using Perl 5.10.1. I'm getting back blank entries for my peerhost request. I'm not sure why. It sounds like it may be a failure in the IO socket module (http://snowhare.com/utilities/perldoc2tree/example/IO/Socket.html) but I'm not really sure. Any insight would be much appreciated.
EDIT:
Since I enabled the strict and warnings I'm getting an 'uninitialized value $display' in the cases where I thought it was blank.
#! /usr/bin/perl
use strict;
use warnings;
use IO::Socket;
use Sys::Syslog qw( :DEFAULT setlogsock);
use threads;
my #threads=();
my #ports=(88,110,389);
main(\#ports);
sub main
{
my $ports=shift;
setlogsock('unix');
openlog($0,'','user');
for my $port (#{$ports} ) {
push #threads, threads->create(\&create_monitor, $port );
}
$_->join foreach #threads;
closelog;
# wait for all threads to finish
}
sub create_monitor{
my $LocalPort=shift;
my $sock = new IO::Socket::INET (
LocalPort => $LocalPort,
Proto => 'tcp',
Listen => 1,
Reuse => 1,
) or die "Could not create socket: $!\n";
while(1)
{
my $peer_connection= $sock->accept;
my $display = $peer_connection->peerhost();
my $message="Connection attempt on port $LocalPort from $display";
#syslog('info', $message);
print $message."\n";
}
}
NOTE - it is intentional that this script never finish. I'll eventually wrap this with an init script and have it run as a service.
Perl accept() has an error code like most other functions. For accept() it is a false return, see also here.
So when you get undefined as result there is an error in accept() call. The error of accept is saved in the errno variable ($!).
Same is true for peerhost() (see here). It also can fail and return an error code.
If you only use the above code without anything else, then probably you reach connection limit of your system (you should close the connections) when accept() fails. See rlimit() to find out how that number can be increased.
One case where peerhost() fails may be that remote connection was closed already.
Solution
As reported by #limulus in the answer I accepted, this was a bug in Net::HTTPS version 6.00. Always be wary of fresh .0 releases. Here's the relevant diff between the buggy and fixed version of that module:
D:\Opt\Perl512.32 :: diff lib\Net\HTTPS.pm site\lib\Net\HTTPS.pm
6c6
< $VERSION = "6.00";
---
> $VERSION = "6.02";
75,78c75,80
< # The underlying SSLeay classes fails to work if the socket is
< # placed in non-blocking mode. This override of the blocking
< # method makes sure it stays the way it was created.
< sub blocking { } # noop
---
> if ($SSL_SOCKET_CLASS eq "Net::SSL") {
> # The underlying SSLeay classes fails to work if the socket is
> # placed in non-blocking mode. This override of the blocking
> # method makes sure it stays the way it was created.
> *blocking = sub { };
> }
Original question
Relevance: It is annoying to see your HTTPS client block indefinitely because the connection endpoint is unreliable.
This experiment is easy to set up and replay at home. You just need two things, a tarpit to trap an incoming client, and a Perl script. The tarpit can be set up using netcat:
nc -k -l localhost 9999 # on Linux, for multiple requests
nc -l -p 9999 localhost # on Cygwin, for one request only
Then, point the script to this tarpit:
use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
print 'LWP::UserAgent::VERSION ', $LWP::UserAgent::VERSION, "\n";
print 'IO::Socket::SSL::VERSION ', $IO::Socket::SSL::VERSION, "\n";
my $ua = LWP::UserAgent->new( timeout => 5, keep_alive => 1 );
$ua->ssl_opts( timeout => 5, Timeout => 5 ); # Yes - see note below!
my $rsp = $ua->request( GET 'https://localhost:9999' );
if ( $rsp->is_success ) {
print $rsp->as_string;
} else {
die $rsp->status_line;
}
What is this going to do? Well, connect to the port opened by NetCat, and then ... hang. Indefinitely. At least in terms of developer time. I mean it might time out after ten minutes or two hours, but I haven't checked; the specified timeout doesn't take effect, not on Linux, and not on Windows (Win32, haven't checked Cygwin).
Versions used:
LWP::UserAgent::VERSION 6.02
IO::Socket::SSL::VERSION 1.44
# on Linux
LWP::UserAgent::VERSION 6.02
IO::Socket::SSL::VERSION 1.44
# on Win32
Now for the timeout and Timeout parameters. The former is the name of the parameter for LWP::UA, the latter is the name for IO::Socket::SSL, used via LWP::Protocol::https. (Incidentally, why is metacpan HTTPS? Well, at least it's not a tarpit.) I am somehow hoping to have these parameters passed along :)
Just so you know, keep_alive doesn't have anything to do with the timeout not working, I verified that empirically. :)
Anyway, before digging deeper, does anyone know what's going on here and how to make the timeout work with HTTPS? Hard to believe I'm the first person running into this.
This is a result of the Net::HTTPS module overriding the blocking method of IO::Socket with a noop. Upgrading to the latest Net::HTTP package should fix this.
The timeout (and Timeout) options apply only to the connection -- how many seconds will LWP::UserAgent wait while connecting -- they are not for setting a timeout on the whole transaction.
You'll want to use Perl's alarm with a $SIG{ALRM} handler to timeout the whole transaction. See perldoc -f alarm or perlipc.
local $SIG{ALRM} = sub { die "SSL timeout\n" };
my $ua = LWP::UserAgent->new( timeout => 5, keep_alive => 1 );
$ua->ssl_opts( timeout => 5, Timeout => 5 );
eval {
alarm(10);
my $rsp = $ua->request( GET 'https://localhost:9999' );
if ( $rsp->is_success ) {
print $rsp->as_string;
} else {
die $rsp->status_line;
}
};
alarm(0);
if ($#) {
if ($# =~ /SSL timeout/) {
warn "request timed out";
} else {
die "error in request: $#";
}
}
(tested on Linux. Alarms can be a bit more cantankerous in Windows/Cygwin)
I asked this question on PerlMonks, and received an answer to the effect that:
The underlying IO::Socket::INET does not support non-blocking sockets
on Win32, thus non-blocking IO::Socket::SSL is not supported on Win32,
which means also, that timeouts don't work (because they are based on
non-blocking). See also http://www.perlmonks.org/?node_id=378675
http://cpansearch.perl.org/src/SULLR/IO-Socket-SSL-1.60/README.Win32
The PerlMonks post pointed to is from 2004. Not sure the information still applies; after all, I've seen the timeout does work on Windows, just not via SSL.