#!/usr/bin/perl -w
#
# This program is under GPL [http://www.gnu.org/copyleft/gpl.htm]
#
# midentd v2.3.1 - identd server with ipmasq, fake and tircproxy/squid support
#
# (c) shurdeek@panorama.sth.ac.at (current maintainer)
# (c) peter@adataloss.nl (original author and old maintainer)
#
# Fix for PPC by Turbo Fredriksson <turbo@debian.org>
#
use strict;
use Socket;
use Fcntl ':flock';

my ($uid, $in, $out, %arg);
my($rip,$lip,$request,$rport,$lport,$tstr,$mstr,$pstr,$mip,$mport,$kernel);
my $tcp_timeout = 3; # timeout for forwarding connection in seconds
my $fakenlen = 6; # faked id will be min this chars long
my $fakexlen = 8; # faked id will be max this chars long
my $forkinterval = 3; # sleep 3s between forks
my $maxfork = 5; # don't fork more than this instances
my $forked = 0; # already forked this many times
my $midentd = 0; # is it a midentd querying?

&parsearg(@ARGV);

if ($arg{help}) {
	&usage;
}

if ( ! -S STDIN ) {
	if (! $arg{uid}) {
		&usage();
		exit;
	} else {
		$uid = $arg{uid};
		if ($uid =~/^\d+$/) {
			my $tmp = getpwuid ($uid);
			if (!$tmp) {
				print "Invalid uid: $uid\n";
				exit;
			}
		} else {
			my $tmp = getpwnam ($uid);
			if (!$tmp) {
				print "Invalid username: $uid\n";
				exit;
			}
			$uid = $tmp;
		}
	}
	$SIG{CHLD} = \&REAPER;
	$SIG{INT} = \&INT;
	if ($> != 0) {
		die "Dude, only root can bind to ports < 1024";
	}
	my $port = 113;
	socket (SERVER, PF_INET, SOCK_STREAM, getprotobyname('tcp')) || die "socket: $!";
	bind (SERVER, sockaddr_in ($port, INADDR_ANY)) || die "Can't bind (1). Check for other running ident services";
	setsockopt (SERVER, SOL_SOCKET, SO_REUSEADDR, pack ("l", 1)) || die "setsockopt: $!";
	#bind (SERVER, sockaddr_in ($port, INADDR_ANY)) || die "Can't bind (2). Check for other running ident services";
	listen (SERVER, SOMAXCONN) || die "listen: $!";
	&daemon;
} else {
	$in = *STDIN;
	$out = *STDOUT;
	&process_request;
}

sub daemon
{
	chdir "/";
	close STDIN; open STDIN, "/dev/null";
	close STDOUT; open STDOUT, ">/dev/null";
	close STDERR; open STDERR, ">/dev/null";
	umask 0466;
	&logger ("Daemon started, listening.");
	# FIXME, maximum number of connections should be limited
	if (fork) {
		# exit parent
		# close SERVER;
		exit;
	}
	$> = $uid;
	$< = $uid;
	if ($< != $uid || $> != $uid) {
		die "Can't change UID\n";
	}
	while (accept (SOCKET, SERVER)) {
		$in = *SOCKET;
		$out = *SOCKET;
		if ($forked < $maxfork) {
			if (fork) {
				&logger ("Forked #".(++$forked));
				sleep $forkinterval;
			} else {
				&process_request;
				exit; # unnecessary but just to be sure :-)
			}
		} else {
			close (SOCKET);
			&logger ("Too many children, rejecting connection.");
		}
	}
}

sub REAPER
{
  my $waitedpid = waitpid(-1, 0);
	$forked-- if ($forked > 0);
  $SIG{CHLD} = \&REAPER;
}

sub INT
{
	&logger ("Daemon exited.");
	close SOCKET; close SERVER;
  $SIG{INT} = \&INT;
}

sub process_request {
	(undef,$rip)=sockaddr_in(getpeername($in)); 

	(undef,$lip)=sockaddr_in(getsockname($out));
	logger("Connection from ".inet_ntoa($rip)." on ".inet_ntoa($lip));

	$|=1;
	#$request=<>;
	sysread($in,$request,128);
	#logger("Request: ".substr($request,0,-1));
	if($request =~ /^MASQ:/) {
		$midentd = 1;
		my(@masqreq);
		@masqreq=split(/:/,$');
		if(@masqreq != 4) {
			ret("ERROR : INVALID-MASQ");
		}
		# THIS IS IMHO OBSOLETE, inetd/xined should handle this with tcp wrappers.
		#if(!allowmasq(inet_ntoa($rip))) {
		#	ret("MQ:ERROR : NOT-ALLOWED");
		#}
	
		$rport=$masqreq[0];
		$rip=pack("H8",$masqreq[1]);
		$lport=$masqreq[2];
		$lip=pack("H8",$masqreq[3]);
		$_=getident();
		ret("$_");
	} else {
		($lport,$rport)=split(/[\,\r\n{*}]/,$request);
		if(!($rport =~ /^([ \d])+$/)) { $rport=0; }
		if(!($lport =~ /^([ \d])+$/)) { $lport=0; }
		$lport =~ s/ //g;
		$rport =~ s/ //g;
	
		if($rport<1 || $rport>65535 || $lport<1 || $lport>65535) {
			ret("$lport, $rport : ERROR : INVALID-PORT");
		}
	
		$_=getident();
		ret("$lport, $rport : $_");
	}
}

sub tstr {
	my $big_endian = check_big_endian();
	logger("Running on big-endian system") if ($big_endian);

	$tstr = sprintf("%8s:%04x %8s:%04x",
		unpack("H8",($big_endian ? $lip : reverse($lip))),
		$lport,
		unpack("H8",($big_endian ? $rip : reverse($rip))),
		$rport);
}

sub mstr 
{
	&kernel;
	if ($kernel == 2) {
		$mstr	= sprintf("%8s:%04x %04x",
			unpack("H8",$rip),
			$rport,
			$lport);
	} else {
		$mstr = "src=".inet_ntoa($rip)." dst=".inet_ntoa($lip)." sport=$rport dport=$lport";
	}
}

sub pstr
{	
	my $big_endian = check_big_endian();
	$tstr = sprintf("%8s:%04x (........):(....)",
		unpack("H8",($big_endian ? $rip : reverse($rip))),
		$rport);
}

sub tcp
{
	my ($uid, $num);
	# TRY LOCAL
	open(PNT,"</proc/net/tcp");
	$_=<PNT>; 
	while(<PNT>) {
		if(/^(....):.$tstr/i) {
			if (!$num) {
				$uid=substr($_,76,5);
				if($_=(getpwuid($uid))[0]) {
					$uid = $_;
				}
				&pstr();
				$num = $1;
			} else {
				my $big_endian = check_big_endian();
				$mip = pack ("H8", $2);
				$mip = ($big_endian ? $mip : reverse($mip));
				$mport = hex($3);
				last unless $mip ne $lip; # loop protection
				logger("Transparent proxy, checking with ".inet_ntoa($mip));
				return;
			}
		}
	}
	close(PNT);
	return $uid;
}

sub chat
{
	my $string = shift;
	my $status = 'timed out';
	my $result;
	socket(MQC,PF_INET,SOCK_STREAM,getprotobyname('tcp'));
	eval {
		local $SIG{ALRM} = sub { die "timed out\n" };
		alarm $tcp_timeout;
		if (!connect (MQC, sockaddr_in (113, $mip))) {
			$status = 'closed';
		} else {
			select(MQC);
			$|=1;
			select($out);
			print MQC $string;
			$status = '';
			while (sysread (MQC, $result, 1)) {
				$status .= $result;
			}
		}
		alarm 0;
	};
	#	if ($@ && $@ eq "timed out\n" and $status ne 'closed' and $status ne '') {
	#		$status = 'timed out';
	#	}
	$status =~ s/\r|\n//gm;
	close MQC;
	return $status;
}

sub masq
{
	my $uid;
	&mstr;
	if(defined($mstr) and !($mip and $mport)) {    
		my($q);
		&kernel();
		if ($kernel == 2) {
			open(PNT,"</proc/net/ip_masquerade");
		} else {
			open(PNT,"</proc/net/ip_conntrack");
		}
		$_=<PNT>;
		while(<PNT>) {
			$q=$_;
			# 2.0 and 2.2
			if(($kernel == 2 && $q =~ /^TCP(.){15}$mstr/i) ||
				# 2.4
				($kernel == 4 && $q =~ /^tcp.*src=([^ ]+).*sport=([^ ]+).*$mstr/)
				) {
				if ($kernel == 2) {	
					$mip = pack("H8",substr($q,4,8));
					$mport = hex(substr($q,13,4));
				} else {
					$mip = inet_aton($1);
					$mport = $2;
				}
				last;
			}
		}
	}
	if ($mip and $mport) {
		logger("Masqueraded connection, checking with ".inet_ntoa($mip));
		$_ = chat("MASQ:$rport:".unpack("H8",$rip).":$mport:".unpack("H8", $mip)."\n");
		my $hostname = &ghbi (inet_ntoa ($mip));
		$hostname =~ s/\..*//g if defined $hostname; # strip domain
		if(/^MQ:/) {
			$uid = $';
			return $uid;
		} elsif (/^timed out$/) {
			# too high load or firewalled
			logger("Timed out, returning hostname/faked reply");
			return &fake($hostname);
		} elsif (/^closed$/) {
			logger("Port closed, returning hostname/faked reply");
			# no identd
			return &fake($hostname);
		} else {
			logger("Failed, doing standard ident request");
			$_ = &chat ("$lport, $rport\r\n");
			if (/^timed out$/) {
				# too high load or firewalled
				logger("Timed out, returning hostname/faked reply");
				return &fake($hostname);
			} elsif (/^closed$/){
				# no identd
				logger("Port closed, returning hostname/faked reply");
				return &fake($hostname);
			} else {
				# We accept whatever the client tells us in order to enable masqueraded
				# machines to create their own policy
				ret ($_);
				return;
			}
		}
	}
	return;
}

sub fake {
	my $c;
	my $hn = shift;
	return ("USERID : UNKNOWN : $hn") if $hn;
	my $uid;
	srand;
	my $len = $fakenlen + rand (1 + $fakexlen - $fakenlen); # can be float 
                                               # because we do a < later
	for ($c = 1; $c <= $len; $c++) {
		$uid .= chr(ord ('a') + int (rand (26)));
	}
	return ("USERID : UNIX : $uid");
}

sub getident {
	my $uid = "";
	&tstr;

	logger("Wants ".inet_ntoa($rip).":$rport-".inet_ntoa($lip).":$lport");

	if ($arg{fake}) {
		logger("Faking reply");
		return &fake;
	}

	$uid = &tcp();
	if ($uid) {
		return("USERID : UNIX : $uid");
	}

	$uid = &masq();

	if ($uid) {
		return("$uid");
	}
	
	# NOTHING WORKED
	return("ERROR : NO-USER");
}

sub logger {
	my($logtext);
	$logtext=shift;
	open(LOG,">>/var/log/midentd/midentd.log");
	flock (LOG, 2); # LOCK_EX
	print LOG localtime()." [$$] $logtext\n";
	flock (LOG, 8); # LOCK_UN
	close(LOG);
}

sub ret {
	$_=shift;
	# the \r is omited for backwards midentd compatibility
	# the \n isn't needed according to RFC but a lot of clients expect it
	print $out ($midentd ? "MQ:" : "")."$_".($midentd ? "" : "\r")."\n";
	logger("Returning $_");
	close SOCKET;
	exit;
}

# Fix for 'http://www.debian.org/Bugs/db/34/34299.html'
sub check_big_endian {
	my($native, $big, $result);

 	$native = 1234567890;
 	$big    = pack("N", $native);
 	$result = unpack("L", $big);

 	if($result == $native) {
		# This is a big endian system.    (PPC's etc)
		return(1);
 	} else {
		# This is a little endian system. (PC's etc)
		return(0);
	}
}

sub parsearg
{
	my $arg;
	while (defined ($arg = shift)) {
		if ($arg eq "-f") {
			$arg{fake} = 1;
		} elsif ($arg eq "-u") {
			$arg{uid} = shift;
		} elsif ($arg eq "-h") {
			$arg{help} = 1;
		}
	}
}

sub kernel
{
	return unless !$kernel;
	if ( -e "/proc/net/ip_masquerade") {
		# 2.0 and 2.2 kernel
		$kernel = 2;
	} elsif ( -e "/proc/net/ip_conntrack") {
		# 2.4 kernel
		$kernel = 4;
	}
}

sub ghbi
{
	my ($ip, $iaddr, @tmp);
	$ip = shift;
	$iaddr = inet_aton ($ip);
	@tmp = gethostbyaddr ($iaddr, AF_INET);
	return $tmp[0] if defined $tmp[0];
	return;
}

sub usage {
	print "midentd [-u username/uid] [-f]\n";
	print "Usage: midentd [-u username/uid] [-f].\n";
	print "-u username/uid : try to change uid to this.\n";
	print "   When used as standalone, this is a must.\n";
	print "-f : always fake replies, return a random name to every request.\n";
}

# vim: tabstop=2