Dear Ladies and Gentlemen, I am hacking a hack of the Peristent Perl interpreter shown in the 5.005_03 perlembed man page (the code itself is below ..).
The problem is that when the path in the code to eval a new or changed file is chosen, the behaviour is unexpected in that when a new version of the file that is syntactically correct but has a run time error (eg missing module load), the new code is _not_ the code that runs, the old (no run-time error) code continues _to_ run. If the host program (that embedding the Persistent interpreter) is restarted, then all is well: the run-time error is trapped (A syntax error is always trapped when the code is eval'd [in the eval_file subroutine]). Perl is 5.005_03; I have yet to try this on a more contemporary Perl. Ddeleting the package symbol table (with Symbol::delete_package) doesn't seem to make any difference. (The code is a modified version of p1.pl from the Nagios, http://www.Nagios.ORG project. What it is does is run Perl 'plugins' that test a service [such as a domain controller login] and report their findings to the scheduling/alerting/presentation logic in the Nagios host program by 1 writing a message intended for system managers/admins to STDOUT 2 exiting with a coded exit status [3 is 'UNKNOWN', 0 'OK' etc]. ) Yours sincerely. -- ------------------------------------------------------------------------ Stanley Hopcroft ------------------------------------------------------------------------ '...No man is an island, entire of itself; every man is a piece of the continent, a part of the main. If a clod be washed away by the sea, Europe is the less, as well as if a promontory were, as well as if a manor of thy friend's or of thine own were. Any man's death diminishes me, because I am involved in mankind; and therefore never send to know for whom the bell tolls; it tolls for thee...' from Meditation 17, J Donne. p1.pl hacked somewhat to be more careful about error handling. package Embed::Persistent; # # Hacked version of the sample code from the perlembedded doco. # # Only major changes are to separate the compiling and cacheing from # the execution so that the cache can be kept in "non-volatile" parent # process while the execution is done from "volatile" child processes # and that STDOUT is redirected to a file by means of a tied filehandle # so that it can be returned to Nagios in the same way as for # commands executed via the normal popen method. # use strict; use vars '%Cache'; use Symbol qw(delete_package); use Text::ParseWords qw(parse_line) ; package OutputTrap; # # Methods for use by tied STDOUT in embedded PERL module. # # Simply redirects STDOUT to a temporary file associated with the # current child/grandchild process. # use strict; # Perl before 5.6 does not seem to have warnings.pm ??? #use warnings; use IO::File; sub TIEHANDLE { my ($class, $fn) = @_; my $handle = new IO::File "> $fn" or die "Cannot open embedded work filei $!\n"; bless { FH => $handle, Value => 0}, $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; my $handle = $self -> {FH}; close $handle; } package Embed::Persistent; sub valid_package_name { my($string) = @_; $string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg; # second pass only for words starting with a digit $string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg; # Dress it up as a real package name $string =~ s|/|::|g; return "Embed::" . $string; } sub log_msg { my $err = shift ; my ($pkg, $file, $line, $evaltxt) = (caller(1))[0, 1, 2, -2] ; # correct line number reported by eval for the 6 line prologue added by eval_file $line -= 6 ; print STDERR qq( **ePN plugin syntax error: $err in package $pkg file $file at line $line in text "$evaltxt". ) ; $@ = 'ePN: plugin syntax error' ; } sub eval_file { my $filename = shift; my $delete = shift; my $epn_stderr_log = '/usr/home/anwsmh/nagios-1.0_test-debug/var/epn.log' ; my $pn = substr($filename, rindex($filename,"/")+1); my $package = valid_package_name($pn); my $mtime = (stat($filename))[9] ; # my $mtime = abs(-M $filename); # Perl 5.005_03 sometimes returns mtime less than 0. if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime} >= $mtime) # $Cache{$package}{mtime} <= $mtime) { # we have compiled this subroutine already, # it has not been updated on disk, nothing left to do print STDERR "\$mtime: $mtime, \$Cache{$package}{mtime}: $Cache{$package}{mtime} - already compiled $package->hndlr.\n"; #print STDERR "already compiled $package->hndlr\n"; } else { print STDERR "Compiling or deleting and recompiling \$filename: $filename.\n" ; local *FH; open FH, $filename or die "open '$filename' $!"; local($/) = undef; my $sub = <FH>; close FH; # cater for routines that expect to get args without prgname # and for those using @ARGV $sub = "shift([EMAIL PROTECTED]);[EMAIL PROTECTED]@_;\n" . $sub; # cater for scripts that have embedded EOF symbols (__END__) $sub =~ s/__END__/\;}\n__END__/; delete_package($package) ; #wrap the code into a subroutine inside our unique package my $eval = qq{ package main; use subs 'CORE::GLOBAL::exit'; sub CORE::GLOBAL::exit { die "ExitTrap: \$_[0] ($package)"; } package $package; sub hndlr { $sub; } }; open NEWSTDERR, ">> $epn_stderr_log" or die "Can't open '$epn_stderr_log' for append: $!" ; open STDERR, '>>& NEWSTDERR' or die "Can't re-open STDERR as file '$epn_stderr_log' in append mode: $!" ; $Cache{$package}{plugin_syntax_error} = 0 ; # trap plugin syntax errors (raised by 'use strict') local $SIG{__WARN__} = \&log_msg ; { # hide our variables within this block my($filename,$mtime,$package,$sub); eval $eval; } # $@ should only be set if the code parses, but fails at runtime # ie the attempt to _define a subroutine named 'hndlr' in package $package_ fails; # it is not easy to imagine this happening. # However, in order to avoid running a non-existent plugin handler, # the __WARN__ handler sets $@ to a value indicating a syntax error. if ($@){ if ( $@ eq 'ePN: plugin syntax error' ) { $Cache{$package}{plugin_syntax_error} = 1 ; } else { my $evaltxt = (caller(1))[-2] ; print STDERR qq( **ePN plugin handler installation error: $@ in package $package, file $pn in text "$evaltxt". ) ; die; } } #cache it unless we're cleaning out each time $Cache{$package}{mtime} = $mtime unless $delete; } } sub run_package { my $filename = shift; my $delete = shift; my $tmpfname = shift; my $ar = shift; my $pn = substr($filename, rindex($filename,"/")+1); my $package = valid_package_name($pn); my $res = 0; # debug require Data::Dumper ; Data::Dumper->import(qw(Dumper)) ; print STDERR Dumper(\%Cache) ; # require Dumpvalue ; # my $d = Dumpvalue->new ; # $d->dumpValue(\%Cache) ; # debug tie (*STDOUT, 'OutputTrap', $tmpfname); my @a = &parse_line('\s+', 0, $ar) ; if ( $Cache{$package}{plugin_syntax_error} ) { print STDOUT "**ePN plugin '$pn' has syntax errors. Check ePN log.\n" ; untie *STDOUT; # return unknown return 3 ; } eval {$res = $package->hndlr(@a);}; if ($@){ if ($@ =~ /^ExitTrap: /) { $res = 0; } else { # get return code (which may be negative) if ($@ =~ /^ExitTrap: (-?\d+)/) { $res = $1; } else { # run time error; exit was not called in plugin # return unknown $res = 3; chomp $@ ; # correct line number reported by eval for the 6 line prologue added by eval_file $@ =~ s/(\d+)\.$/($1 - 6)/e ; $@ .= qq( in plugin '$pn') ; print STDOUT "**ePN plugin runtime error: [EMAIL PROTECTED]" ; } } } untie *STDOUT; return $res; } 1;
