1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
|
#!/usr/local/bin/perl -T
# loc2earth.cgi - generates a redirect to Earth Viewer based on LOC record
# [ see <URL: http://www.kei.com/homepages/ckd/dns-loc/ > or RFC 1876 ]
# by Christopher Davis <ckd@kei.com>
# $Id: loc2earth.fcgi 264 2005-04-06 09:16:15Z olaf $
die "I want 5.004 and I want it now" if $] < 5.004;
# if you don't have FastCGI support, comment out this line and the two lines
# later in the script with "NO FCGI" comments
use CGI::Fast qw(:standard);
# and uncomment the following instead.
#use CGI qw(:standard);
use Net::DNS '0.08'; # LOC support in 0.08 and later
$res = new Net::DNS::Resolver;
@samplehosts= ('www.kei.com',
'www.ndg.com.au',
'gw.alink.net',
'quasar.inexo.com.br',
'hubert.fukt.hk-r.se',
'sargent.cms.dmu.ac.uk',
'thales.mathematik.uni-ulm.de');
while (new CGI::Fast) { # NO FCGI -- comment out this line
print header(-Title => "RFC 1876 Resources: Earth Viewer Demo");
# reinitialize these since FastCGI would keep them around otherwise
@addrs = @netnames = ();
$foundloc = 0;
print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 3.2 Final//EN">
<html><head> <title>RFC 1876 Resources: Earth Viewer Demo</title>
<!-- Generated by $Id: loc2earth.fcgi 264 2005-04-06 09:16:15Z olaf $ -->
<link rev="made" href="mailto:ckd@kei.com">
<link rel="stylesheet" href="../ckdstyle.css" title="ckd\'s styles">
</head>
<body bgcolor="#FFFFFF" text="#000000" vlink="#663399" link="#0000FF" alink="#FF0000">
<h2><a href="./">RFC 1876 Resources</a></h2>
<h1>loc2earth: The <a href="http://www.fourmilab.ch/earthview/vplanet.html">Earth Viewer</a> Demo</h1>
<hr>';
print p("This is a quick & dirty demonstration of the use of the",
a({-href => 'http://www.dimensional.com/~mfuhr/perldns/'},
'Net::DNS module'),"and the",
a({-href =>
'http://www-genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},
'CGI.pm library'), "to write LOC-aware Web applications.");
print startform("GET");
print p(strong("Hostname"),textfield(-name => host, -size => 50));
print p(submit, reset), endform;
if (param('host')) {
($host = param('host')) =~ s/\s//g; # strip out spaces
# check for numeric IPs and do reverse lookup to get name
if ($host =~ m/^\d+\.\d+\.\d+\.\d+$/) {
$query = $res->query($host);
if (defined ($query)) {
foreach $ans ($query->answer) {
if ($ans->type eq "PTR") {
$host = $ans->ptrdname;
}
}
}
}
$query = $res->query($host,"LOC");
if (defined ($query)) { # then we got an answer of some sort
foreach $ans ($query->answer) {
if ($ans->type eq "LOC") {
&print_loc($ans->rdatastr);
$foundloc++;
} elsif ($ans->type eq "CNAME") {
# XXX should follow CNAME chains here
}
}
}
if (!$foundloc) { # try the RFC 1101 search bit
$query = $res->query($host,"A");
if (defined ($query)) {
foreach $ans ($query->answer) {
if ($ans->type eq "A") {
push(@addrs,$ans->address);
}
}
}
if (@addrs) {
checkaddrs:
foreach $ipstr (@addrs) {
$ipnum = unpack("N",pack("CCCC",split(/\./,$ipstr,4)));
($ip1) = split(/\./,$ipstr);
if ($ip1 >= 224) { # class D/E, treat as host addr
$mask = 0xFFFFFFFF;
} elsif ($ip1 >= 192) { # "class C"
$mask = 0xFFFFFF00;
} elsif ($ip1 >= 128) { # "class B"
$mask = 0xFFFF0000;
} else { # class A
$mask = 0xFF000000;
}
$oldmask = 0;
while ($oldmask != $mask) {
$oldmask = $mask;
$querystr =
join(".", reverse (unpack("CCCC",pack("N",$ipnum & $mask))))
. ".in-addr.arpa";
$query = $res->query($querystr,"PTR");
if (defined ($query)) {
foreach $ans ($query->answer) {
if ($ans->type eq "PTR") {
# we want the list in LIFO order
unshift(@netnames,$ans->ptrdname);
}
}
$query = $res->query($querystr,"A");
if (defined ($query)) {
foreach $ans ($query->answer) {
if ($ans->type eq "A") {
$mask = unpack("L",pack("CCCC",
split(/\./,$ans->address,4)));
}
}
}
}
}
if (@netnames) {
foreach $network (@netnames) {
$query = $res->query($network,"LOC");
if (defined ($query)) {
foreach $ans ($query->answer) {
if ($ans->type eq "LOC") {
&print_loc($ans->rdatastr);
$foundloc++;
last checkaddrs;
} elsif ($ans->type eq "CNAME") {
# XXX should follow CNAME chains here
}
}
}
}
}
}
}
}
if (!$foundloc) {
print hr,p("Sorry, there appear to be no LOC records for the",
"host $host in the DNS.");
}
}
print hr,p("Some hosts with LOC records you may want to try:"),
"<ul>\n<li>",join("\n<li>",@samplehosts),"</ul>";
print '<hr>
<a href="http://www.kei.com/homepages/ckd/dns-loc/"><img
src="http://www.kei.com/homepages/ckd/dns-loc/rfc1876-now.gif"
alt="RFC 1876 Now" height=32 width=80 align=right></a>
<address><a href="http://www.kei.com/homepages/ckd/">Christopher Davis</a>
<<a href="mailto:ckd@kei.com">ckd@kei.com</a>></address>
</body></html>';
} # NO FCGI -- comment out this line
sub print_loc {
local($rdata) = @_;
($latdeg,$latmin,$latsec,$lathem,
$londeg,$lonmin,$lonsec,$lonhem) = split (/ /,$rdata);
print hr,p("The host $host appears to be at",
"${latdeg}°${latmin}'${latsec}\" ${lathem}",
"latitude and ${londeg}°${lonmin}'${lonsec}\"",
"${lonhem} longitude according to the DNS.");
$evurl = ("http://www.fourmilab.ch/cgi-bin/uncgi/Earth?" .
"lat=${latdeg}d${latmin}m${latsec}s&ns=" .
(($lathem eq "S")?"lSouth":"lNorth") .
"&lon=${londeg}d${lonmin}m${lonsec}s&ew=" .
(($lonhem eq "W")?"West":"East") .
"&alt=");
print "<p>Generate an Earth Viewer image from ";
foreach $alt (49, 204, 958, 35875) {
print ('<a href="',$evurl,$alt,'">',
$alt,'km</a> ');
}
print " above this point</p>";
}
|
