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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7 - (hide annotations)
Fri Jul 17 18:18:07 2009 UTC (11 years, 6 months ago) by dpavlin
File size: 4425 byte(s)
implement # host before data to push hostname from clients behind nat
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 dpavlin 7 use constant BASEDIR => '/var/www/rrd';
26 dpavlin 1
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 dpavlin 7 $host = $1 if m/^#\s*host\s*(\S+)/;
89 dpavlin 1 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