#!/usr/bin/perl

# Program:	DummyIdentd
# Description:	A dummy identd written in perl
# Author:       Paul Gregg <pgregg@pgregg.com>
# Date:         September 2001
# Summary:      Responds with the same username for every identd request.
# Version:      2.1
# Copyright:    2001, Paul Gregg <pgregg@pgregg.com>
# Copy Policy:  Shareware: Free to copy and distribute provided all code and
#		headers are left intact and no charge is made for this program.
#		I'm happy to accept small donations (beer money) or larger :)
#		if you feel this software is worth it. 
# URL:          http://www.pgregg.com/projects/dummyidentd/
#
# Customise:	See the value() function at the end of this program

use strict;
use Socket;
sub socket_init;
sub log_init;
sub logit;
sub cleanup;
sub value;
$| = 1;


# These defines are things you change to modify the behaviour of DummyIdentd
my $PORT = 113;
my $BINDIP = "0.0.0.0";
my $USERID = "65534";		# UID to switch to immediately after binding
my $STD_IDENT = "Unknown";	# Standard user to reply in ident, see value()
my $TIMEOUT = 5;		# Number of seconds to wait for a request
my $DEBUG = 0;			# Turn on Debugging.

# Do you want dummyidentd to keep logs?  Be careful not to place the log
# anywhere with global write privs as someone could symlink to your /etc/passwd
# Make sure that $USERID can write to this file/directory.
# my $LOGFILE = "/var/log/dummyidentd/dummyidentd.log";
# or set to "" to turn logging off
my $LOGFILE = "";


# You should not have to change anything below here.

my $PROTO = getprotobyname('tcp');
my $INADDR_BIND = inet_aton($BINDIP);

$SIG{INT} = \&cleanup;
$SIG{HUP} = \&cleanup;
$SIG{KILL} = \&cleanup;

# Initialise the socket code, bind to the port and start listening.
socket_init();

logit("Switching to UID $USERID");
$> = $USERID;
$< = $USERID;
if (($< == 0) || ($> == 0)) {
  print "Cannot switch to UID $USERID. Program exiting...\n";
  cleanup();
  exit 1;
}
  
log_init();	# Open up logging filehandles

logit(sprintf("DummyIdentd server started on port $PORT at %s", now()));

my $cr = chr(13);
my $paddr;
for ( ; $paddr = accept(Client,Server); close Client) {
  my $input = "";
  my $nfound = "";
  my $answer = "";
  my $timeleft;
  my $rin; my $win; my $ein; my $rout; my $wout; my $eout;
  $rin = $win = $ein = $rout = $wout = $eout = '';
  my($port,$iaddr) = sockaddr_in($paddr);
  my $name = gethostbyaddr($iaddr,AF_INET);

  vec($rin,fileno(Client), 1) = 1;
  $ein = $rin;
  ($nfound, $timeleft) = select($rin, undef, undef, $TIMEOUT) && 
  	recv(Client, $input, 255, undef);

  if ( $input eq "" ) {
    print Client "Connection timed out...\n";
    logit(sprintf("connection from $name [%s] at port %d - Timed Out after %d seconds", inet_ntoa($iaddr), $port, $TIMEOUT));
  } else {
    chomp($input);
    $input =~ s/$cr//ge;
    $answer = get_response($input, $name, inet_ntoa($iaddr), $port);
    logit(sprintf("connection from $name [%s] at port %d - Received: \"%s\", Responded: \"%s\"", inet_ntoa($iaddr), $port, $input, $answer));
    print Client "$answer\r\n";
  }

  close(Client);
}

cleanup();

exit;

sub socket_init {
  socket(Server, PF_INET, SOCK_STREAM, $PROTO)
	|| die "socket: $!\n";
  setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
	|| die "setsockopt: $!\n";
  bind(Server, sockaddr_in($PORT, $INADDR_BIND))
	|| die "bind: $!\n";
  listen(Server,SOMAXCONN)
	|| die "listen: $!\n";
}

sub log_init {
  if ($LOGFILE ne "") {
    if ( -e $LOGFILE ) {
      open(LOG_FH, ">>$LOGFILE") || die "Cannot open logfile '$LOGFILE' for append: $!\n";
      $LOGFILE = "" if ($? != 0);
    } else {
      open(LOG_FH, ">$LOGFILE") || die "Cannot create logfile '$LOGFILE': $!\n";
      $LOGFILE = "" if ($? != 0);
    }
  }
  #debug(sprintf("Init: Logging to $LOGFILE (%d)\n", LOG_FH));
  #debug("Init: Logging to $LOGFILE");
}


sub debug {
  my $line = shift;
  print "$line\n";
}


sub logit {
  my $line = shift;
  print LOG_FH "$line\n" if ($LOGFILE ne "");
  debug($line) if ($DEBUG);
}


sub cleanup {
  $SIG{INT} = \&cleanup;
  logit(sprintf("Server stopping at: %s", now()));
  logit("-----------------------------------------------------------\n");
  close(LOG_FH);
  exit 0;
}


sub now {
  my @month = ( "", "Jan", "Feb", "Mar", "Apr", "May", "Jun",
	"Jul", "Aug", "Sep", "Oct", "Nov", "Dec" );
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
  return sprintf("%2d %s %4d, %02d:%02d:%02d", $mday, $month[$mon], $year+1900,
	$hour, $min, $sec);
}


sub get_response {
  my $response;
  my $in = shift;
  my $remotehost = shift;
  my $remoteaddr = shift;
  my $remoteport = shift;
  chomp($in);
  $in =~ s/ //g;
  $in =~ tr/0-9,//cd;
  $in =~ s/,/ , /;
  $response = sprintf("%s : USERID : UNIX : %s", $in,
	value($remotehost, $remoteaddr, $remoteport));
  return $response;
}

sub value {
  my $remotehost = shift;
  my $remoteaddr = shift;
  my $remoteport = shift;

  # Work out from the remote host/port what to answer, otherwise just
  # say a standard response.
  if ($remotehost eq "efnet.demon.co.uk") {
    return "MyNick";		# Specific Answer for a server
  } else {
    return "User-" . time;	# User-984637288 - pseudo random response
  }
  return $STD_IDENT;

}