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