|
Apologies, the following is also required. This fixes a bug in the
introduced exit() wrapping: we need to pass a scalar to CORE::exit or
ldirectord will always exit 1.
diff -r --exclude=.hg heartbeat-dev/ldirectord/ldirectord.in
heartbeat-dev-2/ldirectord/ldirectord.in
729c729
< *CORE::GLOBAL::exit = sub { CORE::exit @_; }
---
> *CORE::GLOBAL::exit = sub { CORE::exit(@_ ? shift : 0); };
The cumulative patch is attached.
Bright
On Tue, Jan 13, 2009 at 5:42 PM, Bright Fulton <bright.fulton@xxxxxxxxx> wrote:
> I'm using the following (and attached, if it gets through) patch to
> ldirectord which adds a new checktype: external-perl. This allows an
> external check which is written in Perl to run as a call to an
> anonymous subroutine instead of to system(). I'd appreciate any
> comments on the concept, implementation and possibility of acceptance.
>
> Bright
>
>
> diff -pru --exclude=.hg heartbeat-dev-orig/ldirectord/ldirectord.in
> heartbeat-dev/ldirectord/ldirectord.in
> --- heartbeat-dev-orig/ldirectord/ldirectord.in 2009-01-13
> 17:08:33.000000000 -0500
> +++ heartbeat-dev/ldirectord/ldirectord.in 2009-01-13
> 17:26:26.000000000 -0500
> @@ -112,7 +112,7 @@ service must follow this line immediatel
>
> B<checktimeout = >I<n>
>
> -Timeout in seconds for connect, external and ping checks. If the timeout is
> +Timeout in seconds for connect, external, external-perl and ping
> checks. If the timeout is
> exceeded then the real server is declared dead.
>
> If defined in a virtual server section then the global value is overridden.
> @@ -333,7 +333,7 @@ emailalertfreq and quiescent options lis
> virtual section, in which case the global setting is overridden.
>
> B<checktype =
> ->B<connect>|B<external>|B<negotiate>|B<off>|B<on>|B<ping>|B<checktimeout>I<N>
> +>B<connect>|B<external>|B<external-perl>|B<negotiate>|B<off>|B<on>|B<ping>|B<checktimeout>I<N>
>
> Type of check to perform. Negotiate sends a request and matches a receive
> string. Connect only attemts to make a TCP/IP connection, thus the
> @@ -402,7 +402,7 @@ Default:
>
> B<checkcommand = ">I<path to script>B<">
>
> -This setting is used if checktype is external and is the command to be run
> +This setting is used if checktype is external or external-perl and is
> the command to be run
> to check the status of a real server. It should exit with status 0 if
> everything is ok, or non-zero otherwise.
>
> @@ -420,6 +420,12 @@ Four parameters are passed to the script
>
> =back 4
>
> +If the checktype is external-perl then the command is assumed to be a
> +Perl script and it is evaluated into an anonymous subroutine which is
> +called at check time, avoiding a fork-exec. The argument signature and
> +exit code conventions are identical to checktype external. That is, an
> +external-perl checktype should also work as an external checktype.
> +
> Default: /bin/true
>
> B<checkport = >I<n>
> @@ -663,6 +669,7 @@ use vars qw(
> %FORK_CHILDREN
> $SERVICE_UP
> $SERVICE_DOWN
> + %check_external_perl__funcs
>
> $CRLF
> );
> @@ -716,6 +723,12 @@ use Sys::Hostname;
> use POSIX qw(setsid :sys_wait_h);
> use Sys::Syslog qw(:DEFAULT setlogsock);
>
> +BEGIN
> +{
> + # wrap exit() to preserve replacability
> + *CORE::GLOBAL::exit = sub { CORE::exit @_; }
> +}
> +
> # command line options
> my @OLD_ARGV = @ARGV;
> my $opt_d = '';
> @@ -1209,13 +1222,13 @@ sub read_config
> if ($1 =~ /(\d+)/ && $1>=0) {
> $vsrv{num_connects} = $1;
> $vsrv{checktype} = "combined";
> - } elsif ( $1 =~ /(\w+)/ && ($1
> eq "connect" || $1 eq "negotiate" || $1 eq "ping" || $1 eq "off" || $1
> eq "on" || $1 eq "external") ) {
> + } elsif ( $1 =~ /([\w-]+)/ &&
> ($1 eq "connect" || $1 eq "negotiate" || $1 eq "ping" || $1 eq "off"
> || $1 eq "on" || $1 eq "external" || $1 eq "external-perl") ) {
> $vsrv{checktype} = $1;
> } else {
> - &config_error($line,
> "checktype must be \"connect\", \"negotiate\", \"on\", \"off\",
> \"ping\", \"external\" or a positive number");
> + &config_error($line,
> "checktype must be \"connect\", \"negotiate\", \"on\", \"off\",
> \"ping\", \"external\", \"external-perl\" or a positive number");
> }
> } elsif ($rcmd =~
> /^checkcommand\s*=\s*\"(.*)\"/ or $rcmd =~
> /^checkcommand\s*=\s*(.*)/){
> - $1 =~ /(.+)/ or
> &config_error($line, "invalid external script");
> + $1 =~ /(.+)/ or
> &config_error($line, "invalid check command");
> $vsrv{checkcommand} = $1;
> } elsif ($rcmd =~ /^checktimeout\s*=\s*(.*)/){
> $1 =~ /(\d+)/ && $1 or
> &config_error($line, "invalid check timeout");
> @@ -2457,6 +2470,9 @@ sub _check_real
> } elsif ($$v{checktype} eq "external") {
> &ld_debug(2, "Checking external: real server=$real_id
> (virtual=$virtual_id)");
> check_external($v, $r);
> + } elsif ($$v{checktype} eq "external-perl") {
> + &ld_debug(2, "Checking external-perl: real
> server=$real_id (virtual=$virtual_id)");
> + check_external_perl($v, $r);
> } elsif ($$v{checktype} eq "off") {
> &ld_debug(2, "Checking off: No real or fallback
> servers to be added\n");
> } elsif ($$v{checktype} eq "on") {
> @@ -3015,6 +3031,51 @@ sub check_external
> }
> }
>
> +sub check_external_perl
> +{
> + my ($v, $r) = @_;
> + my $result;
> + my $v_server;
> +
> + eval {
> + local $SIG{'__DIE__'} = "DEFAULT";
> + local $SIG{'ALRM'} = sub { die "Timeout Alarm" };
> + &ld_debug(4, "Timeout is $$v{checktimeout}");
> + alarm $$v{checktimeout};
> + if (defined $$v{server}) {
> + $v_server = $$v{server};
> + } else {
> + $v_server = $$v{fwm};
> + }
> + my $cmdfunc = $check_external_perl__funcs{$$v{checkcommand}};
> + if (!defined($cmdfunc)) {
> + open(CMDFILE, "<$$v{checkcommand}") || die
> "cannot open external-perl checkcommand file: $$v{checkcommand}";
> + $cmdfunc = eval("sub { \@ARGV=\@_; " .
> join("", <CMDFILE>) . " }");
> + close(CMDFILE);
> + $check_external_perl__funcs{$$v{checkcommand}}
> = $cmdfunc;
> + }
> + no warnings 'redefine';
> + local *CORE::GLOBAL::exit = sub {
> + $result = shift;
> + goto external_exit;
> + };
> + $cmdfunc->($v_server, $$v{port}, $$r{server}, $$r{port});
> + external_exit:
> + alarm 0;
> + };
> + if ($@ or $result != 0) {
> + &service_set($v, $r, "down");
> + &ld_debug(3, "Deactivated service $$r{server}:$$r{port}: " .
> + "$@ after calling (external-perl)
> $$v{checkcommand} with result " .
> + "$result");
> + return 0;
> + } else {
> + &service_set($v, $r, "up");
> + &ld_debug(3, "Activated service $$r{server}:$$r{port}");
> + return 1;
> + }
> +}
> +
>
> sub check_sip
> {
> @@ -4313,7 +4374,8 @@ sub get_real_id_str
> $v->{"checktype"} eq "combined") {
> $check = $v->{"checktype"} . ":" . $v->{"service"};
> }
> - elsif($v->{"checktype"} eq "external") {
> + elsif($v->{"checktype"} eq "external" or
> + $v->{"checktype"} eq "external-perl") {
> $check = $v->{"checktype"} . ":" . $v->{"checkcommand"};
> }
> else {
>
ldirectord-external-perl-2.diff
Description: Binary data
_______________________________________________
Please read the documentation before posting - it's available at:
http://www.linuxvirtualserver.org/
LinuxVirtualServer.org mailing list - lvs-users@xxxxxxxxxxxxxxxxxxxxxx
Send requests to lvs-users-request@xxxxxxxxxxxxxxxxxxxxxx
or go to http://lists.graemef.net/mailman/listinfo/lvs-users
|
