#!/usr/bin/perl
# Secure identd v0.5 by Paul S. Boehm <pb@insecurity.net>
# patched for masq support aoe 1999
##
## This Program is under heavy development. As you can see from the
## the changelog at least every 4 days a new version will be available but
## won't be announced everytime, but instead be simply put onto the webpage. 
## This will continue until version 1.0, which should be stable as hell,
## and have all the features needed.
##
# ChangeLog:
# v0.5aoe1 1999     added masq parsing alexander@oelzant.priv.at
# v0.5 Sep 15 '98 - Reads only at most 20 chars from STDIN, then halfcloses the
#                   socket to prevent memory junkflooding, 
#                                      (suggested by wietse venema)
#
# v0.4 Sep 15 '98 - Added security check for $uid (suggested by kevin vajk)
#                   Added char restriction to fakeunames,
#                   Added code to prevent users from faking other users.
#                   Added new commandline params for new features.
#                   Commandline args now toggle instead of set to fixed value.
#                   Checks for /proc/net/tcp and reports when incompatible.
#                   
# 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.
#
## 

# important global settings

$masq_firewall="192.168.2.100";
$debug=0;

# Please at least use perl 5.003!
require 5.003;

use IPC::Open2;
#use strict;
use Socket;


# Global default variables
# Command line options toggle the 0/1 defines.

# 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;

# Respond with random number instead of Usernames (-s)
$uname_random = 0;

# Disallow users to fake other users on the same sys
$no_fake_others = 1; # (-f)

# Only allow the following chars in faked usernames(\ nonalphanumeric chars)
$ok_chars = '0123456789abcdefghijklmnopqrstuvwxyz\_\-';
$use_ok_chars = 1; # (-u)

$hostname = `/bin/hostname`;

#PP: while ($param = shift) {
#  sub { $os_type = "OTHER"; next PP } if ($param eq "-o");
#  sub { $timeout = shift || "120"; next PP } if ($param eq "-t");
#  sub { $uname_secret = &tog($uname_secret); next PP } if ($param eq "-n");
#  sub { $uname_random = &tog($uname_random); next PP } if ($param eq "-s");
#  sub { $no_fake_others = &tog($no_fake_others); next PP } if ($param eq "-f");
#  sub { $use_ok_chars = &tog($use_ok_chars); next PP } if ($param eq "-u");
#  sub { print "[sidentd secret, version v0.5 patched]\n"; exit 0; } if ($param eq "-V");
#}

PP: while ($param = shift) {
if ($param eq "-o")
  { $os_type = "OTHER"; next PP }; 
if ($param eq "-t")
  { $timeout = shift || "120"; next PP };
if ($param eq "-n")
  { $uname_secret = &tog($uname_secret); next PP } ;
if ($param eq "-s")
  { $uname_random = &tog($uname_random); $os_type="OTHER"; next PP }; 
if ($param eq "-f")
  { $no_fake_others = &tog($no_fake_others); next PP }; 
if ($param eq "-u")
  { $use_ok_chars = &tog($use_ok_chars); next PP }; 
if ($param eq "-V")
  { print "[sidentd secret, version v0.5 patched]\n"; exit 0; } 
}

$timeout = 120 if ($timeout =~ /\D/);

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

use IO::Socket;
use Sys::Syslog;

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

# log as authentication facility
openlog("sidentd","pid","authpriv");

sub tog {
  my $tog = shift;
  if ($tog) { return 0; } else { return 1; }
}

sub debugprint {
  if ($debug) {
    $_=shift;
    print;
#    syslog("debug","%s",$_);
  }
}
	
# error printing routine
sub eprint {
  $errmsg=shift;
  if ($uname_random) {
	  $ticket=rand;
	  $realmsg="$port1 , $port2 : USERID : $os_type : $ticket\n";
	  $logmsg="$realmsg (=$errmsg)\n";
  } else {
	  $realmsg=$logmsg=$errmsg;
  };
  syslog("err","%s: %m",($logmsg));
  print $realmsg;
} 

# success printing routine
sub sprint {
  $unam=shift;
  if ($uname_random) {
	  $ticket=rand;
	  $realmsg="$port1 , $port2 : USERID : $os_type : $ticket\n";
	  $logmsg="$port1 , $port2 : USERID : $os_type : $ticket (=$unam)\n";
  } else {
	  $realmsg=$logmsg=$unam;
  };
  syslog("info","%s","$source_ip -> $logmsg");
  print $realmsg;
} 

sub answer {
  my $port1 = shift; my $port2 = shift; $source_ip = shift;
  open(PROC_TCP,"<" . "/proc/net/tcp");

  # Linux only :(
  $sys_ok = <PROC_TCP>; 
  if ($sys_ok !~ /local_address/) {
    &fetch_auths_from_lan;
    &eprint( "$port1 , $port2 : ERROR : UNKNOWN-ERROR\n");
    exit 1;
  }
  undef $sys_ok;

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+)/;

    # Check if uid is non digit.. paranoia is a mighty ally!
    #     (suggested by kevin vajk - kvajk@ricochet.net)
    if ($uid =~ /\D/) {
      &eprint( "$port1 , $port2 : ERROR : UNKNOWN-ERROR\n"); 
    }
  
    $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... again: paranoia is a mighty ally!
    if (!((defined $lport) && (defined $rport) && (defined $uid))) {
      &eprint( "$port1 , $port2 : ERROR : UNKNOWN-ERROR\n"); 
      exit 1;
    }

    ($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");
    &debugprint("$laddr:$lport <-> $raddr:$rport $uid\n");
    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 $masq_firewall) 
         || ($source_ip eq "127.0.0.1")) 
    {
      if (($port1 eq $lport) && ($port2 eq $rport)) {
        ($unam) = getpwuid($uid);

        if (-d $fake_uid_dir) { # if directory for faking exists
          if (-r $fake_uid_dir . "/" . $uid) { # and user may fake

            open(GFU,"<" . $fake_uid_dir . "/" . $uid); # fetch wanted uname
            $fuid = <GFU>; chomp $fuid; close(GFU);
            $uidok = 1;
                             # and check if it contains disallowed chars
            if (($use_ok_chars) && ($ok_chars)) { 
              $uidok = 0 if ($fuid =~ /[^$ok_chars]/);
            }
                             # or if user trys to fake another user
            if (($no_fake_others) && ($uidok)) {
               open (PASSWD,"<" . "/etc/passwd");
               PASSWD: while(<PASSWD>) {
                 ($left) = split(/:/, $_, 2);
                 sub { $uidok = 0; last PASSWD } if ($fuid eq $left);
               }
               close(PASSWD);
            }
                     # or if admin decided this uname may not be used
            if ((-r $bad_fake_uids) && ($uidok)) {
              open(BUID,"<" . $bad_fake_uids);
              while ($buid = <BUID>) {
                chomp $buid;
                $uidok = 0 if ($fuid eq $buid);
              }
              close(BUID);
              undef $buid;
	    }
            # if everything's ok and uname has valid length, set it!
            $unam = $fuid if ((length($fuid) > 0) && (length($fuid) < 10) && ($uidok));
            undef $uidok;
          }
        } # faking end
        &sprint("$port1 , $port2 : USERID : $os_type : $unam\n");
        $dtdtgtt = 1; # did that, done that, got the tshirt!
        last LOOP;
      }
    }
  }
  if (!$dtdtgtt) {
    &debugprint ("no result, going for a walk\n");
    &fetch_auths_from_lan;
    &eprint( "$port1 , $port2 : ERROR : UNKNOWN-ERROR\n");
    undef $dtdtgtt
  }
  close (PROC_TCP);
}


MAIN: {
  # Only get first 20 chars to prevent filling the memory with junk...
  #   thanks to wietse venema (wietse@porcupine.org) for reporting this.

  $in = "";
  GETIN: while (sysread(STDIN,$tin,1)) {
    $in .= $tin;
    last GETIN if ($tin eq "\n");
    last GETIN if (length($in) > 20);
  }

  # That's it.. thank you! (don't accept anything from stdin anymore)
  shutdown STDIN, 0;

  if (!($in =~ /^\s*(\d+)\s*\,\s*(\d+)\s*$/)) {
      &eprint( "0 , 0 : ERROR : UNKNOWN-ERROR\n");
      exit 1;
  }

  local $port1 = $1;  
  local $port2 = $2;  
  if (!(defined $port1 && defined $port2)) {
      &eprint( "0 , 0 : ERROR : UNKNOWN-ERROR\n");
      exit 1;
  }

  local $sockaddr = getpeername STDIN;
  if (length($sockaddr) != 16) {
       &eprint( "0 , 0 : ERROR : UNKNOWN-ERROR\n");
       exit 1;
  }

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


sub fetch_auths_from_lan {

#    if ($hostname !~ /fronteras/){return};

    open TCP,"</proc/net/ip_masq/tcp";
    $sys_ok = <TCP>; 
    if ($sys_ok !~ /SrcIP/) {
	return 1;
    }
    undef $sys_ok;
    while (defined($_=<TCP>)) {
      if (/^TCP  (..)(..)(..)(..):(....) (..)(..)(..)(..):(....) (..)(..)(..)(..):(....) .*/) {
        $fraddr=hex($6).".".hex($7).".".hex($8).".".hex($9);
        $frport=hex($10);
#        $fladdr=hex($5);
        $flport=hex($15);
          $fiaddr=hex($1).".".hex($2).".".hex($3).".".hex($4);
          $fiport=hex($5);
    &debugprint("$fiaddr:$fiport <-> $fraddr:$frport via $masq_firewall:$flport\n");
        if (($flport == $port1) && ($frport == $port2) && ($fraddr ==
	  $source_ip)) {
          open STDERR,">/dev/null";
	  &debugprint ("connecting to $fiaddr for $fiport, $port2\n");
          $socket = IO::Socket::INET->new( Proto     => "tcp",
                                                PeerAddr  => $fiaddr,
                                                PeerPort  => "auth(113)",
                                               );
          if ($socket) { 
            $socket->autoflush(1);
            $socket->timeout(10);
            $socket->send("$fiport, $port2\015\012\015\012");

            while(defined($_=<$socket>)) {
	      &debugprint($_);
	      if (/:.*:/){
		$t=$_;
		$tp=$fiport;
		close $socket
	      }
	    }
            close $socket;
	  } else {die "socket: $1";};
	}
      }
    }
    $_=$t;
    if (/:.*:/) {
      s/$tp/$port1/; 
      &sprint("$_");
      if (!$debug){ exit(0);};
    };
}
sub old_fetch_auths_from_lan {
    my ($t,$socket,$remote,$port, $iaddr, $paddr, $proto, $line);

    $t="";

    if ($hostname !~ /fronteras/){return};
#      open2(\*Reader,\*Writer,"/usr/bin/telnet df auth");
    $remote = "df";
    $port="auth(113)";
    if ($port =~ /\D/) { $port = getservbyname($port, 'tcp') }
    die "No port" unless $port;
    $iaddr   = inet_aton($remote)               || die "no host: $remote"
    ;
    $paddr   = sockaddr_in($port, $iaddr);
    
    $proto   = getprotobyname('tcp');
    open STDERR,">/dev/null";
#    socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
               $socket = IO::Socket::INET->new( Proto     => "tcp",
                                                PeerAddr  => $remote,
                                                PeerPort  => $port,
                                               );
               if ($socket) { 
                 $socket->autoflush(1);
                 $socket->timeout(10);
                 $socket->send("$port1 , $port2\015\012\015\012");

#    connect(SOCK, $paddr)    || die "connect: $!";
#    print SOCK "$port1 , $port2\n\n\n";
                 while(<$socket>) {if (/:.*:/){$t=$_;close $socket}}
                 close $socket;
	       } else {die "socket: $1";};
#      $_=`(/bin/echo $port1,$port2)|/usr/bin/telnet df auth 2>/dev/null`;
    $_=$t;
    $t="";
    if (/UNKNOWN-ERROR/ || /^$/) {
      open2(\*Reader,\*Writer,"/usr/bin/telnet fronteras auth");
      print Writer "$port1,$port2\n";
      while(<Reader>) {$t=$_ if (/:.*:/)}
      close Reader;
      close Writer;
#      $_=`(/bin/echo $port1,$port2)|/usr/bin/telnet fronteras auth 2>/dev/null`;
    };
    $_=$t;
#    if (!/^$/ && !/UNKNOWN-ERROR/) {
#      $t=$_;
#      for (split("\n",$t)){ 
        if (/:.*:/) {
          &sprint("$_");
          exit 0;
        };
#      }; 
#    };
};