rendered paste body #!/usr/bin/perl
# copyright by sonadi
#
# If we're gonna kill each other how we're gonna live forever?
# If we're gonna live forever how we're gonna kill each other?
#
use IO::Socket;
use IO::Select;
use LWP::UserAgent;
use HTTP::Request;
use strict;
my $myName = 'Sandworm';
my $myVer = '0.14';
my $nickreg = qr/(~[\w_]+)|([A-Za-z][\w_]{2,})/;
my $chanreg = qr/[\^\+&#][\w_]+/;
my $privreg = qr/cf\d.\d+/;
my $servreg = qr/c\w+?\.onet(\.pl)?/;
my %cookie;
my $chanlist;
my ($chld, $onet);
my %me = (nick => undef,
pass => undef,
realname => undef,
uokey => undef,
authkey => undef,
addr => 'czat-app.onet.pl',
port => 5015,
serv => undef,
cut_webcams => 1,
fake_who => 0,
cut_busy_mode => 1,
convert_emots => 1, # 1: //haha -> %Ihaha%
channel_history => 4 # 0: drop messages, 1: display as normal PRIVMSG, 2: PRIVMSG + timestamp
# 3: as NOTICE, 4: as NOTICE + timestamp
);
##########################
my $main = new IO::Socket::INET (LocalHost => 'localhost',
LocalPort => 9999,
Listen => 5,
Proto => 'tcp',
Reuse => 1
);
die "Could not create main socket: $!\n" unless $main;
##########################
$SIG{'CHLD'} = 'IGNORE';
while ($chld = $main->accept()) {
my $pid = fork;
die "Could not fork: $!\n" unless defined $pid;
# child
if ($pid == 0) {
my $buf;
close $main;
while ($buf = <$chld>) {
$me{'pass'} = $1 if ($buf =~ /^PASS (\w+)/);
$me{'realname'} = $1 if ($buf =~ /^USER.*:(.+)/);
$me{'nick'} = $1 if ($buf =~ /^NICK ($nickreg)/);
last if $me{'nick'} and $me{'realname'};
}
$me{'realname'} =~ s/[^\w\s\d]//g;
print "Connection from: $me{'nick'}/$me{'realname'}; with password=" . ($me{'pass'} ? "1" : "0") . ";\n";
quote($chld, "3Hello, $me{'nick'}!\n3$myName v$myVer by sonadi\n3May Shai-Hulud clear the path for you\n \n");
quote($chld, "6Oh, oh. Type: '/quote tunel help' for more oh's\n");
# initialize connection to server: get authkey, uokey and so on
init($onet);
my $select = new IO::Select($onet, $chld);
# ok, main part, onet <-> me <-> client
my @ready;
my ($rest, $dest);
while (@ready = $select->can_read(180)) {
foreach $dest (@ready) {
my $msg;
sysread($dest, $msg, 10000);
unless ($msg) {
exit 0;
}
# add previous part
$msg = $rest . $msg;
for ($msg =~ /(.*?\n)/g) {
ronet($_) if ($dest == $onet);
rme($_) if ($dest == $chld);
}
if ($msg !~ /\n$/) {
($rest) = $msg =~ /(.*?)$/;
}
else {
$rest = undef;
}
}
}
exit 0;
}
# parent goes here
# do nothing
}
close $main;
####################
# initialize connection to onet
sub init {
my $key;
$onet = new IO::Socket::INET (PeerAddr => $me{'addr'},
PeerPort => $me{'port'}
);
die "Could not create socket: $!" unless $onet;
# set encoded authkey
quote($onet, "AUTHKEY\n");
quote($onet, "NICK $me{'nick'}\n");
$key = <$onet>;
$key = <$onet>;
ronet($key);
$me{'authkey'} = authkey($me{'authkey'});
quote($onet, "AUTHKEY $me{'authkey'}\n");
uokey();
quote($onet, "USER * $me{'uokey'} czat-app.onet.pl :00,01$me{'realname'} on $myName\n");
# why not?
$me{'pass'} = undef;
}
# send $msg directly to $socket
sub quote {
my ($socket, $msg) = @_;
print $socket "$msg";
}
# $buf from $onet to $chld goes here
sub ronet {
my ($buf) = @_;
my $raw;
$raw = $1 if $buf =~ / (\S*) /;
if ($buf =~ /^ERROR :Closing Link:/) {
exit;
}
# get server name
elsif ($raw eq '001') {
$me{'serv'} = $1 if ($buf =~ /^:(\S+) /);
}
elsif ($raw eq '005') {
$buf =~ s/CHANTYPES=^#/CHANTYPES=+#/;
}
# old 006 - authkey
elsif ($raw eq '801') {
$me{'authkey'} = $1 if $buf =~ /^:[^:]+:(.{16})/;
$buf = undef;
}
# begin of LIST
elsif ($raw eq '818') {
$buf = undef;
$chanlist = undef;
}
# support for LIST
elsif ($raw eq '819') {
# all bullshit out
$buf =~ s/^:.*?://;
foreach (split ',', $buf) {
my ($c, $m, $p) = split ':';
chomp $p;
$chanlist .= ":$me{'serv'} 322 $me{'nick'} $c $p :$m\n";
}
$buf = undef;
}
# end of LIST
elsif ($raw eq '820') {
$buf = $chanlist;
$buf =~ tr/
//d;
}
# channel history
elsif ($raw eq '817') {
unless ($me{'channel_history'} || $me{'channel_history'} > 4) {
$buf = undef;
}
elsif ($buf =~ /^:$servreg \d+ $nickreg ($chanreg) (\d+) ($nickreg) - (:.*)/) {
$buf = ":$6!sandworm\@sandworm PRIVMSG $4 $9";
my $time = $5;
$buf =~ s/PRIVMSG/NOTICE/ if $me{'channel_history'} > 2;
if ($me{'channel_history'} == 2 || $me{'channel_history'} == 4) {
my ($sec, $min, $hour) = localtime($time);
$buf =~ y/
//d;
$buf .= sprintf(" 3(%02d:%02d:%02d)\n", $hour, $min, $sec);
}
else {
$buf .= "\n";
}
}
}
elsif ($raw eq 'MODERMSG') {
if ($buf =~ /^:([^!]+)\S* MODERMSG (\S*) \S* (\S*) :(.*)/) {
$buf = ":$2!fake\@fake PRIVMSG $3 :$4 ($1)\n";
$buf =~ s/
//g;
}
}
elsif ($raw eq 'MODERNOTICE') {
if ($buf =~ /^:([^!]+)\S* MODERNOTICE (\S*) :(.*)/) {
$buf = ":$1!fake\@fake NOTICE $2 :$3\n";
}
}
elsif ($raw eq 'MODE') {
if (($buf =~ /[\+\-](W|P)\S*/) && ($me{'cut_webcams'} == 1)) {
$buf = undef;
}
elsif (($buf =~ /[\+\-]b\S*/) && ($me{'cut_busy_mode'} == 1)) {
$buf = undef;
}
}
elsif ($raw eq 'NOTICE') {
if ($buf =~ /^:ChanServ/) {
my $copy = $buf;
if ($copy =~ /(\d{10})/g) {
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($1);
my $date = "$hour:$min:$sec $mday/$mon";
$buf =~ s/$1/$date/;
}
}
}
elsif ($raw eq '353') { # names, no need no more?
my ($serv, undef, $nick, $type, $chan, @ppl) = split (' ', $buf);
if ($me{'fake_who'}) {
foreach (@ppl) {
my ($n, $m) = $_ =~ /^([`!@%\+]*)([^`!@%\+]+)$/;
$buf .= "$serv 352 $nick $chan * OnetChat $me{'serv'} $m H$n :0 [---]\n";
}
$buf .= "$serv 315 $nick $chan :End of WHO list.\n";
}
}
# TODO: privy
$buf =~ s/\^(?=$privreg)/+/;
### cut'em all!
$buf =~ s/%[FC].*?%//g;
$buf =~ s/%I(\S*?)%/<$1>/g;
$buf =~ s/%%/%/g;
quote($chld, $buf) if $buf;
}
# $buf from $chld to $onet goes here
sub rme {
my ($buf) = @_;
if ($buf =~ /^TUNEL HELP/i) {
quote($chld, "$me{'serv'} Usage:\nTUNEL GET [option]\nTUNEL SET option[,options...] value[,values...]\n");
$buf = undef;
}
elsif ($buf =~ /^TUNEL SET (\S+) (\S+)/i) {
my @o = split ',', $1;
my @a = split ',', $2;
return if (scalar @o != scalar @a);
for (my $i = 0; $i < scalar @o; $i++) {
$me{ $o[$i] } = $a[$i] if exists $me{ $o[$i] };
}
$buf = undef;
}
elsif ($buf =~ /^MODERMSG (\S*) \S* (\S*) :(.*)/i) {
quote($chld, ":$1!fake\@fake PRIVMSG $2 :$3\n");
}
elsif ($buf =~ /^MODERNOTICE (\S*) :(.*)/i) {
quote($chld, ":$me{'nick'}!fake\@fake NOTICE $1 :$2\n");
}
elsif ($buf =~ /^TUNEL GET/i) {
if ($buf =~ /^TUNEL GET (\S+)/i) {
$buf = $me{'serv'} + ' TUNEL: ' . lc $1 . ' = ' . $me{lc $1} . "\n";
quote($chld, $buf) if exists $me{$1};
}
else {
my ($key, $val);
$buf = $me{'serv'} . ' ';
while (($key, $val) = each %me) {
$buf .= "TUNEL: $key = $val\n";
}
quote($chld, $buf);
}
$buf = undef;
}
elsif ($buf =~ /^LIST.*/i) {
$buf = "SLIST\n";
}
elsif ($buf =~ /^JOIN \+/i) {
$buf =~ y/+/^/;
}
$buf =~ s/\+(?=$privreg)/^/;
# convert %% -> %
$buf =~ s/\%/\%\%/g;
# convert emots, e.g.: from //haha to %Ihaha%
# convert also <haha> to %Ihaha%
if ($buf =~ /^(PRIVMSG|TOPIC|NOTICE|PART|QUIT) /) {
$buf =~ s/\/\/([A-Za-z][\w_]*)(?=[^\.,-:\w])/%I$1%/g if ($me{'convert_emots'});
}
$buf =~ s/(^NOTICE \S* :VERSION .*)/$1 \[$myName v$myVer\]/;
$buf = undef if ($buf =~ /^USER /);
quote($onet, $buf) if $buf;
}
#####################
# Onet Authorization
sub authkey {
my ($s) = @_;
my $s1;
my (@f1) = (
29, 43, 7, 5, 52, 58, 30, 59, 26, 35,
35, 49, 45, 4, 22, 4, 0, 7, 4, 30,
51, 39, 16, 6, 32, 13, 40, 44, 14, 58,
27, 41, 52, 33, 9, 30, 30, 52, 16, 45,
43, 18, 27, 52, 40, 52, 10, 8, 10, 14,
10, 38, 27, 54, 48, 58, 17, 34, 6, 29,
53, 39, 31, 35, 60, 44, 26, 34, 33, 31,
10, 36, 51, 44, 39, 53, 5, 56
);
my (@f2) = (
7, 32, 25, 39, 22, 26, 32, 27, 17, 50,
22, 19, 36, 22, 40, 11, 41, 10, 10, 2,
10, 8, 44, 40, 51, 7, 8, 39, 34, 52,
52, 4, 56, 61, 59, 26, 22, 15, 17, 9,
47, 38, 45, 10, 0, 12, 9, 20, 51, 59,
32, 58, 19, 28, 11, 40, 8, 28, 6, 0,
13, 47, 34, 60, 4, 56, 21, 60, 59, 16,
38, 52, 61, 44, 8, 35, 4, 11
);
my (@f3) = (
60, 30, 12, 34, 33, 7, 15, 29, 16, 20,
46, 25, 8, 31, 4, 48, 6, 44, 57, 16,
12, 58, 48, 59, 21, 32, 2, 18, 51, 8,
50, 29, 58, 6, 24, 34, 11, 23, 57, 43,
59, 50, 10, 56, 27, 32, 12, 59, 16, 4,
40, 39, 26, 10, 49, 56, 51, 60, 21, 37,
12, 56, 39, 15, 53, 11, 33, 43, 52, 37,
30, 25, 19, 55, 7, 34, 48, 36
);
my (@p1) = (
11, 9, 12, 0, 1, 4, 10, 13, 3, 6,
7, 8, 15, 5, 2, 14
);
my (@p2) = (
1, 13, 5, 8, 7, 10, 0, 15, 12, 3,
14, 11, 2, 9, 6, 4
);
my (@ai);
my (@ai1);
for (my $i = 0; $i < 16; $i++) {
my $c = ord(substr($s, $i, 1));
$ai[$i] = ($c> ord('9') ? $c> ord('Z') ? ($c - 97) + 36 : ($c - 65) + 10 : $c - 48);
}
for (my $j = 0; $j < 16; $j++) {
$ai[$j] = $f1[ $ai[$j] + $j];
}
(@ai1) = (@ai);
for (my $k = 0; $k < 16; $k++) {
$ai[$k] = ($ai[$k] + $ai1[$p1[$k]]) % 62;
}
for (my $l = 0; $l < 16; $l++) {
$ai[$l] = $f2[$ai[$l] + $l];
}
(@ai1) = (@ai);
for (my $i1 = 0; $i1 < 16; $i1++) {
$ai[$i1] = ($ai[$i1] + $ai1[$p2[$i1]]) % 62;
}
for (my $j1 = 0; $j1 < 16; $j1++) {
$ai[$j1] = $f3[$ai[$j1] + $j1];
}
for (my $k1 = 0; $k1 < 16; $k1++) {
my $l1 = $ai[$k1];
$ai[$k1] = $l1 >= 10 ? $l1>= 36 ? (97 + $l1) - 36 : (65 + $l1) - 10 : 48 + $l1;
$s1 .= chr($ai[$k1]);
}
return $s1;
}
sub uokey {
my ($nick, $pass) = ($me{'nick'}, $me{'pass'});
my ($key, $res);
if ($pass) {
getspoof(url => 'http://secure.onet.pl/_s/kropka/1?DV=secure');
getspoof(url => 'http://czat.onet.pl/', content => 'client.html?ch=sandworm&e=0');
getspoof(url => 'http://secure.onet.pl/mlogin.html', content => 'r=&url=&login=' . $me{'nick'} . '&haslo=' . $me{'pass'} . '&app_id=20&ssl=1&ok=1');
$res = getspoof(url => 'http://czat.onet.pl/include/ajaxapi.xml.php3', content => 'api_function=getUoKey¶ms=a:3:{s:4:"nick";s:'
. length($me{'nick'}) . ':"' . $me{'nick'} . '";s:8:"tempNick";i:0;s:7:"version";s:3:"ksz";}');
}
else {
my $n = substr($me{'nick'}, 1);
$res = getspoof(url => 'http://czat.onet.pl/_s/kropka/1?DV=secure');
$res = getspoof(url => 'http://czat.onet.pl/include/ajaxapi.xml.php3', content => 'api_function=getUoKey¶ms=a:3:{s:4:"nick";s:'
. length($n) . ':"' . $n . '";s:8:"tempNick";i:1;s:7:"version";s:3:"ksz";}');
}
if ($res->{content} =~ m#<uoKey>(.{32})</uoKey>#i) {
$me{'uokey'} = $1;
}
else {
print $1 if $res->{content} =~ m#err_text="([^"]*)"#;
}
}
sub getspoof {
my (%prm) = @_;
my $ua = new LWP::UserAgent (timeout => 30);
$ua->agent("Mozilla/5.0 (X11; Unix)");
my $req;
if ($prm{'content'}) {
$req = new HTTP::Request (POST => $prm{url});
}
else {
$req = new HTTP::Request (GET => $prm{url});
}
my $cook;
foreach (keys %cookie) {
$cook .= $_ . '=' . $cookie{$_} . '; ';
}
$cook =~ s/; $//;
$req->header('Cookie' => $cook);
$req->header('Content-Type' => 'application/x-www-form-urlencoded');
$req->header('Accept' => 'image/gif, text/html, application/xhtml+xml, application/xml, */*;q=0.1');
$req->content($prm{'content'}) if ($prm{'content'});
my $res = $ua->request($req);
my $out;
foreach ($res->header('set-cookie')) {
s/;.*$//;
my ($cook2, $val) = split /=/, $_;
$cookie{$cook2} = $val;
$out->{'cookie'} .= "\n$cook2=$val; ";
}
$out->{'cookie'} =~ s/; $//;
$out->{'content'} = $res->content;
$out;
}
#
#####################