head     1.3;
branch   ;
access   ;
symbols  ;
locks    ; strict;
comment  @# @;


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

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

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


desc
@eric's finger gateway. :-)
@


1.3
log
@*** empty log message ***
@
text
@#!/usr/athena/bin/perl
# Finger gateway
# $Id: finger,v 1.2 94/11/15 02:48:30 nocturne Exp Locker: yonah $
# Eric Mumpower (nocturne@@mit.edu) March '94
#
# Matthew Gray (mkgray@@mit.edu) June '94 Converted to CGI

require 'finger.pl';

&finger'finger_wrapper($ENV{'QUERY_STRING'});
1;
@


1.2
log
@it works under solaris. thank god.
@
text
@d1 1
a1 1
#!/afs/athena/contrib/perl/p
d3 1
a3 1
# $Id: finger,v 1.1 1994/07/16 06:14:58 nocturne Exp nocturne $
@


1.1
log
@Initial revision
@
text
@d3 1
a3 1
# $Id: finger.pl,v 1.12 1994/05/29 10:50:11 nocturne Exp $
d8 1
a8 3
&finger_wrapper($ENV{'QUERY_STRING'});
sub finger_wrapper {
    local($arg) = @@_;
d10 1
a10 262
    ($who,$where) = ($arg =~ /^(.*)@@([^@@]*)$/);

    $noargs = "yup" unless $arg;

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

    $where = $arg unless $where;

    if ($who && &is_mitdir($where)) {
	&forward_mitdir($who);
	return;
    }
	print("Content-Type: text/html\n\n");	
    $pre_string = "@@" unless $who;

    print "<ISINDEX><title>Finger $pre_string$arg</title>\n";
    if ($noargs) {
	print "<h2>Enter the arguments for finger.</h2>\n";
	print "Arguments should be in one of these formats:\n";
	print "<ul>\n<li><code><em>machinename</em></code>\n";
	print "<li><code><em>username</em>@@<em>machinename</em></code>\n";
	print "</ul>\n<hr>\n";
    }
    print "<h1>Finger $pre_string$arg</h1>\n<hr>\n";

    &finger_candy($where, $who);
    
    print("<hr>\nIf you find a machine for which this finger presents confusing\n");
    print("or misformatted information, please please e-mail the full machine\n");
    print("name to <em>webmaster@@mit.edu</em> mentioning the situation, and\n");
    print("we'll do what we can to make things work nicely.");
}

sub is_mitdir {
    local($h) = @@_;
    $h =~ tr/[A-Z]/[a-z]/;

    $h = $1 if ($h =~ /(.+)\.mit\.edu/);

    (($h eq 'mit') || ($h eq 'mit.edu') || ($h eq 'mitdir-too') || ($h eq 'mitdir') || ($h eq '18.72.2.1') || ($h eq '18.72.0.25') || ($h eq 'e40-dungeon-4') || ($h eq 'e40-dungeon-6'));
}

sub forward_mitdir {
    local($who) = @@_;
	print("Location: gopher://mitdir.mit.edu:79/-$who\n\n");
}

sub finger_candy {

    # if you change the name of the finger gateway at this server, change this
    # variable to match.
    $finger_service = "finger";

    local($where, $who, $hostname) = @@_;

    if($where){

	$where =~ tr/[A-Z]/[a-z]/;

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


	# **** Raw IP addresses -- provide a hostname if possible.
	# **** Gnu fingerd. (like netcom)
	# **** Timeout
	
	if (&is_mitdir($hostname)) {
	    print("You have fingered at one of MIT's registrar-information\n");
	    print("finger-servers. This isn't necessarily a bad thing, but\n");
	    print("you're going about it the wrong way. There is a much better\n");
	    print("<a href=\"gopher://gopher.mit.edu/11/mitdir\"><strong>finger interface</strong></a>\n");
	    print("to this server database.\n<p>");
	    return;
	}

	if ( $where !~ /[\d{1,3}\.]{3}\d{1,3}/) {
	    ($name,$aliases,$type,$len,@@addrs) = gethostbyname($where);
	}
	else {
	    ($name,$aliases,$type,$len,@@addrs) = gethostbyaddr(pack('C4', split(/\./, $where)), 2);
	}

	if ((! @@addrs) || (@@addrs[0] eq "")) {
	    print "<strong>Couldn't resolve host $where</strong>\n";
	    return;
	}
    
	if ($#addrs != 0) {
	    print("There is more than one actual machine which belongs\n");
	    print("to this hostname. Select any of these hostnames at\n");
	    print("which to finger:\n<ul>\n");

	    if (($hostname eq "athena-dec.dialup") || ($hostname eq "dec.dialup") || ($hostname eq "athena-vax.dialup") || ($hostname eq "vax.dialup") || ($hostname eq "athena-express.dialup") || ($hostname eq "express.dialup") || ($hostname eq "athena-x.dialup") || ($hostname eq "athena.dialup")) {

		grep( &get_dialup_line($_), @@addrs);
	    }
	    else {
		grep( &multi_finger_print($_), @@addrs);
	    }
	    print("</ul>\n");
	    return
	}

	# Make the socket filehandle.

	if (! socket(S, 2, 1, 6)) {
	    print"Cannot open socket for finger because:\n";
	    print ($!, "\n");
	    return;
	}
	
	if (! connect(S,pack('S n a4 x8', 2, 79, @@addrs[0]))) {
	    if ($! eq "Connection refused") {
		print "<strong>Finger connection refused at $where.</strong>";
	    }
	    else {
		print"Cannot connect to finger socket at remote machine because:\n";
		print($!, "\n");
	    }
	    return;
	}

	# Set socket to be command buffered.

	select(S); $| = 1; select(STDOUT);

	# send query

	print S "$who\r\n";

	$fing = join('', <S>);
        $fing =~ s/</\&lt\;/g;
        $fing =~ s/>/\&gt\;/g;


	if ($who || (( ! $who ) && (($hostname eq 'athena') || ($hostname eq 'athena-tm') || ($hostname eq 'mit-athena') || ($hostname eq '18.72.2.1') || ($hostname eq '18.72.0.39') || ($hostname eq 'e40-dungeon-1')))) {
	    $data = $fing;
	}
	else {
	    $fing =~ /(Machine type[^\n]+\n)?((Load information[^\n]+)\n)?(([^\n]+load average:[^\n]+)\n\r\n)?/;

	    $finger_mach_info=$1;
	    $load_info_1=$3;
	    $load_info_2=$5;
	    $rest=$';

	    $rest =~ /(Login.*\n)/;
	    
	    $stuff  = $`;
	    $banner = $1;
	    $data = $';

	    if (! $who) {
		$data =~ s#^(\S+)#<a href="http://www.mit.edu:8001/$finger_service?\1@@$where"><strong>\1</strong></a>#g;
		$data =~ s#\n(\S+)#\n<a href="http://www.mit.edu:8001/$finger_service?\1@@$where"><strong>\1</strong></a>#g;
	    }
	}
	
	if (($banner) && (! $no_one)) {
	    $data =~ s#No one logged on#<em>No one logged on</em>#;

	    print("<p>$finger_mach_info\n") if $finger_mach_info;
	    print("<p><dl compact><dt>$load_info_1<dd>$load_info_2</dl>\n") if $load_info_1;
	    print("<pre>$stuff</pre>\n") if $stuff;
	    print("<pre><em>$banner</em></pre>\n") if $banner;
	    $data =~ s/\r\n/\n/g;
	    print("<pre>\n$data</pre>\n");
	}
	else {
	    if ($fing =~ /\s*(No one logged on)\s*/) {
		print ("<pre>", $`, "</pre>") if $`;
		print "<em>No one logged on</em>";
		print ("<pre>", $', "</pre>") if $';
	    }
	    else {
		$fing =~ s/\r\n/\n/g;
		print("<pre>$fing</pre>");
	    }
	}
    }
    else {
	print("<h1>Enter finger args</h1>\n");
	print <<"end_msg";
This is the text that you're supposed to see if you didn't 
supply any arguments to the finger gateway. An example
connection would be good, but I'm not sure which one we
really want to use. www.mit.edu ? I don't think that would
be a good place. But I'm not sure where we *could* default.
(shrug)
end_msg
    }
}

sub multi_finger_print {
    local($arg) = @@_;
    $numeric_IP = join('.', unpack('C4', $arg));
    $where = (gethostbyaddr($arg, 2))[0];
    print("<li><a href=\"http://www.mit.edu:8001/");
    print("$finger_service?", ($who)?"$who@@":"", "$numeric_IP\">");
    print(($who)?"$who@@":"", "$where ($numeric_IP)</a>\n");
}

sub get_dialup_line {

    local($address) = @@_;

    $where = (gethostbyaddr($address, 2))[0];

    if (! $where) {
	print "<strong>$arg1 is not a valid host.</strong><p>\n";
	return;
    }

    $that = pack('S n a4 x8', 2, 79, $address);
    
    # Make the socket filehandle.

    if (! socket(S, 2, 1, 6)) {
	print"Cannot open local socket for finger.\n";
	return;
    }
	
    if (! connect(S,$that)) {
	if ($! eq "Connection refused") {
	    print "<strong>Finger connection refused at $where.</strong>\n";
	}
	else {
	    print"Cannot connect to finger socket at $where.</strong>\n";
	}
	return;
    }

    # Set socket to be command buffered.
    
    select(S); $| = 1; select(STDOUT);

    # send query

    print S "\r\n";

    <S> =~ /Machine type is\s+(\S+)/;
    $machtype = $1;
    <S>;
    <S> =~ /up\s+(.*),\s+(\d+)\s+users.*average:\s+([0-9\.]+),/;
    $uptime = $1;
    $nusers = $2;
    $load = $3;
    $uptime =~ s/\s+/ /g;

    print ("<li><a href=\"http://www.mit.edu:8001/finger?$where\">$where</a>\n");

    print ("<ul>\n<li>Users: ", $nusers, "\n<li>Load average: ", $load);
    print ("\n<li>Uptime: ", $uptime, "\n</ul>\n");

    1;
}

a11 1

@
