check in for Bug 6959

Add the ability to run a user defined script to determine wan load-balancing interface health

includes sample http test (scripts/http_test.pl). Configuration will look as follows:

 wan {
     interface-health eth0 {
         nexthop 10.3.0.1
         test 1 {
             test-script /tmp/http_test.pl
             type user-defined
         }
     }
     interface-health eth1 {
         nexthop 10.3.0.1
         test 1 {
             test-script /tmp/http_test.pl
             type user-defined
         }
     }

With corresponding output:

vyatta@vyatta# run show wan-load-balance
Interface:  eth0
  Status:  active
  Last Status Change:  Wed Mar 30 19:03:59 2011
  +Test:  user  Script: /tmp/http_test.pl
    Last Interface Success:  0s
    Last Interface Failure:  n/a
    # Interface Failure(s):  0

Interface:  eth1
  Status:  failed
  Last Status Change:  Wed Mar 30 19:03:59 2011
  -Test:  user  Script: /tmp/http_test.pl
    Last Interface Success:  n/a
    Last Interface Failure:  0s
    # Interface Failure(s):  52

Scripts returns 0 for success, non-zero for failure.

2 files changed, 56 insertions, 0 deletions

diff --git a/scripts/http_test.pl b/scripts/http_test.pl
new file mode 100644
index 0000000..68f8c97
--- /dev/null
+++ b/scripts/http_test.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+#
+# Module: http_test.pl
+# This code was originally developed by Vyatta, Inc.
+# Portions created by Vyatta are Copyright (C) 2009, 2010 Vyatta, Inc.
+# All Rights Reserved.                                                                                                                                                              
+# Authors: Michael Larson
+# Date: 2011
+# Description: wanloadbalance script sample. 
+# Tests whether google.com responds to simple http GET request.
+#
+
+use strict;
+use warnings;
+use POSIX;
+use JSON;
+use Data::Dumper;
+use URI::Escape;
+
+
+my $iface = $ENV{WLB_SCRIPT_IFACE};
+
+my $code;
+my $body;
+
+#let's see if we can reach google out this interface
+my @out = `curl -s -m 3 --interface $iface -i -X GET www.google.com`;
+#now process output, for http status code and for response body
+foreach my $out (@out) {
+    if ($out =~ /^HTTP\/[\d.]+\s+(\d+)\s+.*$/) {
+	$code = $1;
+    }
+    elsif ($out =~ /^\r/ || defined $body) {
+	$body .= $out;
+    }
+}
+
+#success is if http response code is 200 and body is returned
+if (defined($code) && $code == 200 && defined($body)) {
+    #WLB SUCCESS
+    exit(0);
+}
+
+#WLB FAILURE
+exit(1);
diff --git a/scripts/vyatta-wanloadbalance.pl b/scripts/vyatta-wanloadbalance.pl
index ef8165f..dde7387 100644
--- a/scripts/vyatta-wanloadbalance.pl
+++ b/scripts/vyatta-wanloadbalance.pl
@@ -85,6 +85,17 @@ sub write_health {
 		    print FILE_LCK "\t\t\t\tttl $ttl_limit\n";
 		}
 	    }
+	    elsif (defined($test_type) && ($test_type eq "user-defined")) {
+		print FILE_LCK "\t\t\ttype user-defined {\n";
+		my $test_script = $config->returnValue("$rule test-script");
+		if (defined $test_script) {
+		    print FILE_LCK "\t\t\t\ttest-script $test_script\n";
+		}
+		else {
+		    print "ERROR: script must be defined for test-script\n";
+		    exit 1;
+		}
+	    }
 	    else {
 		print FILE_LCK "\t\t\ttype ping {\n";
 	    }