#!/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&params=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&params=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;

}

#
#####################