#-----------------------------------------------------------------------------

#

#

# 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 series comments removed. Check the download archives if you need them.)

# 2.0.0 : Rewrite into an actual finger daemon. MILLIONS of changes.

# 2.0.1 : Fixed > and < conversion.

# MUCH better Lynx support (thanks, Chunky_Ks)

# changed \r and \n in protocol chatter to \015 and \012.

# Made syslogging optional.

# 2.0.4 : Added "noarchive" tagblocks and optional "plan written on"

# date/time output.

# cleanups, and enables taint mode (-T). Input can now timeout, so

# connections can't be hogged indefinitely anymore.

# just works from the command line. (Thanks to Gary "Chunky Kibbles"

# Briggs for the suggestion and patches!)

# 2.1.2 : Centering, based on 80 columns, in text output, digest is now

# sorted correctly. (Thanks, Gary!) Daemon now select()s on the

# listen socket so it can timeout and do the .planfile digest. Other

# cleanups and fixes in the daemon code.

# 2.1.3 : Make sure .plan digest doesn't skips users with identical update

# times.

# 2.1.4 : Moved plan digest hashing to separate function (hashplans()),

# added RSS digest (thanks, zakk!), and unified them in do_digests().

# 2.1.5 : Fixes from Gary Briggs: Fixed a regexp, made line before ending

# text format better, fixed centering on Lynx.

# 2.1.7 : Fix from Gary Briggs: do some text output for [i], [b], and [u]

# markup tags when not in HTML mode.

# 2.1.8 : Fix from Gary Briggs: IcculusFinger_planmove.pl now handles

# moves across filesystems.

# 2.1.9 : Security fixes in request parsing and syslog output by Chunky and

# Primer.

# situations, made image text more useful. Added support for

# stylesheets, and [entry][/entry] tags

# 2.1.11: Changes by Gary Briggs: Fixed div tag placement in $embed

# and plaintext

# 2.1.13: RDF output now works with Thunderbird.

# 2.1.14: Compliments of zakk, finger pages now list a "live bookmark" for

# RSS finger digest.

# 2.1.15: Plain text output fixes: listarchives now right, and removed

# extra newlines from footer.

# Added info on how to access this user's .plan archives.

# 2.1.26: Added Markdown support, removed <pre> tags and workarounds for it.

# A few other output fixes.

# 2.1.28: Added optional alternate URL syntax, use summaries in RSS feeds.

# Added Twitter card images.

#-----------------------------------------------------------------------------

use strict; # don't touch this line, nootch.

use warnings; # don't touch this line, either.

use DBI; # or this. I guess. Maybe.

use File::Basename; # blow.

use Text::Markdown 'markdown';

# Version of IcculusFinger. Change this if you are forking the code.

#-----------------------------------------------------------------------------#

# CONFIGURATION VARIABLES: Change to suit your needs... #

#-----------------------------------------------------------------------------#

# This is a the hostname you want to claim to be...

# This reports "Finger info for $user\@$host ..." in the web interface,

# and is used for listing finger requests to finger clients:

# "Finger $user?section=sectionname\@$host", etc.

my $host = 'icculus.org';

# This is the URL for fingering accounts, for when we need to generate

# URLs. "$url?user=$user&section=sectionname".

my $base_url = 'https://icculus.org/finger';

# If 0, URLs will be $base_url?user=bob, if 1: $base_url/bob

my $new_url_style = 1;

# The processes path is replaced with this string, for security reasons, and

# to satisfy the requirements of Taint mode. Make this as simple as possible.

# Currently, the only thing that uses the PATH environment var is the

# "fortune" fakeuser, which can be safely removed.

my $safe_path = '/usr/bin:/usr/local/bin';

# Turn the process into a daemon. This will handle creating/answering socket

# connections, and forking off children to handle them. This flag can be

# toggled via command line options (--daemonize, --no-daemonize, -d), but

# this sets the default. Daemonizing tends to speed up processing (since the

# daemonize, this program reads requests from stdin and writes results to

# stdout, which makes it suitable for command line use or execution from

# inetd and equivalents.

my $daemonize = 0;

# This is only used when daemonized. Specify the port on which to listen for

# incoming connections. The RFC standard finger port is 79.

my $server_port = 79;

# Set this to immediately drop priveledges by setting uid and gid to these

# values. Set to undef to not attempt to drop privs. You will probably need

# to leave these as undef and run as root (risky!) if you plan to enable

# $the use_homedir variable, below.

#my $wanted_uid = undef;

#my $wanted_gid = undef;

my $wanted_uid = 1056; # (This is the uid of "finger" ON _MY_ SYSTEM.)

my $wanted_gid = 971; # (This is the gid of "iccfinger" ON _MY_ SYSTEM.)

# This is only used when daemonized. Specify the maximum number of finger

# requests to service at once. A separate child process is fork()ed off for

# each request, and if there are more requests then this value, the extra

# clients will be made to wait until some of the current requests are

# serviced. 5 to 10 is usually a good number. Set it higher if you get a

# massive amount of finger requests simultaneously.

my $max_connects = 10;

# This is how long, in seconds, before an idle connection will be summarily

# dropped. This prevents abuse from people hogging a connection without

# actually sending a request, without this, enough connections like this

# will block legitimate ones. At worst, they can only block for this long

# before being booted and thus freeing their connection slot for the next

# guy in line. Setting this to undef lets people sit forever, but removes

# reliance on the IO::Select package. Note that this timeout is how long

# low that legitimate lag can kill them. The default is usually safe.

my $read_timeout = 15;

# Set this to non-zero to log all finger requests via the standard Unix

# syslog facility (requires Sys::Syslog qw(:DEFAULT setlogsock) ...)

my $use_syslog = 1;

# Set $use_homedir to something nonzero if want to read planfiles from the

# standard Unix location ("/home/$user/.plan"). Note that this is a security

# hole, as it means that either IcculusFinger must run as root to insure

# access to a user's homedir, or user's have to surrender a little more

# privacy to give a non-root user access to their homedirs. You should

# consider setting this to zero and reading the comments for $fingerspace,

# below. Note that IcculusFinger comes with a perl script for automating the

# moving of a system's planfiles from the the insecure method to the more

# secure $fingerspace method, including creating the symlinks so your users

# won't really notice a difference.

my $use_homedir = 0;

# Set $files_allowed to allow someone to use a filename instead of a

# username. If you then ask for something of the form "./filename"

# it'll open the file instead of the user's .plan.

# Without good reason the correct setting for this option is 0, and

# anything other than a specific file in the current dir will fail to

# work properly

my $files_allowed = 0;

# If you set $use_homedir to 0, this is the directory that contains the

# planfiles in the format "$fingerdir$username" Note that THIS MUST HAVE

# THE TRAILING DIR SEPARATOR! This is ignored if $use_homedir is NOT zero.

my $fingerspace = '/fingerspace/';

# This is the maximum amount of data that IcculusFinger will read from a

# planfile. If this cuts off in the middle of an opened formatting tag,

# tough luck. IcculusFinger reads the entire planfile (up to the max you

# specify here) into memory before processing tags. Theoretically, this could

# be changed to handle tags on the fly, in which case users that would

# otherwise be over the limit might not be after processing sections, etc,

# but this is not the case here and now.

# Note that images specified inside [img] tags, etc are not counted towards

# this limit (since the web browser would be requesting those images

# separately), and only applies to the max bytes to be read directly from the

# planfile. This is merely here to prevent someone from symlinking their

# planfile to /dev/zero or something that could fill all available memory.

# This value is specified in bytes.

my $max_plan_size = (100 * 1024);

# This is the maximum size, in bytes, that a finger request can be. This is

# to prevent malicious finger clients from trying to fill all of system

# memory.

# This is what is reported to the finger client if the desired user's planfile

# is missing or empty, or the user is unknown (we make NO distinction, for

# the sake of security and privacy). This string can use IcculusFinger

# markup tags (we'll convert as appropriate), but must NOT use HTML directly,

# since it will confuse the regular finger client users. You should not

# leave this blank or undef it, since that's confusing for everyone.

my $no_report_string = "[center][i]Nothing to report.[/i][/center]";

# List at the bottom of the finger output (above wittyremark) when the .plan

# was last updated?

my $show_revision_date = 1;

# This is the default title for the webpage. The user can override it with

# the [title] tag in their .plan file. Do not use HTML. You can specify an

# empty string (""), but not undef; however, you should REALLY have a

# default here...

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;

# If you are a content-Nazi, you can prevent the user's [title] tags from

# being included in the parsing.

my $permit_user_titles = 1;

# If this array is empty, then no stylesheet is used unless a user

# specifies one and you're not a content Nazi. You can populate this

# if you wish.

my @style_array;

# Don't populate this.

my $style = "";

# If you are a content-Nazi, you can prevent the user's [style] tags from

# being included in the parsing.

my $permit_user_styles = 1;

# 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;

# If you are a content-Nazi, you can prevent the user's [wittyremark] tags

# from being included in the parsing.

my $permit_user_wittyremarks = 1;

# You can screw up your output with this, if you like.

# You can append "?debug=1" to your finger request to enable this without

# changing the source.

my $debug = 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";

# 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 <a href=\"$scripturl\">IcculusFinger $version</a>" :

"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)" : "");

# Set this to zero to disable planfile archive lookups.

my $use_database = 1;

# This is the host to connect to for database access.

my $dbhost = 'localhost';

# This is the username for the database connection.

my $dbuser = 'fingermgr';

# The database password can be entered in three ways: Either hardcode it into

# $dbpass, (which is a security risk, but is faster if you have a completely

# closed system), or leave $dbpass set to undef, in which case this script

# will try to read the password from the file specified in $dbpassfile (which

# means that this script and the database can be touched by anyone with read

# access to that file), or leave both undef to have DBI get the password from

# the DBI_PASS environment variable, which is the most secure, but least

# convenient.

my $dbpass = undef;

my $dbpassfile = '/etc/IcculusFinger_dbpass.txt';

# The name of the database to use once connected to the database server.

my $dbname = 'IcculusFinger';

# The name of the table inside the database we're using.

my $dbtable_archive = 'finger_archive';

# This is the time, in minutes, to generate a digest webpage of all available

# finger accounts. The digest includes last updated time and a link to the

# web version of the .plan files. Set this to undef to disable this feature.

# Also, this only runs if we're daemonized (--daemonize commandline option).

# If you aren't daemonized, you can force a digest update by running

# this program from the command line with the --digest option...probably from

# a cronjob.

my $digest_frequency = 10;

# Digests (html and rss) will show at most $digest_max_users plans, newest

# listed first. Five to ten is probably a good idea. undef to list all

# non-empty .planfiles.

#my $digest_max_users = undef;

my $digest_max_users = 10;

# Default count of items in a specific user's RSS feed.

my $oneuser_rss_items = 5;

# Most RSS items to list for specific users' feeds. This is a clamp, in case

# there are more specified in the URL.

# Filename to write finger digest to. "undef" will universally disable digest

# generation, from the daemon or command line. Note that this file is opened

# for writing _AFTER_ the program drops privileges, whether you run this from

# the command line or as a daemon.

my $digest_filename = '/webspace/icculus.org/fingerdigest.html';

# Filename to write finger digest RSS to, "undef" will universally

# disable RSS digest generation, from the daemon or the command line. See

# other notes above.

# This is for RSS feeds for all users. Individual users still get their

# own personal feeds (with the &rss=1 arg on the URL.)

# Set this to a string you want to prepend to the finger digest. If you

# aren't planning to include the digest in another webpage via PHP or

# whatnot, you should put <html> and <title> tags, etc here. "undef" is

# safe, too.

#my $digest_prepend = undef;

my $digest_prepend = "<html><head><title>.plan digest</title></head><body>\n";

# Set this to a url you want to set the about to

# for the finger digest RSS about field. Et cetera.

# Set this to a title you want for the RSS

my $digest_rss_title = "icculus.org finger digest";

# Set this to the link you want for the finger digest (note that this

# relates to the RSS file linking to the actual piece of html, not

# itself)

# Set this to the description for the RSS

my $digest_rss_desc = "finger updates from icculus.org users";

# Set this to the url for the RSS image

# Set this to a string you want to append to the finger digest. If you

# aren't planning to include the digest in another webpage via PHP or

# whatnot, you should put <html> and <title> tags, etc here. "undef" is

# safe, too.

#my $digest_append = undef;

my $digest_append = "</body></html>\n";

# These are special finger accounts; when a user queries for this fake

# user, we hand back the string returned from the attached function as if

# it was the contents of a planfile. Be careful with this, as it opens up

# potential security holes.

# These subs do NOT have a maximum size limit imposed by the

# $max_plan_size setting, above.

# This hash is checked before actual planfiles, so you can override an

# existing user through this mechanism.

my %fakeusers; # the hash has to exist; don't comment this line.

# The elements of the hash, however, can be added and removed at your whim.

$fakeusers{'fortune'} = sub {

return(`/usr/games/fortune`);

};

$fakeusers{'uptime'} = sub {

my $uptime = `/usr/bin/uptime`;

$uptime =~ s/\A.*?(up \d+ days, \d+:\d+),.*\Z/$1/;

return('[center]' . $uptime . '[/center]');

};

$fakeusers{'root'} = sub {

return("ph34r me, for i am root. I'm l33t as kittens.");

};

$fakeusers{'time'} = sub {

return("At the sound of the beep, it will be: " . scalar localtime() .

};

# return('Digest dumped, nootch.');

#};

# This works if run from qmail's tcp-env, and not tcpd.

# interface, since the webserver's IP will be reported, not the

# browser's IP.

$fakeusers{'ipaddr'} = sub {

if (defined $ENV{'TCPREMOTEIP'}) {

} else {

return(undef);

}

};

#-----------------------------------------------------------------------------#

# The rest is probably okay without you laying yer dirty mits on it. #

#-----------------------------------------------------------------------------#

my $is_web_interface = 0;

my $browser = "";

my $wanted_section = undef;

my $output_text = "";

my $archive_date = undef;

my $archive_time = undef;

my $list_sections = 0;

my $list_archives = 0;

sub get_sqldate {

my $mtime = shift;

my @t = localtime($mtime);

$t[5] = "0000" . ($t[5] + 1900);

$t[5] =~ s/.*?(\d\d\d\d)\Z/$1/;

$t[4] = "00" . ($t[4] + 1);

$t[4] =~ s/.*?(\d\d)\Z/$1/;

$t[3] = "00" . $t[3];

$t[3] =~ s/.*?(\d\d)\Z/$1/;

$t[2] = "00" . $t[2];

$t[2] =~ s/.*?(\d\d)\Z/$1/;

$t[1] = "00" . $t[1];

$t[1] =~ s/.*?(\d\d)\Z/$1/;

$t[0] = "00" . $t[0];

$t[0] =~ s/.*?(\d\d)\Z/$1/;

return('' . ($t[5]) . '-' . ($t[4]) . '-' . ($t[3]) . ' ' .

($t[2]) . ':' . ($t[1]) . ':' . ($t[0]));

}

sub get_minimal_sqldate {

my $mtime = shift;

my @t = localtime($mtime);

$t[4] = "00" . ($t[4] + 1);

$t[4] =~ s/.*?(\d\d)\Z/$1/;

$t[3] = "00" . $t[3];

$t[3] =~ s/.*?(\d\d)\Z/$1/;

return('' . ($t[4]) . '/' . ($t[3]) );

}

sub enumerate_planfiles {

my $dirname = (($use_homedir) ? '/home' : $fingerspace);

opendir(DIRH, $dirname) or return(undef);

my @dirents = readdir(DIRH);

closedir(DIRH);

my @retval;

if ($use_homedir) {

foreach (@dirents) {

next if (($_ eq '.') or ($_ eq '..'));

push @retval, "/home/$_/.plan";

}

} else {

foreach (@dirents) {

next if (($_ eq '.') or ($_ eq '..'));

push @retval, "$fingerspace/$_";

}

}

return(@retval);

}

sub hashplans {

my %retval;

my @plans = enumerate_planfiles();

if (not @plans) {

syslog("info", "Failed to enumerate planfiles: $!\n") if ($use_syslog);

}

foreach (@plans) {

my $user = $_;

if ($use_homedir) {

$user =~ s#\A/home/(.*?)/\.plan\Z#$1#;

} else {

$user = basename($_);

}

my @statbuf = stat($_);

my $filesize = $statbuf[7];

next if ($filesize <= 0); # Skip empty .plans

# construct the hash backward for easy

# sorting-by-time in the next loop

my $t = $statbuf[9];

$t++ while defined $retval{$t};

$retval{$t} = $user;

}

return(%retval);

}

sub userurl {

my $user = shift;

my $args = shift;

my $url;

if ($new_url_style) {

$url = "$base_url/$user";

if (defined($args)) {

$url .= "?$args";

}

} else {

$url = "$base_url?user=$user";

if (defined($args)) {

$url .= "&$args";

}

}

}

sub do_digest {

return if not defined $digest_filename;

my %plansdates = hashplans();

return if (not %plansdates);

if (not open DIGESTH, '>', $digest_filename) {

if ($use_syslog) {

syslog("info", "digest: failed to open $digest_filename: $!\n");

}

return;

}

print DIGESTH $digest_prepend if defined $digest_prepend;

print DIGESTH "\n<p>\n ";

print DIGESTH "<table border=0>\n";

my $user = $plansdates{$_};

my $modtime = get_minimal_sqldate($_);

print DIGESTH " <td>$modtime</td>\n";

print DIGESTH " </tr>\n";

last if ((defined $digest_max_users) and (++$x >= $digest_max_users));

}

print DIGESTH $digest_append if defined $digest_append;

close(DIGESTH);

}

sub pubdate {

my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_;

return POSIX::strftime("%a, %e %b %Y %H:%M:%S %z", $sec, $min, $hour,

$mday, $mon, $year, $wday, $yday, $isdst);

}

sub do_rss_digest {

return if not defined $digest_rss_filename;

my %plansdates = hashplans();

return if (not %plansdates);

if (not open RSS_DIGESTH, '>', $digest_rss_filename) {

if ($use_syslog) {

syslog("info", "digest: failed to open $digest_rss_filename: $!\n");

}

return;

}

my $rdfitems = "\n";

my $digestitems = '';

my $x = 0;

foreach (reverse sort keys %plansdates) {

my $user = $plansdates{$_};

my $modtime = get_minimal_sqldate($_);

$rdfitems .= " <rdf:li rdf:resource=\"$href\" />\n";

$digestitems .= " <item rdf:about=\"$href\">\n";

$digestitems .= " <title>$user - $modtime</title>\n";

$digestitems .= " <link>$href</link>\n";

$digestitems .= " <description>.plan update from $user</description>\n";

$digestitems .= " </item>\n\n";

last if ((defined $digest_max_users) and (++$x >= $digest_max_users));

}

print RSS_DIGESTH <<__EOF__;

<?xml version="1.0" encoding="utf-8"?>

xmlns="http://purl.org/rss/1.0/"

>

<channel rdf:about="$digest_rss_about">

<title>$digest_rss_title</title>

<link>$digest_rss_url</link>

<description>$digest_rss_desc</description>

<items>

<rdf:Seq>$rdfitems </rdf:Seq>

</items>

</channel>

<image>

<title>$digest_rss_title</title>

<url>$digest_rss_image</url>

<link>$digest_rss_url</link>

</image>

$digestitems

</rdf:RDF>

close(RSS_DIGESTH);

}

my $linkcount = 0;

my @link_digest;

my %metadata;

my $did_output_start = 0;

sub output_start {

my ($user, $host) = @_;

return if ((not $is_web_interface) and (not $do_html_formatting));

return if $did_output_start;

$did_output_start = 1;

my $rssdigest = '';

if ((defined $digest_rss_title) and (defined $digest_rss_about)) {

my $rssurl = userurl($user, 'rss=1');

$rssdigest = "<link rel=\"alternate\" title=\"Finger updates from $user\@$host\" href=\"$rssurl\" type=\"application/rss+xml\" />\n " .

}

my $twitter = '';

if (defined $metadata{'twitter'}) {

my $uname = $metadata{'twitter'};

my $summary = $metadata{'summary'};

my $image = $metadata{'image'};

my $largeimage = $metadata{'large_image'};

my $cardtype = 'summary';

my $imageurl = undef;

$uname =~ s/'/&\#39/g;

$titlestr =~ s/'/&\#39/g;

$summary =~ s/'/&\#39/g;

if (defined $image) {

$image =~ s/'/&\#39/g;

$imageurl = $image;

}

if (defined $largeimage) {

$largeimage =~ s/'/&\#39/g;

$cardtype = 'summary_large_image';

$imageurl = $largeimage;

}

$twitter .= "<meta name='twitter:card' content='$cardtype' />\n";

if (defined $imageurl) {

$twitter .= "<meta name='twitter:image' content='$imageurl' />\n";

}

}

<html>

<head>

<title> $title </title>