Openkore.com

OpenKore Forums
It is currently 22 Oct 2018, 09:55

All times are UTC - 5 hours [ DST ]





Forum locked This topic is locked, you cannot edit posts or make further replies.  [ 27 posts ]  Go to page 1, 2, 3  Next
Author Message
 Post subject: Merge Receive and Send base modules
PostPosted: 12 Jun 2011, 21:01 
Offline
Developers
Developers

Joined: 05 Dec 2008, 05:42
Posts: 1811
Network::Receive and Network::Send modules need the common base, because both need common setup for handling packet structures and parsing/constructing packets. Let's call it Network::PacketParser (as in $Globals::packetParser) or Network::SuggestYourOwnName.

Functions to be moved to the new base class:

create - no problems
Receive::reconstruct - no problems
Receive::parse - squelch all warnings option needed
{packet_list} would appear there too

Functions not to be moved:

Receive::willMangle, ::mangle - distinct hooks for Send may be added, but global hooks may be not a good idea at all
Receive::decrypt - "At the moment (December 20 2006) there are no servers that still use encrypted packets."
Receive::queryLoginPinCode - only needed in Receive?
Receive::queryAndSaveLoginPinCode - only needed in Receive?
Send::encrypt - "At the moment (December 20 2006) there are no servers that still use encrypted packets."
Send::encryptMessageID
Send::injectMessage, ::injectAdminMessage - don't really belong there; due to very little usage inline reconstruct() may be used instead


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 13 Jun 2011, 06:17 
Offline
Super Moderators
Super Moderators
User avatar

Joined: 06 May 2008, 12:47
Posts: 801
+1

_________________
One ST0 to rule them all? One PE viewer to find them!
One ST_kRO to bring them all and in the darkness bind them...

Mount Doom awaits us, fellowship of OpenKore!


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 13 Jun 2011, 17:53 
Offline
Developers
Developers

Joined: 05 Dec 2008, 05:42
Posts: 1811
Example usage, buyBulkVender:
Code:
Network/Send/ServerType0.pm
===================================================================
sub new {
   my ($class) = @_;
   my $self = $class->SUPER::new(@_);
   
   my %packets = (
      '0134' => ['buy_bulk_vender', 'v a4 a*', [qw(len venderID itemInfo)]], # 0x0134,-1,purchasereq,2:4:8
      '0801' => ['buy_bulk_vender', 'v a4 a4 a*', [qw(len venderID venderCID itemInfo)]], # 0x0801,-1,purchasereq,2:4:8:12
   );
   $self->{packet_list}{$_} = $packets{$_} for keys %packets;
   
   # it would automatically use the first available if not set
   #my %handlers = qw(
   #   buy_bulk_vender 0134
   #);
   #$self->{packet_lut}{$_} = $handlers{$_} for keys %handlers;
   
   return $self;
}

sub sendBuyBulkVender {
   my ($self, $venderID, $r_array, $venderCID) = @_;
   $self->sendToServer($self->reconstruct({
      switch => 'buy_bulk_vender',
      venderID => $venderID,
      venderCID => $venderCID,
      itemInfo => (join '', map { pack 'v2', @{$_}{qw(amount itemIndex)} } @$r_array),
   }));
   debug "Sent bulk buy vender: ".(join ', ', map {"$_->{itemIndex} x $_->{amount}"} @$r_array)."\n", "sendPacket";
}

Network/Send/iRO.pm
===================================================================
+ sub new {
+  my ($class) = @_;
+   my $self = $class->SUPER::new(@_);
+   
+   my %handlers = qw(
+      buy_bulk_vender 0801
+   );
+   $self->{packet_lut}{$_} = $handlers{$_} for keys %handlers;
+   
+   return $self;
+ }

-*sendBuyBulkVender = *Network::Send::ServerType0::sendBuyBulkVender2;

That sendBuyBulkVender can be then moved to some object representing vender or item, as it's independent of serverType (disregarding internal structure for now).

sendMasterHANLogin:
Code:
      '0064' => ['master_login', 'V a24 a24 C', [qw(version username password master_version)]],
      '02B0' => ['master_login', 'V a24 a24 C H32 H26 C', [qw(version username password_rijndael master_version ip mac isGravityID)]],

      if ($masterServer->{masterLogin_packet} eq '') {
         $self->sendClientMD5Hash() unless $masterServer->{clientHash} eq ''; # this is a hack, just for testing purposes, it should be moved to the login algo later on
         my $key = ... my $chain = ... my $in = ... my $rijndael = ...
         
         $msg = $self->reconstruct({
            switch => 'master_login',
            version => $version,
            master_version => $master_version,
            username => $username,
            password => $password,
            password_rijndael => $rijndael->Encrypt($in, undef, 24, 0),
            ip => '3139322e3136382e322e3400685f4c40', # gibberish, ofcourse ;-)
            mac => '31313131313131313131313100', # gibberish
            isGravityID => 0,
         });
      } else {


Base changes:
Code:
Index: doc/modules.txt
===================================================================
--- doc/modules.txt   (revision 7778)
+++ doc/modules.txt   (working copy)
@@ -22,6 +22,7 @@
TaskManager
Modules
Network::DirectConnection
+Network::PacketParser
Network::Receive
Network::Send
Network::XKore
Index: Network/PacketParser.pm
===================================================================
--- Network/PacketParser.pm   (revision 7769)
+++ Network/PacketParser.pm   (working copy)
@@ -17,14 +17,14 @@
#
# Please also read <a href="http://www.openkore.com/wiki/index.php/Network_subsystem">the
# network subsystem overview.</a>
-package Network::Receive;
+package Network::PacketParser;

use strict;
use encoding 'utf8';
use Carp::Assert;
use Scalar::Util;

-use Exception::Class ('Network::Receive::InvalidServerType', 'Network::Receive::CreationError');
+use Exception::Class ('Network::PacketParser::InvalidServerType', 'Network::PacketParser::CreationError');

use Globals;
#use Settings;
@@ -40,8 +40,25 @@
use Utils::Crypton;
use Translation;

+### CATEGORY: Hash members
+
+##
+# Hash* {packet_list}
+#
+# A list of packet handlers and decoding information.
+#
+# 'packet switch' => ['handler function', 'unpack string', [qw(argument names)]]
+
+##
+# Hash* {packet_lut}
+#
+# Lookup table for currently used packet switches.
+# Used for constructing packets by handler name.
+#
+# 'handler function' => 'packet switch'
+
######################################
-### Public methods
+### CATEGORY: Class methods
######################################

# Do not call this directly. Use create() instead.
@@ -52,38 +69,53 @@
   # If you are wondering about those funny strings like 'x2 v1' read http://perldoc.perl.org/functions/pack.html
   # and http://perldoc.perl.org/perlpacktut.html

-   # Defines a list of Packet Handlers and decoding information
-   # 'packetSwitch' => ['handler function','unpack string',[qw(argument names)]]
-
   $self->{packet_list} = {};
+   $self->{packet_lut} = {};

   return bless $self, $class;
}

##
-# Network::Receive->create(String serverType)
+# Network::PacketParser->create(Network net, String serverType)
+# net: An object compatible with the '@MODULE(Network)' class.
+# serverType: A server type.
#
# Create a new server message parsing object for the specified server type.
#
-# Throws Network::Receive::InvalidServerType if the specified server type does
+# Throws Network::PacketParser::InvalidServerType if the specified server type does
# not exist.
-# Throws Network::Receive::CreationError if some other error occured.
+# Throws Network::PacketParser::CreationError if some other error occured.
+=pod
+   eval("use $class;");
+   if ($@ =~ /Can\'t locate/) {
+      Network::Send::ServerTypeNotSupported->throw(error => "Server type '$type' not supported.");
+   } elsif ($@) {
+      die $@;
+   }
+
+   my $instance = $class->new();
+
+   if (!$instance) {
+      Network::Send::CreationException->throw(
+         error => "Cannot create message sender object for server type '$type'.");
+   }
+=cut
sub create {
-   my ($self, $serverType) = @_;
+   my ($base, $net, $serverType) = @_;
   
   my ($mode, $type, $param) = Settings::parseServerType ($serverType);
-   my $class = "Network::Receive::$type" . ($param ? "::$param" : ""); #param like Thor in bRO_Thor
+   my $class = join '::', $base, $type, ($param ? ($param) : ()); #param like Thor in bRO_Thor
   
-   debug "[ST recv] $class ". " (mode: " . ($mode ? "new" : "old") .")\n";
+   debug "[$base] $class ". " (mode: " . ($mode ? "new" : "old") .")\n";

   undef $@;
   eval("use $class;");
   if ($@ =~ /^Can't locate /s) {
-      Network::Receive::InvalidServerType->throw(
+      Network::PacketParser::InvalidServerType->throw(
         TF("Cannot load server message parser for server type '%s'.", $type)
      );
   } elsif ($@) {
-      Network::Receive::CreationError->throw(
+      Network::PacketParser::CreationError->throw(
         TF("An error occured while loading the server message parser for server type '%s':\n%s",
            $type, $@)
      );
@@ -91,45 +123,22 @@
   
   my $self = $class->new;
   
-   if ($Settings::sys{devel_networkReceiveHooks}) {
-      # hook all handlers from Network::Receive::* for compatibility
-      # (if/when all handlers will be moved out of Network, this could be removed)
-      
-      # TODO: some way of handling only packets that are not handled by any plugins?
-      my @handlers = grep { $self->can ($_) } keys %{{map { $_->[0] => 1 } values %{$self->{packet_list}}}};
-      
-      if (@handlers) {
-         debug TF("Adding hooks for packet handlers in %s: %s\n", $class, join ', ', @handlers), 'network_compatibility';
-         
-         Scalar::Util::weaken (my $weakSelf = $self);
-         
-         my $handler = sub {
-            my (undef, $args, $callback) = @_;
-            
-            $weakSelf->$callback ($args);
-            $args->{return} = 1;
-         };
-         
-         $self->{recvpacketHandleHooks} = Plugins::addHooks (map { ["packet_handle/$_", $handler, $_] } @handlers);
-      }
-   }
+   $self->{base} = $base;
+   $self->{net} = $net;
+   $self->{serverType} = $type; # TODO: eliminate {serverType} from there
+   Modules::register($class);
   
   return $self;
}

-sub DESTROY {
-   my ($self) = @_;
-   
-   if ($Settings::sys{devel_networkReceiveHooks} && $self->{recvpacketHandleHooks}) {
-      debug T("Removing hooks for packet handlers in Network::Receive\n"), 'network_compatibility';
-      
-      Plugins::delHooks ($self->{recvpacketHandleHooks});
-   }
-}
+### CATEGORY: Methods

-# $packetParser->reconstruct($args)
+##
+# Bytes $packetParser->reconstruct(Hash* args)
#
-# Reconstructs a raw packet from $args using $self->{packet_list}.
+# Reconstructs a raw packet from $args using {packet_list} and {packet_lut}.
+#
+# $args->{switch} may contain a packet switch or a handler name.
sub reconstruct {
   my ($self, $args) = @_;

@@ -174,6 +183,18 @@
   return $packet;
}

+##
+# Hash* $packetParser->parse(Bytes msg)
+#
+# Parses a raw packet using {packet_list}.
+#
+# Result hashref would contain parsed arguments and the following information:
+# `l
+# - switch: packet switch
+# - RAW_MSG: original message passed
+# - RAW_MSG_SIZE: length of original message passed
+# - KEYS: list of argument names from {packet_list}
+# `l`
sub parse {
   my ($self, $msg) = @_;

@@ -206,29 +227,15 @@
      }
   }

-   if ($Settings::sys{devel_networkReceiveHooks}) {
+   my $callback = $self->can($handler->[0]);
+   if ($callback) {
      Plugins::callHook("packet_pre/$handler->[0]", \%args);
      Misc::checkValidity("Packet: " . $handler->[0] . " (pre)");
-      unless ($args{return}) {
-         if (Plugins::hasHook("packet_handle/$handler->[0]", \%args)) {
-            Plugins::callHook("packet_handle/$handler->[0]", \%args);
-            Misc::checkValidity("Packet: " . $handler->[0]);
-         } else {
-            warning "Packet Parser: Unhandled Packet: $switch Handler: $handler->[0]\n";
-            debug ("Unpacked: " . join(', ', @{\%args}{@{$handler->[2]}}) . "\n"), "packetParser", 2 if $handler->[2];
-         }
-      }
+      $self->$callback(\%args);
+      Misc::checkValidity("Packet: " . $handler->[0]);
   } else {
-      my $callback = $self->can($handler->[0]);
-      if ($callback) {
-         Plugins::callHook("packet_pre/$handler->[0]", \%args);
-         Misc::checkValidity("Packet: " . $handler->[0] . " (pre)");
-         $self->$callback(\%args);
-         Misc::checkValidity("Packet: " . $handler->[0]);
-      } else {
-         warning "Packet Parser: Unhandled Packet: $switch Handler: $handler->[0]\n";
-         debug ("Unpacked: " . join(', ', @{\%args}{@{$handler->[2]}}) . "\n"), "packetParser", 2 if $handler->[2];
-      }
+      warning "Packet Parser: Unhandled Packet: $switch Handler: $handler->[0]\n";
+      debug ("Unpacked: " . join(', ', @{\%args}{@{$handler->[2]}}) . "\n"), "packetParser", 2 if $handler->[2];
   }

   Plugins::callHook("packet/$handler->[0]", \%args);
@@ -272,8 +279,8 @@
# }
# </pre>
sub willMangle {
-   if (Plugins::hasHook("Network::Receive/willMangle")) {
-      my ($self, $messageID) = @_;
+   my ($self, $messageID) = @_;
+   if (Plugins::hasHook("$self->{base}/willMangle")) {
      my $packet = $self->{packet_list}{$messageID};
      my $name;
      $name = $packet->[0] if ($packet);
@@ -282,13 +289,14 @@
         messageID => $messageID,
         name => $name
      );
-      Plugins::callHook("Network::Receive/willMangle", \%args);
+      Plugins::callHook("$self->{base}/willMangle", \%args);
      return $args{return};
   } else {
      return undef;
   }
}

+##
# boolean $packetParser->mangle(Array* args)
#
# Calls the appropriate plugin function to mangle the packet, which
@@ -303,135 +311,8 @@
      $hook_args{messageName} = $entry->[0];
   }

-   Plugins::callHook("Network::Receive/mangle", \%hook_args);
+   Plugins::callHook("$self->{base}/mangle", \%hook_args);
   return $hook_args{return};
}

-##
-# Network::Receive->decrypt(r_msg, themsg)
-# r_msg: a reference to a scalar.
-# themsg: the message to decrypt.
-#
-# Decrypts the packets in $themsg and put the result in the scalar
-# referenced by $r_msg.
-#
-# This is an old method used back in the iRO beta 2 days when iRO had encrypted packets.
-# At the moment (December 20 2006) there are no servers that still use encrypted packets.
-#
-# Example:
-# } elsif ($switch eq "ABCD") {
-#    my $level;
-#    Network::Receive->decrypt(\$level, substr($msg, 0, 2));
-sub decrypt {
-   use bytes;
-   my ($self, $r_msg, $themsg) = @_;
-   my @mask;
-   my $i;
-   my ($temp, $msg_temp, $len_add, $len_total, $loopin, $len, $val);
-   if ($config{encrypt} == 1) {
-      undef $$r_msg;
-      undef $len_add;
-      undef $msg_temp;
-      for ($i = 0; $i < 13;$i++) {
-         $mask[$i] = 0;
-      }
-      $len = unpack("v1",substr($themsg,0,2));
-      $val = unpack("v1",substr($themsg,2,2));
-      {
-         use integer;
-         $temp = ($val * $val * 1391);
-      }
-      $temp = ~(~($temp));
-      $temp = $temp % 13;
-      $mask[$temp] = 1;
-      {
-         use integer;
-         $temp = $val * 1397;
-      }
-      $temp = ~(~($temp));
-      $temp = $temp % 13;
-      $mask[$temp] = 1;
-      for($loopin = 0; ($loopin + 4) < $len; $loopin++) {
-          if (!($mask[$loopin % 13])) {
-              $msg_temp .= substr($themsg,$loopin + 4,1);
-         }
-      }
-      if (($len - 4) % 8 != 0) {
-         $len_add = 8 - (($len - 4) % 8);
-      }
-      $len_total = $len + $len_add;
-      $$r_msg = $msg_temp.substr($themsg, $len_total, length($themsg) - $len_total);
-   } elsif ($config{encrypt} >= 2) {
-      undef $$r_msg;
-      undef $len_add;
-      undef $msg_temp;
-      for ($i = 0; $i < 17;$i++) {
-         $mask[$i] = 0;
-      }
-      $len = unpack("v1",substr($themsg,0,2));
-      $val = unpack("v1",substr($themsg,2,2));
-      {
-         use integer;
-         $temp = ($val * $val * 34953);
-      }
-      $temp = ~(~($temp));
-      $temp = $temp % 17;
-      $mask[$temp] = 1;
-      {
-         use integer;
-         $temp = $val * 2341;
-      }
-      $temp = ~(~($temp));
-      $temp = $temp % 17;
-      $mask[$temp] = 1;
-      for($loopin = 0; ($loopin + 4) < $len; $loopin++) {
-          if (!($mask[$loopin % 17])) {
-              $msg_temp .= substr($themsg,$loopin + 4,1);
-         }
-      }
-      if (($len - 4) % 8 != 0) {
-         $len_add = 8 - (($len - 4) % 8);
-      }
-      $len_total = $len + $len_add;
-      $$r_msg = $msg_temp.substr($themsg, $len_total, length($themsg) - $len_total);
-   } else {
-      $$r_msg = $themsg;
-   }
-}
-
-
-#######################################
-###### Private methods
-#######################################
-
-sub queryLoginPinCode {
-   my $message = $_[0] || T("You've never set a login PIN code before.\nPlease enter a new login PIN code:");
-   do {
-      my $input = $interface->query($message, isPassword => 1,);
-      if (!defined($input)) {
-         quit();
-         return;
-      } else {
-         if ($input !~ /^\d+$/) {
-            $interface->errorDialog(T("The PIN code may only contain digits."));
-         } elsif ((length($input) <= 3) || (length($input) >= 9)) {
-            $interface->errorDialog(T("The PIN code must be between 4 and 9 characters."));
-         } else {
-            return $input;
-         }
-      }
-   } while (1);
-}
-
-sub queryAndSaveLoginPinCode {
-   my ($self, $message) = @_;
-   my $pin = queryLoginPinCode($message);
-   if (defined $pin) {
-      configModify('loginPinCode', $pin, silent => 1);
-      return 1;
-   } else {
-      return 0;
-   }
-}
-
1;
Index: Network/Send.pm
===================================================================
--- Network/Send.pm   (revision 7778)
+++ Network/Send.pm   (working copy)
@@ -24,11 +24,10 @@
package Network::Send;

use strict;
+use base qw(Network::PacketParser);
use encoding 'utf8';
use Carp::Assert;

-use Exception::Class ('Network::Send::ServerTypeNotSupported', 'Network::Send::CreationException');
-
use Globals qw(%config $encryptVal $bytesSent $conState %packetDescriptions $enc_val1 $enc_val2);
use I18N qw(stringToBytes);
use Utils qw(existsInList);
@@ -74,58 +73,11 @@
   Network::Send::Compatibility->export_to_level(1, undef, @EXPORT_OK);
}

-# Not not call this method directly, use create() instead.
-sub new {
-   my ($class) = @_;
-   return bless {}, $class;
-}
+### CATEGORY: Class methods

##
-# int $NetworkSend->{serverType}
+# void Network::Send::encrypt(r_msg, themsg)
#
-# The server type for this message sender object, as passed to the
-# create() method.
-
-##
-# Network::Send->create(net, int serverType)
-# net: An object compatible with the '@MODULE(Network)' class.
-# serverType: A server type.
-#
-# Create a new message sender object for the specified server type.
-#
-# Throws Network::Send::ServerTypeNotSupported if the specified server type
-# is not supported.
-# Throws Network::Send::CreationException if the server type is supported, but the
-# message sender object cannot be created.
-sub create {
-   my (undef, $net, $serverType) = @_;
-
-   my ($mode, $type, $param) = Settings::parseServerType ($serverType);
-   my $class = "Network::Send::$type" . ($param ? "::$param" : ""); #param like Thor in bRO_Thor
-   
-   debug "[ST send] $class ". " (mode: " . ($mode ? "new" : "old") .")\n";
-
-   eval("use $class;");
-   if ($@ =~ /Can\'t locate/) {
-      Network::Send::ServerTypeNotSupported->throw(error => "Server type '$type' not supported.");
-   } elsif ($@) {
-      die $@;
-   }
-
-   my $instance = $class->new();
-
-   if (!$instance) {
-      Network::Send::CreationException->throw(
-         error => "Cannot create message sender object for server type '$type'.");
-   }
-
-   $instance->{net} = $net;
-   $instance->{serverType} = $type;
-   Modules::register($class);
-
-   return $instance;
-}
-
# This is an old method used back in the iRO beta 2 days when iRO had encrypted packets.
# At the moment (December 20 2006) there are no servers that still use encrypted packets.
sub encrypt {
@@ -209,6 +161,10 @@
   $$r_msg = $newmsg;
}

+### CATEGORY: Methods
+
+##
+# void $messageSender->encryptMessageID(r_message)
sub encryptMessageID {
   use bytes;
   my ($self, $r_message) = @_;
@@ -232,6 +188,10 @@
   }
}

+##
+# void $messageSender->injectMessage(String message)
+#
+# Send text message to the connected client's party chat.
sub injectMessage {
   my ($self, $message) = @_;
   my $name = stringToBytes("|");
@@ -246,6 +206,10 @@
   $self->{net}->clientSend($msg);
}

+##
+# void $messageSender->injectAdminMessage(String message)
+#
+# Send text message to the connected client's system chat.
sub injectAdminMessage {
   my ($self, $message) = @_;
   $message = stringToBytes($message);
@@ -257,6 +221,10 @@
   $self->{net}->clientSend($message);
}

+##
+# void $messageSender->sendToServer(Bytes msg)
+#
+# Send a raw data to the server.
sub sendToServer {
   my ($self, $msg) = @_;
   my $net = $self->{net};
@@ -295,6 +263,11 @@
   }
}

+##
+# void $messageSender->sendRaw(String raw)
+# raw: space-delimited list of hex byte values
+#
+# Send a raw data to the server.
sub sendRaw {
   my ($self, $raw) = @_;
   my $msg;
Index: Network/Receive.pm
===================================================================
--- Network/Receive.pm   (revision 7778)
+++ Network/Receive.pm   (working copy)
@@ -20,12 +20,11 @@
package Network::Receive;

use strict;
+use base qw(Network::PacketParser);
use encoding 'utf8';
use Carp::Assert;
use Scalar::Util;

-use Exception::Class ('Network::Receive::InvalidServerType', 'Network::Receive::CreationError');
-
use Globals;
#use Settings;
use Log qw(message warning error debug);
@@ -41,273 +40,10 @@
use Translation;

######################################
-### Public methods
+### CATEGORY: Class methods
######################################

-# Do not call this directly. Use create() instead.
-sub new {
-   my ($class) = @_;
-   my $self;
-
-   # If you are wondering about those funny strings like 'x2 v1' read http://perldoc.perl.org/functions/pack.html
-   # and http://perldoc.perl.org/perlpacktut.html
-
-   # Defines a list of Packet Handlers and decoding information
-   # 'packetSwitch' => ['handler function','unpack string',[qw(argument names)]]
-
-   $self->{packet_list} = {};
-
-   return bless $self, $class;
-}
-
##
-# Network::Receive->create(String serverType)
-#
-# Create a new server message parsing object for the specified server type.
-#
-# Throws Network::Receive::InvalidServerType if the specified server type does
-# not exist.
-# Throws Network::Receive::CreationError if some other error occured.
-sub create {
-   my ($self, $serverType) = @_;
-   
-   my ($mode, $type, $param) = Settings::parseServerType ($serverType);
-   my $class = "Network::Receive::$type" . ($param ? "::$param" : ""); #param like Thor in bRO_Thor
-   
-   debug "[ST recv] $class ". " (mode: " . ($mode ? "new" : "old") .")\n";
-
-   undef $@;
-   eval("use $class;");
-   if ($@ =~ /^Can't locate /s) {
-      Network::Receive::InvalidServerType->throw(
-         TF("Cannot load server message parser for server type '%s'.", $type)
-      );
-   } elsif ($@) {
-      Network::Receive::CreationError->throw(
-         TF("An error occured while loading the server message parser for server type '%s':\n%s",
-            $type, $@)
-      );
-   }
-   
-   my $self = $class->new;
-   
-   if ($Settings::sys{devel_networkReceiveHooks}) {
-      # hook all handlers from Network::Receive::* for compatibility
-      # (if/when all handlers will be moved out of Network, this could be removed)
-      
-      # TODO: some way of handling only packets that are not handled by any plugins?
-      my @handlers = grep { $self->can ($_) } keys %{{map { $_->[0] => 1 } values %{$self->{packet_list}}}};
-      
-      if (@handlers) {
-         debug TF("Adding hooks for packet handlers in %s: %s\n", $class, join ', ', @handlers), 'network_compatibility';
-         
-         Scalar::Util::weaken (my $weakSelf = $self);
-         
-         my $handler = sub {
-            my (undef, $args, $callback) = @_;
-            
-            $weakSelf->$callback ($args);
-            $args->{return} = 1;
-         };
-         
-         $self->{recvpacketHandleHooks} = Plugins::addHooks (map { ["packet_handle/$_", $handler, $_] } @handlers);
-      }
-   }
-   
-   return $self;
-}
-
-sub DESTROY {
-   my ($self) = @_;
-   
-   if ($Settings::sys{devel_networkReceiveHooks} && $self->{recvpacketHandleHooks}) {
-      debug T("Removing hooks for packet handlers in Network::Receive\n"), 'network_compatibility';
-      
-      Plugins::delHooks ($self->{recvpacketHandleHooks});
-   }
-}
-
-# $packetParser->reconstruct($args)
-#
-# Reconstructs a raw packet from $args using $self->{packet_list}.
-sub reconstruct {
-   my ($self, $args) = @_;
-
-   my $switch = $args->{switch};
-   unless ($switch =~ /^[0-9A-F]{4}$/) {
-      # lookup by handler name
-      unless (exists $self->{packet_lut}{$switch}) {
-         # alternative (if any) isn't set yet, pick the first available
-         for (keys %{$self->{packet_list}}) {
-            if ($self->{packet_list}{$_}[0] eq $switch) {
-               $self->{packet_lut}{$switch} = $_;
-               last;
-            }
-         }
-         unless (exists $self->{packet_lut}{$switch}) {
-            die "Can't construct unknown packet $switch";
-         }
-      }
-      
-      $switch = $self->{packet_lut}{$switch};
-   }
-
-   my $packet = $self->{packet_list}{$switch};
-   my ($name, $packString, $varNames) = @{$packet};
-
-   my @vars = ();
-   for my $varName (@{$varNames}) {
-      push(@vars, $args->{$varName});
-   }
-   my $packet = pack("H2 H2 $packString", substr($switch, 2, 2), substr($switch, 0, 2), @vars);
-   
-   if (exists $rpackets{$switch}) {
-      if ($rpackets{$switch} > 0) {
-         # fixed length packet, pad/truncate to the correct length
-         $packet = pack('a'.$rpackets{$switch}, $packet);
-      } else {
-         # variable length packet, store its length in the packet
-         substr($packet, 2, 2) = pack('v', length $packet);
-      }
-   }
-   
-   return $packet;
-}
-
-sub parse {
-   my ($self, $msg) = @_;
-
-   $bytesReceived += length($msg);
-   my $switch = Network::MessageTokenizer::getMessageID($msg);
-   my $handler = $self->{packet_list}{$switch};
-
-   unless ($handler) {
-      warning "Packet Parser: Unknown switch: $switch\n";
-      return undef;
-   }
-
-   # set this alternative (if any) as the one in use with that server
-   # TODO: permanent storage (with saving)?
-   $self->{packet_lut}{$handler->[0]} = $switch;
-
-   debug "Received packet: $switch Handler: $handler->[0]\n", "packetParser", 2;
-
-   # RAW_MSG is the entire message, including packet switch
-   my %args = (
-      switch => $switch,
-      RAW_MSG => $msg,
-      RAW_MSG_SIZE => length($msg),
-      KEYS => $handler->[2],
-   );
-   if ($handler->[1]) {
-      my @unpacked_data = unpack("x2 $handler->[1]", $msg);
-      foreach my $key (@{$handler->[2]}) {
-         $args{$key} = shift @unpacked_data;
-      }
-   }
-
-   if ($Settings::sys{devel_networkReceiveHooks}) {
-      Plugins::callHook("packet_pre/$handler->[0]", \%args);
-      Misc::checkValidity("Packet: " . $handler->[0] . " (pre)");
-      unless ($args{return}) {
-         if (Plugins::hasHook("packet_handle/$handler->[0]", \%args)) {
-            Plugins::callHook("packet_handle/$handler->[0]", \%args);
-            Misc::checkValidity("Packet: " . $handler->[0]);
-         } else {
-            warning "Packet Parser: Unhandled Packet: $switch Handler: $handler->[0]\n";
-            debug ("Unpacked: " . join(', ', @{\%args}{@{$handler->[2]}}) . "\n"), "packetParser", 2 if $handler->[2];
-         }
-      }
-   } else {
-      my $callback = $self->can($handler->[0]);
-      if ($callback) {
-         Plugins::callHook("packet_pre/$handler->[0]", \%args);
-         Misc::checkValidity("Packet: " . $handler->[0] . " (pre)");
-         $self->$callback(\%args);
-         Misc::checkValidity("Packet: " . $handler->[0]);
-      } else {
-         warning "Packet Parser: Unhandled Packet: $switch Handler: $handler->[0]\n";
-         debug ("Unpacked: " . join(', ', @{\%args}{@{$handler->[2]}}) . "\n"), "packetParser", 2 if $handler->[2];
-      }
-   }
-
-   Plugins::callHook("packet/$handler->[0]", \%args);
-   return \%args;
-}
-
-##
-# boolean $packetParser->willMangle(Bytes messageID)
-# messageID: a message ID, such as "008A".
-#
-# Check whether the message with the specified message ID will be mangled.
-# If the bot is running in X-Kore mode, then messages that will be mangled will not
-# be sent to the RO client.
-#
-# By default, a message will never be mangled. Plugins can register mangling procedures
-# though. This is done by using the following hooks:
-# `l
-# - "Network::Receive/willMangle" - This hook has arguments 'messageID' (Bytes) and 'name' (String).
-#          'name' is a human-readable description of the message, and may be undef. Plugins
-#          should set the 'return' argument to 1 if they want willMangle() to return 1.
-# - "Network::Receive/mangle" - This hook has arguments 'messageArgs' and 'messageName' (the latter may be undef).
-# `l`
-# The following example demonstrates how this is done:
-# <pre class="example">
-# Plugins::addHook("Network::Receive/willMangle", \&willMangle);
-# Plugins::addHook("Network::Receive/mangle", \&mangle);
-#
-# sub willMangle {
-#     my (undef, $args) = @_;
-#     if ($args->{messageID} eq '008A') {
-#         $args->{willMangle} = 1;
-#     }
-# }
-#
-# sub mangle {
-#     my (undef, $args) = @_;
-#     my $message_args = $args->{messageArgs};
-#     if ($message_args->{switch} eq '008A') {
-#         ...Modify $message_args as necessary....
-#     }
-# }
-# </pre>
-sub willMangle {
-   if (Plugins::hasHook("Network::Receive/willMangle")) {
-      my ($self, $messageID) = @_;
-      my $packet = $self->{packet_list}{$messageID};
-      my $name;
-      $name = $packet->[0] if ($packet);
-
-      my %args = (
-         messageID => $messageID,
-         name => $name
-      );
-      Plugins::callHook("Network::Receive/willMangle", \%args);
-      return $args{return};
-   } else {
-      return undef;
-   }
-}
-
-# boolean $packetParser->mangle(Array* args)
-#
-# Calls the appropriate plugin function to mangle the packet, which
-# destructively modifies $args.
-# Returns false if the packet should be suppressed.
-sub mangle {
-   my ($self, $args) = @_;
-
-   my %hook_args = (messageArgs => $args);
-   my $entry = $self->{packet_list}{$args->{switch}};
-   if ($entry) {
-      $hook_args{messageName} = $entry->[0];
-   }
-
-   Plugins::callHook("Network::Receive/mangle", \%hook_args);
-   return $hook_args{return};
-}
-
-##
# Network::Receive->decrypt(r_msg, themsg)
# r_msg: a reference to a scalar.
# themsg: the message to decrypt.
@@ -401,9 +137,15 @@


#######################################
-###### Private methods
+### CATEGORY: Private class methods
#######################################

+##
+# int Network::Receive::queryLoginPinCode([String message])
+# Returns: login PIN code, or undef if cancelled
+# Ensures: length(result) in 4..8
+#
+# Request login PIN code from user.
sub queryLoginPinCode {
   my $message = $_[0] || T("You've never set a login PIN code before.\nPlease enter a new login PIN code:");
   do {
@@ -423,6 +165,11 @@
   } while (1);
}

+##
+# boolean Network::Receive->queryAndSaveLoginPinCode([String message])
+# Returns: true on success
+#
+# Request login PIN code from user and save it in config.
sub queryAndSaveLoginPinCode {
   my ($self, $message) = @_;
   my $pin = queryLoginPinCode($message);


Notes: parse() automatically calls corresponding handler, which may be not desirable if that would be used for working with XKore etc; reconstruct() creates a packet but doesn't send it. Maybe additional two functions should be added, the one which would only parse, the second which would create and send a packet.

Needs critical review.


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 14 Jun 2011, 11:08 
Offline
Administrator
Administrator
User avatar

Joined: 24 Apr 2008, 12:02
Posts: 1301
OK.
So the Parse/unparse should deconstruct and construct packet.
that's all good. It's even good for xKore modes too.
the question is: If we implement central storage for that, how we will handle Unusual packets such as 0x7fd PACKET_ZC_BROADCASTING_SPECIAL_ITEM_OBTAIN ?
if thet question could be solved with minimal impact, then I give Green Light on all Networking Changes and Code merge.

_________________
Join our Team. Click here.
Image


Image


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 14 Jun 2011, 12:57 
Offline
Developers
Developers

Joined: 05 Dec 2008, 05:42
Posts: 1811
For now, unusual packets may be packed/unpacked using some packet-specific callbacks, or just be left in the current implementation.


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 14 Jun 2011, 13:30 
Offline
Administrator
Administrator
User avatar

Joined: 24 Apr 2008, 12:02
Posts: 1301
EternalHarvest wrote:
For now, unusual packets may be packed/unpacked using some packet-specific callbacks, or just be left in the current implementation.

I think, that there should be some functions witch override usual pack/unpack, allowing to pack/unpack such complex packets.
eg. The packet "pack"/"unpack" array could have some subref added somewhere, and that sub does the magic =)

_________________
Join our Team. Click here.
Image


Image


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 14 Jun 2011, 13:59 
Offline
Developers
Developers

Joined: 05 Dec 2008, 05:42
Posts: 1811
EternalHarvest wrote:
be packed/unpacked using some packet-specific callbacks

kLabMouse wrote:
some functions witch override usual pack/unpack

You described the same thing?


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 14 Jun 2011, 14:26 
Offline
Administrator
Administrator
User avatar

Joined: 24 Apr 2008, 12:02
Posts: 1301
OK. So You can Implement thus packets.Good.
I give a Green Light. Also, do not forget about Plugins... thus need to be compatible.

_________________
Join our Team. Click here.
Image


Image


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 14 Jun 2011, 18:21 
Offline
Developers
Developers

Joined: 05 Dec 2008, 05:42
Posts: 1811
Code:
sub parse_buy_bulk_vender {
   my ($self, $args) = @_;
   @{$args->{items}} = map {{ amount => unpack('v', $_), itemIndex => unpack('x2 v', $_) }} unpack '(a4)*', $args->{itemInfo};
}

sub reconstruct_buy_bulk_vender {
   my ($self, $args) = @_;
   # ITEM index. There were any other indexes expected to be in item buying packet?
   $args->{itemInfo} = pack '(a4)*', map { pack 'v2', @{$_}{qw(amount itemIndex)} } @{$args->{items}};
}

sub sendBuyBulkVender {
   my ($self, $venderID, $r_array, $venderCID) = @_;
   $self->sendToServer($self->reconstruct({
      switch => 'buy_bulk_vender',
      venderID => $venderID,
      venderCID => $venderCID,
      items => $r_array,
   }));
   debug "Sent bulk buy vender: ".(join ', ', map {"$_->{itemIndex} x $_->{amount}"} @$r_array)."\n", "sendPacket";
}

Code:
sub reconstruct {
   # ...
+   if (my $callback = $self->can("reconstruct_$name")) {
+      $self->$callback($args);
+   }
   # ...
}


Top
 Profile  
 
 Post subject: Re: Merge Receive and Send base modules
PostPosted: 14 Jun 2011, 18:26 
Offline
Administrator
Administrator
User avatar

Joined: 24 Apr 2008, 12:02
Posts: 1301
Great. So any Pack/Unpack could be overloaded.
RLY Good!

_________________
Join our Team. Click here.
Image


Image


Top
 Profile  
 
Display posts from previous:  Sort by  
Forum locked This topic is locked, you cannot edit posts or make further replies.  [ 27 posts ]  Go to page 1, 2, 3  Next

All times are UTC - 5 hours [ DST ]


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to:  
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group