<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#!/var/stable-perl5/bin/perl
# Finger gateway
# $Id: finger.pl,v 1.22 2008/01/04 00:52:04 root Exp $
# Eric Mumpower (nocturne@mit.edu) March '94
#
# Matthew Gray (mkgray@mit.edu) June '94 Converted to CGI

use Socket;

package finger;

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

    if ($arg !~ /@/ &amp;&amp; $arg =~ /%40/) {
	$encodedat = index($arg, "%40");
	$newarg = "";
	for ($i = 0; $i &lt; $encodedat; ++$i) {
	    $newarg .= substr($arg, $i, 1);
	}
	$newarg .= "@";
	for ($i = $encodedat + 3; $i &lt; length($arg); ++$i) {
	    $newarg .= substr($arg, $i, 1);
	}
	$arg = $newarg;
    }

    ($who,$where) = ($arg =~ /^(.*)@([^@]*)$/);

    $noargs = "yup" unless $arg;

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

    $where = $arg unless $where;

    if ($who &amp;&amp; &amp;is_mitdir($where)) {
	&amp;forward_mitdir($who);
	return;
    }

    print("Content-Type: text/html\n\n");	

    $pre_string = "@" unless $arg =~ /@/;

    print &lt;&lt;END;
&lt;html&gt;&lt;head&gt;&lt;isindex&gt;
&lt;title&gt;Finger $pre_string$arg&lt;/title&gt;&lt;/head&gt;
&lt;body&gt;
END
    if ($noargs) {
	print &lt;&lt;END;
&lt;h2&gt;Enter the arguments for finger.&lt;/h2&gt;
Arguments should be in one of these formats:
&lt;ul&gt;&lt;li&gt;&lt;code&gt;&lt;em&gt;machinename&lt;/em&gt;&lt;/code&gt;&lt;/li&gt;
&lt;li&gt;&lt;code&gt;&lt;em&gt;username&lt;/em&gt;@&lt;em&gt;machinename&lt;/em&gt;&lt;/code&gt;&lt;/li&gt;
&lt;/ul&gt;&lt;hr&gt;
END
    }
    print "&lt;h1&gt;Finger $pre_string$arg&lt;/h1&gt;\n";

    &amp;finger'finger_candy($where, $who);
    
    print &lt;&lt;END;
&lt;hr&gt;

Connections that are refused ("&lt;b&gt;connection refused&lt;/b&gt;") are usually
a product of the system you are fingering, &lt;b&gt;not&lt;/b&gt; of our gateway.
Contact the maintainers of the site you are trying to finger if you
get a connection refused.  See our &lt;a href="/faq/finger.html"&gt;finger
gateway FAQ&lt;/a&gt; for more information.  Note in particular that AOL
does not allow finger requests. &lt;p&gt;

Otherwise, if you find a machine for which this finger presents
confusing or misformatted information, please please e-mail the full
machine name to &lt;em&gt;stuffmaster\@mit.edu&lt;/em&gt; mentioning the situation,
and we'll do what we can to make things work nicely.

&lt;/body&gt;&lt;/html&gt;
END
}

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: http://web.mit.edu/search.html\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;
	}

	if (($hostname =~ "^aol.com\$") || ($hostname =~ "\\.aol.com")) {
	    print &lt;&lt;END;
Sorry.  Our finger gateway won't work with AOL because AOL doesn't
accept finger connections.  &lt;p&gt;
END
	    return;
	}

	# **** Raw IP addresses -- provide a hostname if possible.
	# **** Gnu fingerd. (like netcom)
	# **** Timeout
	
	if (&amp;is_mitdir($hostname)) {
	    print &lt;&lt;END;
You have fingered at one of MIT's registrar-information
finger-servers. This isn't necessarily a bad thing, but
you're going about it the wrong way. There is a much better
&lt;a href="http://web.mit.edu/cwis/www/mitdir/"&gt;&lt;strong&gt;finger
interface&lt;/strong&gt;&lt;/a&gt; to this server database.&lt;p&gt;
END
	    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 "&lt;strong&gt;Couldn't resolve host $where&lt;/strong&gt;\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&lt;ul&gt;\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( &amp;get_dialup_line($_), @addrs);
	    }
	    else {
		grep( &amp;multi_finger_print($_), @addrs);
	    }
	    print("&lt;/ul&gt;\n");
	    return
	}

	$sockaddr = 'S n a4 x8';
	
	# The port number for finger is 79
	$portnum = 79;

	($name, $aliases, $proto) = getprotobyname("tcp");
	# I don't think this next line is necessary anymore.
	# $packwhere = pack($sockaddr, &amp;main'AF_INET, $portnum, @addrs[0]);

	# Make the socket filehandle.

	if (! socket(S, &amp;main'AF_INET, &amp;main'SOCK_STREAM, $proto)) {
	    print"Cannot open socket for finger because:\n";
	    print ($!, "\n");
	    return;
	}

	$connected = 0;
	eval {
	  local $SIG{ALRM} = sub { die "alarm\n";};
          alarm(3);	
	  if (! connect(S,pack($sockaddr, &amp;main'AF_INET, $portnum, @addrs[0]))) {
	      if ($! eq "Connection refused") {
		  print "&lt;strong&gt;Finger connection refused at $where.&lt;/strong&gt;";
	      }
	      else {
	  	print"Cannot connect to finger socket at remote machine because:\n";
		print($!, "\n");
   	      }
	  } else {
              $connected = 1;
          }

	# Set socket to be command buffered.

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

	# send query

	print S "$who\r\n";

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

	  alarm(0);
};
if ($@) {
print "Connection refused\n";
return;
}
	# remove nonprintable characters, hopefully.

	$fing =~ s/[^\s\040-\176]//g;

	if ($who || (( ! $who )
                     &amp;&amp; (($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+)#&lt;a href="/$finger_service?\1\@$where"&gt;&lt;strong&gt;\1&lt;/strong&gt;&lt;/a&gt;#g;
		$data =~ s#\n(\S+)#\n&lt;a href="/$finger_service?\1\@$where"&gt;&lt;strong&gt;\1&lt;/strong&gt;&lt;/a&gt;#g;
	    }
	}
	
	if (($banner) &amp;&amp; (! $no_one)) {
	    $data =~ s#No one logged on#&lt;em&gt;No one logged on&lt;/em&gt;#;

	    print("&lt;p&gt;$finger_mach_info\n") if $finger_mach_info;
	    print("&lt;p&gt;&lt;dl&gt;&lt;dt&gt;$load_info_1&lt;dd&gt;$load_info_2&lt;/dl&gt;\n") if $load_info_1;
	    print("&lt;pre&gt;$stuff&lt;/pre&gt;\n") if $stuff;
	    print("&lt;pre&gt;&lt;em&gt;$banner&lt;/em&gt;&lt;/pre&gt;\n") if $banner;
	    $data =~ s/\r\n/\n/g;
	    print("&lt;pre&gt;&lt;tt&gt;\n$data&lt;/tt&gt;&lt;/pre&gt;\n");
	}
	else {
	    if ($fing =~ /\s*(No one logged on)\s*/) {
		print ("&lt;pre&gt;", $`, "&lt;/pre&gt;") if $`;
		print "&lt;em&gt;No one logged on&lt;/em&gt;";
		print ("&lt;pre&gt;", $', "&lt;/pre&gt;") if $';
	    }
	    else {
		$fing =~ s/\r\n/\n/g;
		print("&lt;pre&gt;$fing&lt;/pre&gt;");
	    }
	}
    }
    else {
	print("&lt;h1&gt;Enter finger args&lt;/h1&gt;\n");
	print &lt;&lt;END;
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
    }
}

sub multi_finger_print {
    local($arg) = @_;
    $numeric_IP = join('.', unpack('C4', $arg));
    $where = (gethostbyaddr($arg, 2))[0];
    print("&lt;li&gt;&lt;a href=\"/");
    print("$finger_service?", ($who)?"$who@":"", "$numeric_IP\"&gt;");
    print(($who)?"$who@":"", "$where ($numeric_IP)&lt;/a&gt;\n");
}

sub get_dialup_line {

    local($address) = @_;

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

    if (! $where) {
	print "&lt;strong&gt;$arg1 is not a valid host.&lt;/strong&gt;&lt;p&gt;\n";
	return;
    }
    
    $portnum = 79;

    
    # Make the socket filehandle.

    $sockaddr = 'S n a4 x8';
    ($name, $aliases, $proto) = getprotobyname("tcp");

    if (! socket(S, &amp;main'AF_INET, &amp;main'SOCK_STREAM, $proto)) {
	print"Cannot open local socket for finger: $!.\n";
	return;
    }
	
    if (! connect(S, pack('S n a4 x8', &amp;main'AF_INET, $portnum, $address))) {
	if ($! eq "Connection refused") {
	    print "&lt;strong&gt;Finger connection refused at $where.&lt;/strong&gt;\n";
	}
	else {
	    print"Cannot connect to finger socket at $where.&lt;/strong&gt;\n";
	}
	return;
    }

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

    # send query

    print S "\r\n";

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

    print ("&lt;li&gt;&lt;a href=\"/finger?$where\"&gt;$where&lt;/a&gt;\n");

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

    1;
}

sub decode {
    local($tmp) = @_;
    $tmp =~ s/\+/ /g;
    $tmp =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig;
    $tmp;
}

1;
</pre></body></html>