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 |
|