#!/usr/bin/perl -w
use IO::Handle;
use strict;
use Socket;
use Carp;

my $DEBUG = 0;
my $LOGGING = 1;

my $matchAddr = 0;

my $rootAlt	= 'root';
my $nb_forks	= 1;
my $maxident	= 8;
my $BUFLEN	= 1024;
my $TIMEOUT	= 3;	# forwarding connection timeout
my $TIMEOUT_S	= 120;	# standalone connection timeout

my $port = shift || 1133;
my $logfile	= "onlined.log";
my $online_file = "online.log";

$port = $1 if $port =~ /(\d+)/; # untaint port number

sub logmsg
{
	if ($LOGGING) {
		if (open(LOGFILE, ">>$logfile"))
		{
			autoflush LOGFILE;
			print LOGFILE "$0 $$: @_ at ", scalar localtime, "\n";
			close(LOGFILE);
		}
	} else {
		print STDOUT "$0 $$: @_ at ", scalar localtime, "\n";
	}
}

{
	my $proto = getprotobyname('tcp');
	socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
	setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,pack("l", 1))	|| die "setsockopt6: $!";
	bind(Server, sockaddr_in($port, INADDR_ANY))		|| die "bind: $!";
	listen(Server,SOMAXCONN)				|| die "listen: $!";
	logmsg "server started on port $port";

	my $waitedpid = 0;
	my $paddr;
	my $forks = 0;

	sub REAPER {
	    $waitedpid = wait;
	    $SIG{CHLD} = \&REAPER;  # loathe sysV
	    logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
	}

	$SIG{CHLD} = \&REAPER;

	for ( $waitedpid = 0; $forks < $nb_forks; )
	{
		my $forked = fork;
		if ($forked == 0)
		{
			while ($paddr = accept(Client,Server))
			{
				autoflush Client;
				my ($ip_cli,$pcli,$ncli) = &ip_port_host(getpeername(Client));
				my ($ip_ser,$pser,$nser) = &ip_port_host(getsockname(Client));
				logmsg "connection from $ip_cli [$ncli] at port $pcli";
				$DEBUG && (logmsg "ident: $ip_cli:$pcli [$ncli], $ip_ser:$pser [$nser]");
				eval
				{
					local $SIG{ALRM} = sub { die "alarm clock restart" };
					alarm($TIMEOUT_S);
					&online(*Client);
					alarm 0;
				};
				if ($@ and $@ !~ /alarm clock restart/) { die }
				$waitedpid = 0;
				close Client;
			}
		} elsif ($forked == -1) {
			print "Can't fork";
		} else {
			$forks++;
		}
	}
}

sub ip_port_host {
	my ($paddr) = @_;
	my ($family, $boucle, $iaddr);
	my ($ip_num,$port,$name);

	$family = AF_INET;
	($port,$iaddr) = unpack_sockaddr_in($paddr);
	$ip_num = inet_ntoa($iaddr);
	$name = gethostbyaddr($iaddr,$family);
	defined($name) || ($name = "Unresolved");

	return ($ip_num,$port,$name);
}

sub online {
	my ($handle ) = @_;

	my ($line, $nick);

	if (defined($handle))
	{
		return 0 if (sysread($handle, $line, $BUFLEN) < 1);
	} else {
		return 0 if (sysread(STDIN, $line, $BUFLEN) < 1);
		$handle = \*STDOUT;
	}
	return 0 if ($line !~ /^([a-z]+)\s*$/);
	$nick = $1;

	if (open(ONLINE, '>>', $online_file))
	{
		print ONLINE $nick, ":", time, "\n";
		printf $handle ("Coucou $nick\r\n");
		close(ONLINE);
	} else {
		printf $handle ("Sorry $nick\r\n");
	}
	return 1;
}
