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 & 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<<a href="mailto:ckd@kei.com">ckd@kei.com</a>></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}°${latmin}'${latsec}\" ${lathem}", 182 "latitude and ${londeg}°${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