head	1.6;
access;
symbols;
locks; strict;
comment	@# @;


1.6
date	95.04.12.03.22.02;	author wwwmaint;	state Exp;
branches;
next	1.5;

1.5
date	95.04.12.03.06.29;	author wwwmaint;	state Exp;
branches;
next	1.4;

1.4
date	95.04.12.01.38.04;	author wwwmaint;	state Exp;
branches;
next	1.3;

1.3
date	95.03.07.14.18.20;	author yonah;	state Exp;
branches;
next	1.2;

1.2
date	94.11.15.02.48.49;	author nocturne;	state Exp;
branches;
next	1.1;

1.1
date	94.11.15.02.02.21;	author nocturne;	state Exp;
branches;
next	;


desc
@eric's magic machine stuff. :-)
@


1.6
log
@added link around MX addresses
@
text
@#!/usr/local/bin/perl
# Machine information (and finger-outside-MIT) gateway
# $Id: machine,v 1.5 1995/04/12 03:06:29 wwwmaint 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. :-)

require 'our-socket.ph';
require 'finger.pl';
require 'resolv.pl';
require 'hesiod.pl';

$query = join(' ', @@ARGV) if $ARGV[0];
&do_machine($query);

sub do_machine {
    local($machine) = @@_;
    local($hostname);
    # remember, the previous line simply declares $hostname locally. :-)

    $noargs = "yup" unless $machine;

    $machine= (gethostbyaddr(pack('C4', split(/\./, $ENV{'REMOTE_HOST'})), 2))[0] if $noargs;

    $machine =~ tr/A-Z/a-z/;

    if ($machine =~ /(.+)\.mit\.edu/) {
        $hostname = $1;
    }
    else {
	$hostname = $machine;
    }

    print("Content-Type: text/html\n\n");
    # &main'MIME_header('ok', 'text/html');   #HTTP/1.0 compliance
    
    print "<html>\n<head>\n";
    print "<title>Machine Information for $machine</title>\n";
    print "<link rev=made href=mailto:nocturne@@mit.edu>\n";
    print "<link rev=owns href=mailto:webmaster@@mit.edu>\n";
    print "</head><body>\n";
    print "<ISINDEX>\n\n";
    if ($noargs) {
	print("<h2>Enter a hostname for the machine-information gateway.</h2>\n");
	print("<hr>\n");
    }
    print("<h1>Machine Information for $machine</h1>\n<hr>\n");

    @@addr = &my_hostinfo($machine);
    return unless (@@addr);

    &fetch_portstuff($machine, @@addr);

    &fetch_hesinfo($hostname);

    &finger_machine($machine);

    # 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 "</body>\n</html>\n";
}

sub pad {
    local($string, $len) = @@_;
    $string . (' ' x ($len-length($string)));
}

sub fetch_hesinfo {
    local($name) = @@_;
    local(@@hesiod_info, $key, $tag);

    if ($name !~ /\./) {
	@@hesiod_info = &hes_resolve($name, "cluster");
	if (@@hesiod_info) {
	    print "<h2>Hesiod information for $name</h2>\n<ul>";
	    for (@@hesiod_info) {
		$_ =~ /(.*)\s(.*)/;
		$key = $1;
		$tag = $2;
		if ($key eq "lpr") {
		    print "<li><em>Default Printer</em>: $tag\n";
		}
		elsif ($key eq "syslib") {
		    print "<li><em>System Packs</em>: $tag\n";
		}
		else {
		    print"<li><em>$key</em>: $tag\n";
		}
	    }
	    print "</ul>\n<hr>\n";
	}
    }
}

sub fetch_portstuff {
    local($name, @@addr) = @@_;
    local($thataddr, $stuff, $response);

    $stuff = "";
    if ($#addr != 0) {
	$stuff = "(" . @@addr[0] . ")";
    }

    $thataddr = @@addr[0];

    if ($response = &do_port($thataddr, 13)) {
	print("<h2>Local time at $name $stuff:</h2>\n");
	print "<pre>$response</pre>\n<hr>\n";
    }

    if ($response = &do_port($thataddr, 17)) {
	print("<h2>Quote of the Day at $name $stuff:</h2>\n");
	print "<pre>$response</pre>\n<hr>\n";
    }

}

sub do_port {
    local($addr, $port) = @@_;
    local($that, $proto, @@addrs);

    $proto = (getprotobyname("tcp"))[2];

    @@addrs = &fetchaddrs($addr);
    $that  = pack('S n a4 x8', &main'AF_INET, $port, @@addrs[0]);

    # Make the socket filehandle, open the socket
    return unless (socket(S, &main'AF_INET, &main'SOCK_STREAM, $proto) &&
                  connect(S, $that));
	
    # Set socket to be command buffered.
    # select(S); $| = 1; select(STDOUT);

    # fetch response
    $their_answer = join('', <S>);

    close(S);

    return $their_answer;
}


sub finger_machine {
    local($machine) = @@_;

    print "<h2>Finger @@$machine</h2>\n";

    # This function is defined in finger.pl

    &finger'finger_candy($machine, '');

    print("<hr>\n");

}

sub my_hostinfo {
    local($dhost) = @@_;

    # Taken from code written by Marc Horowitz, remember.

    $xhost = "";
    @@oname = ();
    @@addr = ();
    @@alias = ();
    @@hinfo = ();
    %mx = ();
    $good = 0;

    if ($dhost =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) {
	@@r = &res_search("$4.$3.$2.$1.in-addr.arpa","PTR","IN");
	if (!$r[3]) {
	    $xhost = (split(' ',$r[$r[6]]))[4];
	    @@r = &res_search($xhost,"A","IN");
	    if ($r[3]) {
		print ("WARNING: Couldn't resolve hostname, ",
		       "something is weird.\n");
		$good++;	# Well, sort of
	    } else {
		$xhost = "";
	    }
	}
    } else {
	@@r = &res_search($dhost,"A","IN");
    }

    # parse the reply

    if (!$r[3]) {
	for $ans (@@r[$r[6]..$r[6]+$r[7]-1]) {
	    ($name,$type,$class,$ttl,$data) = split(' ',$ans,5);

	    if ($type eq "CNAME") {
		$good++;
		push(@@alias,$name);
	    } elsif ($type eq "A") {
		$good++;
		push(@@oname,$name) if !grep($_ eq $name, @@oname);
		push(@@addr,$data);
	    }
	}
    } else {
	$errstr = $r[3];
    }

    $addlname = ($oname[0] || $dhost);

    # get hinfo if needed

    @@r = &res_search($addlname,"HINFO","IN");

    if (!$r[3]) {
	for $ans (@@r[$r[6]..$r[6]+$r[7]-1]) {
	    ($name,$type,$class,$ttl,$hi) = split(' ',$ans,5);
	    
	    if ($type eq "HINFO") {
		$good++;
		$hi =~ s!,!/!;
		push(@@hinfo,$hi);
	    }
	}
    }

    # get MX addresses if needed

    @@r = &res_search($addlname,"MX","IN");

    if (!$r[3]) {
	for $ans (@@r[$r[6]..$r[6]+$r[7]-1]) {
	    ($name,$type,$class,$ttl,$rank,$host) = split(' ',$ans,6);

	    if ($type eq "MX") {
		$good++;
		$mx{$rank*1000+$uid++} .= $host;
	    }
	}
    }

    print("<h2>Hostinfo $dhost</h2>\n");

    # print error if nothing came up

    if (!$good) {
	warn "$errstr: '$dhost'\n";
	$error++;
	print("No such machine.\n");
    }
    else {
	# print what we have, of what was requested.
	
	print("<ul>\n<li>Desired host: $dhost\n");

	if ($xhost) {
	    print "<li>Unofficial name: $xhost\n";
	}

	for (@@oname) {
	    print "<li>Official name: $_\n";
	}

	for (@@alias) {
	    print "<li>Alias: $_\n";
	}

	if ($#addr !=0) {
	    for (@@addr) {
		$othername = (gethostbyaddr(pack('C4', split(/\./, $_)), 2))[0];
		print "<li>Host address: <a href=\"http://www.mit.edu:8001/machine?$_\">$_ ($othername)</a>\n";
	    }
	}
	else {
	    print "<li>Host address: @@addr[0]\n";
	}

	for (@@hinfo) {
	    print "<li>Host info: $_\n";
	}

	for (sort keys(%mx)) {
	    print "<li>MX address: ";
	    print "<a href=\"http://www.mit.edu:8001/machine?$mx{$_}\">";
            print "$mx{$_}</a>\n";
	}

	print("</ul>\n<hr>\n");

    }
    @@addr;
}

sub my_findhost {
    local ($arg) = @@_;

    $netinfo_file = "/afs/net.mit.edu/admin/hosts/hosts";

    if ($arg !~ /\./) {
	if (open(NETINFO, $netinfo_file)) {
	    # &main'set_timeout(60*60);
	    while (<NETINFO>) {
		if (/\s$arg\s/) {
		    print "Cnames for the machine are:<br>\n";
		    print ($_, "\n");
		    break;
		}
	    }
	    close(NETINFO);
	    print("<hr>\n");
	    
	}
	else {
	    print ("Couldn't open host information table in /afs/net.mit.edu\n");
	}
    }
}

sub fetchaddrs {
    local($where) = @@_;
    local($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;
@


1.5
log
@fixed several platform-dependent constants and
cleaned up the code a lot.
@
text
@d3 1
a3 1
# $Id: machine,v 1.4 1995/04/12 01:38:04 wwwmaint Exp wwwmaint $
d283 3
a285 1
	    print "<li>MX address: $mx{$_}\n";
@


1.4
log
@yonah's mods
@
text
@d3 1
a3 1
# $Id: machine,v 1.3 95/03/07 14:18:20 yonah Exp $
d19 2
a20 2
    local($machine, $hostname) = @@_;

d39 6
a44 1
    print("<ISINDEX><title>Machine Information for $machine</title>\n");
d63 2
d74 1
d100 2
a101 1
    local($name, @@addr, $othername) = @@_;
a104 1
	$othername = (gethostbyaddr(pack('C4', split(/\./, @@addr[0])), 2))[0];
a106 1
    $thataddr = pack('C4', split(/\./, @@addr[0]));
d108 2
d123 4
a126 1
    local($addr, $port, $othername) = @@_;
d128 3
a130 2
    $that = pack('S n a4 x8', 2, $port, $addr);
    
d132 2
a133 2

    return unless (socket(S, 2, 1, 6) && connect(S,$that));
a135 1
    
d139 1
a140 1
    $their_answer = join('', <S>);
d143 1
a143 1
    $their_answer;
d315 13
@


1.3
log
@*** empty log message ***
@
text
@d1 1
a1 1
#!/usr/athena/bin/perl
d3 1
a3 1
# $Id: machine,v 1.2 1994/11/15 02:48:49 nocturne Exp $
@


1.2
log
@it works under solaris. thank god.
@
text
@d1 1
a1 1
#!/afs/athena/contrib/perl/p
d3 1
a3 1
# $Id: machine,v 1.1 1994/11/15 02:02:21 nocturne Exp nocturne $
d10 1
a10 1
require 'sys/socket.ph';
@


1.1
log
@Initial revision
@
text
@d3 1
a3 1
# $Id: machine.pl,v 1.23 1994/05/22 07:38:48 nocturne Exp $
d10 2
a12 1
require 'finger.pl';
@
