gistfile1.txt

#!/usr/bin/perl
#
# no nonsense ident server by Tikiman
#  will kill processess that attract too many identd requests

# ipnat/FreeBSD mods by jjp.
#  This is a REALLY lame way to do it, but it works. 
#  Whatever UID this runs under would have to have:
#    Root access
#   -or-
#    Sudo access without password to lsof and ipnat.
#
#   Since you'd be using ipnat anyway, run this under a non-root ID
#    and simply use an rdr rule to redirect the local 113 port higher
#    If you don't have sudo, it's rather easy to install and setup, 
#    and it's worth having around when configured correctly.

use IO::Socket;
use IO::Select;

$^O =~ /freebsd/i or die "This version only for FreeBSD";

$high_port = "65536";  # Highest port to bother with. 
                       # This is needed to ensure bad data isn't received
                       # and thus passed into some potentially vulnerable
                       # code.

$listen_port = 113; # Change this to run under a different UID.
$use_sudo = 0;      # Set to 0 if running as root.
$use_ipnat = 1;     # Set to 1 to enable ipnat support 
                    #  NOTE: Support without ipnat not currently working
                    #        but if you're using this, you must want ipnat

$searchpath = "/sbin:/usr/sbin:/usr/local/sbin/"; # $PATH is evil

$kill_procs = 0;    # Kill runaway Processes?
                    #   Still in progress to work w/ipnat

# with these settings, a process will get killed if it attracts
#  5 identd requests over a 60 second period - this is most likely
#  to harsh, someting like 20 requests in 60 seconds will work better
$attempts = "5";    # number of allowed attempts per timespan
$timespan = "60";   # timespan

$timeout = 10;     # number of seconds to wait before the connection
                   #  gets closed

$timeout_cycle = 10; 

# if your identd server is pretty busy, idle sockets can be eliminated 
#  in a timely manner.  Otherwise, the server will just stay in blocking 
#  mode and never check for idle sockets - the timeout cycle allows the 
#  select loop to time out after a while and sweep out idle sockets.

%mappings = (
    "root" => "jim"
);

# these are username mappings - if you or find it more convenient to 
#  irc as root, you can map root to some other username.

#`killall in.identd 2>/dev/null`;  # kill off any old identd's

$lsof_cmd  = findcmd("lsof");    # Find lsof

unless $lsof_cmd {  # Can't run without lsof!
    die "lsof not found! Check path?";
}

if $use_ipnat { 
    $ipnat_cmd = findcmd("ipnat");   # Find ipnat
    unless $ipnat_cmd {
        die "Wanted ipnat support but ipnat not found! Check path?";
    }
    
}
if $use_sudo {
    $sudo_cmd  = findcmd("sudo");    # Find sudo
    if $sudo_cmd { # Preceed commands with sudo
        $lsof_cmd = $sudo_cmd . " " . $lsof_cmd;
        $ipnat_cmd = $sudo_cmd . " " . $ipnat_cmd;
    } else {
        die "Wanted sudo support but sudo not found! Check path?";
    }

}

forkoff();

$server = new IO::Socket::INET (
                                   LocalPort => $listen_port,
                                   Listen => 10,
                                   Reuse => 1 ); # open a socket

$server or die "Can't create server: $@\n";

$sel = new IO::Select($server);

while(1) {
    my $request;
    foreach my $client ($sel->can_read($timeout_cycle)) {
        if ($client == $server) {
            my $newclient = $server->accept;
            $sel->add($newclient);
            $timeout{$newclient} = time();
        } else {            
            my $read = sysread($client,$request,4098);

            unless (defined($read) and length($request)) {
                delete $timeout{$client};
                $sel->remove($client);
                close($client);
            }

            $request =~ s/\015|\012|\n//g;  # lose any obnoxious characters
            
            my($lport,$rport) = split(/\s*,\s*/,$request); # split the request
           
            if ((($lport =~ /^\d+.\d+$) 
                  || ($lport =~ /^\d+$/) 
                  || ($lport =~/^\.\d+$)) 
                  && ($lport < $high_port) { # Validate data as numeric
                my $locadd = $client->sockhost() . ":$lport"; 
            } else { 
                kill_conn(); # Don't waste our time with trash requests
                next;
            }

            if ((($rport =~ /^\d+.\d+$) 
                  || ($rport =~ /^\d+$/) 
                  || ($rport =~/^\.\d+$)) 
                  && ($rport < $high_port) { # Validate data as numeric
                my $remadd = $client->peerhost() . ":$rport"; 
            } else { 
                kill_conn(); # Don't waste our time with trash requests
                next;
            }

            $ipnat_cmd_exec = $ipnat_cmd . " -l | grep \"MAP \"";
            
            my $found = 0;
            my @tmp = split("\n",`$ipnat_cmd_exec`); # get active ipnat maps
            foreach (@tmp) {
                @tmp2 = split(/\s+/); 
                my $latochk = $tmp2[5] . ":" . $tmp2[6];
                my $ratochk = substr($tmp2[7],1,length($tmp2[7])) . ":" . chop($tmp2[8]);
                if (($latochk eq $locadd) and ($ratochk eq $remadd)) {

                    my $dest = sockaddr_in (113, $tmp2[2]);
                    connect (IPN, $dest) || { kill_conn(); next; }
                    my $data = $tmp2[3] . "," . $rport;
                    send (IPN, $data);
                    recv (IPN, $data);
                    my @reply = split(/' : '/, $data);
                    my $user = chomp($reply[3]);
                    $found = 1;
                }
            }   
            if !$found {
               my $lsoftochk = $lsof_cmd . " -ni tcp@" . $remadd;
               my @tmp = split("\n",`$lsoftochk`); # get matching connections
               my @conninfo = split(/\s+/,$tmp[2]); 
               my $addrmatch = $locadd . "->" . $remadd;
               if ($addrmatch eq $conninfo[8]) {
                   my $user = $conninfo[2];
                   my $procnum = $conninfo[1];
                   $found = 1;
               }
               
            }

            unless($found) { 
                # bogus requests dont even deserve a response
                kill_conn();
                next;
            }

            if $kill_procs {
                $arrayref = $times{$procnum}; 
                unless($arrayref) { # create array if necessary
                    $arrayref = [];
                    $times{$procnum} = $arrayref;
                }
                
                unshift(@$arrayref, time()); # stick latest time in the array
                $back = $arrayref->[$attempts - 1]; # this was the old value
                if ($back) {
                    pop(@$arrayref); # ensure array doesn't get out of control
                    if ( (time() - $back) < $timespan) { # do we need to kill?
                        kill(9,$procnum);
                        delete $times{$procnum};
                        shutdown($client,2);
                        next;
                    }
                }
            }
            
            exists $mappings{$user} and $user = $mappings{$user};

            print $client "$request : USERID : UNIX : $user\n";

            kill_conn();
        }
        sweepSocks();
    }
    sweepSocks();
}


sub sweepSocks {
    foreach $handle ($sel->handles) {
        next if $handle == $server;
        $tmp = time() - $timeout{$handle};
        if ($tmp > $timeout) {
            delete $timeout{$handle};
            $sel->remove($handle);
            close($handle);
        }
    }
}

sub forkoff {
    my $kid = fork();
    if ($kid) {
        print "Process launched into background ($kid)\n";
        exit;
    }
}

sub findcmd {
    @path = split(/:/$searchpath);
    foreach $i (@path) {
      if (-e "$path[$i]".$_[0]) { return "$path[$i]".$_[0]; }
    }
    return "";
}

sub kill_conn {
    delete $timeout{$client};
    $sel->remove($client);
    close($client);
}