#!/usr/bin/perl

#
# Simple Perl Identd Server
# 
# jotham <jotham.read@gmail.com>
#

use IO::Socket;
use IO::File;
use Net::hostent;

#
# Configuration
#

$SERVER_PORT  = 113;                                 # local port to bind to
$LSOF_COMMAND = "/usr/sbin/lsof -FpLn -P -n -i4TCP"; # lsof line, will have '@REMOTE_ADDR:REMOTE_PORT' appended to it
$VERBOSE      = 1;                                   # print log messages to STDOUT
$LOG_FILE     = "/var/log/perl_identd.log";          # location of log file

#
# Logging
#

$LOG = IO::File->new($LOG_FILE, O_WRONLY|O_APPEND|O_CREAT) or die "Couldn't open " . $LOG_FILE . " for writing: " . $! . "\n";
$LOG->autoflush(1);

#
# lsof_find ($find_remote_addr, $find_remote_port, $find_local_addr, $find_local_port)
#

sub lsof_find
{
	($find_remote_addr, $find_remote_port, $find_local_addr, $find_local_port) = @_;
	($last_p, $last_L, $last_n) = (0, 0, 0);
	if ( open(LSOF, $LSOF_COMMAND."@" . $find_remote_addr . ":" . $find_remote_port . " |") )
	{
		while ( <LSOF> )
		{
			($field, $content) = m/(\w)(.*)/;
			if ( $field eq "p" ) {
				$last_p = $content;
			}
			elsif ( $field eq "L" )
			{
				$last_L = $content;
			}
			elsif ( $field eq "n")
			{
				$last_n = $content;
				($local_addr, $local_port, $remote_addr, $remote_port) = ( $content =~ m/(.+?):(.+?)->(.+?):(.+?)\z/ ) or next;
				if ( $find_local_port == $local_port )
				{
					return ($last_p, $last_L, 0);
				}
			}
		}
	}
	else
	{
		return (0, 0, $!);
	}
}

#
# logmsg ($message)
#

sub logmsg
{
	$message = localtime() . " - " . $_[0] . "\n";
	print $LOG $message;
	if ( $verbose )
	{
		print $message;
	}
}

#
# server_start ()
#

sub server_start
{
	unless ( $server = IO::Socket::INET->new(LocalPort => $server_port, Type => SOCK_STREAM, Reuse => 1, Listen => 1) )
	{
		logmsg("Couldn't bind to port " . $server_port . " " .$@);
		return;
	}

	logmsg("Server started.");

	while ( $client = $server->accept() )
	{
		$client->autoflush(1);
		$hostinfo = gethostbyaddr($client->peeraddr);
		
		# Debug for some wierd $client problem
		if ( $client == 0 )
		{
			logmsg("DEBUG_WARNING: \$client == 0");
		}
		if ( $hostinfo == 0 )
		{
			logmsg("DEBUG_WARNING: \$hostinfo == 0");
		}
		
		# Log new connection
		if ( $hostinfo !=0 && $hostinfo->name )
		{
			logmsg("Connection from " . $client->peerhost . " (" . $hostinfo->name . ").");
		}
		else
		{
			logmsg("Connection from " . $client->peerhost . ".");
		}

		# Process request
		while ( <$client> )
		{
			if ( /(\w+)\W*,\W*(\w+)\r?\n/ ) # match (word)(not-word*),(not-word*)(word)\r?\n
			{
				($remote_addr, $remote_port, $local_addr, $local_port) = ($client->peerhost, $2, 0, $1);
				($pid, $user) = lsof_find($remote_addr, $remote_port, $local_addr, $local_port);
				logmsg("  Request local_port: '" . $local_port . "', remote_port: '" . $remote_port . "', user: '" . $user . "'.");
				if ( $pid != 0 )
				{
					print $client $local_port . " , " . $remote_port . " : USERID : UNIX :" . $user. "\r\n";
				}
				else
				{
					print $client $local_port . " , " . $remote_port . " : ERROR : NO-USER\r\n";
				}
			}
			else
			{
				# Log unprocessed request
				($arg0) = /(.*?)\r?\n/; # strip CR?NL
				logmsg("  Received: '" . $arg0 . "'.");
				print $client "0 , 0 : ERROR : UNKNOWN-ERROR\r\n"
			}
			last;
		}
		close $client;
		logmsg("Connection closed.");
	}
}

#
# main
#

sub main
{
	server_start();
}

main();