Perl Net::SFTP::Foreign disconnect not closing the connection - perl

While calling $sftp->disconnect() connection is not getting closed and the Perl script is going in hung state until I manually kill the process .
Below is the code how we are creating a SFTP connection :
my %sftp_args = ( user => $username, autodie => 1, stderr_discard => 1,more => qw(-v),
timeout => $timeout_secs,ssh_cmd => $SSH_PATH );
my $sftp = Net::SFTP::Foreign->new($remote_host, %sftp_args);
When we are calling the disconnect method script is getting hung.
$sftp->disconnect();
I tried putting the disconnect is in eval under alarm but still it is not coming back .
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm 25;
my $retrun = $sftp->disconnect();
alarm 0;
};
my $exception = $#;
msg("Error Dump".Dumper($exception));
}
Below is the error i am getting in my nohup.out file.
bash: line 1: 27860 Alarm clock sftp_connection.pl

After doing the analysis on the Net::SFTP::Foreign Module i was able to find the solution . So Net::SFTP::Foreign module has a bug below are the details , i found this in perldoc:
On some operating systems, closing the pipes used to communicate the
slave SSH process does not terminate it and a work around has to be applied.
If you find that your scripts hung when the $sftp object gets out of scope,
try setting $Net::SFTP::Foreign::dirty_cleanup to a true value
According to the above comment i made the changes in my application and now it is working fine:
my %sftp_args = ( user => $username, autodie => 1, stderr_discard => 1,
timeout => $timeout_secs, ssh_cmd => $SSH_PATH, dirty_cleanup => 1 );
my $sftp = Net::SFTP::Foreign->new($remote_host, %sftp_args);
return $sftp;

Related

How to check Net::Telnet session is still live in Perl?

I have a Perl script to run some commands on remote equipment by Net::Telnet. Sometimes, telnet session would be disconnected by remote side because login timeout or other cause. I want to know how I can check telnet session is still live before send next command? Thanks a lot!
my $tc = new Net::Telnet{Host=>$host,Port=>23};
sub checkTelnetLive { ??? }
my #commands=($cmd1,$cmd2,...);
foreach $cmd(#commands) {
if checkTelnetLive {
$tc->put($cmd);
$tc->waitfor('/COMPLD/');
}
else {
die "Remote equipment has disconnected session."
}
}
my $tc = new Net::Telnet (Host=> $host, Port=>23, Errmode => 'return' );
or you can use eval
eval {
my $tc = new Net::Telnet (Host=> $host, Port=>23, Errmode => 'return' );
#. plus other code
};
warn $# if $#;

PERL Net::SFTP::Foreign autodie=>0 then 1

I'm writing a script that retrieves some files automatically once a day on some sftp server.
The problem is this sftp server is not very reliable and sometimes the client have to retry a couple of times until opening the session successfully.
I choose Net::SFTP::Foreign for different reasons (especially because it uses the native ssh command from the system).
I wrote a loop in order to retry the opening sftp session 3 times before giving up.
My problem :
I want to keep the autodie=1 because it automatically handles the non-recoverable errors for all methods used later in the code.
But the autodie=1 prevents me to trap any error during the session opening (Net::SFTP::Foreign->new) and therefore the retries part is useless.
Here is the part of the code I wrote, the autodie is set to 0 in order to make work the retries part (but I want autodie=1).
Is it possible to open the sftp connection with autodie=>0 so that the retries part actually works, and then change this value with autodie=>1 in order to have the auto handling of non-recoverable errors ?
Any help would be much appreciated :)
use Net::SFTP::Foreign;
print "Opening SFTP session...\n";
my $j = 1;
my $sftp_max_retry = 5;
while (1) {
$sftp = do {
local $SIG{TERM} = 'IGNORE'; # used to avoid the message "Killed by signal 15".
Net::SFTP::Foreign->new(
host => "some_host_unavailable",
port => 22,
user => "some_user",
password => "some_pwd",
autodie => 0,
timeout => 10,
autoflush => 1,
);
};
if ($sftp->error) {
if ($j > $sftp_max_retry) {
print "Opening SFTP failed, maximum retry reached !\n";
exit 2;
}
print "Opening SFTP session (retry $j/$sftp_max_retry)...\n";
sleep $sftp_retry_loop;
$j++;
}else{
print "\nConnection successful\n";
last;
}
}
You can wrap your connection into eval statement and set autodie to 1.
This should work:
use Net::SFTP::Foreign;
print "Opening SFTP session...\n";
my $j = 1;
my $sftp_max_retry = 5;
my $sftp;
while (1) {
eval {
$sftp = do {
local $SIG{TERM} = 'IGNORE'; # used to avoid the message "Killed by signal 15".
Net::SFTP::Foreign->new(
host => "some_host_unavailable",
port => 22,
user => "some_user",
password => "some_pwd",
autodie => 1,
timeout => 10,
autoflush => 1,
);
};
}
if ($#) {
if ($j > $sftp_max_retry) {
print "Opening SFTP failed, maximum retry reached !\n";
exit 2;
}
print "Opening SFTP session (retry $j/$sftp_max_retry)...\n";
sleep $sftp_retry_loop;
$j++;
}else{
print "\nConnection successful\n";
last;
}
}

Perl Net::Server hot deployment

I am using Net::Server::Prefork to launch a TCP server. The startup routine looks like this:
use 5.10.1;
use strict;
use warnings;
use parent 'Net::Server::Fork';
Dispatcher->run(
'host' => $host || '*',
'port' => $port || 7000,
'ipv' => '*',
'log_level' => $main::config{'backend.loglevel'} || 0,
'log_file' => $main::config{'backend.logfile'} || undef,
'pid_file' => $main::config{'backend.pidfile'} || undef,
'user' => $main::config{'backend.user'} || 'nobody',
'group' => $main::config{'backend.group'} || 'nogroup',
'max_servers' => $main::config{'backend.maxconnections'} || 3,
'background' => !$main::config{'backend.foreground'} || undef,
'allow' => $main::config{'ip'} || '.*',
'reverse_lookups' => 1,
);
Dispatcher uses this function to process requests:
sub process_request {
eval {
local $SIG{'ALRM'} = sub { die "Timed Out!\n" };
my $previous_alarm = alarm($timeout);
my #args;
{
my $command = <STDIN>;
#args = split /\s+/, $command;
alarm($timeout);
}
alarm(($main::config{'timeout'} + 5) || 185);
{
Dispatcher::main(#args);
}
alarm($previous_alarm);
};
};
Now this is all good and well. However, when updating the server, I currently have the problem that in order not to kill requests that are in the midst of being processed, I have to check for active processes and wait until they are finished with the additional problem that while waiting new clients could connect.
So - is there a chance to 'phase out' running child processes, i.e. terminate idle preforked processes, replace them with new version, and replace each running (old) process with a new version once the old process finishes?
Alternatively, can I block incoming connections until all old child processes are finished and then restart the server as a whole? I was thinking about doing this with temporary firewall rules, but would really prefer having perl handle this.
Any ideas are appreciated!
Have you tried to use leave_children_open_on_hup configuration option and restart server using HUP signal? [recipe for linux/unix]
It should work according to documentation.
Net::Server Restarting

Resolving issue with Net::OpenSSH and passing multiple commands to a router

I'm working on moving a Perl script that pushed commands to routers. We have turned off telnet, so I'm working on getting SSH to work. After looking at a number of SSH libraries in Perl, I've opted to use Net::OpenSSH. I have no problem logging in and passing commands to the routers, but the problem I'm having is with entering config mode and subsequently passing a command.
The problem is that with each command entered, the underlying system appears to logout then reenter with the next subsequent command. For example with a Juniper router I'm trying to do the following:
edit private
set interfaces xe-1/3/2 description "AVAIL: SOMETHING GOES HERE"
commit
exit
quit
Tailing the syslog from the router I'm seeing something like this...
(...)
UI_LOGIN_EVENT: User 'tools' login, class 'j-remote-user' [65151], ssh-connection 'xxx.xxx.xxx.xxx 42247 xxx.xxx.xxx.xxx 22', client-mode 'cli'
UI_CMDLINE_READ_LINE: User 'tools', command 'edit private '
UI_DBASE_LOGIN_EVENT: User 'tools' entering configuration mode
UI_DBASE_LOGOUT_EVENT: User 'tools' exiting configuration mode
UI_LOGOUT_EVENT: User 'tools' logout
UI_AUTH_EVENT: Authenticated user 'remote' at permission level 'j-remote-user'
UI_LOGIN_EVENT: User 'tools' login, class 'j-remote-user' [65153], ssh-connection 'xxx.xxx.xxx.xxx 42247 xxx.xxx.xxx.xxx 22', client-mode 'cli'
UI_CMDLINE_READ_LINE: User 'tools', command 'set interfaces '
UI_LOGOUT_EVENT: User 'tools' logout
(...)
As you notice I'm getting a LOGOUT_EVENT after each command entered. Of course exiting config mode immediately after entering it causes the set interfaces command to fail as it's no longer in config mode.
The Perl code I'm using is as follows...
#!/usr/bin/perl -w
use strict;
use lib qw(
/usr/local/admin/protect/perl
/usr/local/admin/protect/perl/share/perl/5.10.1
);
use Net::OpenSSH;
my $hostname = "XXXXX";
my $username = "tools";
my $password = "XXXXX";
my $timeout = 60;
my $cmd1 = "edit private";
my $cmd2 = 'set interfaces xe-1/3/2 description "AVAIL: SOMETHING GOES HERE"';
my $cmd3 = "commit";
my $cmd4 = "exit";
my $ssh = Net::OpenSSH->new($hostname, user => $username, password => $password, timeout => $timeout,
master_opts => [-o => "StrictHostKeyChecking=no"]);
$ssh->error and die "Unable to connect to remote host: " . $ssh->error;
my #lines = eval { $ssh->capture($cmd1) };
foreach (#lines) {
print $_;
};
#lines = eval { $ssh->capture($cmd2) };
foreach (#lines) {
print $_;
};
#lines = eval { $ssh->capture($cmd3) };
foreach (#lines) {
print $_;
};
#lines = eval { $ssh->capture($cmd4) };
foreach (#lines) {
print $_;
};
$ssh->system("quit");
The sequence of events is the same as when telnet was used. The only real change was in using SSH objects verses Telnet objects. I'm stumped. Any ideas you could provide would be quite helpful.
[SOLVED, sort of]
The suggestion let Net::Telnet do the driving was the correct one. The following code works...
#!/usr/bin/perl -w
use strict;
use Net::OpenSSH;
use Net::Telnet;
use Data::Dumper;
my $promptEnd = '/\w+[\$\%\#\>]\s{0,1}$/o';
my $cmd1 = "show system uptime | no-more";
my $cmd2 = "show version brief | no-more";
my $hostname = "xxx.xxx";
my $username = "xxxxxxx";
my $password = "xxxxxxx";
my $timeout = 60;
my $ssh = Net::OpenSSH->new(
$hostname,
user => $username,
password => $password,
timeout => $timeout,
master_opts => [ -o => "StrictHostKeyChecking=no" ]
);
$ssh->error and die "Unable to connect to remote host: " . $ssh->error;
my ( $fh, $pid ) = $ssh->open2pty( { stderr_to_stdout => 1 } );
my %params = (
fhopen => $fh,
timeout => $timeout,
errmode => 'return',
);
$conn = Net::Telnet->new(%params);
$conn->waitfor($promptEnd);
#lines = $conn->cmd($cmd1);
foreach (#lines) {
print $_;
}
#lines = $conn->cmd($cmd2);
foreach (#lines) {
print $_;
}
$conn->cmd("quit");
The problem I'm having is that I can't seem to separate the code into subroutines. Once the $conn object is returned from a subroutine, the underlying ssh connection drops. I need to separate this logic in order to not have to rewrite many, many programs and lines of code that relay on this pusher routine. However that problem I'll direct to another question.
[Edit, fully solved]
Just an update in case anyone needs to do something similar.
While the above worked very well when run under a single subroutine, I found that any time I passed the handle to another subroutine, the telnet handle remained open, but the ssh connection dropped.
To solve this I found that if I passed the ssh handle to another subroutine, then later attached the open2pty, and attached Net::Telnet, then I could pass the Net::Telnet handle between subroutines without the underlying ssh connection dropping. This also worked for Net::Telnet::Cisco as well. I have this code working well with Cisco, Juniper, and Brocade routers.
You should also consider adding a few more parameters to the Net::Telnet->new() because it is interacting with ssh rather than a TELNET server.
-telnetmode => 0
-output_record_separator => "\r",
-cmd_remove_mode => 1,
Because there is no TELNET server on remote side, -telnetmode => 0 turns off TELNET negotiation.
The end-of-line is most likely just a carriage-return (i.e. -output_record_separator => "\r") rather than the TCP or TELNET combination of carriage-return linefeed ("\r\n").
Always strip the echoed back input -cmd_remove_mode => 1
There are several possibilities:
Some routers accept having the sequence of commands sent up front via stdin:
my $out = $ssh->capture({stdin_data => join("\r\n", #cmds, '')})
In other cases you will have to use something like Expect to send a command, wait for the prompt to appear again, send another command, etc.
If you were using Net::Telnet before, the Net::OpenSSH docs explain how to integrate both (though I have to admit that combination is not very tested).
Also, some routers provide some way to escape to a full Unix-like shell. I.e., preppending the commands with a bang:
$ssh->capture("!ls");

check if the connection to websocket still open with Net::Async::WebSocket

I am Perl beginner and I am fighting with websockets at the moments. After a lot of reading, trying and copy-pasting I got this code to work:
use strict;
use warnings;
use utf8;
use Data::Dumper;
use IO::Async::Loop;
use IO::Async::Timer::Periodic;
use Net::Async::WebSocket::Client;
use Protocol::WebSocket::URL;
my ($url, $msg, $last_update);
$url = 'ws://127.0.0.1/stream';
$msg = 'get_lists';
my $uri = Protocol::WebSocket::URL->new->parse($url);
my $loop = IO::Async::Loop->new;
my $client = Net::Async::WebSocket::Client->new(
on_frame => sub {
my ($self, $frame) = #_;
chomp($frame);
$last_update = time(); # use this in timer below
# do something else
}
);
$loop->add($client);
$client->connect(
host => $uri->host,
service => $uri->port,
url => $url,
on_connected => sub {
warn "Connection established";
if ($msg) {
$client->send_frame("$msg\n");
}
},
on_connect_error=> sub { die "CONNECT: ".Dumper \#_; },
on_resolve_error=> sub { die "RESOLVE: ".Dumper \#_; },
on_fail => sub { die "FAIL: ".Dumper \#_; },
on_read_eof => sub {
$loop->remove($client);
# reconnect?
}
);
# is the connection to socket is still open?
# check every 30 seconds if $last_update was not updated
my $timer = IO::Async::Timer::Periodic->new(
interval=> 30,
on_tick => sub {
if (!$last_update || time()-30 > $last_update) {
warn "Connection probably dead. No new data for 20 seconds.";
## check connection
## and reconnect if needed
}
},
);
$timer->start;
$loop->add($timer);
$loop->loop_forever;
I need one more thing here and I am not sure how to solve this:
I found some info like https://stackoverflow.com/a/12091867/1645170 but I do not understand how to put SO_KEEPALIVE in my code. I should probably make my own IO::Socket connection and somehow pass it to Async::Net::WebSocket but I was not able to do it. Actually I don't really have an idea how shoud I do this. Obviously beginner's problems.
I tried the second approach with a timer which should check every 30 seconds whether the connection is open (if no new data came through socket). Again, same problem but from the other side: not sure how to check with the above code whether the connection is open.
I could make a basic IO::Socket connection but I would like to do somehow with the above code because I like how Net::Async::WebSocket does it with events (on_read-eof, on_frame etc).
How to check if it is still works?
Create a "heartbeat". Send a "ping" at every x second from a client and wait until a "pong" gets back. Die if timeout reached.
On the server you could add your own socket (from one of the examples).
If hope it will help you.
my $serversock = IO::Socket::INET->new(
LocalHost => "127.0.0.1",
Listen => 1,
) or die "Cannot allocate listening socket - $#";
$serversock->setsockopt(SOL_SOCKET, SO_KEEPALIVE, 1);
my #serverframes;
my $acceptedclient;
my $server = Net::Async::WebSocket::Server->new(
handle => $serversock,