/[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 1 - (show annotations)
Thu Jul 16 18:48:19 2009 UTC (14 years, 8 months ago) by dpavlin
File size: 4411 byte(s)
import upstream http://rrd.me.uk/rrd-simple-monitoring.tar.gz

without prerequisities

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

Properties

Name Value
svn:executable *

  ViewVC Help
Powered by ViewVC 1.1.26