#!/usr/bin/perl -w
#-----------------------------------------------------------------------------
#
# Copyright (C) 2000 Ryan C. Gordon (icculus@icculus.org)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#-----------------------------------------------------------------------------
#-----------------------------------------------------------------------------
# Revision history:
# 1.0.0 : First release
# 1.0.2 : Minor bugfixes.
# 1.1.0 : Prints version in
, more customizable, optionally allows
# fingering to arbitrary sites for use as a web interface to finger,
# supports VirtualHost sites, better error output.
# 1.1.1 : Highlights URLs and email addresses.
# 1.2.0 : Changed email address. Moved script name to $script_link.
# Reads [title], [url], and [img] tags.
# 1.2.1 : [center] and [font] tags added.
# 1.3.0 : (Yes, I went up two minors in one day.) Plain text output from
# the command line.
# 1.3.1 : Added bold, italics, and underlines ([b][u][i][/i][/u][/b])
# Text output gets the witty remark, etc, too.
# 1.3.2 : Added "?format=n" argument to the web interface, and fixed a
# formatting bug with the [center] tag in Opera.
# 1.3.3 : [link] tags spit out URL in non HTML formatted version. Handles
# newlines in [center] tags for Opera. Fixed bug where HTML
# formatting was enabled in the regular finger interface.
# 1.3.4 : Bugfixes to the "&" -> "&" substitution and the URL
# highlighter. Added almost useless debugging facility.
# 1.3.5 : More debugging output, and randomized titles. Debugging can be
# enabled/disabled in the URL.
# 1.3.6 : Added [wittyremark] tag at a user's request. [title] tags on a
# line by themselves have the newline removed, so that 50 random
# titles don't end up with 50 blank lines in the output; this is
# true for [wittyremark], too. Email address auto-URLifying can
# handle addresses with a '.' at the end, for example at the end
# of a sentence. Changed the ending output, and made the credits
# (formerly $script_link and hardcoded) more configurable.
# 1.3.7 : Removed '\r' chars from textmode footer.
# 1.3.8 : Fixes for Lynx text browser.
# 1.3.9 : Allows use of [defaultsection] and [section=""][/section] tags.
# This is hacky right now. DO NOT USE THESE TAGS.
# 1.3.10 : Modified the URL-detecting regexp to be a little more accurate.
#-----------------------------------------------------------------------------
# TODO: Let [img] tags nest inside [link] tags.
# TODO: Make [center] tags attempt to format plain text.
use strict; # don't touch this line, nootch.
use warnings; # don't touch this line, either.
#-----------------------------------------------------------------------------#
# CONFIGURATION VARIABLES: Change to suit your needs... #
#-----------------------------------------------------------------------------#
# Version of IcculusFinger. Change this if you are forking the code.
my $version = "v1.3.10";
# This is the default title for the webpage. The user can override it with
# the [title] tag in their .plan file.
my $title = "IcculusFinger $version";
# Alternately, you can populate this array with strings, and IcculusFinger
# will randomly pick one at runtime. Note that the user's [title] tags also
# land in here, so you are interfering with their ability to override the
# title if you add to this array. The $title variable above is used only if
# this array is empty, and thus gives you a comfortable default in case the
# user doesn't supply her own title. Do as you will.
my @title_array;
# Location where the server can find the finger client it will be using
# to get information. This string is executed and what it writes to stdout
# is read in by this script.
my $fingerprog = "/usr/local/bin/afinger --portname=fingertags";
# Uncomment this to always do finger requests to the same host.
# Define which host the finger request goes to. If you don't define $host,
# then users may finger any system on the internet by specifying a hostname:
# user=dimwit@doofus.com, for example. Not setting $host at all like that
# could leave a mild exploit available.
# This is ignored if run from the command line.
#my $host = undef; # Makes this script work as a web interface to finger.
#my $host = "icculus.org"; # limit queries to users@icculus.org
my $host = $ENV{SERVER_NAME}; # This is good for VirtualHost setups.
# This is printed after the credits at the bottom. Change it to whatever you
# like. Do not use HTML. You can specify an empty string (""), but undef
# doesn't fly here. The user can change this with [wittyremark] tags.
my $wittyremark = "Stick it in the camel and go.";
# Alternately, you can populate this array with strings, and IcculusFinger
# will randomly pick one at runtime. Note that the user's [wittyremark] tags
# also land in here, so you are interfering with their ability to override
# if you add to this array. The $wittyremark variable above is used only if
# this array is empty, and thus gives you a comfortable default in case the
# user doesn't supply her own content. Do as you will.
my @wittyremark_array;
# you can screw up your output with this, if you like.
# in the web interface, you can use "?debug=1" to enable this without
# changing the source.
my $debugging = 0;
# This is the URL to where the script can be obtained. Feel free to change
# it if you you are forking the code, but unless you've got a good reason,
# I'd appreciate it if you'd leave my (ahem) official IcculusFinger webpage
# in this variable. Set it to undef to not supply a link at all in the
# final HTML output.
#my $scripturl = undef;
#my $scripturl = "/misc/finger.pl";
my $scripturl = "http://icculus.org/IcculusFinger/";
# This is only used in the HTML-formatted output.
# I'd prefer you leave this be, but change it if you must.
my $html_credits = (defined $scripturl) ?
"Powered by IcculusFinger $version" :
"Powered by IcculusFinger $version" ;
# This is only used in the plaintext-formatted output.
# I'd prefer you leave this be, but change it if you must.
my $text_credits = "Powered by IcculusFinger $version" .
((defined $scripturl) ? " ($scripturl)" : "");
#-----------------------------------------------------------------------------#
# The rest is probably okay without you laying yer dirty mits on it. #
#-----------------------------------------------------------------------------#
my $is_web_interface = 0;
my $do_html_formatting = 0;
my $browser = "";
my $user;
my $dbgnl = "\n";
my $wanted_section = undef;
sub output_start {
return if not $is_web_interface;
print <<__EOF__;
$title
__EOF__
}
sub output_ending {
# TODO: Make that ------ line fit the length of the strings.
if (not $is_web_interface) {
print "-------------------------------------------------------------------------\n";
print "$text_credits\n";
print "$wittyremark\n\n";
return;
}
print <<__EOF__;
$html_credits
$wittyremark
__EOF__
}
# Mainline.
$host =~ tr/A-Z/a-z/ if defined $host;
if ((defined $ENV{GATEWAY_INTERFACE}) and ($ENV{GATEWAY_INTERFACE} ne "")) {
$is_web_interface = 1;
$do_html_formatting = 1;
$dbgnl = "
\n";
if ((defined $ENV{HTTP_USER_AGENT}) and ($ENV{HTTP_USER_AGENT} ne "")) {
$browser = $ENV{HTTP_USER_AGENT};
}
my $QueryString = $ENV{QUERY_STRING};
if ($QueryString =~ /user=(.*)/) {
$user = $1;
$user =~ s/&.*//;
$user =~ tr/A-Z/a-z/;
}
if ($QueryString =~ /format=(.*)/) {
$do_html_formatting = $1;
$do_html_formatting =~ s/&.*//;
$do_html_formatting =~ tr/A-Z/a-z/;
}
if ($QueryString =~ /debug=(.*)/) {
$debugging = $1;
$debugging =~ s/&.*//;
$debugging =~ tr/A-Z/a-z/;
}
if ($QueryString =~ /section=(.*)/) {
$wanted_section = $1;
$wanted_section =~ s/&.*//;
$wanted_section =~ tr/A-Z/a-z/;
}
# !!! FIXME: This is a pretty lame solution.
if ($browser =~ /Lynx/) {
$do_html_formatting = 0;
}
} else { # regular request over finger protocol; no HTML, etc.
$dbgnl = "\n";
$user = shift;
if (not defined $user) {
print("USAGE: $0 \n");
exit 42;
}
$user = "$user\@localhost" if (not $user =~ /\@/);
$is_web_interface = 0;
$do_html_formatting = 0;
}
my $requested_host = undef;
if ((defined $user) && ($user =~ s/\@(.*)//)) {
$requested_host = $1;
$requested_host =~ tr/A-Z/a-z/;
}
my $errormsg = undef;
if (not defined $user) {
$errormsg = "No user specified.";
} elsif ((not defined $host) and (not defined $requested_host)) {
$errormsg = "No host specified.";
} elsif ((defined $host) and (defined $requested_host)) {
if (($is_web_interface) and ($host ne $requested_host)) {
$errormsg = "You aren't permitted to specify a hostname, just a user.";
}
} elsif (length($user) > 20) {
# The 20 char limit is just for safety against potential buffer overflows
# in finger servers, but it's more or less arbitrary.
# !!! TODO FIXME: Check for bogus characters in username/host.
$errormsg = "Bogus user specified.";
}
if (defined $errormsg) {
output_start();
print " " if $is_web_interface;
print "$errormsg";
print "
" if $is_web_interface;
print "\n";
} else {
print("Content-type: text/html\n\n\n") if $is_web_interface;
$host = $requested_host if not defined $host;
if ($debugging) {
print("WARNING: Debugging is enabled in this finger request!$dbgnl");
print("fingering $user at $host ...$dbgnl");
print("HTML formatting: $do_html_formatting ...$dbgnl");
print("Is web interface: $is_web_interface ...$dbgnl");
print("Browser: $browser ...$dbgnl");
}
if (not open(FINGER, "$fingerprog $user\@$host |")) {
output_start();
print(" Couldn't run finger program: $!.
\n\n");
} else {
my $output_text = "";
while () {
$output_text = $output_text . $_;
}
close(FINGER);
if ($is_web_interface) {
# HTMLify some common characters...
1 while ($output_text =~ s/</s);
1 while ($output_text =~ s/>/>/s);
}
# Select a section.
# !!! FIXME: Filter out all [defaultsection] tags and take the last
# !!! FIXME: one...or maybe a random one? Hhm.
if (not defined $wanted_section) {
if ($output_text =~ s/\[defaultsection=\"(\w*)\"\](\r\n|\n|\b)//) {
$wanted_section = $1;
if ($debugging) {
print("default section: $wanted_section ...$dbgnl");
}
}
} else {
# ditch this tag...
$output_text =~ s/\[defaultsection=\"(\w*)\"\](\r\n|\n|\b)//is;
}
if (defined $wanted_section) {
if ($debugging) {
print("Using specific section: $wanted_section ...$dbgnl");
}
# !!! FIXME: Why isn't the substitution working? I need to assign $2 directly for some reason...
if ($output_text =~ s/\[section=\"$wanted_section\"\](\r\n|\n|\b)(.*?)\[\/section\](\r\n|\n|\b)/$2/is) {
$output_text = $2;
} else {
$output_text = "section \"$wanted_section\" not found.\n";
}
} else {
1 while ($output_text =~ s/\[section=\".*?\"\](.*?)\[\/section\](\r\n|\n|\b)/$1/is);
}
while ($output_text =~ s/\[title\](.*?)\[\/title\](\r\n|\n|\b)//is) {
push @title_array, $1;
}
# Change [title][/title] tags.
while ($output_text =~ s/\[title\](.*?)\[\/title\](\r\n|\n|\b)//is) {
push @title_array, $1;
}
# Change [wittyremark][/wittyremark] tags.
while ($output_text =~ s/\[wittyremark\](.*?)\[\/wittyremark\](\r\n|\n|\b)//is) {
push @wittyremark_array, $1;
}
# Change [b][/b] tags.
if ($do_html_formatting) {
1 while ($output_text =~ s/\[b](.*?)\[\/b\]/$1<\/b>/is);
} else {
1 while ($output_text =~ s/\[b](.*?)\[\/b\]/$1/is);
}
# Change [i][/i] tags.
if ($do_html_formatting) {
1 while ($output_text =~ s/\[i](.*?)\[\/i\]/$1<\/i>/is);
} else {
1 while ($output_text =~ s/\[i](.*?)\[\/i\]/$1/is);
}
# Change [u][/u] tags.
if ($do_html_formatting) {
1 while ($output_text =~ s/\[u](.*?)\[\/u\]/$1<\/u>/is);
} else {
1 while ($output_text =~ s/\[u](.*?)\[\/u\]/$1/is);
}
# Change [center][/center] tags.
if ($do_html_formatting) {
if ($browser =~ /Opera/) {
while ($output_text =~ /\[center](.*?)\[\/center\]/is) {
my $buf = $1;
1 while ($buf =~ s/\n/
/s);
$output_text =~ s/\[center](.*?)\[\/center\]/<\/pre>$buf<\/code><\/center>/is;
}
} else {
1 while ($output_text =~ s/\[center](.*?)\[\/center\]/$1<\/center>/is);
}
} else {
1 while ($output_text =~ s/\[center](.*?)\[\/center\]/$1/is);
}
# Change [font][/font] tags.
if ($do_html_formatting) {
1 while ($output_text =~ s/\[font (.*?)](.*?)\[\/font\]/$2<\/font>/is);
} else {
1 while ($output_text =~ s/\[font (.*?)](.*?)\[\/font\]/$2/is);
}
# Change [link][/link] tags.
if ($do_html_formatting) {
1 while ($output_text =~ s/\[link=\"(.*?)\"\](.*?)\[\/link\]/$2<\/a>/is);
} else {
1 while ($output_text =~ s/\[link=\"(.*?)\"\](.*?)\[\/link\]/$2 \[$1\]/is);
}
# Change [img][/img] tags.
if ($do_html_formatting) {
1 while ($output_text =~ s/\[img=\"(.*?)\"\](.*?)\[\/img\]//is);
} else {
1 while ($output_text =~ s/\[img=\"(.*?)\"\](.*?)\[\/img\]/$2/is);
}
if ($do_html_formatting) {
# try to make URLs into hyperlinks in the HTML output.
1 while ($output_text =~ s/(?)\b([a-zA-Z]+?:\/\/[-~=\w&\.\/?]+)/$1<\/a>/);
# try to make email addresses into hyperlinks in the HTML output.
1 while ($output_text =~ s/\b(?)\b([\w\.]+?\@[\w\.]+)(\b|\.)/$1<\/a>/);
# HTMLify newlines.
#1 while ($output_text =~ s/\r//s);
#1 while ($output_text =~ s/(?)\n/
\n/s);
# this has to be done after any possible URL detection...
# convert ampersands for the browser.
1 while ($output_text =~ s/(?)\&(?!amp)/&/s);
}
# Pick a random title...
if ($debugging) {
my $x;
$x = $#title_array + 1;
print("Number of titles: $x ...$dbgnl");
print(" titles:$dbgnl");
foreach (@title_array) {
print(" - [$_]$dbgnl");
}
$x = $#wittyremark_array + 1;
print("Number of witty remarks: $x ...$dbgnl");
print(" witty remarks:$dbgnl");
foreach (@wittyremark_array) {
print(" - [$_]$dbgnl");
}
}
if ($debugging) {
print("Actual finger output begins below line...$dbgnl");
print("---------------------------------------------------$dbgnl");
}
if ($#title_array >= 0) {
$title = $title_array[int(rand($#title_array + 1))];
}
if ($#wittyremark_array >= 0) {
$wittyremark = $wittyremark_array[int(rand($#wittyremark_array + 1))];
}
output_start();
if ($is_web_interface) {
print(" Finger info for $user\@$host...
\n");
#print("
\n\n");
print("
\n\n\n\n");
print("$output_text");
#print("
\n\n");
print("\n
\n");
} else {
print("$title\n\n");
print("$output_text\n");
}
}
}
output_ending();
exit 0;
# end of finger.pl ...