1#@!#!123s

: / kunden / kunden / proc / thread-self / root / usr / share / doc / libnet-dns-perl / examples / contrib /
Filename : loc2earth.fcgi
back
#!/usr/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 1811 2020-10-05 08:24:23Z willem $

use strict;
use warnings;


# 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 = Net::DNS::Resolver->new();

@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 ( CGI::Fast->new ) {		# 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 1811 2020-10-05 08:24:23Z willem $ -->
 <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 &amp; 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 my $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 my $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 my $ans ($query->answer) {
	  if ($ans->type eq "A") {
	    push(@addrs,$ans->address);
	  }
	}
      }
      if (@addrs) {
      checkaddrs:
	foreach my $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 my $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 my $ans ($query->answer) {
		  if ($ans->type eq "A") {
		    $mask = unpack("L",pack("CCCC",
					    split(/\./,$ans->address,4)));
		  }
		}
	      }
	    }
	  }
	  if (@netnames) {
	    foreach my $network (@netnames) {
	      $query = $res->query($network,"LOC");
	      if (defined ($query)) {
		foreach my $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>
&lt;<a href="mailto:ckd@kei.com">ckd@kei.com</a>&gt;</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}&#176;${latmin}'${latsec}\" ${lathem}",
	     "latitude and ${londeg}&#176;${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 my $alt (49, 204, 958, 35875) {
    print ('<a href="',$evurl,$alt,'">',
	   $alt,'km</a> ');
  }
  return print " above this point</p>";
}