#!/usr/bin/perl
# Secure identd v0.3 by Paul S. Boehm <pb@insecurity.net>
## 
# ChangeLog:
# v0.3 Sep 14 '98 - cleaned up code, added support for the more important
#                   pidentd command line parameters, added additional
#                   error checking/handling code on suggestion by jay aych.
#                   finally disallowed faking of specified usernames.
#                   Added README and INSTALL... gets me rid of dumb mails...
#                   
# v0.2 Sep 12 '98 - fixed a stupid bug: close(<PROC_TCP>) -> close(PROC_TCP)
#                   no security related problems with that...
#
# v0.1 Sep 12 '98 - first release
#
# This is a perl implementation of the Identification Protocol as specified
# in RFC 1413. It's small and designed to be secure(perl is a good choice
# for secure daemons). It can only be used from inetd. Users can set
# a fake ident reply for their uid by writing whatever fake username
# they want to $fake_uid_dir/their_numeric_uid. Official distribution
# Page is at http://insecurity.net/ ! Sidentd only runs on systems with 
# linux like /proc/net/tcp. Distributed under GPL version equal or greater 2.
#
## 

# Global default variables
# Be aware that the commandline options don't toggle...they override.

# Directory to contain UID->fakeusername mapping data.
$fake_uid_dir  = "/var/identd";

# File to contain non allowed fakeidents(e.g. root)
$bad_fake_uids = "/var/identd/badident";

# OS Type (e.g. UNIX or OTHER) (-o)
$os_type = "UNIX";

# Timeout (-t)
$timeout = 120;

# Respond with uids instead of Usernames (-n)
$uname_secret = 0;

PP: while ($param = shift) {
  sub { $os_type = "OTHER"; next PP } if ($param eq "-o");
  sub { $timeout = shift; next PP } if ($param eq "-t");
  sub { $uname_secret = 1; next PP } if ($param eq "-n");
  sub { print "[sidentd, version v0.3]\n"; exit } if ($param eq "-V");
}

$SIG{"ALRM"} = sub { exit; };
alarm($timeout);

use Socket;

# No buffer, flush right away!
$| = 1;


sub answer {
  my $port1 = shift; my $port2 = shift; my $source_ip = shift;
  open(PROC_TCP,"</proc/net/tcp");
  <PROC_TCP>; # Skip Header/Info line!

LOOP:while ($proc_tcp = <PROC_TCP>) {
    my ($laddr,$lport,$raddr,$rport,$uid) = $proc_tcp =~ /^\s*\S+\: (\S+)\:(\S+)\s+(\S+)\:(\S+)\s+\S+\s+\S+\:\S+\s+\S+\:\S+\s+\S+\s+(\S+)/;
  
    $laddr = hex($laddr);
    $raddr = hex($raddr);
    $lport = hex($lport);
    $rport = hex($rport);

    # something like this was suggested by jay aych zeppelin@ootganootga.dok.org
    # don't see a reason for this(/proc/net/tcp is trusted, i suppose)..
    # but anyway... paranoia is a mighty ally!
    if (!((defined $lport) && (defined $rport))) {
      print "$port1 , $port2 : ERROR : UNKNOWN-ERROR\n"; 
      exit;
    }

    ($a,$b,$c,$d) = pack('I4',$laddr);
    $foo = $a . $b . $c . $d;
    $foo = substr($foo,0,4);
    $laddr = inet_ntoa($foo);
    undef $a,$b,$c,$d,$foo;  

    ($a,$b,$c,$d) = pack('I4',$raddr);
    $foo = $a . $b . $c . $d;
    $foo = substr($foo,0,4);
    $raddr = inet_ntoa($foo);
    undef $a,$b,$c,$d,$foo;  
  
    # Skip listening connections.
    next if ($raddr eq "0.0.0.0");
    
    if (($laddr eq $source_ip) || ($raddr eq $source_ip) 
# localhost can ask about every connection, maybe could be used for evading
# strict permissions on /proc/net/tcp. comment out the following line
# to change this behaviour.
         || ($source_ip eq "127.0.0.1")) 
    {
      if (($port1 eq $lport) && ($port2 eq $rport)) {
        ($unam) = getpwuid($uid);
        if (-d $fake_uid_dir) {
          if (-r $fake_uid_dir . "/" . $uid) {
            open(GFU,$fake_uid_dir . "/" . $uid);
            $fuid = <GFU>; chomp $fuid; close(GFU);
            $uidok = 1;
            if (-r $bad_fake_uids) {
              open(BUID,$bad_fake_uids);
              while ($buid = <BUID>) {
                chomp $buid;
                $uidok = 0 if ($fuid eq $buid);
              }
              close(BUID);
              undef $buid;
	    }
            $unam = $fuid if ((length($fuid) > 0) && (length($fuid) < 10) && ($uidok));
            undef $uidok;
          }
        }
        print "$port1 , $port2 : USERID : $os_type : $unam\n";
        $dtdtgtt = 1;
        last LOOP;
      }
    }
  }
  if (!$dtdtgtt) {
    print "$port1 , $port2 : ERROR : UNKNOWN-ERROR\n";
    undef $dtdtgtt
  }
  close (PROC_TCP);
}


MAIN: {
  local $in = <STDIN>;
  
  $in =~ /^\s*(\d+)\s*\,\s*(\d+)\s*$/;
  local $port1 = $1;  
  local $port2 = $2;  
  if (!(defined $port1 && defined $port2)) {
      print "0 , 0 : ERROR : UNKNOWN-ERROR\n";
      exit 1;
  }

  local $sockaddr = getpeername STDIN;

  # maybe jay aych meant this.  
  if (length($sockaddr) != 16) {
       print "0 , 0 : ERROR : UNKNOWN-ERROR\n";
       exit 1;
  }

  local ($port, $addr) = unpack_sockaddr_in($sockaddr);
  local $sip = inet_ntoa($addr);
  
  &answer($port1,$port2,$sip);
}
