Dear Folks,
This problems is somewhat related to the earlier post about high leak
rate of an embedded Perl application with a threaded Perl.
The problem is that when the embedding shim is called (the Perl code
based on perldoc perlembed, persistent interpreter with caching) from
Perl _or_ C, libperl (I think) raises a SEGV.
This happens with both one of the SourceForge Compile Fram Linux hosts
(2.4 kernel/5.8.0 threaded Perl) and FreeBSD.
Here is the FreeBSD example.
tsitc> cat > check_ok
#!/usr/bin/perl -w
use strict ;
print "Ok. In the beginning was the word and the word was with GOD.\n" ;
exit 0 ;
tsitc> chmod 755 check_ok
# minimal Nagios plugin.
tsitc> ./check_ok
Ok. In the beginning was the word and the word was with GOD.
# C wrapper
tsitc> ./mini_epn
Enter file name: check_ok
embedded perl plugin return code and output was: 0 & 'Ok. In the
beginning was the word and the word was with GOD.
'
Enter file name: ./check_ok
embedded perl plugin return code and output was: 0 & 'Ok. In the
beginning was the word and the word was with GOD.
'
Enter file name:
tsitc>
# Perl wrapper
tsitc> ./drive_epn.pl
plugin command line: check_ok
embedded perl plugin return code and output was: 0 & Ok. In the
beginning was the word and the word was with GOD.
plugin command line: check_ok
embedded perl plugin return code and output was: 0 & Ok. In the
beginning was the word and the word was with GOD.
plugin command line:
tsitc>
# Turn on logging
# ie tie STDERR to
# a file
tsitc> perl -i.bak -pe 's/(RETICENT\s+=>\s+)1/${1}0/;
s/(DEBUG\s+=>\s+)0/${1}1/;' p1.pl
tsitc> ./mini_epn
Enter file name: check_ok
Bus error(core dumped)
tsitc> ./drive_epn.pl
plugin command line: check_ok
Bus error(core dumped)
tsitc> gdb mini_epn
GNU gdb 4.18 (FreeBSD)
Copyright 1998 Free Software Foundation, Inc.
GDB is free software, covered by the GNU General Public License, and you
are
welcome to change it and/or distribute copies of it under certain
conditions.
Type "show copying" to see the conditions.
There is absolutely no warranty for GDB. Type "show warranty" for
details.
This GDB was configured as "i386-unknown-freebsd"...Deprecated bfd_read
called at
/usr/src/gnu/usr.bin/binutils/gdb/../../../../contrib/gdb/gdb/dbxread.c
line 2627 in elfstab_build_psymtabs
Deprecated bfd_read called at
/usr/src/gnu/usr.bin/binutils/gdb/../../../../contrib/gdb/gdb/dbxread.c
line 933 in fill_symbuf
(gdb) r
Starting program:
/usr/home/anwsmh/perl/nagios/Nagios/Persistent/examples/mini_epn
Enter file name: check_ok
Program received signal SIGBUS, Bus error.
0x2809022e in Perl_gv_fetchmeth () from
/usr/local/lib/perl5/5.8.5/mach/CORE/libperl.so
(gdb)
(the backtrace is thousands of lines and maybe showing a loop).
The link to the Perl wrapper shim is at
http://cvs.sourceforge.net/viewcvs.py/nagios/nagios/p1.pl?rev=1.4&only_with_tag=HEAD&view=auto
Enabling DEBUG or GARRULOUS is simply a way of having the wrapper dump
debugging messages (such as the code turned into a Perl subroutine) to a
file.
It used to work with 5.005.
I think this is unlikely to be a Perl problem (knowing me) but if anyone
thinks so, I will try and help.
Here's the guts of the debugging stuff in case someone can helpfully
spot the error.
BEGIN {
no strict 'refs' ;
my $indirect_fh = 'ErrorTrap::NEWSTDERR' ;
open $indirect_fh, '>> ' . EPN_STDERR_LOG
or die "Can't open '" . EPN_STDERR_LOG . " for append:
$!" ;
}
package ErrorTrap;
#
# Methods for use by tied STDERR in embedded PERL module.
#
#
sub TIEHANDLE {
my ($class) = @_;
open STDERR, '>>& NEWSTDERR'
or die "Can't re-open STDERR as file in append mode: $!"
;
bless { FH => *STDERR{IO} }, $class;
}
sub PRINT {
my $self = shift;
my $handle = $self->{FH} ;
print $handle join("", @_);
}
sub PRINTF {
my $self = shift;
my $fmt = shift;
my $handle = $self->{FH} ;
printf $handle ($fmt, @_);
}
sub CLOSE {
my $self = shift;
close $self->{FH} ;
}
..
tie (*STDERR, 'ErrorTrap');
# $@ is set for any warning and error. This guarantees
that the plugin will not be run.
if ($@) {
# Log eval'd text of plugin.
# Correct the line number of the error by
removing the lines added (the subroutine prologue).
my $i = 1 ;
$eval =~ s/^/sprintf('%10d ', $i++)/meg ;
print STDERR '[', time(), ']', qq( **ePN '$pn'
error '$@' in text "\n$eval"\n) ;
$Cache{$package}{plugin_error} = $@ ;
$Cache{$package}{mtime} = $mtime unless $delete;
# If the compilation fails, leave nothing behind
that may affect subsequent compilations.
die;
Thank you.
Yours sincerely.
--
Stanley Hopcroft
IP Australia
Ph: (02) 6283 3189 Fax: (02) 6281 1353
PO Box 200 Woden ACT 2606
http://www.ipaustralia.gov.au
--
This message contains privileged and confidential information only
for use by the intended recipient. If you are not the intended
recipient of this message, you must not disseminate, copy or use
it in any manner. If you have received this message in error,
please advise the sender by reply e-mail. Please ensure all
e-mail attachments are scanned for viruses prior to opening or
using.
