/[rrd-simple-monitoring]/cgi-bin/rrd-server.cgi
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Contents of /cgi-bin/rrd-server.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7 - (show annotations)
Fri Jul 17 18:18:07 2009 UTC (9 years, 10 months ago) by dpavlin
File size: 4425 byte(s)
implement # host before data to push hostname from clients behind nat
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 => '/var/www/rrd';
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 $host = $1 if m/^#\s*host\s*(\S+)/;
89 next unless /^\d+\.[\w\.\-\_\d]+\s+[\d\.]+\s*$/;
90 push @pairs, $_;
91 }
92
93 # Don't bother opening a pipe if there's nothing to sent
94 unless (@pairs) {
95 printf("OKAY - %s - no valid pairs\n", $host);
96
97 } else {
98 # Simply open a handle to the rrd-server.pl and send in the data
99 if (open(PH,'|-', BASEDIR."/bin/rrd-server.pl -u $host")) {
100 print PH $_ for @pairs;
101 close(PH);
102 printf("OKAY - %s - received %d pairs\n", $host, scalar(@pairs));
103
104 # Say if we failed the customer :)
105 } else {
106 print "FAILED - UNABLE TO EXECUTE\n";
107 }
108 }
109
110 exit;
111
112 sub get_query {
113 my $str = shift;
114 my $kv = {};
115 $str =~ tr/&;/&/s;
116 $str =~ s/^[&;]+//, $str =~ s/[&;]+$//;
117 for (split /[&;]/, $str) {
118 my ($k,$v) = split(/=/, $_, 2);
119 next if $k eq '';
120 $kv->{url_decode($k)} = url_decode($v);
121 }
122 return $kv;
123 }
124
125 sub url_decode {
126 local $_ = @_ ? shift : $_;
127 defined or return;
128 tr/+/ /;
129 s/%([a-fA-F0-9]{2})/pack "H2", $1/eg;
130 return $_;
131 }
132
133 sub ip2host {
134 my $ip = shift;
135 my @numbers = split(/\./, $ip);
136 my $ip_number = pack("C4", @numbers);
137 my ($host) = (gethostbyaddr($ip_number, 2))[0];
138 if (defined $host && $host) {
139 return $host;
140 } else {
141 return $ip;
142 }
143 }
144
145 sub isIP {
146 return 0 unless defined $_[0];
147 return 1 if $_[0] =~ /^(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]?)\.
150 (25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)$/x;
151 return 0;
152 }
153
154 sub resolve {
155 return ip2host(@_) if isIP($_[0]);
156 return host2ip(@_);
157 }
158
159 sub host2ip {
160 my $host = shift;
161 my @addresses = gethostbyname($host);
162 if (@addresses > 0) {
163 @addresses = map { inet_ntoa($_) } @addresses[4 .. $#addresses];
164 return wantarray ? @addresses : $addresses[0];
165 } else {
166 return $host;
167 }
168 }
169
170 1;
171

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26