Suddenly, one server cannot be backed up. i get a strange error message:
2011-01-04 10:10:37 host1: Can't fork at /usr/share/backuppc/lib/BackupPC/Lib.pm line 1128.
What does this error mean?
All other hosts (with same OS) don't have this problem.
Thanks in advance for any reply. :)
$cmd = [split(/\s+/, $cmd)] if ( ref($cmd) ne "ARRAY" );
print(STDERR "cmdSystemOrEval: about to system ",
$bpc->execCmd2ShellCmd(#$cmd), "\n")
if ( $bpc->{verbose} );
if ( !defined($pid = open(CHILD, "-|")) ) { # <<<<<<<<< 1128
my $err = "Can't fork to run #$cmd\n";
$? = 1;
$$stdoutCB .= $err if ( ref($stdoutCB) eq 'SCALAR' );
&$stdoutCB($err) if ( ref($stdoutCB) eq 'CODE' );
return $err if ( !defined($stdoutCB) );
return;
}
binmode(CHILD);
if ( !$pid ) {
#
# This is the child
#
close(STDERR);
if ( $ignoreStderr ) {
open(STDERR, ">", "/dev/null");
} else {
open(STDERR, ">&STDOUT");
}
alarm(0);
$cmd = [map { m/(.*)/ } #$cmd]; # untaint
#
# force list-form of exec(), ie: no shell even for 1 arg
#
exec { $cmd->[0] } #$cmd;
print(STDERR "Exec of #$cmd failed\n");
exit(1);
}
The error message given at the top does not match the error message given in the code for some reason.
The error message lacks reporting $ERRNO. See fork(2) for the modes of failure for this system call.
Improve error reporting, then you need not guess about the cause.
Related
For some reason I am implementing some specific network protocol similar to STOMP in plain pure Perl.
The connection can be either a direct network socket, or an SSL tunnel provided by openssl s_client created by a call to open3 (no IO::Socket::SSL available on the host).
Depending on the dialog a request to the server may or may not have a response, or may have multiple responses. How can I test the file descriptors for the existence of data? Currently when no data is available, it waits until the defined timeout.
EDIT: I have probably a vocabulary issue between file handle vs. file descriptor to perform my research. I just found that eof() may help but cannot use it correctly yet.
While it is a bit complicated to provide an SCCCE, here is the interesting parts of the code:
# creation of a direct socket connection
sub connect_direct_socket {
my ($host, $port) = #_;
my $sock = new IO::Socket::INET(PeerAddr => $host,
PeerPort => $port,
Proto => 'tcp') or die "Can't connect to $host:$port\n";
$sock->autoflush(1);
say STDERR "* connected to $host port $port" if $args{verbose} || $args{debug};
return $sock, $sock, undef;
}
# for HTTPS, we are "cheating" by creating a tunnel with OpenSSL in s_client mode
my $tunnel_pid;
sub connect_ssl_tunnel {
my ($dest) = #_;
my ($host, $port);
$host = $dest->{host};
$port = $dest->{port};
my $cmd = "openssl s_client -connect ${host}:${port} -servername ${host} -quiet";# -quiet -verify_quiet -partial_chain';
$tunnel_pid = open3(*CMD_IN, *CMD_OUT, *CMD_ERR, $cmd);
say STDERR "* connected via OpenSSL to $host:$port" if $args{verbose} || $args{debug};
say STDERR "* command = $cmd" if $args{debug};
$SIG{CHLD} = sub {
print STDERR "* REAPER: status $? on ${tunnel_pid}\n" if waitpid($tunnel_pid, 0) > 0 && $args{debug};
};
return *CMD_IN, *CMD_OUT, *CMD_ERR;
}
# later
($OUT, $IN, $ERR) = connect_direct_socket($url->{host}, $url->{port});
# or
($OUT, $IN, $ERR) = connect_ssl_tunnel($url);
# then I am sending with a
print $OUT $request;
# and read the response with
my $selector = IO::Select->new();
$selector->add($IN);
FRAME:
while (my #ready = $selector->can_read($args{'max-wait'} || $def_max_wait)) {
last unless #ready;
foreach my $fh (#ready) {
if (fileno($fh) == fileno($IN)) {
my $buf_size = 1024 * 1024;
my $block = $fh->sysread(my $buf, $buf_size);
if($block){
if ($buf =~ s/^\n*([^\n].*?)\n\n//s){
# process data here
}
if ($buf =~ s/^(.*?)\000\n*//s ){
goto EOR;
# next FRAME;
} }
$selector->remove($fh) if eof($fh);
}
}
}
EOR:
EDIT 2 and epilogue
As a summary, depending in the protocol dialog
a request can have an expected response (for instance a CONNECT must return a CONNECTED)
a request to get the pending messages can return a single response, multiple responses at once (without intermediate request), or no response (and in this case the can_read() with no parameter of Ikegami is blocking, what I want to avoid).
Thanks to Ikegami I have changed my code as the following:
the timeout argument to can_read() is passed as an argument to the sub that is processing the responses
for initial connections I am passing a timeout of several seconds
when I expect instant responses I am passing a timeout of 1 second
in the process loop, after any correct response I replace the initial timeout by a 0.1 to not block if no more data is waiting in the filehandle
Here is my updated code:
sub process_stomp_response {
my $IN = shift;
my $timeout = shift;
my $resp = [];
my $buf; # allocate the buffer once and not in loop - thanks Ikegami!
my $buf_size = 1024 * 1024;
my $selector = IO::Select->new();
$selector->add($IN);
FRAME:
while (1){
my #ready = $selector->can_read($timeout);
last FRAME unless #ready; # empty array = timed-out
foreach my $fh (#ready) {
if (fileno($fh) == fileno($IN)) {
my $bytes = $fh->sysread($buf, $buf_size);
# if bytes undef -> error, if 0 -> eof, else number of read bytes
my %frame;
if (defined $bytes){
if($bytes){
if ($buf =~ s/^\n*([^\n].*?)\n\n//s){
# process frame headers here
# [...]
}
if ($buf =~ s/^(.*?)\000\n*//s ){
# process frame body here
# [...]
push #$resp, \%frame;
$timeout = 0.1; # for next read short timeout
next FRAME;
}
} else {
# EOF
$selector->remove($fh);
last FRAME;
}
} else {
# something is wrong
say STDERR "Error reading STOMP response: $!";
}
} else {
# what? not the given fh
}
}
}
return $resp;
}
Do not use eof in conjunction with select (which can_read wraps). It performs a buffered read, which breaks select.
select will mark a handle as ready for reading when it reaches EOF, and sysread returns zero on EOF. So all you need to do to detect EOF is to check for sysread returning zero.
Note that using a new buffer for every pass was a mistake sysread can easily return only part of a message. The following fixes this, and shows how to handle errors and EOF from sysread.
Globals:
my %clients_by_fd;
When you get a new connection:
$selector->add( $fh );
$clients_by_fd{ fileno( $fh ) } = {
buf => "",
# Any other info you want here.
};
Event loop:
while ( 1 ) {
my #ready = $selector->can_read();
for my $fh ( #ready ) {
my $client = $clients_by_fd{ fileno( $fh ) };
my $buf_ref = \$client->{ buf };
my $rv = sysread( $fh, $$buf_ref, 1024*1024, length( $$buf_ref ) );
if ( !$rv ) {
if ( defined( $rv ) ) {
# EOF
if ( length( $$buf_ref ) ) {
warn( "Error reading: Incomplete message\n" );
}
} else {
# Error
warn( "Error reading: $!\n" );
}
delete $clients_by_fd{ fileno( $fh ) };
$select->remove( $fh );
}
while ( $$buf_ref =~ s/^.*?\n\n//s ) {
process_message( $client, $& );
}
}
}
in a .pl I have the following error (capture), the script is used through SPECTRUM, a network monitoring tool, and the script is used to capture the running config of a device, what could be the fault ? Thank you.
#!/opt/SPECTRUM/bin/perl -w
# This script will capture the running configuration of a
# Cisco SAN-OS device through an SSH session and print it to STDOUT.
#
# Error Codes:
# 0 = Success
# 255 = Usage error
# 254 = Invalid timeout value
# 252 = Login error
# 249 = Exec prompt not found error
# 244 = Error retrieving configuration
# 245 = Insufficient privileges
# 253 = Unexpected output
#
use strict;
use warnings;
use Net::SSH::Expect;
$ENV{'PATH'} = "/usr/bin:". $ENV{'PATH'};
### Main ###
if( $#ARGV != 4 && $#ARGV != 5 )
{
print "Usage: capture_running.pl <device IP> <user> <pass> <enable_pass>
<login_timeout_in_seconds> <capture_timeout_in_seconds>\n";
print STDERR "Usage: capture_running.pl <deviceIP> <user> <pass>
<enable_pass> <login_timeout_in_seconds> <capture_timeout_in_seconds>\n";
exit 255;
}
elsif( $ARGV[4] < 1 || $ARGV[4] > 600 )
{
print "$ARGV[4] is the login timeout and must be an int between 1 and 600 seconds\n";
print STDERR "$ARGV[4] is the login timeout and must be an int between 1 and 600 seconds\n";
exit 254;
}
elsif( $#ARGV == 5 && ( $ARGV[5] < 1 || $ARGV[5] > 600 ) )
{
print "$ARGV[5] is the capture timeout and must be an int between 1 and 600 seconds\n";
print STDERR "$ARGV[5] is the capture timeout and must be an int between 1 and 600 seconds\n";
exit 254;
}
else
{
my $capture_timeout = $ARGV[4];
if( $ARGV[5] )
{
$capture_timeout = $ARGV[5];
}
my $errorCode = 1;
my #data;
my $errorString = "\nHost $ARGV[0]: \n";
($errorCode, #data) = GetConfig( $ARGV[0], $ARGV[1], $ARGV[2], $ARGV[3],
$ARGV[4], $capture_timeout );
if( $errorCode == 0 )
{
# Success. The running configuration
# content is in the data variable
foreach ( #data ) { print "$_\n" }; # print the configuration to STDOUT
exit 0;
}
else
{
print STDERR $errorString;
if( $errorCode == 245 )
{
print STDERR join " ", #data, "\nEnsure that the device user has
sufficient privileges to disable paging and view the config\n";
}
else
{
print STDERR join " ", #data, "\n";
}
exit $errorCode;
}
}
exit 0;
sub GetConfig
{
my $deviceIP=shift;
my $user=shift;
my $pass=shift;
my $epass=shift;
my $login_timeout=shift;
my $capture_timeout=shift;
my #config;
my $msg;
my $ssh = Net::SSH::Expect->new ( host => $deviceIP,
user => $user,
password=> $pass,
raw_pty => 1,
no_terminal => 0,
timeout => $login_timeout,
ssh_option => '-1 -c DES'
);
my $login_output;
eval { $login_output = $ssh->login(); };
if( $# )
{
$msg = "Login has failed. Output: $login_output";
return( 252, $msg );
}
# login output should contain the right prompt characters
if( $login_output !~ /\>\s*\z/ )
{
$msg = "Login has failed. Didn't see device prompt as expected.";
$ssh->close();
return( 252, $msg );
}
if( $login_output !~ /\>\s*\z/ ) # Replace '#' is the prompt character here
{
# we don't have the '#' prompt, means we still can't exec commands
$msg = "Exec prompt not found.";
$ssh->close();
return( 249, $msg );
}
my $elogin = $ssh->exec("en");
my $elogin2 = $ssh->exec($epass);
if( $elogin2 !~ /\#\s*\z/ ) # Replace '#' is the prompt character here
{
$msg = "Exec prompt not found.";
$ssh->close();
return( 249, $msg );
}
# disable paging
# different commands for different devices, if they don't
# work then we will get messages about problems later
# specifically the "No prompt after 'sh run'" error
# errmsg doesn't get set when these error and if we use print
# and getlines to read for errors it causes problems with print "sh run"
# later.
# $ssh->exec( "term pager 0" );
my $paging = $ssh->exec( "term pager 0" );
if ( $paging =~ /\s?%\s/ )
{
$msg = "Unable to set terminal size to 0 - Insufficient privileges";
$ssh->close();
return( 245, $msg);
}
$ssh->send( "sh run" );
$ssh->timeout( $capture_timeout );
$ssh->peek(0);
while( my $line = $ssh->read_line() )
{
# get configuration content
if( $line !~
/sh run|Building configuration|Current configuration|^\s*$/ )
{
push #config, $line;
}
}
if( #config <= 0 )
{
$msg = "No data retrieved, the capture timeout may be too low.";
$ssh->close();
return( 244, $msg );
}
if( scalar grep { $_ =~ /^%/ } #config )
{
# Ensure show running actually returned the config and not an error
# message containing '%'
return( 245, #config );
}
return( 0, #config ); # everything was okay, return the captured data
}
It would really help us if you took the time to ensure the code you give us is well-formatted and as easy to read as possible.
But the code causing the problem is this:
my $login_output;
eval { $login_output = $ssh->login(); };
if( $# )
{
$msg = "Login has failed. Output: $login_output";
return( 252, $msg );
}
It's the only place where $login_output is used in a "concatenation (.) or string" as described in the error message.
So the the call to $ssh->login() is failing in such a way as to leave $login_output undefined.
I don't know anything about Net::SSH::Expect, but I suspect that you need to change the arguments to the new() call (a few lines above) in some way.
You'll get more information about what has gone wrong by adding $# to the debug output.
The most likely candidate for that error is this:
my $login_output;
eval { $login_output = $ssh->login(); };
if( $# )
{
$msg = "Login has failed. Output: $login_output"; # this line
return( 252, $msg );
}
Remove $login_output from that line since it will be uninitialized if login() dies/croaks. You can replace it with $# to get the message supplied to die/croak.
I am running some commands in a remote server by connecting from my local server. To achieve this I am connecting to remote server using Net::SSH::Expect perl module. Connection is establishing here, but sometimes when I execute the command the following error comes up -
Can't call method "send" on an undefined value at .....
Here is my code:
my ($ip, $user, $passwd) = ("my.ip.address.here","user", "password");
my $ssh = SSH_Connection( $ip, $user, $passwd );
my $command_to_execute = "<Command to be executed will build here>";
print "$command_to_execute\n";
$str = 'Bye';
$ssh->send("$command_to_execute; echo $str");
$output = $ssh->waitfor($str, undef);
$ssh->close();
print "END\n";
sub SSH_Connection {
my ( $host, $user, $passwd ) = #_;
my $ssh = Net::SSH::Expect->new (
host => $host, #ip
user => $user, #'user'
password => $passwd, #'password'
raw_pty => 1,
no_terminal => 0,
);
my $login_output;
my $handledie = eval {
$login_output = $ssh->login();
};
if ( $# ) {
if ($# =~ m/SSHConnectionError/i ) {
print "SSH Connection Error\n";
} elsif ( $# =~ m/SSHProcessError/ix ) {
print "SSH Process Error\n";
} elsif ( $# =~ m/SSHConnectionAborted/ix ) {
print "SSH Connection Aborted\n";
} else {
print "SSH Unknown Error: $#\n";
}
}
if ($login_output !~ /Last login/) {
die "Login has failed.";
} else {
return $ssh;
}
print "SSH to ip - $host failed\n";
}
First I'm building the command and storing it in $command_to_execute variable.
At the end of command execution I'll get keyword Bye. So I am waiting for that keyword to match.
My question is -
Why I am getting above mentioned error?
Suppose if my command execution is failed, will the control will come back to my script ? Because its waiting for $str word.
I doubt about the error catching method is not proper. Please suggest a better solution.
I am trying to build a program wich creates some forks and writes the results of the forks back to the main program. Thereby I try to use IO::Pipe
sub ForkRequests {
my $pipe = IO::Pipe->new();
my $pid;
foreach my $feature ( #features ) {
if ( $pid = fork() ) {
$pipe->reader();
while ( <$pipe> ) {
print $_. "\n";
}
}
elsif ( defined $pid ) {
#child
$pipe->writer();
#somecalculations [...]
print $pipe $calcresults;
}
}
}
I got my code for doing a pipe from the module's documentation.
If i now try to execute, I get an error message
Can't locate object method "reader" via package "IO::Pipe::End" at lmtest3.pl line 56.
Can't locate object method "writer" via package "IO::Pipe::End" at lmtest3.pl line 63.
Can't locate object method "reader" via package "IO::Pipe::End" at lmtest3.pl line 56, <GEN0> line 1.
Can't locate object method "writer" via package "IO::Pipe::End" at lmtest3.pl line 63, <GEN0> line 1.
So, my code does not seem to initiate a pipe object, but an IO::Pipe::End.
So my question is, can anybody see the mistake in there? Why does it return the wrong object, and how would this be done correctly?
EDIT
I have some requests to some servers (most of the time 1 request to 7 ervers).
Those request names are saved in #features, and will be executed at the point of #somecalculations.
Because the server response is pretty slow, I want those requests to start in parallel. They all have to get back to the main program and print the reply to the console.
I tried this code
sub ForkRequests {
my $i = 0;
my #pipes;
my $pid;
foreach my $feature ( #features ) {
#pipes[$i] = IO::Pipe->new();
if ( $pid = fork() ) {
#pipes[$i]->reader();
}
elsif ( defined $pid ) {
#child
#pipes[$i]->writer();
# calculations
my $w = #pipes[$i];
print $w $calc;
print $w "end\n";
}
$i++;
}
}
if ( $pid == 1 ) {
while ( 1 ) {
foreach my $pipe ( #pipes ) {
while ( <$pipe> ) {
unless ( $_ == "end" ) {
print $_. "\n";
}
else { last; }
}
}
}
}
else {
exit;
}
}
as said, to save those pipes, but I still got a problem in reading them, as the program exits before it gets answers.
The problem is that you are forking multiple child processes but trying to use the same pipe for all of them.
The reader method converts $pipe into an IO::Pipe::End object that you can read data from, so the first child is connected correctly. But you then call reader again on the same $pipe, and the error is thrown because it is no longer an object of the right class.
You simply need to create a new pipe for each child process:
sub fork_requests {
for my $feature ( #features ) {
my $pipe = IO::Pipe->new;
my $pid;
if ( $pid = fork ) {
$pipe->reader;
print while <$pipe>;
}
elsif ( defined $pid ) {
$pipe->writer;
# some calculations . . .
print $pipe $calcresults;
exit;
}
}
}
Update
Okay I think I understand what it is you need. This complete program should show you.
I have written fork_requests so that it expects a list of features as parameters, and I have written the child code so that it sleeps for two seconds to emulate the processing time and then simply prints the name of the feature.
The parent code stores all the pipes in an array, as I suggested, and prints the output from each of them in the order they were queued. All five child processes complete after two seconds, so the parent is suspended for that time and then prints the features originally passed in.
use strict;
use warnings;
use IO::Pipe;
STDOUT->autoflush;
fork_requests('A' .. 'E');
sub fork_requests {
my #pipes;
for my $feature ( #_ ) {
my $pipe = IO::Pipe->new;
my $pid;
if ( $pid = fork ) {
$pipe->reader;
push #pipes, $pipe;
}
elsif ( defined $pid ) {
$pipe->writer;
select $pipe;
# some calculations . . .
sleep 2;
my $calcresults = $feature;
print $calcresults, "\n";
exit;
}
}
for my $pipe ( #pipes ) {
print while <$pipe>;
}
}
output
A
B
C
D
E
Strange issue I am running into. I have a few devices with Telnet/SSH issues. When I run my script the results are saying the script was successful. When debug is on I get the follow results..
[ 0.012464] pr finding prompt
[ 0.016593] tr creating Net::Telnet wrapper for telnet
[ 0.017859] tr connecting with: telnet Host 10.xx.xx.xx Port 23
How could I add something to show a error if a promopt is not present or the connection times out?
Thanks
#!/usr/bin/perl
use Net::Appliance::Session;
$file = '1list';
open (FH, "< $file") or die "Can't open $file for read: $!";
my #ios_list = <FH>;
close FH or die "Cannot close $file: $!";
chomp(#ios_list);
my $ios_username = 'xxxx';
my $ios_password = 'xxxx';
DEVICE:
for my $ios_device_ip ( #ios_list ) {
my #version_info;
my $proto = shift;
if (($proto == 43)||($proto == 44)){
$tran = "SSH";
$app="/usr/local/bin/ssh";
}else{
$tran = "Telnet";
$app="/bin/telnet";
}
my $session_obj = Net::Appliance::Session->new(
host => $ios_device_ip,
transport => $tran,
personality => 'ios',
);
#interace
eval {
# try to login to the ios device, ignoring host check
$session_obj->connect(
username => $ios_username,
password => $ios_password,
#SHKC => 0
);
# get our running config
$session_obj->begin_privileged;
$session_obj->cmd('conf t');
$session_obj->cmd('aaa authorization config-commands');
$session_obj->cmd('exit');
$session_obj->end_privileged;
$session_obj->cmd('write memory');
# close down our session
$session_obj->close;
};
#error check
if ($#) {
if ( UNIVERSAL::isa($#, 'Net::Appliance::Session::Exception') ) {
# fault description from Net::Appliance::Session
print "We had an error during our Telnet/SSH session to device : $ios_devi
ce_ip \n";
print $#->message . " \n";
# message from Net::Telnet
print "Net::Telnet message : " . $#->errmsg . "\n";
# last line of output from your appliance
print "Last line of output from device : " . $#->lastline . "\n\n";
}
elsif (UNIVERSAL::isa($#, 'Net::Appliance::Session::Error') ) {
# fault description from Net::Appliance::Session
print "We had an issue during program execution to device : $ios_device_ip
\n";
# print $#->message . " \n";
}
else {
# we had some other error that wasn't a deliberately created exception
print "We had an issue when accessing the device : $ios_device_ip \n";
print "$ios_device_ip The reported error was : $# \n";
}
next DEVICE;
}
print #version_info;
print "$ios_device_ip ok \n";
#end
}
If you're having trouble connecting, it may help to check $# after the eval as there may be an error you're ignoring.
#interace
eval {
# try to login to the ios device, ignoring host check
$session_obj->connect(
username => $ios_username,
password => $ios_password,
#SHKC => 0
);
It's also worth noting that this doesn't do anything:
my $proto = shift;
if (($proto == 43)||($proto == 44)){
$tran = "SSH";
$app="/usr/local/bin/ssh";
}else{
shift is operating on #_ which isn't populated, so $proto will always be undef.