[lvs-users] ldirectord checktype external-perl

Bright Fulton bright.fulton at gmail.com
Tue Jan 13 22:42:35 GMT 2009


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.diff
Type: application/octet-stream
Size: 6038 bytes
Desc: not available
Url : http://lists.graemef.net/pipermail/lvs-users/attachments/20090113/68b79960/attachment-0001.obj 


More information about the lvs-users mailing list