API tools faq
paste
Advertisement
cheako

General M-i-t-M transparent proxy for linux, supports Diabo

cheako
Apr 29th, 2012
408
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 36.58 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl -w
  2.  
  3. # $Id: tproxy.pl,v 1.81 2009/08/01 02:56:31 root Exp root $
  4. # A socket proxy deamon.
  5.  
  6. use strict;
  7. use warnings;
  8.  
  9. use feature "switch";
  10.  
  11. use IO::Socket;
  12. use IO::Async::Loop;
  13. use IO::Async::Stream;
  14. use POE::Filter::Block;
  15. use constant;
  16.  
  17. *STDOUT->autoflush(1);
  18.  
  19. use constant LISTEN_PORT => 8081;
  20.  
  21. use constant Client => 0;
  22. use constant Server => 1;
  23. use constant DIRTXT => ("Client", "Server", "Server raw", "Server rblock",
  24.     "Server uncomp");
  25. my %connections; # $CONNECTC_PORT = [ clientpkthandler, serverpkthandler,
  26. #   POE::Filter::Block client, POE::Filter::Block server,
  27. #   POE::Filter::Block serveruncomp, [ [ skilltree ] ], CONNECTS_HOST ];
  28. #       skilltree = [ total, base, ext ];
  29.  
  30. my $callme = sub { return 0; };
  31. my $loop = IO::Async::Loop->new;
  32.  
  33. ####################
  34. # Helper Functions #
  35. ####################
  36. sub hexprint {
  37.     my $buff = shift @_;
  38.     open(CC, "|/usr/bin/hd -C | uniq");
  39.     print CC $buff;
  40.     close CC;
  41. }
  42. sub defaultpkthandler {
  43.     my $buff = shift @_;
  44.     my $direction = shift @_;
  45.     my $CONNECTC_PORT = shift @_;
  46.     print "". (DIRTXT)[$direction] ." ${CONNECTC_PORT}:\n";
  47.     hexprint $buff;
  48. }
  49. ########################
  50. # End Helper Functions #
  51. ########################
  52.  
  53. ######################################################
  54. # Code jacked from mantralord, Cthulhon, and binrapt #
  55. ######################################################
  56. # http://heroinglands.googlecode.com/svn/trunk/heroin/compression.cpp
  57.  
  58. use constant index_table => (
  59.     0x0247, 0x0236, 0x0225, 0x0214, 0x0203, 0x01F2, 0x01E1, 0x01D0,
  60.     0x01BF, 0x01AE, 0x019D, 0x018C, 0x017B, 0x016A, 0x0161, 0x0158,
  61.     0x014F, 0x0146, 0x013D, 0x0134, 0x012B, 0x0122, 0x0119, 0x0110,
  62.     0x0107, 0x00FE, 0x00F5, 0x00EC, 0x00E3, 0x00DA, 0x00D1, 0x00C8,
  63.     0x00BF, 0x00B6, 0x00AD, 0x00A8, 0x00A3, 0x009E, 0x0099, 0x0094,
  64.     0x008F, 0x008A, 0x0085, 0x0080, 0x007B, 0x0076, 0x0071, 0x006C,
  65.     0x0069, 0x0066, 0x0063, 0x0060, 0x005D, 0x005A, 0x0057, 0x0054,
  66.     0x0051, 0x004E, 0x004B, 0x0048, 0x0045, 0x0042, 0x003F, 0x003F,
  67.     0x003C, 0x003C, 0x0039, 0x0039, 0x0036, 0x0036, 0x0033, 0x0033,
  68.     0x0030, 0x0030, 0x002D, 0x002D, 0x002A, 0x002A, 0x0027, 0x0027,
  69.     0x0024, 0x0024, 0x0021, 0x0021, 0x001E, 0x001E, 0x001B, 0x001B,
  70.     0x0018, 0x0018, 0x0015, 0x0015, 0x0012, 0x0012, 0x0012, 0x0012,
  71.     0x000F, 0x000F, 0x000F, 0x000F, 0x000C, 0x000C, 0x000C, 0x000C,
  72.     0x0009, 0x0009, 0x0009, 0x0009, 0x0006, 0x0006, 0x0006, 0x0006,
  73.  
  74.     0x0003, 0x0003, 0x0003, 0x0003, 0x0003, 0x0003, 0x0003, 0x0003,
  75.     0x0003, 0x0003, 0x0003, 0x0003, 0x0003, 0x0003, 0x0003, 0x0003,
  76.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  77.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  78.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  79.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  80.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  81.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  82.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  83.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  84.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  85.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  86.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  87.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  88.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  89.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  90.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
  91.     0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000
  92. );
  93.  
  94. use constant character_table => (
  95.     0x00, 0x00, 0x01, 0x00, 0x01, 0x04, 0x00, 0xFF, 0x06, 0x00, 0x14, 0x06,
  96.     0x00, 0x13, 0x06, 0x00, 0x05, 0x06, 0x00, 0x02, 0x06, 0x00, 0x80, 0x07,
  97.     0x00, 0x6D, 0x07, 0x00, 0x69, 0x07, 0x00, 0x68, 0x07, 0x00, 0x67, 0x07,
  98.     0x00, 0x1E, 0x07, 0x00, 0x15, 0x07, 0x00, 0x12, 0x07, 0x00, 0x0D, 0x07,
  99.     0x00, 0x0A, 0x07, 0x00, 0x08, 0x07, 0x00, 0x07, 0x07, 0x00, 0x06, 0x07,
  100.     0x00, 0x04, 0x07, 0x00, 0x03, 0x07, 0x00, 0x6C, 0x08, 0x00, 0x51, 0x08,
  101.     0x00, 0x20, 0x08, 0x00, 0x1F, 0x08, 0x00, 0x1D, 0x08, 0x00, 0x18, 0x08,
  102.     0x00, 0x17, 0x08, 0x00, 0x16, 0x08, 0x00, 0x11, 0x08, 0x00, 0x10, 0x08,
  103.     0x00, 0x0F, 0x08, 0x00, 0x0C, 0x08, 0x00, 0x0B, 0x08, 0x00, 0x09, 0x08,
  104.     0x01, 0x96, 0x09, 0x97, 0x09, 0x01, 0x90, 0x09, 0x95, 0x09, 0x01, 0x64,
  105.     0x09, 0x6B, 0x09, 0x01, 0x62, 0x09, 0x63, 0x09, 0x01, 0x56, 0x09, 0x58,
  106.     0x09, 0x01, 0x52, 0x09, 0x55, 0x09, 0x01, 0x4D, 0x09, 0x50, 0x09, 0x01,
  107.     0x45, 0x09, 0x4C, 0x09, 0x01, 0x40, 0x09, 0x43, 0x09, 0x01, 0x31, 0x09,
  108.     0x3B, 0x09, 0x01, 0x28, 0x09, 0x30, 0x09, 0x01, 0x1A, 0x09, 0x25, 0x09,
  109.     0x01, 0x0E, 0x09, 0x19, 0x09, 0x02, 0xE2, 0x0A, 0xE8, 0x0A, 0xF0, 0x0A,
  110.     0xF8, 0x0A, 0x02, 0xC0, 0x0A, 0xC2, 0x0A, 0xCE, 0x0A, 0xE0, 0x0A, 0x02,
  111.     0xA0, 0x0A, 0xA2, 0x0A, 0xB0, 0x0A, 0xB8, 0x0A, 0x02, 0x8A, 0x0A, 0x8F,
  112.     0x0A, 0x93, 0x0A, 0x98, 0x0A, 0x02, 0x81, 0x0A, 0x82, 0x0A, 0x83, 0x0A,
  113.     0x89, 0x0A, 0x02, 0x7C, 0x0A, 0x7D, 0x0A, 0x7E, 0x0A, 0x7F, 0x0A, 0x02,
  114.     0x77, 0x0A, 0x78, 0x0A, 0x79, 0x0A, 0x7A, 0x0A, 0x02, 0x73, 0x0A, 0x74,
  115.     0x0A, 0x75, 0x0A, 0x76, 0x0A, 0x02, 0x6E, 0x0A, 0x6F, 0x0A, 0x70, 0x0A,
  116.     0x72, 0x0A, 0x02, 0x61, 0x0A, 0x65, 0x0A, 0x66, 0x0A, 0x6A, 0x0A, 0x02,
  117.     0x5D, 0x0A, 0x5E, 0x0A, 0x5F, 0x0A, 0x60, 0x0A, 0x02, 0x57, 0x0A, 0x59,
  118.     0x0A, 0x5A, 0x0A, 0x5B, 0x0A, 0x02, 0x4A, 0x0A, 0x4B, 0x0A, 0x4E, 0x0A,
  119.     0x53, 0x0A, 0x02, 0x46, 0x0A, 0x47, 0x0A, 0x48, 0x0A, 0x49, 0x0A, 0x02,
  120.     0x3F, 0x0A, 0x41, 0x0A, 0x42, 0x0A, 0x44, 0x0A, 0x02, 0x3A, 0x0A, 0x3C,
  121.     0x0A, 0x3D, 0x0A, 0x3E, 0x0A, 0x02, 0x36, 0x0A, 0x37, 0x0A, 0x38, 0x0A,
  122.     0x39, 0x0A, 0x02, 0x32, 0x0A, 0x33, 0x0A, 0x34, 0x0A, 0x35, 0x0A, 0x02,
  123.     0x2B, 0x0A, 0x2C, 0x0A, 0x2D, 0x0A, 0x2E, 0x0A, 0x02, 0x26, 0x0A, 0x27,
  124.     0x0A, 0x29, 0x0A, 0x2A, 0x0A, 0x02, 0x21, 0x0A, 0x22, 0x0A, 0x23, 0x0A,
  125.     0x24, 0x0A, 0x03, 0xFB, 0x0B, 0xFC, 0x0B, 0xFD, 0x0B, 0xFE, 0x0B, 0x1B,
  126.     0x0A, 0x1B, 0x0A, 0x1C, 0x0A, 0x1C, 0x0A, 0x03, 0xF2, 0x0B, 0xF3, 0x0B,
  127.     0xF4, 0x0B, 0xF5, 0x0B, 0xF6, 0x0B, 0xF7, 0x0B, 0xF9, 0x0B, 0xFA, 0x0B,
  128.     0x03, 0xE9, 0x0B, 0xEA, 0x0B, 0xEB, 0x0B, 0xEC, 0x0B, 0xED, 0x0B, 0xEE,
  129.     0x0B, 0xEF, 0x0B, 0xF1, 0x0B, 0x03, 0xDE, 0x0B, 0xDF, 0x0B, 0xE1, 0x0B,
  130.     0xE3, 0x0B, 0xE4, 0x0B, 0xE5, 0x0B, 0xE6, 0x0B, 0xE7, 0x0B, 0x03, 0xD6,
  131.     0x0B, 0xD7, 0x0B, 0xD8, 0x0B, 0xD9, 0x0B, 0xDA, 0x0B, 0xDB, 0x0B, 0xDC,
  132.     0x0B, 0xDD, 0x0B, 0x03, 0xCD, 0x0B, 0xCF, 0x0B, 0xD0, 0x0B, 0xD1, 0x0B,
  133.     0xD2, 0x0B, 0xD3, 0x0B, 0xD4, 0x0B, 0xD5, 0x0B, 0x03, 0xC5, 0x0B, 0xC6,
  134.     0x0B, 0xC7, 0x0B, 0xC8, 0x0B, 0xC9, 0x0B, 0xCA, 0x0B, 0xCB, 0x0B, 0xCC,
  135.     0x0B, 0x03, 0xBB, 0x0B, 0xBC, 0x0B, 0xBD, 0x0B, 0xBE, 0x0B, 0xBF, 0x0B,
  136.     0xC1, 0x0B, 0xC3, 0x0B, 0xC4, 0x0B, 0x03, 0xB2, 0x0B, 0xB3, 0x0B, 0xB4,
  137.     0x0B, 0xB5, 0x0B, 0xB6, 0x0B, 0xB7, 0x0B, 0xB9, 0x0B, 0xBA, 0x0B, 0x03,
  138.     0xA9, 0x0B, 0xAA, 0x0B, 0xAB, 0x0B, 0xAC, 0x0B, 0xAD, 0x0B, 0xAE, 0x0B,
  139.     0xAF, 0x0B, 0xB1, 0x0B, 0x03, 0x9F, 0x0B, 0xA1, 0x0B, 0xA3, 0x0B, 0xA4,
  140.     0x0B, 0xA5, 0x0B, 0xA6, 0x0B, 0xA7, 0x0B, 0xA8, 0x0B, 0x03, 0x92, 0x0B,
  141.     0x94, 0x0B, 0x99, 0x0B, 0x9A, 0x0B, 0x9B, 0x0B, 0x9C, 0x0B, 0x9D, 0x0B,
  142.     0x9E, 0x0B, 0x03, 0x86, 0x0B, 0x87, 0x0B, 0x88, 0x0B, 0x8B, 0x0B, 0x8C,
  143.     0x0B, 0x8D, 0x0B, 0x8E, 0x0B, 0x91, 0x0B, 0x03, 0x2F, 0x0B, 0x4F, 0x0B,
  144.     0x54, 0x0B, 0x5C, 0x0B, 0x71, 0x0B, 0x7B, 0x0B, 0x84, 0x0B, 0x85, 0x0B
  145. );
  146.  
  147. use constant bit_masks => (
  148.     0x0000, 0x0001, 0x0003, 0x0007, 0x000F, 0x001F, 0x003F, 0x007F,
  149.     0x00FF, 0x01FF, 0x03FF, 0x07FF, 0x0FFF, 0x1FFF, 0x3FFF, 0x7FFF
  150. );
  151.  
  152. # Let's try and test this.
  153. if (0) {
  154.     my $return;
  155.     my $input = "\x17\x46\x34\x86\xc0\x38".
  156.         "\xf9\x48\x9e\x2b\x0c\x8b\x3f\xff".
  157.         "\x82\x18\xc6\x90\xd8\x07\x19\x2b".
  158.         "\x17\x43\x33\x67\x43\x7c\x63\x48".
  159.         "\x6c\x03\x80\x89\xb0\xc6\x90\xd8".
  160.         "\x07\x6e\xbd\xde\xe1\x2e\xe1\x32".
  161.         "\xe1\x36\xe1\x3a\xe7\xee\x32\x5c".
  162.         "\xb1\x72\xcd\xc6\x5b\xaa\xb9\x6e".
  163.         "\xe7\xb4\x4b\x2e\x35\x5a\x00\x94".
  164.         "\xa3\x64\xc8\x6e\xb8\xe3\x71\xd2".
  165.         "\xe1\xcc\x3c\x18\xd2\x1b\x00\xe0".
  166.         "\x9d\x34\x3a\x87\xae\x17\x48\xe1".
  167.         "\x8c\x24\x3b\x9f\x2a\x8e\x89\x48".
  168.         "\xb1\x48\x0a\x8d\x24\x58\xa4\x05".
  169.         "\x46\x91\x58\x43\x42\xbc\x43\x42".
  170.         "\xb8\x21\x02\xa0\x14\x69\x81\x30".
  171.         "\x2a\xba\x4e\x1d\x46\x34\x86\xc0".
  172.         "\x39\xc6\xab\x6d\xb6\xd8\x75\x18".
  173.         "\xd2\x1b\x00\xe8\x04\xb6\xdb\x6d".
  174.         "\x97\xc6\x17\xfd\xef\xee\xef\xfd".
  175.         "\xf7\x77\x77\xbd\xe4\xa4\x3f\x7b".
  176.         "\x9a\x1c\x9a\x0b\x0b\x4e\x4b\x89".
  177.         "\xcd\x08\xe6\x8f\x7a\x73\x41\xc8".
  178.         "\xe1\x29\xa0\xf0\x6a\xc1\xa1\x24".
  179.         "\xd1\xef\x73\x46\x0d\x11\xdc\xd0".
  180.         "\xc0\xd1\xd3\x3d\xee\x68\xec\x92".
  181.         "\xaf\xff\xf0\xe5\x6a\x3f\x27\x7f".
  182.         "\xff\xe1\xf7\x5b\x5b\x5b\x20\x2b".
  183.         "\x6b\x79\xdc\x80\xe4\x04\x80\xad".
  184.         "\xad\xe7\x72\x02\xb6\xb6\xb6\x40".
  185.         "\x48\x0f\xad\xad\xff\xe4\x07\xce".
  186.         "\xfa\xde\xb7\xff\xfc\xc6\x31\xa4".
  187.         "\x36\x01\xc3\x13\xf3\x98\xb8\x72".
  188.         "\xe6\x67\x2b\x9e\x9c\x9f\x02\x87".
  189.         "\x48\xa7\x8b\xd4\x18\x46\x33\xa3".
  190.         "\x19\xab\xce\x4c\x84\x93\xa3\x33".
  191.         "\xe9\x1e\x05\x50\x1d\x1a\x06\xa0".
  192.         "\x26\x26\x88\xe6\x95\xb1\x96\x40".
  193.         "\x87\xe5\xf0\xac\x85\x74\xa4\x98".
  194.         "\x31\x01\x42\xe8\xd4\x01\x80\x38".
  195.         "\x38\x1d\xc0";
  196.     warn unless ($return = decompress_packet($input));
  197.     defaultpkthandler($return, Server, 0);
  198. }
  199.  
  200. ###########################################################
  201. # Stop Code jacked from mantralord, Cthulhon, and binrapt #
  202. ###########################################################
  203.  
  204. ###############
  205. # LengthCodec #
  206. ###############
  207. # These two are 257 bytes long.
  208. # Undef values indecate to run function[256].
  209. use constant bngsclientoplength => (
  210.     undef,5,9,5,9,5,9,9,5,9,9,1,5,9,9,5,
  211.     9,9,1,9,undef,undef,13,5,17,5,9,9,3,9,9,17,
  212.     13,9,5,9,5,9,13,9,9,9,9,undef,undef,undef,undef,9,
  213.     9,9,17,17,5,17,9,5,13,5,3,3,9,5,5,3,
  214.     1,1,undef,undef,17,9,13,13,1,9,undef,9,5,3,undef,7,
  215.     9,9,5,1,1,undef,undef,undef,3,17,undef,undef,undef,7,6,5,
  216.     1,3,5,5,9,undef,undef,undef,37,1,undef,1,undef,13,undef,undef,
  217.     undef,undef,undef,undef,undef,undef,undef,undef,
  218.         undef,undef,undef,undef,undef,undef,undef,
  219.     undef,undef,undef,undef,undef,undef,undef,undef,
  220.         undef,undef,undef,undef,undef,undef,undef,
  221.     undef,undef,undef,undef,undef,undef,undef,undef,
  222.         undef,undef,undef,undef,undef,undef,undef,
  223.     undef,undef,undef,undef,undef,undef,undef,undef,
  224.         undef,undef,undef,undef,undef,undef,undef,
  225.     undef,undef,undef,undef,undef,undef,undef,undef,
  226.         undef,undef,undef,undef,undef,undef,undef,
  227.     undef,undef,undef,undef,undef,undef,undef,undef,
  228.         undef,undef,undef,undef,undef,undef,undef,
  229.     undef,undef,undef,undef,undef,undef,undef,undef,
  230.         undef,undef,undef,undef,undef,undef,undef,
  231.     undef,undef,undef,undef,undef,undef,undef,undef,
  232.         undef,undef,undef,undef,undef,undef,undef,
  233.     undef,undef,undef,undef,undef,undef,undef,undef,
  234.         undef,undef,undef,undef,undef,undef,undef,
  235.     undef,undef,undef,undef,undef,undef,undef,undef,
  236.         undef,
  237.     sub {
  238.         my $stuff = shift @_;
  239.         given ( $stuff ) {
  240.         when ( /^\x14\x01\x00.*?\x00\x00\x00/s ) { return length($&); }
  241.         when ( /^\x15\x01\x00.*?\x00\x00\x00/s ) { return length($&); }
  242.         when ( /^\x14\x01\x00/s ) { return }
  243.         when ( /^\x15\x01\x00/s ) { return }
  244.         when ( /^\x2b/s ) { warn "Unused"; return }
  245.         when ( /^\x2c/s ) { warn "Unused, hack"; return }
  246.         when ( /^\x2d/s ) { warn "Unused, hack"; return }
  247.         when ( /^\x2e/s ) { warn "Unknown"; return }
  248.         when ( /^\x42/s ) { warn "Unknown/Unused"; return }
  249.         when ( /^\x43/s ) { warn "Unknown/Unused"; return }
  250.         when ( /^\x4a/s ) { warn "Unused"; return }
  251.         when ( /^\x55/s ) { warn "Unused"; return }
  252.         when ( /^\x56/s ) { warn "Unused"; return }
  253.         when ( /^\x57/s ) { warn "Unused"; return }
  254.         when ( /^\x5a/s ) { warn "Unused"; return 1; }
  255.         when ( /^\x5b/s ) { warn "Unused"; return }
  256.         when ( /^\x5c/s ) { warn "Unused"; return }
  257.         when ( /^\x65/s ) { warn "Hack Detection"; return 1 }
  258.         when ( /^\x66(.)/s ) { warn "Warden Response";
  259.             return unpack("C", $1); }
  260.         when ( /^\x67/s ) { warn "--"; return }
  261.         when ( /^\x6a/s ) { warn "--"; return }
  262.         when ( /^\x6c/s ) { warn "--"; return }
  263.         when ( /^\x6e/s ) { warn "Unknown/Unused"; return }
  264.         when ( /^\x6f/s ) { warn "Unknown/Unused"; return }
  265.         default { return } };
  266.     }
  267. );
  268. use constant bngsserveroplength => (
  269.     1,8,1,12,1,1,1,6,6,12,6,6,9,13,12,16,
  270.     16,8,26,14,18,11,undef,undef,15,2,2,3,5,3,4,6,
  271.     10,12,12,13,90,90,undef,40,103,97,15,undef,8,undef,undef,undef,
  272.     undef,undef,undef,undef,undef,undef,undef,undef,
  273.         undef,undef,undef,undef,undef,undef,undef,8,
  274.     13,undef,6,undef,undef,13,undef,11,11,undef,undef,undef,16,17,7,1,
  275.     15,14,42,10,10,3,undef,undef,14,26,40,36,5,5,38,5,
  276.     7,2,7,undef,undef,7,7,16,21,12,12,16,16,10,1,1,
  277.     1,1,1,32,10,13,6,2,21,6,13,8,6,18,5,10,
  278.     undef,20,29,undef,undef,undef,undef,undef,undef,2,6,6,11,7,10,33,
  279.     13,26,6,8,undef,13,9,1,7,16,17,7,undef,undef,7,8,
  280.     10,7,8,24,3,8,undef,7,undef,7,undef,7,undef,9,undef,2,
  281.     1,53,undef,5,undef,undef,undef,undef,
  282.         undef,undef,undef,undef,undef,undef,undef,undef,
  283.     undef,undef,undef,undef,undef,undef,undef,undef,undef,
  284.         undef,undef,undef,undef,undef,undef,undef,
  285.     undef,undef,undef,undef,undef,undef,undef,undef,undef,
  286.         undef,undef,undef,undef,undef,undef,undef,
  287.     undef,undef,undef,undef,undef,undef,undef,undef,undef,
  288.         undef,undef,undef,undef,undef,undef,undef,
  289.     undef,undef,undef,undef,undef,undef,undef,undef,undef,
  290.         undef,undef,undef,undef,undef,undef,undef,
  291.     sub {
  292.         my $stuff = shift @_;
  293.         given ( $stuff ) {
  294.         when ( /^\x16/s ) { warn "Unknown"; return }
  295.         when ( /^\x17/s ) { warn "Unused"; return }
  296.         when ( /^\x26.{9}[^\x00]*\x00[^\x00]\x00/s ) {
  297.             return length($&); }
  298.         when ( /^\x2b/s ) { warn "Unused"; return }
  299.         when ( /^[\x2d-\x3d]/s ) { warn "Unused"; return }
  300.         when ( /^\x41/s ) { warn "Unused"; return }
  301.         when ( /^\x43/s ) { warn "Unused"; return }
  302.         when ( /^\x44/s ) { warn "Unused"; return }
  303.         when ( /^\x46/s ) { warn "Unused"; return }
  304.         when ( /^\x49/s ) { warn "Unused"; return }
  305.         when ( /^\x4a/s ) { warn "Unused"; return }
  306.         when ( /^\x4b/s ) { warn "Unused"; return }
  307.         when ( /^\x56/s ) { warn "Unused"; return }
  308.         when ( /^\x57/s ) { warn "Unused"; return }
  309.         when ( /^\x63/s ) { warn "Waypoint Menu: ". length($stuff);
  310.             return length($stuff); }
  311.         when ( /^\x64/s ) { warn "Unused"; return }
  312.         when ( /^\x80/s ) { warn "Unused"; return }
  313.         when ( /^[\x83-\x88]/s ) { warn "Unused"; return }
  314.         when ( /^\x94(.)/s ) { return (6 + unpack("C", $1) * 3); }
  315.         when ( /^\x9c/s ) { warn "Item Action (World): ".
  316.             length($stuff); return length($stuff); }
  317.         when ( /^\x9d/s ) { warn "Item Action (Owned): ".
  318.             length($stuff); return length($stuff); }
  319.         when ( /^\xa6/s ) { warn "Unknown"; return }
  320.         when ( /^\xa8.{5}(.)/s ) { warn "Set State";
  321.             return unpack("C", $1); }
  322.         when ( /^\xaa.{5}(.)/s ) { return unpack("C", $1); }
  323.         when ( /^\xac.{11}(.)/s ) { warn "Assign NPC";
  324.             return unpack("C", $1); }
  325.         when ( /^\xae(..)/s ) { warn "Warden Request";
  326.             return unpack("S<", $1); }
  327.         when ( /^\xb2/s ) { warn "Unknown"; return }
  328.         default { return } };
  329.     }
  330. );
  331.  
  332. if (0) {
  333.     foreach ( 0..$#{[bngsclientoplength]} ) {
  334.         printf("%3.3x %s\n", $_, (bngsclientoplength)[$_] || "");
  335.     };
  336. };
  337.  
  338. if (0) {
  339.     foreach ( 0..$#{[bngsserveroplength]} ) {
  340.         printf("%3.3x %s\n", $_, (bngsserveroplength)[$_] || "");
  341.     };
  342. };
  343.  
  344. ###################
  345. # End LengthCodec #
  346. ###################
  347.  
  348. ###################
  349. # Packet handlers #
  350. ###################
  351. sub bncsclientpkthandler {
  352.     my $oper = shift @_;
  353.     my $CONNECTC_PORT = shift @_;
  354.     unless ( defined(${$connections{$CONNECTC_PORT}}[2]) ||
  355.          defined(${$connections{$CONNECTC_PORT}}[3]) ) {
  356.         given ( $oper ) {
  357.         when ( /^\x01/s ) {
  358.             ${$connections{$CONNECTC_PORT}}[2] =
  359.               POE::Filter::Block->new( LengthCodec => [ sub {
  360.                     die "never gonna get called" },
  361.                 sub { my $stuff = shift;
  362.                     unless ($$stuff =~ /^\xff.(..)/) {
  363.                         return;
  364.                     }
  365.                     return unpack("S<", $1);
  366.             }   ]   );
  367.             ${$connections{$CONNECTC_PORT}}[3] =
  368.               POE::Filter::Block->new( LengthCodec => [ sub {
  369.                         die "never gonna get called" },
  370.                     sub { my $stuff = shift;
  371.                         unless ($$stuff =~
  372.                           /^\xff.(..)/) {
  373.                             return;
  374.                         }
  375.                         return unpack("S<", $1);
  376.             }   ]   );
  377.             warn unless ($oper =~ s/^\x01//s);
  378.         }
  379. #       when ( /^\x02/s ) {
  380. #       }
  381.         default {
  382.             ${$connections{$CONNECTC_PORT}}[0] =
  383.               sub { defaultpkthandler(shift @_, Client, shift @_); };
  384.             ${$connections{$CONNECTC_PORT}}[1] =
  385.               sub { defaultpkthandler(shift @_, Server, shift @_); };
  386.         } };
  387.         my_on_read(6112, $CONNECTC_PORT, Client, undef, \$oper, undef);
  388.         return 0;
  389.     };
  390.     given ( $oper ) {
  391.     when ( /^\xff\x50\x3a\x00\x00\x00\x00\x00(.{8})
  392.           \x0c\x00\x00\x00\x53\x55\x6e\x65\xc0\xa8\xa7
  393.           \x0a\x2c\x01\x00\x00\x09\x04\x00\x00\x09\x04
  394.           \x00\x00(...)\x00(.{13})\x00$/xs ) {
  395.         print "". (DIRTXT)[Client] ." $CONNECTC_PORT says hello: " .
  396.             reverse($1). ", $3 $2.\n"
  397.     }
  398.     when ( /^\xff\x25\x08\x00(....)$/s ) {
  399.         print "". (DIRTXT)[Client] ." $CONNECTC_PORT Pong 0x". unpack("H8", $1) .".\n";
  400.     }
  401.     when ( /^\xff\x33\x1e\x00\x04\x00\x00\x80\x00\x00\x00\x00
  402.          \x62\x6e\x73\x65\x72\x76\x65\x72\x2d\x44\x32\x44
  403.          \x56\x2e\x69\x6e\x69\x00$/xs ) { 1; }
  404.     when ( /^\xff\x40\x04\x00$/xs ) { 1; }
  405.     when ( /^\xff\x3a(..)(....)(....)(.{20})
  406.           ([^\x00]*)\x00$/xs ) {
  407.         print "". (DIRTXT)[Client] ." $CONNECTC_PORT log $5 the 0x".
  408.             unpack("H8", $2) ." fuck into 0x".
  409.             unpack("H8", $3) ." with\n\tthis 0x".
  410.             unpack("H40", $4) ." and these ".
  411.             unpack("S<", $1) ." bytes.\n";
  412.     }
  413.     when ( /^ \xff\x3e(..)\x01\x00\x00\x00(....)(.{16})
  414.           ([^\x00]*)\x00$/xs ) {
  415.         print "". (DIRTXT)[Client] ." $CONNECTC_PORT login to $4 with ".
  416.             unpack("S<", $1) ." bytes, ClientID: 0x".
  417.             unpack("H8", $2) ." and PassHash:\n\t0x".
  418.             unpack("H32", $3) ."\n";
  419.     }
  420.     when ( /^\xff\x0b\x08\x00\x50\x58\x32\x44$/s ) { 1; }
  421. #   when ( /^\xff\x51/s ) {
  422. #       defaultpkthandler($oper, Client, $CONNECTC_PORT);
  423. #       print "". (DIRTXT)[Client] ." $CONNECTC_PORT returning chalange and name.\n";
  424. #   }
  425.     default {
  426.         defaultpkthandler($oper, Client, $CONNECTC_PORT);
  427.     } };
  428. };
  429.  
  430. sub bncsserverpkthandler {
  431.     my $oper = shift @_;
  432.     my $CONNECTC_PORT = shift @_;
  433.     my $buffref = shift @_;
  434.     given ( $oper ) {
  435.     when ( /^\xff\x25\x08\x00(....)$/s ) {
  436.         print "". (DIRTXT)[Server] ." $CONNECTC_PORT Ping 0x". unpack("H8", $1) .".\n";
  437.     }
  438.     when ( /^\xff\x33\x26\x00\x04\x00\x00\x80\x00\x00\x00\x00
  439.          (.{8})
  440.          \x62\x6e\x73\x65\x72\x76\x65\x72\x2d\x44\x32\x44
  441.          \x56\x2e\x69\x6e\x69\x00$/xs ) {
  442.         print "". (DIRTXT)[Server] ." $CONNECTC_PORT latest filetime quadword 0x".
  443.           unpack("H16", $1) .".\n";
  444.     }
  445.     when ( /^\xff\x51\x09\x00\x00\x00\x00\x00\x00$/s ) {
  446.         print "". (DIRTXT)[Server] ." $CONNECTC_PORT CD-Key and Game.exe passed.\n";
  447.     }
  448.     when ( /^\xff\x3a\x08\x00\x00\x00\x00\x00$/s ) {
  449.         print "". (DIRTXT)[Server] ." $CONNECTC_PORT logged in successfully.\n";
  450.     }
  451.     when ( /^\xff\x3e\x0a(.{8})$/s ) {
  452.         print "". (DIRTXT)[Server] ." $CONNECTC_PORT Realm Logon Failed 0x".
  453.             unpack("H16", $1) .".\n";
  454.     }
  455.     when ( /^\xff\x3e(..)(....)(....)(.{8})(.)(.)(.)(.)(....)
  456.           (.{48})([^\x00]*)\x00$/xs ) {
  457.         print "". (DIRTXT)[Server] ." $CONNECTC_PORT Realm Logon successful: 0x".
  458.             unpack("H8", $2) ." MCP Cookie 0x".
  459.             unpack("H8", $3) ." MCP Status\n\t0x".
  460.             unpack("H16", $4) ." MCP Chunk 1, IP=".
  461.             sprintf("%3.3d.%3.3d.%3.3d.%3.3d:%d",
  462.                 unpack("C", $5),
  463.                 unpack("C", $6),
  464.                 unpack("C", $7),
  465.                 unpack("C", $8),
  466.                 unpack("L<", $9)). " MCP Chunk 2:\n\t".
  467.                 unpack("H96", $10) ."\n\t".
  468.             unpack("S<", $1) ." bytes user=$11.\n";
  469.         # We are going to have to do some SHIT here.
  470.         my $CONNECT_HOST = inet_ntoa($5 . $6 . $7 . $8);
  471.         my $CONNECT_PORT = unpack("L<", $9);
  472.         my $CONNECTS_HOST = ${$connections{$CONNECTC_PORT}}[5];
  473.         my ($NCONNECTS_PORT,$NCONNECTC_PORT) = ("","");
  474.         my $callbk = $callme;
  475.         $callme = sub {
  476.                         causepain(\$NCONNECTS_PORT,\$NCONNECTC_PORT,
  477.                 \$CONNECTS_HOST,\$CONNECT_HOST,\$CONNECT_PORT);
  478.         };
  479.         $loop->loop_stop();
  480.         $callme = $callbk;
  481.         my $buff = inet_aton($CONNECTS_HOST).
  482.             pack("L<", $NCONNECTS_PORT);
  483.         # Yes, right here I need to alter $$buffref.
  484.         $$buffref =~ s/^(\xff\x3e.{18}).{8}
  485.             (.{48}[^\x00]*\x00)$/$1$buff$2/xs;
  486.     }
  487.     when ( /^\xff\x40(..)(....)(....)/s ) {
  488.         print "". (DIRTXT)[Server] ." $CONNECTC_PORT Relm List ". unpack("S<", $1)
  489.           ."bytes code 0x". unpack("H8", $2) .", ". unpack("L<", $3)
  490.           ." of them:\n";
  491.         my $ctr = 12;
  492.         for (0..unpack("L<", $3)) {
  493.             my $dat = substr($oper, $ctr);
  494.             if ($dat =~ /^(....)([^\x00]*)\x00([^\x00]*)\x00/s ) {
  495.                 $ctr += length($&);
  496.                 print "\tName=$2 Desc=$3 Id=0x".
  497.                   unpack("H8", $1) ."\n"
  498.             }
  499.         }
  500.     }
  501.     when ( /^\xff\x46/s ) {
  502.         defaultpkthandler($oper, Server, $CONNECTC_PORT);
  503.         print "". (DIRTXT)[Server] ." $CONNECTC_PORT returning MOTD.\n";
  504.         print "$1.\n" if ( $oper =~ /(There are currently [\d]+ users playing [\d]+ games of .*?, and [\d]+ users playing [\d]+ games on Battle.net)/s );
  505.         print "$1.\n" if ( $oper =~ /(Last logon: .*?)\x0a\00/s );
  506.     }
  507.     # Full channel list - who gives a flying FUCK.
  508.     when ( /^\xff\x0b/s ) { 1; }
  509.     default {
  510.         defaultpkthandler($oper, Server, $CONNECTC_PORT);
  511.     } };
  512. };
  513.  
  514. sub bngsclientpkthandler {
  515.     my $oper = shift @_;
  516.     my $CONNECTC_PORT = shift @_;
  517.     given ( $oper ) {
  518.     when ( /\x68(....)(....)(.)(....)(....)(....)\x00(.{16})$/s ) {
  519.         print "". (DIRTXT)[Client]
  520.             ." $CONNECTC_PORT Invoke Player:\n\tServer Token 0x".
  521.             unpack("H16", $1 . $2) ." name ".
  522.             unpack("Z16", $7) ." the 0x".
  523.             unpack("H2", $3) ."\n\tVersion 0x".
  524.             unpack("H8", $4) ." x 0x".
  525.             unpack("H16", $5 . $6) ."\n";
  526.     }
  527.     when ( /\x6d(....)(....)\x00{4}$/s ) {
  528.         print "". (DIRTXT)[Client]
  529.             ." $CONNECTC_PORT Ping: Tickcount 0x".
  530.             unpack("H8", $1) ." Delay 0x".
  531.             unpack("H8", $2) ."\n";
  532.     }
  533.     when ( /\x6b$/s ) {
  534.         print "". (DIRTXT)[Client]
  535.             ." $CONNECTC_PORT I'm Ready.\n";
  536.     }
  537.     when ( /^\x15\x01\x00(.*?)\x00\x00\x00/s ) {
  538.         print "". (DIRTXT)[Client] ." $CONNECTC_PORT said: $1\n";
  539.         given ( $1 ) {
  540.         when ( /^Ident$/ ) {
  541.             # $stream2->write( "\x04\x01\x00\x00\x00\x01\x00\x00\x00\x00" );
  542.         } };
  543.     }
  544.     default {
  545.         defaultpkthandler($oper, Client, $CONNECTC_PORT);
  546.     } };
  547. };
  548.  
  549. sub bngsserverpkthandler {
  550.     my $tmp = decompress_packet(shift @_);
  551.     my $CONNECTC_PORT = shift @_;
  552. #   defaultpkthandler($tmp, 4, $CONNECTC_PORT);
  553.     my $opers = [ ];
  554.     $opers = ${$connections{$CONNECTC_PORT}}[4]->get( [ $tmp ] )
  555.         unless ( length($tmp) == 0 );
  556.     foreach my $oper (@$opers) {
  557.         given ( $oper ) {
  558.         when ( /^\x01(.)(....)(.)(.)$/s ) {
  559.             print "". (DIRTXT)[Server]
  560.                 ." $CONNECTC_PORT Game Flags:\n\tDifficulty ".
  561.                 unpack("C", $1) ."\n\tBitField: ".
  562.                 unpack("H16", $2) ."\n\tExpansion: ".
  563.                 unpack("C", $3) ."\n\tLadder: ".
  564.                 unpack("C", $4) ."\n";
  565.         }
  566.         when ( /^\x00$/s ) {
  567.             print "". (DIRTXT)[Server]
  568.                 ." $CONNECTC_PORT Game Loading\n";
  569.         }
  570.         when ( /^\x02$/s ) {
  571.             print "". (DIRTXT)[Server]
  572.                 ." $CONNECTC_PORT Load Successful\n";
  573.         }
  574.         when ( /^\x8f(.{32})$/s ) {
  575.             print "". (DIRTXT)[Server]
  576.                 ." $CONNECTC_PORT Pong:\n\t0x".
  577.                 unpack("H64", $1) ."\n";
  578.         }
  579.         when ( /^\x59(....)(.)(.{16})(..)(..)$/s ) {
  580.             print "". (DIRTXT)[Server]
  581.                 ." $CONNECTC_PORT Spawn Player:\n\t0x".
  582.                 unpack("H16", $1) ." ".
  583.                 unpack("Z16", $3) ." the 0x".
  584.                 unpack("H2", $2) ."\n\tat 0x".
  585.                 unpack("H4", $2) ." x 0x".
  586.                 unpack("H4", $2) ."\n";
  587.         }
  588.         when ( /^\xaa(.)(....)(.)(.*)/s ) {
  589.             print "". (DIRTXT)[Server]
  590.                 ." $CONNECTC_PORT Spawn Unit:\n\t0x".
  591.                 unpack("H16", $2) ." the 0x".
  592.                 unpack("H2", $1) ." with ".
  593.                 unpack("C", $3) ." bytes\n\t0x".
  594.                 unpack("H*", $4) ."\n";
  595.         }
  596.         when ( /^\x76(.)(....)/s ) {
  597.             print "". (DIRTXT)[Server]
  598.                 ." $CONNECTC_PORT Player In Proximity:\n\t0x".
  599.                 unpack("H16", $2) ." the 0x".
  600.                 unpack("H2", $1) ."\n";
  601.         }
  602.         when ( /^\x94(.)(....)/s ) {
  603.             my ($igunit, $sgunit, $ctr) = (
  604.                 unpack("L<", $2), unpack("H8", $2),
  605.                 unpack("C", $1)
  606.             );
  607.             print "". (DIRTXT)[Server]
  608.                 ." $CONNECTC_PORT Base Skill Levels: 0x$sgunit".
  609.                 " has $ctr skills:\n";
  610.             for (0..$ctr) {
  611.                 my $dat = substr($oper, 6 + $_ * 3, 3);
  612.                 if ($dat =~ /^(..)(.)$/s ) {
  613.                     my ($iskl, $sskl, $pnt) = (
  614.                         unpack("S<", $1), unpack("H4", $1),
  615.                         unpack("C", $2)
  616.                     );
  617.                     print "\t\tSkill=0x$sskl".
  618.                         " Points=$pnt\n";
  619.                     my $skillptr =
  620.                         ${$connections{$CONNECTC_PORT}}
  621.                             [5]->[$igunit]->[$iskl];
  622.                     $$skillptr[2] = $pnt;
  623.                     unless (defined($$skillptr[1])) {
  624.                         $$skillptr[1] = $pnt
  625.                     } else {
  626.                         warn $$skillptr[1];
  627.                     };
  628.                 };
  629.             }
  630.         }
  631.         when ( /^\x22(..)(....)(..)(.)(..)$/s ) {
  632.             my ($igunit, $sgunit, $iskl, $sskl, $pnt) = (
  633.                 unpack("L<", $2), unpack("H8", $2),
  634.                 unpack("S<", $3), unpack("H4", $3),
  635.                 unpack("C", $4)
  636.             );
  637.             print "". (DIRTXT)[Server]
  638.                 ." $CONNECTC_PORT Update Item Skill:\n\t0x".
  639.                 unpack("H8", $2) ." the 0x".
  640.                 unpack("H4", $1) ." with ".
  641.                 unpack("C", $4) ." added in 0x".
  642.                 unpack("H4", $3) ." but 0x".
  643.                 unpack("H4", $4) ." Unknown\n";
  644.             ${$connections{$CONNECTC_PORT}}
  645.                 [5]->[$igunit]->[$iskl] = []
  646.                     unless (defined(
  647.                         ${$connections{$CONNECTC_PORT}}
  648.                             [5]->[$igunit]->[$iskl]));
  649.             my $skillptr =
  650.                 ${$connections{$CONNECTC_PORT}}
  651.                     [5]->[$igunit]->[$iskl];
  652.             if (defined($$skillptr[1])) {
  653.                 $$skillptr[1] += $pnt
  654.             } else {
  655.                 warn $skillptr;
  656.                 warn @$skillptr;
  657.             };
  658.             unless (defined($$skillptr[3])) {
  659.                 $$skillptr[3] = $pnt
  660.             } else {
  661.                 warn $$skillptr[3];
  662.             };
  663.             print "Current skill lvl for 0x$sgunit with ".
  664.                 "0x$sskl is " . ${$skillptr}[1] .".\n"
  665.         }
  666.         when ( /^\x27(.)(....)\00(..)\xff\xff\xff\xff$/s ) {
  667.             print "". (DIRTXT)[Server]
  668.                 ." $CONNECTC_PORT Set Right Skill: type 0x".
  669.                 unpack("H2", $1) ." unit 0x".
  670.                 unpack("H8", $2) ." as 0x".
  671.                 unpack("H4", $3) ."\n";
  672.         }
  673.         when ( /^\x27(.)(....)\01(..)\xff\xff\xff\xff$/s ) {
  674.             print "". (DIRTXT)[Server]
  675.                 ." $CONNECTC_PORT Set Left Skill: type 0x".
  676.                 unpack("H2", $1) ." unit 0x".
  677.                 unpack("H8", $2) ." as 0x".
  678.                 unpack("H4", $3) ."\n";
  679.         }
  680.         when ( /^\x27(.)(....)\01(..)\xff\xff\xff\xff$/s ) {
  681.             print "". (DIRTXT)[Server]
  682.                 ." $CONNECTC_PORT Game Quest Info:\n\t0x".
  683.                 unpack("H2", $1) ." unit 0x".
  684.                 unpack("H8", $2) ." as 0x".
  685.                 unpack("H4", $3) ."\n";
  686.         }
  687.         when ( /^\x23(.)(....)(.{34})$/s ) {
  688.             print "". (DIRTXT)[Server]
  689.                 ." $CONNECTC_PORT NPC Info: type 0x".
  690.                 unpack("H2", $1) ." 0x".
  691.                 unpack("H8", $2) ." with these 34 bytes:\n";
  692.             hexprint $3;
  693.         }
  694.         when ( /^\x26(.{9})([^\x00])*\x00([^\x00])\x00$/s ) {
  695.             print "". (DIRTXT)[Server]
  696.                 ." $CONNECTC_PORT $2 and below said: $3\n";
  697.             hexprint $1;
  698.         }
  699. #           when ( /^\x15\x01\x00(.*?)\x00\x00\x00/s ) {
  700. #           print "". (DIRTXT)[Client] ." $CONNECTC_PORT said: $1\n";
  701. #       }
  702.         default {
  703.             defaultpkthandler($oper, Server, $CONNECTC_PORT);
  704.     }   };  };
  705. };
  706.  
  707. #######################
  708. # End Packet handlers #
  709. #######################
  710.  
  711. #########################
  712. # Loop Helper Functions #
  713. #########################
  714. sub my_on_read {
  715.     my ($CONNECT_PORT, $CONNECTC_PORT, $direction,
  716.         $self, $buffref, $closed ) = @_;
  717. #   defaultpkthandler($$buffref, 2, $CONNECTC_PORT) if ($direction == Server);
  718.     my $opers = [ $$buffref ];
  719.     $opers = ${$connections{$CONNECTC_PORT}}[2+$direction]->get([$$buffref])
  720.         if ( defined(${$connections{$CONNECTC_PORT}}[2+$direction]) );
  721.     foreach my $oper (@$opers) {
  722. #       defaultpkthandler($oper, 3, $CONNECTC_PORT) if ($direction == Server);
  723.         &{${$connections{$CONNECTC_PORT}}[0+$direction]}(
  724.             $oper, $CONNECTC_PORT, $buffref);
  725.     };
  726.     return 0;
  727. };
  728.  
  729. sub setupconnection {
  730.     my ($CONNECT_PORT, $CONNECTC_PORT ) = @_;
  731.       given( $CONNECT_PORT ) {
  732.     when ( 6112 ) { $connections{$CONNECTC_PORT} = [
  733.      sub { bncsclientpkthandler(shift @_, shift @_); },
  734.      sub { bncsserverpkthandler(shift @_, shift @_); },
  735.      undef,
  736.      undef,
  737.      undef
  738.      ];
  739.     }
  740.     when ( 4000 ) { $connections{$CONNECTC_PORT} = [
  741.      sub { bngsclientpkthandler(shift @_, shift @_); },
  742.      sub { bngsserverpkthandler(shift @_, shift @_); },
  743.      POE::Filter::Block->new( LengthCodec => [ sub {
  744.         die "never gonna get called" },
  745.         sub { my $stuff = shift @_;
  746.             return if ( length($$stuff) == 0 );
  747.             my $op = unpack("C",substr($$stuff,0,1));
  748.             my $len = (bngsclientoplength)[$op];
  749.             return $len if (defined ($len));
  750.             return (bngsclientoplength)[256]($$stuff);
  751.      }  ]   ),
  752.      POE::Filter::Block->new( LengthCodec => [ sub {
  753.         die "never gonna get called" },
  754.         sub { my $stuff = shift @_;
  755.             given ( $$stuff ) {
  756.                 when ( /^\xaf\x01/s ) {
  757.                     $$stuff =~ s/^\xaf\x01//s;
  758.                     return;
  759.                 }
  760.                 when ( /^([\xF0-\xFF].)/s ) {
  761.                     my $ret = unpack("S>", $1) - 61440 - 2;
  762.                     $$stuff =~ s/^[\xF0-\xFF].//s;
  763.                     return $ret;
  764.                 }
  765.                 when ( /^([^\xF0-\xFF])/s ) {
  766.                     my $ret = unpack("C", $1) - 1;
  767.                     $$stuff =~ s/^[^\xF0-\xFF]//s;
  768.                     return $ret;
  769.                 }
  770.                 default { return; }
  771.             };
  772.             warn; return;
  773.      }  ]   ),
  774.      POE::Filter::Block->new( LengthCodec => [ sub {
  775.         die "never gonna get called" },
  776.         sub { my $stuff = shift @_;
  777.             return if ( length($$stuff) == 0 );
  778.             my $op = unpack("C",substr($$stuff,0,1));
  779.             my $len = (bngsserveroplength)[$op];
  780.             return $len if (defined ($len));
  781.             return (bngsserveroplength)[256]($$stuff);
  782.      }  ]   )
  783.     ];
  784.     }
  785.     default { warn "Unk port: $CONNECT_PORT"; $connections{$CONNECTC_PORT} = [
  786.      sub { defaultpkthandler(shift @_, Client, shift @_); },
  787.      sub { defaultpkthandler(shift @_, Server, shift @_); },
  788.      undef,
  789.      undef,
  790.      undef
  791.      ];
  792.     }
  793.       }
  794.     return 0;
  795. };
  796. #############################
  797. # End Loop Helper Functions #
  798. #############################
  799.  
  800. $loop->listen(
  801.    service  => LISTEN_PORT,
  802.    socktype => SOCK_STREAM,
  803.  
  804.    on_accept => sub {
  805.       my ( $socket1 ) = @_;
  806.  
  807.       my $CONNECTC_HOST = $socket1->peerhost;
  808.       my $CONNECTC_PORT = $socket1->peerport;
  809.       ${$connections{$CONNECTC_PORT}}[5] = $socket1->sockhost;
  810.       my ($CONNECT_HOST, $CONNECT_PORT ) = getforwardaddr($socket1);
  811.  
  812.     setupconnection($CONNECT_PORT, $CONNECTC_PORT);
  813.  
  814.       $loop->connect(
  815.          host    => $CONNECT_HOST,
  816.          service => $CONNECT_PORT,
  817.  
  818.          on_connected => sub {
  819.             my ( $socket2 ) = @_;
  820.  
  821.         my $CONNECTC_HOST = $socket1->peerhost;
  822.         my $CONNECTC_PORT = $socket1->peerport;
  823.  
  824.             # Now we need two Streams, cross-connected.
  825.             my ( $stream1, $stream2 );
  826.  
  827.             $stream1 = IO::Async::Stream->new(
  828.                handle => $socket1,
  829.  
  830.                on_read => sub {
  831.             my ( undef, $buffref, undef) = @_;
  832.             my_on_read($CONNECT_PORT, $CONNECTC_PORT, Client,
  833.                 shift @_, shift @_, shift @_);
  834.             # Just copy all the data
  835.             $stream2->write( $$buffref ); $$buffref = "";
  836.             return 0;
  837.         },
  838.                on_closed => sub {
  839.                   $stream2->close_when_empty;
  840.                   print "Connection from $CONNECTC_HOST:$CONNECTC_PORT closed\n";
  841.                },
  842.             );
  843.  
  844.             $stream2 = IO::Async::Stream->new(
  845.                handle => $socket2,
  846.  
  847.                on_read => sub {
  848.             my ( undef, $buffref, undef) = @_;
  849.             my_on_read($CONNECT_PORT, $CONNECTC_PORT, Server,
  850.                 shift @_, shift @_, shift @_);
  851.             # Just copy all the data
  852.             $stream1->write( $$buffref ); $$buffref = "";
  853.         },
  854.                on_closed => sub {
  855.                   $stream1->close_when_empty;
  856.                   print "Connection to $CONNECT_HOST:$CONNECT_PORT closed\n";
  857.                },
  858.             );
  859.  
  860.             $loop->add( $stream1 );
  861.             $loop->add( $stream2 );
  862.          },
  863.  
  864.          on_resolve_error => sub { print STDERR "Cannot resolve - $_[0]\n"; },
  865.          on_connect_error => sub { print STDERR "Cannot connect\n"; },
  866.       );
  867.    },
  868.  
  869.    on_resolve_error => sub { die "Cannot resolve - $_[0]\n"; },
  870.    on_listen_error  => sub { die "Cannot listen\n"; },
  871. );
  872.  
  873. $loop->loop_forever
  874.     until (&$callme);
  875.  
  876. # *****************************************************
  877. # * Beyond this point is code I'd rather not look at. *
  878. # *****************************************************
  879.  
  880. ######################################################
  881. # Code jacked from mantralord, Cthulhon, and binrapt #
  882. ######################################################
  883. # http://heroinglands.googlecode.com/svn/trunk/heroin/compression.cpp
  884.  
  885. sub decompress_packet {
  886.     my ($input) = @_;
  887.     my ($size, $output_buffer) =
  888.         (length($input), "");
  889.     my ($a, $b, $c, $d);
  890.     my ($maximum_count, $index, $count, $input_pointer);
  891.  
  892.     $b = 0;
  893.  
  894.     $count = 0x20;
  895.  
  896.     while(1)
  897.     {
  898.          if($count >= 0x8)
  899.          {
  900.               while($size > 0 && $count >= 8)
  901.               {
  902.                     $count -= 0x8;
  903.                     $size--;
  904.                     $a = unpack("C", $input)
  905.                         << $count;
  906.                     $input =~ s/^.//;
  907.                     $b |= $a;
  908.               }
  909.          }
  910.  
  911.          $index = (index_table)[( $b >> 0x18 )];
  912.          $a = (character_table)[$index];
  913.          $d = ($b >> (0x18 - $a)) & (bit_masks)[$a];
  914.          $c = (character_table)[$index + 2 * $d + 2];
  915.  
  916.          $count += $c;
  917.          if($count > 0x20)
  918.          {
  919.               return $output_buffer;
  920.          }
  921.  
  922.          $output_buffer .= pack("C",
  923.             (character_table)[$index + 2 * $d + 1]);
  924.  
  925.          $b <<= ($c & 0xFF);
  926.     }
  927. };
  928.  
  929. ##########################################################
  930. # End Code jacked from mantralord, Cthulhon, and binrapt #
  931. ##########################################################
  932.  
  933. ############################################################
  934. # Linux keeps the original destination for us, pull it out #
  935. ############################################################
  936. sub getforwardaddr {
  937.     my $sock = shift @_;
  938.     my ($my_port, $my_ipnum) = ($sock->sockport, $sock->sockhost);
  939.     my ($cl_port, $cl_ipnum) = ($sock->peerport, $sock->peerhost);
  940.     my ($re_ipnum, $re_port);
  941.     open(INFO, "</proc/net/ip_conntrack") or die "Can't open proc: $!";
  942.     while ( my $pline = <INFO> ) {
  943.         if ( $pline =~ /^tcp      6 ([0-9]+) ESTABLISHED src=([0-9.]+) dst=([0-9.]+) sport=([0-9]+) dport=([0-9]+) packets=[0-9]+ bytes=[0-9]+ src=${my_ipnum} dst=${cl_ipnum} sport=${my_port} dport=${cl_port} packets=[0-9]+ bytes=[0-9]+ \[ASSURED\] mark=[0-9]+ secmark=[0-9]+ use=[0-9]+$/ ) {
  944.             ($re_ipnum, $re_port) = ($3, $5);
  945.             last;
  946.         }
  947.     }
  948.     close(INFO);
  949.  
  950.     return ($re_ipnum, $re_port);
  951. }
  952. ##################################
  953. # End Linux Original Destination #
  954. ##################################
  955.  
  956. #########################
  957. # Fresh rehash of main. #
  958. #########################
  959. sub causepain {
  960.     my ($CONNECTS_PORT,$CONNECTC_PORT,$CONNECTS_HOST,$CONNECT_HOST,
  961.         $CONNECT_PORT);
  962.     $CONNECTS_PORT = ${shift @_};
  963.     $CONNECTC_PORT = ${shift @_};
  964.     $CONNECTS_HOST = ${shift @_};
  965.     $CONNECT_HOST = ${shift @_};
  966.     $CONNECT_PORT = ${shift @_};
  967.     my ($socket1,$socket2,$CONNECTC_HOST);
  968.     my @pepsid = (undef, sub {
  969.         my ($CONNECT_PORT, $CONNECTC_PORT, $CONNECTC_HOST,
  970.             $CONNECT_HOST, $socket1, $socket2) = @_;
  971.         setupconnection($CONNECT_PORT, $CONNECTC_PORT);
  972.  
  973.         # Now we need two Streams, cross-connected.
  974.         my ( $stream1, $stream2 );
  975.  
  976.             $stream1 = IO::Async::Stream->new(
  977.             handle => $socket1,
  978.  
  979.             on_read => sub {
  980.                 my ( undef, $buffref, undef) = @_;
  981.                 my_on_read($CONNECT_PORT, $CONNECTC_PORT, Client,
  982.                     shift @_, shift @_, shift @_);
  983.                 # Just copy all the data
  984.                 $stream2->write( $$buffref ); $$buffref = "";
  985.                 return 0;
  986.             },
  987.             on_closed => sub {
  988.                 $stream2->close_when_empty;
  989.                 print "Connection from $CONNECTC_HOST:$CONNECTC_PORT closed\n";
  990.             },
  991.         );
  992.  
  993.         $stream2 = IO::Async::Stream->new(
  994.             handle => $socket2,
  995.  
  996.             on_read => sub {
  997.                 my ( undef, $buffref, undef) = @_;
  998.                 my_on_read($CONNECT_PORT, $CONNECTC_PORT, Server,
  999.                     shift @_, shift @_, shift @_);
  1000.                 # Just copy all the data
  1001.                 $stream1->write( $$buffref ); $$buffref = "";
  1002.             },
  1003.             on_closed => sub {
  1004.                 $stream1->close_when_empty;
  1005.                 print "Connection to $CONNECT_HOST:$CONNECT_PORT closed\n";
  1006.             },
  1007.         );
  1008.  
  1009.         $loop->add( $stream1 );
  1010.         $loop->add( $stream2 );
  1011.  
  1012.     } );
  1013.     $loop->connect(
  1014.         host    => $CONNECT_HOST,
  1015.         service => $CONNECT_PORT,
  1016.  
  1017.         on_connected => sub {
  1018.             ( $socket2 ) = @_;
  1019.  
  1020.             my $tmp = shift @pepsid;
  1021.             &$tmp($CONNECT_PORT, $CONNECTC_PORT, $CONNECTC_HOST,
  1022.                 $CONNECT_HOST, $socket1, $socket2)
  1023.                     if defined($tmp);
  1024.  
  1025.         },
  1026.         on_resolve_error => sub { warn "Cannot resolve - $_[0]\n"; },
  1027.         on_connect_error => sub { warn "Cannot connect\n"; },
  1028.     );
  1029.     $loop->listen(
  1030.         service => 0,
  1031.         socktype => SOCK_STREAM,
  1032.         # Make sure we are on the SAME address client is connected.
  1033.         host => $CONNECTS_HOST,
  1034.         # D2 does not support IPV6, even if we do ;).
  1035.         family => AF_INET,
  1036.  
  1037.         on_listen => sub {
  1038.             my $sock = shift @_;
  1039.             $CONNECTS_PORT = $sock->sockport;
  1040.             $loop->loop_stop();
  1041.         },
  1042.         on_accept => sub {
  1043.             ( $socket1 ) = @_;
  1044.  
  1045.             $CONNECTC_HOST = $socket1->peerhost;
  1046.             $CONNECTC_PORT = $socket1->peerport;
  1047.             my $tmp = shift @pepsid;
  1048.             &$tmp($CONNECT_PORT, $CONNECTC_PORT, $CONNECTC_HOST,
  1049.                 $CONNECT_HOST, $socket1, $socket2)
  1050.                     if defined($tmp);
  1051.  
  1052.         },
  1053.         on_resolve_error => sub { warn "Cannot resolve - $_[0]\n"; },
  1054.         on_listen_error  => sub { warn "Cannot listen\n"; },
  1055.     );
  1056.     return 0;
  1057. };
  1058.  
  1059. #############################
  1060. # End Fresh rehash of main. #
  1061. #############################
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!