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
Related
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;
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");
I would like to do some non-blocking SSH to a couple of thousand machines that i'm tracking (my own machines), I have a Dancer application up and running, and I'm willing to use AnyEvent::timer to execute SSH commands asynchronously (each machine has its own polling interval, and I don't want one machine to wait for another to complete with its SSH work).
I'm wondering, what is the best way to act asynchronously in a synchronous environment?
It is not very good idea to run any external commands from within your web scripts.
For one, should your external call block or crash for any reason, it will create bad experience for the user (even it that user is just you).
Then, running external commands as web user may have a lot of security implications - I would think your web user most likely has passwordless ssh set up, doesn't it? What if someone figures out some security hole in your script and manages to use it to ssh into your servers?
Instead, you should create separate service or process which will regularly poll your servers status using ssh (or what else) and save results of that scan into database - Postgres or MySQL.
Then, change your Dancer app to display collected results from database, rather than doing live ssh request. This way it will be very fast and secure.
I could not be a good idea but it is possible. I have a big Dancer application to execute scripts remotely and I'm doing it with fork and Net::SSH2. I tried with thread but there are some modules that are not thread-safe so I recommend to use fork.
I have some comments in my blog http://perlondancer.blogspot.mx/2014/04/executing-remote-commands-from-dancer.html and in this gist is the code example below: https://gist.github.com/johandry/11197516
#!/usr/bin/env perl
use strict;
use warnings;
use Dancer;
use Net::SSH2;
sub execCommand ($$) {
my ( $ssh2, $cmd ) = #_;
my %args=(
timeout => 1_000, # polling timeout
bufsize => 10_240, # read buffer size when polling
);
$ssh2->blocking(1); #needed for ssh->channel
my $chan=$ssh2->channel(); # create SSH2 channel
if ($ssh2->error()) {
return (undef, undef, 100);
}
# exec $cmd (caveat: only one command line can be executed over this channel. No "ls -l;whoami" combo. Use ssh->shell instead.
unless ($chan->exec($cmd)) {
return (undef, undef, 500);
}
# defin polling context: will poll stdout (in) and stderr (ext)
my #poll = ( { handle => $chan, events => ['in','ext'] } );
my %std=(); # hash of strings. store stdout/stderr results
$ssh2->blocking( 0 ); # needed for channel->poll
while(!$chan->eof) { # there still something to read from channel
$ssh2->poll( $args{'timeout'}, [ #poll ] ); # if any event, it will be store into $poll;
my( $n, $buf ); # number of bytes read (n) into buffer (buf)
foreach my $poll ( #poll ) { # for each event
foreach my $ev ( qw( in ext ) ) { #for each stdout/stderr
next unless $poll->{revents}{$ev};
#there are something to read here, into $std{$ev} hash
if( $n = $chan->read( $buf, $args{'bufsize'}, $ev eq 'ext' ) ) { #got n byte into buf for stdout ($ev='in') or stderr ($ev='ext')
$std{$ev}.=$buf;
}
} #done foreach
}
}
$chan->wait_closed(); #not really needed but cleaner
my $exit_code=$chan->exit_status();
$chan->close(); #not really needed but cleaner
$ssh2->blocking(1); # set it back for sanity (future calls)
return ($std{'in'},$std{'ext'},$exit_code);
}
sub execute ($$$$) {
my ($ip, $username, $password, $cmd) = #_;
my $pid = fork();
if ($pid) {
# This is the parent (DANCER)
debug "Process started with PID $pid\n";
} elsif ( $pid == 0 ) {
# This is the child
my $ssh2 = Net::SSH2->new();
$ssh2->connect( $ip ) or debug("Cannot connect to $ip");
my $publicKeyFile = './id_rsa.pub'; # path(setting('appdir'), 'db', 'id_rsa.pub'); # I prefer to copy the public key in your app dir due to permissions issues
my $privateKeyFile = './id_rsa'; # path(setting('appdir'), 'db', 'id_rsa'); # I prefer to copy the private key in your app dir due to permissions issues
if ( $ssh2->auth_publickey( $username, $publicKeyFile, $privateKeyFile, $password ) ) {
my ($stdout, $stderr, $exitcode) = execCommand($ssh2, $cmd);
} else {
debug "Could not authenticate to $ip with $username";
}
$ssh2->disconnect();
} else {
debug "Could not fork: $!\n";
}
}
set logger => "console";
set log => "core";
set show_errors => 1;
get '/uptime/:ip' => sub {
my $username = "the username";
my $password = "the password";
execute(param('ip'), $username, $password, "uptime > /tmp/dancer_example.txt");
return 'uptime is running';
};
dance;
true;
Net::SSH2 can be used asynchronously, but it is quite buggy and crashes often. Forget about using it for running thousands (or just hundreds) of connections in parallel on the same process. It may be ok if you use it wrapped in new processes as recomended by #Johandry, but then you can just run the ssh command using AnyEvent::Util::run_cmd.
Net::OpenSSH is another Perl module that can be used asynchronously. It shouldn't be too difficult to integrate it inside AnyEvent.
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,
I have a piece of code that creates a UNIX domain socket using IO::Socket::UNIX and gives it to an instance of IO::Async::Listener to handle listening on the socket and notifying on receiving data. The IO::Async::Listener, then, is added to a IO::Async::Loop event loop instance.
The sockets are created dynamically in a controlled manager, of course.
On a certain condition, I'd like to remove the socket from the event loop (completely delete it, or temporarily disable it on other conditions if possible) but I don't know how.
IO::Async::Loop offers to remove IO::Async::Notifier objects from the event loop via $loop->remove( $notifier ) but creating the notifier was handled internally by IO::Async::Listener (via IO::Async::Stream, I presume?). Even on Ctrl-C of my script, the socket file is not deleted, do I just have to manually close $socket and unlink( $path ) of the socket file?
Here's an abstract code of the desired behavior:
#!/usr/bin/perl
use IO::Async::Loop;
use IO::Async::Listener;
use IO::Socket::UNIX;
my $loop = IO::Async::Loop->new;
my $listener = IO::Async::Listener->new(
on_stream => sub {
my ( undef, $stream ) = #_;
$stream->configure(
on_read => sub {
my ( $self, $buffref, $eof ) = #_;
$self->write( $buffref );
$buffref = "";
return 0;
},
);
$loop->add( $stream );
},
);
$loop->add( $listener );
my $socket = IO::Socket::UNIX->new(
Local => "echo.sock",
Listen => 1,
) || die "Cannot make UNIX socket - $!\n";
$listener->listen(
handle => $socket,
);
my $condition = true;
while($condition) {
// this is probably wrong
$loop->remove( $listener );
$condition = false;
}
You seem to have two related questions here.
You can remove the listener object from the loop by using the loop's remove method:
$loop->remove( $listener )
However, removing the listener from the loop won't unlink the socket node from the fileystem. For that you will need the unlink code you suggested.
Personally, in such code as creates sockets like this, I make use of an END block:
my $path = "echo.sock";
my $socket = IO::Socket::UNIX->new(
Local => $path,
Listen => 1,
) || die "Cannot make UNIX socket - $!\n";
END { $socket and unlink $path }
$SIG{INT} = $SIG{TERM} = sub { exit 1 };
The $SIG line is required to ensure that SIGINT and SIGTERM still run the END block, rather than just causing the perl process to immediately terminate.
Finally, you should note that you can use a neater form of the listen method, rather than explicitly creating the UNIX socket in your case, you can just
my $listener = ...
$loop->add( $listener );
$listener->listen(
addr => {
family => "unix",
socktype => "stream",
path => "echo.sock",
},
);
Though again in this case you will still need the END block.