#!/usr/bin/perl -Tw

########################################################
# A finger daemon that replies bogus data and logs     #
# every finger request to a file.                      #
# Copyright by Michael Kummer			       #
# Distributed under the GPL                            #
########################################################

# NOTE: This version forks to handle multiple clients at the same time.
# It also gives the choice to log to STDOUT or to a file.
# In addition it limits the amount of connection that are handled at the
# same time. 
# Stay tuned!

# Please hammer it as hard as you can and send me your responses.
# If you wanna merge your code pieces drop me a line and i'll verify it
# <frost@outfit.2y.net>

require 5.001;
use strict;
BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
use Socket;
use Carp;
use FileHandle;

## SET THESE VARIABLES ##

my $maxconn = 10;
my $curconn = 0;
my $logging = 0;	# 0 = STDOUT
			# 1 = to file
my $logfile = 'plfingerd.log'; 

## END OF SETTINGS ##


# DONT CHANGE ANYTHING BELOW THIS LINE UNLESS YOU KNOW WHAT YOU ARE DOING!!

my $port = 79;
my $proto = getprotobyname('tcp');

sub spawn;
sub logmsg {
        if ($logging == 0) {
                print "$0 $$: @_ at ", scalar localtime, "\n";
        } else {
                open(LOG_FILE, ">>$logfile");
                print LOG_FILE "$0 $$: @_ at ", scalar localtime, "\n";
                close(LOG_FILE);
        }
}

socket(Finger, PF_INET, SOCK_STREAM, $proto) or die "socket: $!";
setsockopt(Finger, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die "setsockopt: $!";
bind(Finger, sockaddr_in($port, INADDR_ANY)) or die "bind: $!";
listen(Finger, SOMAXCONN) or die "listen: $!";

logmsg "Finger service started on port $port";

my $waitpid = 0;
my $paddr;

sub REAPER {
	$waitpid = wait;
	$SIG{CHLD} = \&REAPER;
	if ($curconn > 0) {
		$curconn = $curconn - 1;
	}
	logmsg "reaped $waitpid" . ($? ? " with exit $?" : "");
}

$SIG{CHLD} = \&REAPER;

for ( ; $paddr = accept(Client, Finger); close Client) {

	my($port, $iaddr) = sockaddr_in($paddr);
	my $name = gethostbyaddr($iaddr, AF_INET);

	logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port";
	
	spawn sub {
		logmsg "spawning ...";
		my $fUSER = <Client>;
		
		logmsg "current connections: $curconn";
		if ($curconn < $maxconn) {
			$curconn = $curconn + 1;
			logmsg "new count: $curconn";
		} else {
			logmsg "No more connections allowed";
			return;
		}
		logmsg "finger request for user $fUSER";

		my $DATA_STRING = "Login: $fUSER Name: $fUSER Directory: /home/$fUSER\n Shell: /bin/sh\n Never logged in.\n No mail.\n No Plan.";
		print Client $DATA_STRING;
	};
}  

sub spawn {
	my $coderef = shift;

	unless (@_ ==0 && $coderef && ref($coderef) eq 'CODE') {
		confess "usage: spawn CODEREF";
	}

	my $pid;
	if (!defined($pid = fork)) {
		logmsg "cannot fork: $!";
		return;
	} elsif ($pid) {
		logmsg "begat $pid";
		return; # that's the parent
	} # else i'm the child - go spawn

	exit &$coderef();
}