rrd-simple-monitoring/cgi-bin/rrd-server.cgi

#!/usr/bin/perl -w
############################################################
#
#   $Id: rrd-server.cgi 693 2006-06-26 19:11:42Z nicolaw $
#   rrd-server.cgi - Data gathering CGI script for RRD::Simple
#
#   Copyright 2006, 2007 Nicola Worthington
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
#
############################################################
# vim:ts=4:sw=4:tw=78

# User defined constants
use constant BASEDIR => '/home/nicolaw/webroot/www/rrd.me.uk';

############################################################


use 5.6.1;
use warnings;
use strict;
use Socket;

# We'll need to print a header unless we're in MOD_PERL land
print "Content-type: plain/text\n\n" unless exists $ENV{MOD_PERL};

my $host;
my $param = get_query($ENV{QUERY_STRING});
my $remote_addr = $ENV{REMOTE_ADDR};

# Take the host from the "target" if they know the "secret"
if (defined($ENV{RRD_SECRET}) && defined($param->{secret} && defined($param->{target}))
                && "$ENV{RRD_SECRET}" eq "$param->{secret}") {
        $host = $param->{target};

} else {
        # Check for HTTP proxy source addresses
        for (qw(HTTP_X_FORWARDED_FOR HTTP_VIA HTTP_CLIENT_IP HTTP_PROXY_CONNECTION
                        FORWARDED_FOR X_FORWARDED_FOR X_HTTP_FORWARDED_FOR HTTP_FORWARDED)) {
                if (defined $ENV{$_} && $ENV{$_} =~ /([\d\.]+)/) {
                        my $ip = $1;
                        if (isIP($ip)) {
                                $remote_addr = $ip;
                                last;
                        }
                }
        }

        # Fail if we can't see who is sending us this data
        unless ($remote_addr) {
                print "FAILED - NO REMOTE_ADDR\n";
                exit;
        }

        $host = ip2host($remote_addr);
        my $ip = host2ip($host);

        # Fail if we don't believe they are who their DNS says they are
        if ("$ip" ne "$remote_addr") {
                print "FAILED - FORWARD AND REVERSE DNS DO NOT MATCH\n";
                exit;
        }

        # Custom hostname flanges
        $host = 'legolas.wd.tfb.net'    if $host eq 'bb-87-80-233-47.ukonline.co.uk' || $ip eq '87.80.233.47';
        $host = 'pippin.wd.tfb.net'     if $host eq '82.153.185.41' || $ip eq '82.153.185.41';
        $host = 'pippin.wd.tfb.net'     if $host eq '82.153.185.40' || $ip eq '82.153.185.40';
        $host = 'isle-of-cats.etla.org' if $ip   eq '82.71.23.88';
}

# Build a list of valid pairs
my @pairs;
while (<>) {
        #warn "$host $_";
        next unless /^\d+\.[\w\.\-\_\d]+\s+[\d\.]+\s*$/;
        push @pairs, $_;
}

# Don't bother opening a pipe if there's nothing to sent
unless (@pairs) {
        printf("OKAY - %s - no valid pairs\n", $host);

} else {
        # Simply open a handle to the rrd-server.pl and send in the data
        if (open(PH,'|-', BASEDIR."/bin/rrd-server.pl -u $host")) {
                print PH $_ for @pairs;
                close(PH);
                printf("OKAY - %s - received %d pairs\n", $host, scalar(@pairs));

        # Say if we failed the customer :)
        } else {
                print "FAILED - UNABLE TO EXECUTE\n";
        }
}

exit;

sub get_query {
        my $str = shift;
        my $kv = {};
        $str =~ tr/&;/&/s;
        $str =~ s/^[&;]+//, $str =~ s/[&;]+$//;
        for (split /[&;]/, $str) {
                my ($k,$v) = split(/=/, $_, 2);
                next if $k eq '';
                $kv->{url_decode($k)} = url_decode($v);
        }
        return $kv;
} 

sub url_decode {
        local $_ = @_ ? shift : $_;
        defined or return;
        tr/+/ /;
        s/%([a-fA-F0-9]{2})/pack "H2", $1/eg;
        return $_;
} 

sub ip2host {
        my $ip = shift;
        my @numbers = split(/\./, $ip);
        my $ip_number = pack("C4", @numbers);
        my ($host) = (gethostbyaddr($ip_number, 2))[0];
        if (defined $host && $host) {
                return $host;
        } else {
                return $ip;
        }
}

sub isIP {
        return 0 unless defined $_[0];
        return 1 if $_[0] =~ /^(25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.
                                (25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.
                                (25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.
                                (25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$/x;
        return 0;
}

sub resolve {
        return ip2host(@_) if isIP($_[0]);
        return host2ip(@_);
}

sub host2ip {
        my $host = shift;
        my @addresses = gethostbyname($host);
        if (@addresses > 0) {
                @addresses = map { inet_ntoa($_) } @addresses[4 .. $#addresses];
                return wantarray ? @addresses : $addresses[0];
        } else {
                return $host;
        }
}

1;

1	dpavlin	1	#!/usr/bin/perl -w
2			############################################################
3			#
4			# $Id: rrd-server.cgi 693 2006-06-26 19:11:42Z nicolaw $
5			# rrd-server.cgi - Data gathering CGI script for RRD::Simple
6			#
7			# Copyright 2006, 2007 Nicola Worthington
8			#
9			# Licensed under the Apache License, Version 2.0 (the "License");
10			# you may not use this file except in compliance with the License.
11			# You may obtain a copy of the License at
12			#
13			# http://www.apache.org/licenses/LICENSE-2.0
14			#
15			# Unless required by applicable law or agreed to in writing, software
16			# distributed under the License is distributed on an "AS IS" BASIS,
17			# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
18			# See the License for the specific language governing permissions and
19			# limitations under the License.
20			#
21			############################################################
22			# vim:ts=4:sw=4:tw=78
23
24			# User defined constants
25			use constant BASEDIR => '/home/nicolaw/webroot/www/rrd.me.uk';
26
27			############################################################
28
29
30
31
32			use 5.6.1;
33			use warnings;
34			use strict;
35			use Socket;
36
37			# We'll need to print a header unless we're in MOD_PERL land
38			print "Content-type: plain/text\n\n" unless exists $ENV{MOD_PERL};
39
40			my $host;
41			my $param = get_query($ENV{QUERY_STRING});
42			my $remote_addr = $ENV{REMOTE_ADDR};
43
44			# Take the host from the "target" if they know the "secret"
45			if (defined($ENV{RRD_SECRET}) && defined($param->{secret} && defined($param->{target}))
46			&& "$ENV{RRD_SECRET}" eq "$param->{secret}") {
47			$host = $param->{target};
48
49			} else {
50			# Check for HTTP proxy source addresses
51			for (qw(HTTP_X_FORWARDED_FOR HTTP_VIA HTTP_CLIENT_IP HTTP_PROXY_CONNECTION
52			FORWARDED_FOR X_FORWARDED_FOR X_HTTP_FORWARDED_FOR HTTP_FORWARDED)) {
53			if (defined $ENV{$_} && $ENV{$_} =~ /([\d\.]+)/) {
54			my $ip = $1;
55			if (isIP($ip)) {
56			$remote_addr = $ip;
57			last;
58			}
59			}
60			}
61
62			# Fail if we can't see who is sending us this data
63			unless ($remote_addr) {
64			print "FAILED - NO REMOTE_ADDR\n";
65			exit;
66			}
67
68			$host = ip2host($remote_addr);
69			my $ip = host2ip($host);
70
71			# Fail if we don't believe they are who their DNS says they are
72			if ("$ip" ne "$remote_addr") {
73			print "FAILED - FORWARD AND REVERSE DNS DO NOT MATCH\n";
74			exit;
75			}
76
77			# Custom hostname flanges
78			$host = 'legolas.wd.tfb.net' if $host eq 'bb-87-80-233-47.ukonline.co.uk' \|\| $ip eq '87.80.233.47';
79			$host = 'pippin.wd.tfb.net' if $host eq '82.153.185.41' \|\| $ip eq '82.153.185.41';
80			$host = 'pippin.wd.tfb.net' if $host eq '82.153.185.40' \|\| $ip eq '82.153.185.40';
81			$host = 'isle-of-cats.etla.org' if $ip eq '82.71.23.88';
82			}
83
84			# Build a list of valid pairs
85			my @pairs;
86			while (<>) {
87			#warn "$host $_";
88			next unless /^\d+\.[\w\.\-\_\d]+\s+[\d\.]+\s*$/;
89			push @pairs, $_;
90			}
91
92			# Don't bother opening a pipe if there's nothing to sent
93			unless (@pairs) {
94			printf("OKAY - %s - no valid pairs\n", $host);
95
96			} else {
97			# Simply open a handle to the rrd-server.pl and send in the data
98			if (open(PH,'\|-', BASEDIR."/bin/rrd-server.pl -u $host")) {
99			print PH $_ for @pairs;
100			close(PH);
101			printf("OKAY - %s - received %d pairs\n", $host, scalar(@pairs));
102
103			# Say if we failed the customer :)
104			} else {
105			print "FAILED - UNABLE TO EXECUTE\n";
106			}
107			}
108
109			exit;
110
111			sub get_query {
112			my $str = shift;
113			my $kv = {};
114			$str =~ tr/&;/&/s;
115			$str =~ s/^[&;]+//, $str =~ s/[&;]+$//;
116			for (split /[&;]/, $str) {
117			my ($k,$v) = split(/=/, $_, 2);
118			next if $k eq '';
119			$kv->{url_decode($k)} = url_decode($v);
120			}
121			return $kv;
122			}
123
124			sub url_decode {
125			local $_ = @_ ? shift : $_;
126			defined or return;
127			tr/+/ /;
128			s/%([a-fA-F0-9]{2})/pack "H2", $1/eg;
129			return $_;
130			}
131
132			sub ip2host {
133			my $ip = shift;
134			my @numbers = split(/\./, $ip);
135			my $ip_number = pack("C4", @numbers);
136			my ($host) = (gethostbyaddr($ip_number, 2))[0];
137			if (defined $host && $host) {
138			return $host;
139			} else {
140			return $ip;
141			}
142			}
143
144			sub isIP {
145			return 0 unless defined $_[0];
146			return 1 if $_[0] =~ /^(25[0-5]\|2[0-4][0-9]\|[01]?[0-9][0-9]?)\.
147			(25[0-5]\|2[0-4][0-9]\|[01]?[0-9][0-9]?)\.
148			(25[0-5]\|2[0-4][0-9]\|[01]?[0-9][0-9]?)\.
149			(25[0-5]\|2[0-4][0-9]\|[01]?[0-9][0-9]?)$/x;
150			return 0;
151			}
152
153			sub resolve {
154			return ip2host(@_) if isIP($_[0]);
155			return host2ip(@_);
156			}
157
158			sub host2ip {
159			my $host = shift;
160			my @addresses = gethostbyname($host);
161			if (@addresses > 0) {
162			@addresses = map { inet_ntoa($_) } @addresses[4 .. $#addresses];
163			return wantarray ? @addresses : $addresses[0];
164			} else {
165			return $host;
166			}
167			}
168
169			1;
170