#!/local/bin/perl
# finger.pl -- WWW to finger gateway (with faces support)
#
#This has been converted from a plexus 'include' to a CGI-bin and had
#a number of modifications suited for this interface by
# bdowling@ccs.neu.edu
# Marc VanHeyningen March 1993
#
# This is a simple gateway into finger space from HTTP.
# It is intended to be fast and not to laden the HTTP server, which is
# why it uses sockets within perl rather than simply execing finger.
#------------------------------ Configuration ------------------------------
#The domain name is used to report the 'domain' for which a user is actually
#in. This is normally how you would want email addresses to 'local' users
#to look like.
$DOMAIN_NAME = 'wickedmind.com';
#local_fingerhost is where the finger query should default when query is local
$LOCAL_FINGERHOST = 'fingerd.wickedmind.com';
#faces_path is the full-real path of where the faces tree exists.
#This should be an array. These should specify the toplevel
#directories of a 'facesdir' style tree of Faces.
@faces_path = (
'/home/www/CCS/html/pictures/faces'
);
#faces_url is the begining of the URL of a server that has access to the above
#faces. This is normally the mapping the server understands pointing to the
#directory above. (if it is found below the $FACES_PATH toplevel directory)
#The '/dom/hostname/username/face.xbm' will be appended onto this.
#NOTE: this array corresponds to the array above, thus each absolute path from
# the @faces_path should have a corresponding URL in this array.
@faces_url = (
'/pictures/faces'
);
#This breaks away from the standard facesdir scheme by allowing you to support
#different image formats in the same facesdir directory. These filenames
#are tested for existance in each @faces_path directory, the first one is
#returned.
@faces_filenames = (
'face.gif',
'face.xbm'
);
#Example finger address, used in examples of how to use gateway.
#These are simply appended to the SCRIPT_NAME, so they need to contain
#'?' or '/L?'
@example_usage = (
'/L?bdowling', # Long format
'?remy', # Short format
'/L?coke@xcf.berkeley.edu'
);
#-------------------------- End of Configuration --------------------------
#You may wish to modify the paragraphs printed when no real queries are
#given, other than that most of this needs no further configuration.
#The following should really come from socket.ph to make it more portable,
#but having it here makes it a little more efficient and 'safe'.
$SOCKADDR = 'S n a4 x8';
eval 'sub AF_INET {2;}';
eval 'sub SOCK_STREAM {1;}';
$fingerwho = $ENV{'QUERY_STRING'};
print <<"EOT";
Content-type: text/html
EOT
if ($ENV{'PATH_INFO'} =~ m:/USAGE:) {
print <<"EOT";
Finger Gateway (Extended Usage)
Constructing URLs
You can construct URLs pointing to this gateway to 'automatically'
finger a certain email address. This gateway has two forms, a
short and long format as follows:
- short format:
-
Available via the URL http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}?[address]
- long format:
-
Available via the URL http://$ENV{'SERVER_NAME'}$ENV{'SCRIPT_NAME'}/L?[address]
Addresses
[address] is an internet email address in the form:
For local users:
username
or for users remote to $DOMAIN_NAME:
username\@host.domain.dom
Examples
EOT
} elsif (!$fingerwho) {
print <<"EOT";
Finger Gateway
Finger Gateway
To use this gateway, enter an internet email address in the form:
For local users:
username
For users remote to $DOMAIN_NAME:
username\@host.domain.dom
EOT
unless ($ENV{'PATH_INFO'} =~ m:/L:) {
print <<"EOT";
This form will return short finger information for users
local to this site.
There is a form for
long format information.
EOT
} else {
print <<"EOT";
The current form will return long format finger information.
There is a form for
short format information.
EOT
}
print <<"EOT";
Extended Usage information is also
available.
EOT
} else {
&do_finger($ENV{'PATH_INFO'}, $ENV{'QUERY_STRING'});
}
print <<"EOT";
EOT
exit;
# ----------------------------------------------------------------------
sub do_finger {
local($options, $query) = @_;
local($user, $site, $fqdn, $aliases, $type, $len, $thataddr);
local($face, $bogus, $localfinger);
if($query =~ /^([;\w\-\.]+)@([\w\-\.]+)$/) {
$user = $1;
$site = $2;
} elsif($query =~ /^([^.]+)\.?/) { # Attempt local finger
$user = $1;
$site = $LOCAL_FINGERHOST;
$localfinger = 1;
}
($fqdn, $aliases, $type, $len, $thataddr) = gethostbyname($site);
if($fqdn eq "") {
$fqdn = $site;
$bogus = 1;
}
print "
\nFinger Gateway Response\n\n";
print "\n\n";
if(($face = &get_face_path($user, $fqdn)) ne "") {
print '
', "\n";
}
if ($localfinger && ($DOMAIN_NAME ne "")) {
print "$user@$DOMAIN_NAME";
} else {
print "$user@$fqdn";
}
foreach $face (&get_face_path("unknown", $fqdn)) {
print '', "\n";
}
print "
\n\n";
if($bogus) {
print "Unable to look up host '$fqdn'\n\n";
exit;
}
# Get the finger service information
($name, $aliases, $finger_port) = getservbyname("finger","tcp");
$finger_port = 79 unless $finger_port;
($name, $aliases, $proto) = getprotobyname("tcp");
($name, $aliases, $type, $len, $thisaddr) =
gethostbyname($ENV{'SERVER_NAME'});
# Get finger text
$this = pack($SOCKADDR, &AF_INET, 0, $thisaddr);
$that = pack($SOCKADDR, &AF_INET, $finger_port, $thataddr);
socket(FS, &AF_INET, &SOCK_STREAM, $proto) ||
print "Internal Error (socket: $!)\n";
bind(FS, $this) || print "Internal Error (bind: $!)\n";
connect(FS, $that) || print "Internal Error (connect: $!)\n";
$| = 1;
select((select(FS), $| = 1)[0]);
if ($options =~ /\/L/) { # Long format
print FS "/W $user\r\n";
} else {
print FS "$user\r\n";
}
while() { print; }
close(FS);
print "\n";
}
sub get_face_path {
local($user, $fqdn) = @_;
local(@hits, $filename, $faces_paths, $index, $faces_dir);
$user =~ tr/[A-Z]/[a-z]/;
$fqdn =~ tr/[A-Z]/[a-z]/;
($faces_paths = $FACES_PATH) =~ s/:/|/g; # Used in regex substitution below
$index = $[;
CHECK_DIR:
foreach $faces_dir (@faces_path) {
local(@fqdn) = reverse(split(/\./, $fqdn));
while($#fqdn >= $[) {
foreach (@faces_filenames) {
$filename = $faces_dir . "/" . join("/",@fqdn) . "/" .
$user . "/$_";
last if (-e $filename);
}
if(-e $filename) {
$filename =~ s/^$faces_dir/@faces_url[$index]/;
last CHECK_DIR unless wantarray;
push(@hits, $filename);
}
pop @fqdn;
}
last CHECK_DIR if(@hits);
$filename = "";
$index++;
}
return wantarray ? @hits : $filename;
}