source-git / perl-Net-DNS

Clone
Source Code
GIT

Blame contrib/loc2earth.fcgi

c8 c8s master
  1.   0ac1538eb2492896e69185f4e64ee79a5819c4b1
  2.   contrib
  3.   loc2earth.fcgi
Blob History Raw
Packit e6c8bb 
#!/usr/local/bin/perl -T
Packit e6c8bb
Packit e6c8bb 
# loc2earth.cgi - generates a redirect to Earth Viewer based on LOC record
Packit e6c8bb 
# [ see <URL: http://www.kei.com/homepages/ckd/dns-loc/ > or RFC 1876 ]
Packit e6c8bb
Packit e6c8bb 
# by Christopher Davis <ckd@kei.com>
Packit e6c8bb
Packit e6c8bb 
# $Id: loc2earth.fcgi 264 2005-04-06 09:16:15Z olaf $
Packit e6c8bb
Packit e6c8bb 
die "I want 5.004 and I want it now" if $] < 5.004;
Packit e6c8bb
Packit e6c8bb 
# if you don't have FastCGI support, comment out this line and the two lines
Packit e6c8bb 
#  later in the script with "NO FCGI" comments
Packit e6c8bb 
use CGI::Fast qw(:standard);
Packit e6c8bb
Packit e6c8bb 
# and uncomment the following instead.
Packit e6c8bb 
#use CGI qw(:standard);
Packit e6c8bb
Packit e6c8bb 
use Net::DNS '0.08';		# LOC support in 0.08 and later
Packit e6c8bb
Packit e6c8bb 
$res = new Net::DNS::Resolver;
Packit e6c8bb
Packit e6c8bb 
@samplehosts= ('www.kei.com',
Packit e6c8bb 
	       'www.ndg.com.au',
Packit e6c8bb 
	       'gw.alink.net',
Packit e6c8bb 
	       'quasar.inexo.com.br',
Packit e6c8bb 
	       'hubert.fukt.hk-r.se',
Packit e6c8bb 
	       'sargent.cms.dmu.ac.uk',
Packit e6c8bb 
	       'thales.mathematik.uni-ulm.de');
Packit e6c8bb
Packit e6c8bb 
while (new CGI::Fast) {		# NO FCGI -- comment out this line
Packit e6c8bb 
  print header(-Title => "RFC 1876 Resources: Earth Viewer Demo");
Packit e6c8bb
Packit e6c8bb 
  # reinitialize these since FastCGI would keep them around otherwise
Packit e6c8bb 
  @addrs = @netnames = ();
Packit e6c8bb 
  $foundloc = 0;
Packit e6c8bb
Packit e6c8bb 
  print '
Packit e6c8bb 
<html><head> <title>RFC 1876 Resources: Earth Viewer Demo</title>
Packit e6c8bb
Packit e6c8bb 
 <link rev="made" href="mailto:ckd@kei.com">
Packit e6c8bb 
 <link rel="stylesheet" href="../ckdstyle.css" title="ckd\'s styles">
Packit e6c8bb 
</head>
Packit e6c8bb 
<body bgcolor="#FFFFFF" text="#000000" vlink="#663399" link="#0000FF" alink="#FF0000">
Packit e6c8bb 
RFC 1876 Resources
Packit e6c8bb 
loc2earth: The Earth Viewer Demo
Packit e6c8bb 
';
Packit e6c8bb
Packit e6c8bb 
  print p("This is a quick & dirty demonstration of the use of the",
Packit e6c8bb 
	  a({-href => 'http://www.dimensional.com/~mfuhr/perldns/'},
Packit e6c8bb 
	    'Net::DNS module'),"and the",
Packit e6c8bb 
	  a({-href =>
Packit e6c8bb 
		 'http://www-genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},
Packit e6c8bb 
	    'CGI.pm library'), "to write LOC-aware Web applications.");
Packit e6c8bb
Packit e6c8bb 
  print startform("GET");
Packit e6c8bb
Packit e6c8bb 
  print p(strong("Hostname"),textfield(-name => host, -size => 50));
Packit e6c8bb
Packit e6c8bb 
  print p(submit, reset), endform;
Packit e6c8bb
Packit e6c8bb 
  if (param('host')) {
Packit e6c8bb 
    ($host = param('host')) =~ s/\s//g; # strip out spaces
Packit e6c8bb
Packit e6c8bb 
    # check for numeric IPs and do reverse lookup to get name
Packit e6c8bb 
    if ($host =~ m/^\d+\.\d+\.\d+\.\d+$/) {
Packit e6c8bb 
      $query = $res->query($host);
Packit e6c8bb
Packit e6c8bb 
      if (defined ($query)) {
Packit e6c8bb 
	foreach $ans ($query->answer) {
Packit e6c8bb 
	  if ($ans->type eq "PTR") {
Packit e6c8bb 
	    $host = $ans->ptrdname;
Packit e6c8bb 
	  }
Packit e6c8bb 
	}
Packit e6c8bb 
      }
Packit e6c8bb 
    }
Packit e6c8bb
Packit e6c8bb 
    $query = $res->query($host,"LOC");
Packit e6c8bb
Packit e6c8bb 
    if (defined ($query)) {	# then we got an answer of some sort
Packit e6c8bb 
      foreach $ans ($query->answer) {
Packit e6c8bb 
	if ($ans->type eq "LOC") {
Packit e6c8bb 
	  &print_loc($ans->rdatastr);
Packit e6c8bb 
	  $foundloc++;
Packit e6c8bb 
	} elsif ($ans->type eq "CNAME") {
Packit e6c8bb 
	  # XXX should follow CNAME chains here
Packit e6c8bb 
	}
Packit e6c8bb 
      }
Packit e6c8bb 
    }
Packit e6c8bb 
    if (!$foundloc) {		# try the RFC 1101 search bit
Packit e6c8bb 
      $query = $res->query($host,"A");
Packit e6c8bb 
      if (defined ($query)) {
Packit e6c8bb 
	foreach $ans ($query->answer) {
Packit e6c8bb 
	  if ($ans->type eq "A") {
Packit e6c8bb 
	    push(@addrs,$ans->address);
Packit e6c8bb 
	  }
Packit e6c8bb 
	}
Packit e6c8bb 
      }
Packit e6c8bb 
      if (@addrs) {
Packit e6c8bb 
      checkaddrs:
Packit e6c8bb 
	foreach $ipstr (@addrs) {
Packit e6c8bb 
	  $ipnum = unpack("N",pack("CCCC",split(/\./,$ipstr,4)));
Packit e6c8bb 
	  ($ip1) = split(/\./,$ipstr);
Packit e6c8bb 
	  if ($ip1 >= 224) { # class D/E, treat as host addr
Packit e6c8bb 
	    $mask = 0xFFFFFFFF;
Packit e6c8bb 
	  } elsif ($ip1 >= 192) { # "class C"
Packit e6c8bb 
	    $mask = 0xFFFFFF00;
Packit e6c8bb 
	  } elsif ($ip1 >= 128) { # "class B"
Packit e6c8bb 
	    $mask = 0xFFFF0000;
Packit e6c8bb 
	  } else {	# class A
Packit e6c8bb 
	    $mask = 0xFF000000;
Packit e6c8bb 
	  }
Packit e6c8bb 
	  $oldmask = 0;
Packit e6c8bb 
	  while ($oldmask != $mask) {
Packit e6c8bb 
	    $oldmask = $mask;
Packit e6c8bb 
	    $querystr =
Packit e6c8bb 
		join(".", reverse (unpack("CCCC",pack("N",$ipnum & $mask))))
Packit e6c8bb 
		     . ".in-addr.arpa";
Packit e6c8bb 
	    $query = $res->query($querystr,"PTR");
Packit e6c8bb 
	    if (defined ($query)) {
Packit e6c8bb 
	      foreach $ans ($query->answer) {
Packit e6c8bb 
		if ($ans->type eq "PTR") {
Packit e6c8bb 
		  # we want the list in LIFO order
Packit e6c8bb 
		  unshift(@netnames,$ans->ptrdname);
Packit e6c8bb 
		}
Packit e6c8bb 
	      }
Packit e6c8bb 
	      $query = $res->query($querystr,"A");
Packit e6c8bb 
	      if (defined ($query)) {
Packit e6c8bb 
		foreach $ans ($query->answer) {
Packit e6c8bb 
		  if ($ans->type eq "A") {
Packit e6c8bb 
		    $mask = unpack("L",pack("CCCC",
Packit e6c8bb 
					    split(/\./,$ans->address,4)));
Packit e6c8bb 
		  }
Packit e6c8bb 
		}
Packit e6c8bb 
	      }
Packit e6c8bb 
	    }
Packit e6c8bb 
	  }
Packit e6c8bb 
	  if (@netnames) {
Packit e6c8bb 
	    foreach $network (@netnames) {
Packit e6c8bb 
	      $query = $res->query($network,"LOC");
Packit e6c8bb 
	      if (defined ($query)) {
Packit e6c8bb 
		foreach $ans ($query->answer) {
Packit e6c8bb 
		  if ($ans->type eq "LOC") {
Packit e6c8bb 
		    &print_loc($ans->rdatastr);
Packit e6c8bb 
		    $foundloc++;
Packit e6c8bb 
		    last checkaddrs;
Packit e6c8bb 
		  } elsif ($ans->type eq "CNAME") {
Packit e6c8bb 
		    # XXX should follow CNAME chains here
Packit e6c8bb 
		  }
Packit e6c8bb 
		}
Packit e6c8bb 
	      }
Packit e6c8bb 
	    }
Packit e6c8bb 
	  }
Packit e6c8bb 
	}
Packit e6c8bb 
      }
Packit e6c8bb 
    }
Packit e6c8bb 
    if (!$foundloc) {
Packit e6c8bb 
      print hr,p("Sorry, there appear to be no LOC records for the",
Packit e6c8bb 
		 "host $host in the DNS.");
Packit e6c8bb 
    }
Packit e6c8bb 
  }
Packit e6c8bb 
  print hr,p("Some hosts with LOC records you may want to try:"),
Packit e6c8bb 
  "
    \n
  • ",join("\n
  • ",@samplehosts),"
";
Packit e6c8bb
Packit e6c8bb 
  print '
Packit e6c8bb
Packit e6c8bb 
  src="http://www.kei.com/homepages/ckd/dns-loc/rfc1876-now.gif"
Packit e6c8bb 
    alt="RFC 1876 Now" height=32 width=80 align=right>
Packit e6c8bb 
<address>Christopher Davis
Packit e6c8bb 
<ckd@kei.com></address>
Packit e6c8bb 
</body></html>';
Packit e6c8bb
Packit e6c8bb 
} 		# NO FCGI -- comment out this line
Packit e6c8bb
Packit e6c8bb 
sub print_loc {
Packit e6c8bb 
  local($rdata) = @_;
Packit e6c8bb
Packit e6c8bb 
  ($latdeg,$latmin,$latsec,$lathem,
Packit e6c8bb 
   $londeg,$lonmin,$lonsec,$lonhem) = split (/ /,$rdata);
Packit e6c8bb 
  print hr,p("The host $host appears to be at",
Packit e6c8bb 
	     "${latdeg}°${latmin}'${latsec}\" ${lathem}",
Packit e6c8bb 
	     "latitude and ${londeg}°${lonmin}'${lonsec}\"",
Packit e6c8bb 
	     "${lonhem} longitude according to the DNS.");
Packit e6c8bb 
  $evurl = ("http://www.fourmilab.ch/cgi-bin/uncgi/Earth?" .
Packit e6c8bb 
	    "lat=${latdeg}d${latmin}m${latsec}s&ns=" .
Packit e6c8bb 
	    (($lathem eq "S")?"lSouth":"lNorth") .
Packit e6c8bb 
	    "&lon=${londeg}d${lonmin}m${lonsec}s&ew=" .
Packit e6c8bb 
	    (($lonhem eq "W")?"West":"East") .
Packit e6c8bb 
	    "&alt=");
Packit e6c8bb 
  print "
Generate an Earth Viewer image from ";
Packit e6c8bb 
  foreach $alt (49, 204, 958, 35875) {
Packit e6c8bb 
    print ('',
Packit e6c8bb 
	   $alt,'km ');
Packit e6c8bb 
  }
Packit e6c8bb 
  print " above this point
";
Packit e6c8bb 
}

Powered by Pagure 5.13.3

SSH Hostkey/Fingerprint | Documentation