#!/usr/bin/perl # Machine information (and finger-outside-MIT) gateway # $Id: machine,v 1.21 2022/05/15 01:32:20 andersk Exp wwwmaint $ # Eric Mumpower (nocturne@mit.edu) March '94 # Basically all of the code in "hostinfo" was taken from # /afs/gza.com/user/marc/perl/hostinfo.pl . I really don't # understand a lot of what it does. :-) use Net::Hesiod; use Net::DNS; use IO::Socket; use CGI; use strict; use warnings; my $query = CGI::param('hostname') || (@ARGV ? $ARGV[0] : undef); &do_machine($query); sub do_machine { my ($machine) = @_; my ($hostname); # remember, the previous line simply declares $hostname locally. :-) my $noargs = !$machine; $machine = $machine || (gethostbyaddr(pack('C4', split(/\./, $ENV{'REMOTE_ADDR'})), 2))[0]; $machine =~ tr/A-Z/a-z/; if ($machine =~ /(.+)\.mit\.edu/) { $hostname = $1; } else { $hostname = $machine; } print CGI::header(); print "\n\n"; print "Machine Information for ", CGI->escapeHTML($machine), "\n"; print "\n"; print "\n"; print "\n"; print "
\n"; # print "\n\n"; if ($noargs) { print("

Enter a hostname for the machine-information gateway.

\n"); print("
\n"); } print("

Machine Information for ", CGI->escapeHTML($machine), "

\n
\n"); my @addr = &my_hostinfo($machine); return unless (@addr); &fetch_portstuff($machine, @addr); &fetch_hesinfo($hostname); # This works about as fast as it's going to, I think. It's too slow, # though, so I'm disabling it. &my_findhost($hostname); print("
\nConnections that are refused (\"connection refused\") are usually a product of the system you are fingering, not of our gateway.\n Contact the maintainers of the site you are trying to finger if you get a connection refused.

\n"); print "\n\n"; } sub pad { my ($string, $len) = @_; $string . (' ' x ($len-length($string))); } sub fetch_hesinfo { my ($name) = @_; my (@hesiod_info, $key, $tag); if ($name !~ /\./) { $name = $name . '.mit.edu'; } if ($name =~ /\w+\.mit\.edu$/ || $name =~ /^18\./) { my $ctxt = new Net::Hesiod; @hesiod_info = $ctxt->resolve($name,'cluster'); if (@hesiod_info) { print "

Hesiod information for ", CGI->escapeHTML($name), "

\n\n
\n"; } } } sub fetch_portstuff { my ($name, @addr) = @_; my ($thataddr, $stuff, $response); $stuff = ""; if ($#addr != 0) { $stuff = "(" . $addr[0] . ")"; } $thataddr = $addr[0]; if ($response = &do_port($thataddr, 13)) { print("

Local time at ", CGI->escapeHTML($name), " ", CGI->escapeHTML($stuff), ":

\n"); print "
", CGI->escapeHTML($response), "
\n
\n"; } if ($response = &do_port($thataddr, 17)) { print("

Quote of the Day at ", CGI->escapeHTML($name), " ", CGI->escapeHTML($stuff), ":

\n"); print "
", CGI->escapeHTML($response), "
\n
\n"; } } sub do_port { my ($addr, $port) = @_; my ($that, $proto, @addrs, $their_answer); $proto = (getprotobyname("tcp"))[2]; @addrs = &fetchaddrs($addr); $that = pack('S n a4 x8',AF_INET, $port, $addrs[0]); eval{ local $SIG{ALRM} = sub {die "alarm\n";}; alarm(3); # Make the socket filehandle, open the socket return unless (socket(S,AF_INET, SOCK_STREAM, $proto) && connect(S, $that)); # Set socket to be command buffered. # select(S); $| = 1; select(STDOUT); # fetch response $their_answer = join('', ); close(S); alarm(0); }; return $their_answer; } sub my_hostinfo { my ($dhost) = @_; # Taken from code written by Marc Horowitz, remember. my $xhost = ""; my @oname = (); my @addr = (); my @alias = (); my @hinfo = (); my @mx = (); my $good = 0; my @r; my $errstr; my $resolver = new Net::DNS::Resolver(); my $query = $resolver->query($dhost); if ($dhost =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { foreach my $rr ($query->answer) { if ($rr->type eq 'PTR') { $dhost = $rr->ptrdname(); $query = $resolver->query($dhost); last; } } } if ($query) { foreach my $rr ($query->answer) { if ($rr->type eq 'CNAME') { push(@alias,$rr->name); } if ($rr->type eq 'A') { push(@oname,$rr->name); push(@addr,$rr->address); } } } else { print "Couldn't create query for ", CGI->escapeHTML($dhost); return; } my $addlname = $oname[0]; unless ($addlname) { print "No Such Machine"; return; } # get hinfo if needed $query = $resolver->query($addlname,"HINFO","IN"); if ($query) { foreach my $rr ($query->answer) { push(@hinfo,$rr->string()); } } # get MX addresses if needed $query = $resolver->query($addlname,"MX"); if ($query) { foreach my $rr ($query->answer) { push(@mx,{name=>$rr->exchange(), pref=>$rr->preference()}); } } @mx = sort {$a->{"pref"} <=> $b->{"pref"}} @mx; print("

Hostinfo ", CGI->escapeHTML($dhost), "

\n"); # print what we have, of what was requested. print("\n
\n"); return @addr; } sub my_findhost { my ($arg) = @_; my $netinfo_file = "/afs/net.mit.edu/admin/hosts/hosts"; if ($arg !~ /\./) { if (open(NETINFO, $netinfo_file)) { # &main'set_timeout(60*60); while () { if (/\s$arg\s/) { print "Cnames for the machine are:
\n"; print (CGI->escapeHTML($_), "\n"); last; } } close(NETINFO); print("
\n"); } else { print ("Couldn't open host information table in /afs/net.mit.edu\n"); } } } sub fetchaddrs { my ($where) = @_; my ($name, $aliases, $type, $len, @addrs); if ( $where !~ /^(\d{1,3}\.){0,3}\d{1,3}$/) { ($name,$aliases,$type,$len,@addrs) = gethostbyname($where); } else { ($name,$aliases,$type,$len,@addrs) = gethostbyaddr(pack('C4', split(/\./, $where)), 2); } return @addrs; } 1;