Index: src/perl/control-services/control-services.conf
===================================================================
--- src/perl/control-services/control-services.conf	(nonexistent)
+++ src/perl/control-services/control-services.conf	(revision 2674)
@@ -0,0 +1,30 @@
+#
+# Configuration for control-services.pl. All variables are in perl syntax.
+#
+
+# zones we can manage
+@main::zones = ( 'example.org.' );
+
+# nameservers for the zone
+@main::nameservers = ( 'ns1.example.org' );
+
+# allowed record types
+@main::types = ( 'A', 'PTR', 'CNAME', 'TXT' );
+
+# allowed classes
+@main::classes = ( 'IN' );
+
+# default TTL for new records
+$main::default_ttl = 86400;
+
+# Location of the log file; must be writable by the hobbit user
+$main::logfile = '/tmp/control-services.log';
+
+# DDNS tsig info. Your key that you generated goes here:
+$main::tsig_keyname = 'example';
+$main::tsig_key     = 'JUet5dbTvV9OOmWxc4cp8UUSSbct617swzaldieBZuF=';
+
+# Hobbit configuration information
+$main::hobbit_cgi = "http://www.example.org/hobbit-seccgi/bb-ack.sh";
+$main::uname = 'cgiuser';
+$main::password = 'some-cgi-password';

Property changes on: src/perl/control-services/control-services.conf
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Index: src/perl/control-services/manage-domain.pl
===================================================================
--- src/perl/control-services/manage-domain.pl	(nonexistent)
+++ src/perl/control-services/manage-domain.pl	(revision 2674)
@@ -0,0 +1,158 @@
+#!/usr/bin/perl
+
+# manage-domain.pl -- Manage a domain using DDNS to add or remove hosts
+#
+#  '$RCSfile$'
+#  Copyright: 2005 Regents of the University of California 
+#
+#   '$Author$'
+#     '$Date$'
+# '$Revision$' 
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+
+use Net::DNS;
+use Getopt::Long;
+use strict;
+
+# include the configuration
+require '/etc/control-services.conf';
+
+# make my pipes piping hot
+$| = 1;
+
+# run the main routine
+&main;
+
+sub main {
+    my ($host, $ip, $command);
+
+    GetOptions( "host=s" => \$host,
+                "ip=s"   => \$ip,
+                "command=s"   => \$command );
+    if (! defined($host) || ! defined ($ip) || !defined($command)) {
+        usage();
+    } else {
+        my $zone = $main::zones[0];
+        my $class = $main::classes[0];
+        my $ttl = '60';
+        my $type = 'A';
+        my $message = '';
+        my $success = 1;
+
+        # get a resolver handle and set the dns server to use
+        my $resref = &get_resolver($main::tsig_keyname,$main::tsig_key);
+        $$resref->nameservers($main::nameservers[0]);
+
+        if ($command eq 'add') {
+            # Add a record
+            ($success,$message) = &add_records( $resref, $zone, $class,
+                                        $host, $ttl, $type, $ip );
+            debug("Add records success: " . $success);
+            debug("Add records message: " . $message);
+        } elsif ($command eq 'delete') {
+            # Delete a record
+            my $record = "$host.$zone $type $ip";
+            #my $record = "$host.$zone";
+            my @rr = ($record);
+            ($success,$message) = &del_records($resref,$zone,$class,@rr);
+            debug("Del records success: " . $success);
+            debug("Del records message: " . $message);
+        } else {
+            usage();
+        }
+    }
+}
+
+# Get a resolver to be used for DDNS updates
+sub get_resolver {
+    my ($tsig_keyname,$tsig_key) = @_;
+    my $res = Net::DNS::Resolver->new;
+    $res->tsig($tsig_keyname,$tsig_key);
+    return \$res;
+}
+
+# Add a RR using DDNS update
+sub add_records {
+    my ($res,$zone,$class,$name,$ttl,$type,$content) = @_;
+    
+    # create update packet
+    my $update = Net::DNS::Update->new($zone,$class);
+    my $rr = "$name.$zone $ttl $type $content";
+    debug("Inserting new record: \n    " . $rr);
+    $update->push(update => rr_add($rr));
+    my $reply = ${$res}->send($update);
+
+    # initialize return vars
+    my $success = 0;
+    my $message = '';
+
+    # Did it work?
+    if ($reply) {
+    if ($reply->header->rcode eq 'NOERROR') {
+            $message = "Update succeeded";
+        $success = 1;
+        } else {
+            $message = 'Update failed: ' . $reply->header->rcode;
+        }
+    } else {
+        $message = 'Update failed: ' . $res->errorstring;
+    }
+
+    return ($success,$message);
+}
+
+# Delete one or more RRs using DDNS update
+sub del_records {
+    my ($res,$zone,$class,@rr) = @_;
+
+    my $update = Net::DNS::Update->new($zone,$class);
+
+    # build update packet(s)
+    foreach my $record (@rr) {
+        $update->push(update => rr_del($record));
+    }
+
+    # send it
+    my $reply = ${$res}->send($update);
+
+    my $msg = '';
+    my $success = 0;
+    if ($reply) {
+        if ($reply->header->rcode eq 'NOERROR') {
+            $msg = "Update succeeded";
+        $success = 1;
+        } else {
+            $msg = 'Update failed: ' . $reply->header->rcode;
+        $success = 0;
+        }
+    } else {
+        $msg = 'Update failed: ' . $res->errorstring;
+    $success = 0;
+    }
+    return ($success,$msg);
+}
+
+# Print out debugging messages
+sub debug {
+    my $msg = shift;
+    print $msg, "\n";
+}
+
+# Print a usage statement
+sub usage {
+        print "Usage: manage-domain.pl --host hostname --ip xxx.xxx.xxx.xxx --command [add|delete]\n";
+}

Property changes on: src/perl/control-services/manage-domain.pl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Index: src/perl/control-services/control-services.pl
===================================================================
--- src/perl/control-services/control-services.pl	(nonexistent)
+++ src/perl/control-services/control-services.pl	(revision 2674)
@@ -0,0 +1,248 @@
+#!/usr/bin/perl -w
+
+# control-services.pl -- Monitor a listed set of services to be sure
+#             they are running.  If not running, modify the DNS system
+#             to remove them from the lookup for that service
+#
+#  '$RCSfile$'
+#  Copyright: 2005 Regents of the University of California 
+#
+#   '$Author$'
+#     '$Date$'
+# '$Revision$' 
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+
+use Net::DNS;
+use LWP::UserAgent;
+use HTTP::Request;
+use HTTP::Response;
+use URI::URL;
+use strict;
+
+# include the configuration
+require '/etc/control-services.conf';
+
+# make my pipes piping hot
+$| = 1;
+
+# run the main routine
+#&testddns;
+#print &acknowledgeAlert("223456", "Foo is good");
+&updateDns;
+
+# When a service becomes unavailable make a DNS change that will take
+# that service provider out of the DNS system temporarily
+sub updateDns {
+    my $recovered = $ENV{"RECOVERED"};
+    my $fqdn      = $ENV{"BBHOSTNAME"};
+    my $ip        = $ENV{"MACHIP"};
+    my $service   = $ENV{"BBSVCNAME"};
+    my $color     = $ENV{"BBCOLORLEVEL"};
+    my $message   = $ENV{"BBALPHAMSG"};
+    my $ackcode   = $ENV{"ACKCODE"};
+    my $zone = $main::zones[0];
+    my $class = $main::classes[0];
+    my $ttl = $main::default_ttl;
+    my $type = $main::types[0];
+    my $success = 0;
+
+    # Convert the hobbit IP number format to dotted decimal format
+    $ip =~ s/(...)(...)(...)(...)/$1.$2.$3.$4/;
+    $ip =~ s/^0*//;
+    $ip =~ s/\.0*/\./g;
+
+    # Check if the service went down or recovered
+    if (!$recovered && $color eq 'red') {
+        # If it is down, remove the host from the DNS 
+        my $record = "$service.$zone $type $ip";
+        my @rr = ($record);
+        ($success,$message) = &del_records($zone,$class,@rr);
+        my $response = "";
+        if ($success) {
+            $response = "Relying on failover hosts.";
+            #$response = &acknowledgeAlert($ackcode, $text);
+        }
+        &log("Failed:", $recovered, $fqdn, $ip, $service, 
+                $color, $message, $response);
+    } elsif ($recovered) {
+        # If it is being restored, add the host back to the DNS
+        $ttl      = '60';
+        ($success,$message) = &add_records($zone, $class, $service, $ttl, 
+                                           $type, $ip);
+        my $response = "";
+        if ($success) {
+            $response = "Host restored to DNS.";
+        }
+        &log("Recovered:", $recovered, $fqdn, $ip, $service, 
+                $color, $message, $response);
+    }
+}
+
+# Acknowledge the failure with Hobbit so that additional notifications 
+# are supressed 
+# This seems to not be working properly with hobbit right now  --TODO
+sub acknowledgeAlert {
+    my ($ackcode, $message) = @_;
+    my $action = "Ack";
+    my $url = url($main::hobbit_cgi);
+    $url->query_form(ACTION => $action, 
+                     NUMBER => $ackcode, 
+                     MESSAGE => $message);
+    my $ua = LWP::UserAgent->new();
+    $ua->agent("control-services/0.1");
+    my $request = HTTP::Request->new(GET => $url);
+    $request->referer($main::hobbit_cgi);
+    $request->authorization_basic($main::uname, $main::password);
+    my $response = $ua->request($request);
+    if ($response->is_error() ) {
+        return $response->status_line;
+    } else {
+        my $content = $response->content();
+        return $content;
+    }
+}
+
+# Log the run of the script to a temporary log file
+sub log {
+    my ($lead, $recovered, $fqdn, $ip, $service, $color, $message, $response) = @_;
+
+    open(LOG,">>$main::logfile") || 
+        die "Log file could not be opened.";
+    print LOG $lead;
+    print LOG " ";
+    print LOG $ip;
+    print LOG " ";
+    print LOG $fqdn;
+    print LOG " ";
+    print LOG $service;
+    print LOG " ";
+    print LOG $color;
+    print LOG " ";
+    print LOG $recovered;
+    print LOG " ";
+    print LOG $message;
+    print LOG " ";
+    print LOG $response;
+    print LOG "\n";
+    close(LOG);
+}
+
+# test routine to see if DNS update using DDNS is working
+sub testddns {
+    my $zone = $main::zones[0];
+    my $class = $main::classes[0];
+    my $ttl = $main::default_ttl;
+    my $type = $main::types[0];
+    my $message = '';
+    my $success = 1;
+
+    # Add a record
+    $ttl      = '60';
+    $type     = 'A';
+    my $host     = 'testhost';
+    my $ip       = '24.237.20.95';
+    ($success,$message) = &add_records($zone, $class, $host, $ttl, $type, $ip);
+    debug("Add records success: " . $success);
+    debug("Add records message: " . $message);
+
+    # Delete a record
+    my $record = "$host.$zone";
+    my @rr = ($record);
+    ($success,$message) = &del_records($zone,$class,@rr);
+    debug("Del records success: " . $success);
+    debug("Del records message: " . $message);
+}
+
+# Get a resolver to be used for DDNS updates
+sub get_resolver {
+    my ($tsig_keyname,$tsig_key) = @_;
+    my $res = Net::DNS::Resolver->new;
+    $res->tsig($tsig_keyname,$tsig_key);
+    return \$res;
+}
+
+# Add a RR using DDNS update
+sub add_records {
+    my ($zone,$class,$name,$ttl,$type,$content) = @_;
+    
+    # get a resolver handle and set the dns server to use
+    my $res= &get_resolver($main::tsig_keyname,$main::tsig_key);
+    $$res->nameservers($main::nameservers[0]);
+
+    # create update packet
+    my $update = Net::DNS::Update->new($zone,$class);
+    my $rr = "$name.$zone $ttl $type $content";
+    $update->push(update => rr_add($rr));
+    my $reply = ${$res}->send($update);
+
+    # initialize return vars
+    my $success = 0;
+    my $message = '';
+
+    # Did it work?
+    if ($reply) {
+        if ($reply->header->rcode eq 'NOERROR') {
+            $message = "Update succeeded";
+            $success = 1;
+        } else {
+            $message = 'Update failed: ' . $reply->header->rcode;
+        }
+    } else {
+        $message = 'Update failed: ' . $res->errorstring;
+    }
+
+    return ($success,$message);
+}
+
+# Delete one or more RRs using DDNS update
+sub del_records {
+    my ($zone,$class,@rr) = @_;
+
+    # get a resolver handle and set the dns server to use
+    my $res= &get_resolver($main::tsig_keyname,$main::tsig_key);
+    $$res->nameservers($main::nameservers[0]);
+
+    my $update = Net::DNS::Update->new($zone,$class);
+
+    # build update packet(s)
+    foreach my $record (@rr) {
+        $update->push(update => rr_del($record));
+    }
+
+    # send it
+    my $reply = ${$res}->send($update);
+
+    my $msg = '';
+    my $success = 0;
+    if ($reply) {
+        if ($reply->header->rcode eq 'NOERROR') {
+            $msg = "Update succeeded";
+            $success = 1;
+        } else {
+            $msg = 'Update failed: ' . $reply->header->rcode;
+        }
+    } else {
+        $msg = 'Update failed: ' . $res->errorstring;
+    }
+    return ($success,$msg);
+}
+
+# Print out debugging messages
+sub debug {
+    my $msg = shift;
+    print $msg, "\n";
+}

Property changes on: src/perl/control-services/control-services.pl
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
Index: src/perl/control-services/README
===================================================================
--- src/perl/control-services/README	(nonexistent)
+++ src/perl/control-services/README	(revision 2674)
@@ -0,0 +1,111 @@
+#
+# control-services.pl -- Monitor a listed set of services to be sure
+#             they are running.  If not running, modify the DNS system
+#             to remove them from the lookup for that service
+#
+#  '$RCSfile$'
+#  Copyright: 2005 Regents of the University of California 
+#
+#   '$Author$'
+#     '$Date$'
+# '$Revision$' 
+#
+#  This program is free software; you can redistribute it and/or modify
+#  it under the terms of the GNU General Public License as published by
+#  the Free Software Foundation; either version 2 of the License, or
+#  (at your option) any later version.
+#
+#  This program is distributed in the hope that it will be useful,
+#  but WITHOUT ANY WARRANTY; without even the implied warranty of
+#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#  GNU General Public License for more details.
+#
+#  You should have received a copy of the GNU General Public License
+#  along with this program; if not, write to the Free Software
+#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+
+Welcome to the control-services.pl program.
+
+This program is designed to run as a script under the Hobbit system monitoring
+program (http://hobbitmon.sourceforge.net/).  When Hobbit is configured 
+properly, this script will be called to make changes to the DNS services that
+are registered in your DNS server.  The changes are accomplished using 
+Dynamic DNS (DDNS).  The system is intended to help manage a set of services
+that are running on several hosts in round-robin DNS fashion and to remove
+inaccessible hosts when they are detected as failed, and restore them when 
+they recover.
+
+Configuration consists of:
+  1) Install and configure Hobbit (see http://hobbitmon.sourceforge.net)
+  2) Install and configure BIND for DDNS (see below)
+  3) Install this script (see below)
+
+3) Setting up BIND for DDNS
+-----------------------------
+
+You need to configure BIND to accept signed dynamic updates for your zone.  
+
+    a) Create a key using dnssec-keygen.
+
+        % dnssec-keygen  -b 256 -n HOST -a HMAC-MD5 example
+
+        This will create 2 key files in different formats
+
+    b) Add the key to your named.conf file in a block (copy it from either 
+       of the two generated key files):
+
+        key "examplekey" {
+            algorithm       hmac-md5;
+            secret "0QI/OEYtZA5aI6rpMTwrodfMpg1xxCaDHdR/tvI9Lgc=";
+        };
+
+    c) For each zone that you want to enable updates, add this key to
+       your 'allow-update' and 'allow-transfer' blocks:
+    
+       zone "example.com" {
+           type master;
+           file "/var/named/example.com.zone"
+           allow-update ( key examplekey; };
+           allow-transfer { key examplekey; };
+       }
+
+    d) Reload named to reload your configuration (killall -HUP named).
+
+3) Install the control-services.pl script
+-----------------------------------------
+Prerequisites:
+
+    The following Perl Modules are required:
+        Net::DNS
+        LWP::UserAgent
+        HTTP::Request
+        HTTP::Response
+        URI::URL
+    These modules are available through CPAN, and are most easily gotten using
+    the CPAN shell (as root, "perl -MCPAN -e shell").
+
+Installation:
+  1) copy the file to a commonly accessible location (typically /usr/local/bin)
+  2) change ownership to the web-server user
+  3) copy the configuration file to /etc and customize for your situation
+     -- set the key name and value from your DDNS server
+     -- set domain and other parameters properly
+  4) change ownership of the config file to the web-server user
+  5) restrict access to the config file to only the web server user
+  6) Create the log file directory, writable by the hobbit user
+  7) Place alert rules in the hobbit/server/etc/hobbit-alerts.cfg file that
+     use the script.  See the hobbit-alerts.cfg man page for details. An
+     example rule might be:
+
+     HOST=ldap.example.com SERVICE=ldap RECOVERED
+          SCRIPT /usr/local/bin/control-services.pl ldap FORMAT=SCRIPT REPEAT=1
+
+
+IMPORTANT NOTE
+----------------
+Make sure that the configuration file is only readable by the webserver user
+and writable by root. The config file contains the key to allow updates
+to your DNS server, so be sure the config file is secure.
+
+Enjoy!

Property changes on: src/perl/control-services/README
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision
\ No newline at end of property
