#!/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 !~ /@/ && $arg =~ /%40/) { $encodedat = index($arg, "%40"); $newarg = ""; for ($i = 0; $i < $encodedat; ++$i) { $newarg .= substr($arg, $i, 1); } $newarg .= "@"; for ($i = $encodedat + 3; $i < 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 && &is_mitdir($where)) { &forward_mitdir($who); return; } print("Content-Type: text/html\n\n"); $pre_string = "@" unless $arg =~ /@/; print < Finger $pre_string$arg END if ($noargs) { print <Enter the arguments for finger. Arguments should be in one of these formats:
  • machinename
  • username@machinename
END } print "

Finger $pre_string$arg

\n"; &finger'finger_candy($where, $who); print < Connections that are refused ("connection refused") are usually a product of the system you are fingering, not of our gateway. Contact the maintainers of the site you are trying to finger if you get a connection refused. See our finger gateway FAQ for more information. Note in particular that AOL does not allow finger requests.

Otherwise, if you find a machine for which this finger presents confusing or misformatted information, please please e-mail the full machine name to stuffmaster\@mit.edu mentioning the situation, and we'll do what we can to make things work nicely. 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 < END return; } # **** Raw IP addresses -- provide a hostname if possible. # **** Gnu fingerd. (like netcom) # **** Timeout if (&is_mitdir($hostname)) { print <finger interface to this server database.

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 "Couldn't resolve host $where\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

    \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("
\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, &main'AF_INET, $portnum, @addrs[0]); # Make the socket filehandle. if (! socket(S, &main'AF_INET, &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, &main'AF_INET, $portnum, @addrs[0]))) { if ($! eq "Connection refused") { print "Finger connection refused at $where."; } 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('', ); $fing =~ s//\>\;/g; alarm(0); }; if ($@) { print "Connection refused\n"; return; } # remove nonprintable characters, hopefully. $fing =~ s/[^\s\040-\176]//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+)#\1#g; $data =~ s#\n(\S+)#\n\1#g; } } if (($banner) && (! $no_one)) { $data =~ s#No one logged on#No one logged on#; print("

$finger_mach_info\n") if $finger_mach_info; print("

$load_info_1
$load_info_2
\n") if $load_info_1; print("
$stuff
\n") if $stuff; print("
$banner
\n") if $banner; $data =~ s/\r\n/\n/g; print("
\n$data
\n"); } else { if ($fing =~ /\s*(No one logged on)\s*/) { print ("
", $`, "
") if $`; print "No one logged on"; print ("
", $', "
") if $'; } else { $fing =~ s/\r\n/\n/g; print("
$fing
"); } } } else { print("

Enter finger args

\n"); print <"); print(($who)?"$who@":"", "$where ($numeric_IP)\n"); } sub get_dialup_line { local($address) = @_; $where = (gethostbyaddr($address, 2))[0]; if (! $where) { print "$arg1 is not a valid host.

\n"; return; } $portnum = 79; # Make the socket filehandle. $sockaddr = 'S n a4 x8'; ($name, $aliases, $proto) = getprotobyname("tcp"); if (! socket(S, &main'AF_INET, &main'SOCK_STREAM, $proto)) { print"Cannot open local socket for finger: $!.\n"; return; } if (! connect(S, pack('S n a4 x8', &main'AF_INET, $portnum, $address))) { if ($! eq "Connection refused") { print "Finger connection refused at $where.\n"; } else { print"Cannot connect to finger socket at $where.\n"; } return; } # Set socket to be command buffered. select(S); $| = 1; select(STDOUT); # send query print S "\r\n"; =~ /Machine type is\s+(\S+)/; $machtype = $1; ; =~ /up\s+(.*),\s+(\d+)\s+users.*average:\s+([0-9\.]+),/; $uptime = $1; $nusers = $2; $load = $3; $uptime =~ s/\s+/ /g; print ("

  • $where\n"); print ("
      \n
    • Users: ", $nusers, "\n
    • Load average: ", $load); print ("\n
    • Uptime: ", $uptime, "\n
    \n"); 1; } sub decode { local($tmp) = @_; $tmp =~ s/\+/ /g; $tmp =~ s/%([\da-f]{1,2})/pack(C,hex($1))/eig; $tmp; } 1;