[lvs-users] ldirectord checktype external-perl

Bright Fulton bright.fulton at gmail.com
Wed Jan 14 23:27:05 GMT 2009


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 at gmail.com> 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 {
>
-------------- next part --------------
A non-text attachment was scrubbed...
Name: ldirectord-external-perl-2.diff
Type: application/octet-stream
Size: 6056 bytes
Desc: not available
Url : http://lists.graemef.net/pipermail/lvs-users/attachments/20090114/9a0d3533/attachment-0001.obj 


More information about the lvs-users mailing list