Project

General

Profile

1 2674 jones
#!/usr/bin/perl -w
2
3
# control-services.pl -- Monitor a listed set of services to be sure
4
#             they are running.  If not running, modify the DNS system
5
#             to remove them from the lookup for that service
6
#
7
#  '$RCSfile$'
8
#  Copyright: 2005 Regents of the University of California
9
#
10
#   '$Author$'
11
#     '$Date$'
12
# '$Revision$'
13
#
14
#  This program is free software; you can redistribute it and/or modify
15
#  it under the terms of the GNU General Public License as published by
16
#  the Free Software Foundation; either version 2 of the License, or
17
#  (at your option) any later version.
18
#
19
#  This program is distributed in the hope that it will be useful,
20
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
21
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22
#  GNU General Public License for more details.
23
#
24
#  You should have received a copy of the GNU General Public License
25
#  along with this program; if not, write to the Free Software
26
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
27
#
28
29
use Net::DNS;
30
use LWP::UserAgent;
31
use HTTP::Request;
32
use HTTP::Response;
33
use URI::URL;
34
use strict;
35
36
# include the configuration
37
require '/etc/control-services.conf';
38
39
# make my pipes piping hot
40
$| = 1;
41
42
# run the main routine
43
&updateDns;
44
45
# When a service becomes unavailable make a DNS change that will take
46
# that service provider out of the DNS system temporarily
47
sub updateDns {
48
    my $recovered = $ENV{"RECOVERED"};
49
    my $fqdn      = $ENV{"BBHOSTNAME"};
50
    my $ip        = $ENV{"MACHIP"};
51
    my $service   = $ENV{"BBSVCNAME"};
52
    my $color     = $ENV{"BBCOLORLEVEL"};
53
    my $message   = $ENV{"BBALPHAMSG"};
54
    my $ackcode   = $ENV{"ACKCODE"};
55
    my $zone = $main::zones[0];
56
    my $class = $main::classes[0];
57
    my $ttl = $main::default_ttl;
58
    my $type = $main::types[0];
59
    my $success = 0;
60
61
    # Convert the hobbit IP number format to dotted decimal format
62
    $ip =~ s/(...)(...)(...)(...)/$1.$2.$3.$4/;
63
    $ip =~ s/^0*//;
64
    $ip =~ s/\.0*/\./g;
65
66
    # Check if the service went down or recovered
67
    if (!$recovered && $color eq 'red') {
68
        # If it is down, remove the host from the DNS
69
        my $record = "$service.$zone $type $ip";
70
        my @rr = ($record);
71
        ($success,$message) = &del_records($zone,$class,@rr);
72
        my $response = "";
73
        if ($success) {
74
            $response = "Relying on failover hosts.";
75
            #$response = &acknowledgeAlert($ackcode, $text);
76
        }
77
        &log("Failed:", $recovered, $fqdn, $ip, $service,
78
                $color, $message, $response);
79
    } elsif ($recovered) {
80
        # If it is being restored, add the host back to the DNS
81
        $ttl      = '60';
82
        ($success,$message) = &add_records($zone, $class, $service, $ttl,
83
                                           $type, $ip);
84
        my $response = "";
85
        if ($success) {
86
            $response = "Host restored to DNS.";
87
        }
88
        &log("Recovered:", $recovered, $fqdn, $ip, $service,
89
                $color, $message, $response);
90
    }
91
}
92
93
# Acknowledge the failure with Hobbit so that additional notifications
94
# are supressed
95
# This seems to not be working properly with hobbit right now  --TODO
96
sub acknowledgeAlert {
97
    my ($ackcode, $message) = @_;
98
    my $action = "Ack";
99
    my $url = url($main::hobbit_cgi);
100
    $url->query_form(ACTION => $action,
101
                     NUMBER => $ackcode,
102
                     MESSAGE => $message);
103
    my $ua = LWP::UserAgent->new();
104
    $ua->agent("control-services/0.1");
105
    my $request = HTTP::Request->new(GET => $url);
106
    $request->referer($main::hobbit_cgi);
107
    $request->authorization_basic($main::uname, $main::password);
108
    my $response = $ua->request($request);
109
    if ($response->is_error() ) {
110
        return $response->status_line;
111
    } else {
112
        my $content = $response->content();
113
        return $content;
114
    }
115
}
116
117
# Log the run of the script to a temporary log file
118
sub log {
119
    my ($lead, $recovered, $fqdn, $ip, $service, $color, $message, $response) = @_;
120
121
    open(LOG,">>$main::logfile") ||
122
        die "Log file could not be opened.";
123
    print LOG $lead;
124
    print LOG " ";
125
    print LOG $ip;
126
    print LOG " ";
127
    print LOG $fqdn;
128
    print LOG " ";
129
    print LOG $service;
130
    print LOG " ";
131
    print LOG $color;
132
    print LOG " ";
133
    print LOG $recovered;
134
    print LOG " ";
135
    print LOG $message;
136
    print LOG " ";
137
    print LOG $response;
138
    print LOG "\n";
139
    close(LOG);
140
}
141
142
# Get a resolver to be used for DDNS updates
143
sub get_resolver {
144
    my ($tsig_keyname,$tsig_key) = @_;
145
    my $res = Net::DNS::Resolver->new;
146
    $res->tsig($tsig_keyname,$tsig_key);
147
    return \$res;
148
}
149
150
# Add a RR using DDNS update
151
sub add_records {
152
    my ($zone,$class,$name,$ttl,$type,$content) = @_;
153
154
    # get a resolver handle and set the dns server to use
155
    my $res= &get_resolver($main::tsig_keyname,$main::tsig_key);
156
    $$res->nameservers($main::nameservers[0]);
157
158
    # create update packet
159
    my $update = Net::DNS::Update->new($zone,$class);
160
    my $rr = "$name.$zone $ttl $type $content";
161
    $update->push(update => rr_add($rr));
162
    my $reply = ${$res}->send($update);
163
164
    # initialize return vars
165
    my $success = 0;
166
    my $message = '';
167
168
    # Did it work?
169
    if ($reply) {
170
        if ($reply->header->rcode eq 'NOERROR') {
171
            $message = "Update succeeded";
172
            $success = 1;
173
        } else {
174
            $message = 'Update failed: ' . $reply->header->rcode;
175
        }
176
    } else {
177
        $message = 'Update failed: ' . $res->errorstring;
178
    }
179
180
    return ($success,$message);
181
}
182
183
# Delete one or more RRs using DDNS update
184
sub del_records {
185
    my ($zone,$class,@rr) = @_;
186
187
    # get a resolver handle and set the dns server to use
188
    my $res= &get_resolver($main::tsig_keyname,$main::tsig_key);
189
    $$res->nameservers($main::nameservers[0]);
190
191
    my $update = Net::DNS::Update->new($zone,$class);
192
193
    # build update packet(s)
194
    foreach my $record (@rr) {
195
        $update->push(update => rr_del($record));
196
    }
197
198
    # send it
199
    my $reply = ${$res}->send($update);
200
201
    my $msg = '';
202
    my $success = 0;
203
    if ($reply) {
204
        if ($reply->header->rcode eq 'NOERROR') {
205
            $msg = "Update succeeded";
206
            $success = 1;
207
        } else {
208
            $msg = 'Update failed: ' . $reply->header->rcode;
209
        }
210
    } else {
211
        $msg = 'Update failed: ' . $res->errorstring;
212
    }
213
    return ($success,$msg);
214
}
215
216
# Print out debugging messages
217
sub debug {
218
    my $msg = shift;
219
    print $msg, "\n";
220
}