Merge Receive and Send base modules
Moderator: Moderators
-
- Developers
- Posts: 1798
- Joined: 05 Dec 2008, 05:42
- Noob?: Yes
Merge Receive and Send base modules
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
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
-
- Super Moderators
- Posts: 801
- Joined: 06 May 2008, 12:47
- Noob?: No
Re: Merge Receive and Send base modules
+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!
One ST_kRO to bring them all and in the darkness bind them...
Mount Doom awaits us, fellowship of OpenKore!
-
- Developers
- Posts: 1798
- Joined: 05 Dec 2008, 05:42
- Noob?: Yes
Re: Merge Receive and Send base modules
Example usage, buyBulkVender:
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:
Base changes:
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.
Code: Select all
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;
sendMasterHANLogin:
Code: Select all
'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 {
Code: Select all
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);
Needs critical review.
Re: Merge Receive and Send base modules
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.
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.
-
- Developers
- Posts: 1798
- Joined: 05 Dec 2008, 05:42
- Noob?: Yes
Re: Merge Receive and Send base modules
For now, unusual packets may be packed/unpacked using some packet-specific callbacks, or just be left in the current implementation.
Re: Merge Receive and Send base modules
I think, that there should be some functions witch override usual pack/unpack, allowing to pack/unpack such complex packets.EternalHarvest wrote:For now, unusual packets may be packed/unpacked using some packet-specific callbacks, or just be left in the current implementation.
eg. The packet "pack"/"unpack" array could have some subref added somewhere, and that sub does the magic =)
-
- Developers
- Posts: 1798
- Joined: 05 Dec 2008, 05:42
- Noob?: Yes
Re: Merge Receive and Send base modules
EternalHarvest wrote:be packed/unpacked using some packet-specific callbacks
You described the same thing?kLabMouse wrote:some functions witch override usual pack/unpack
Re: Merge Receive and Send base modules
OK. So You can Implement thus packets.Good.
I give a Green Light. Also, do not forget about Plugins... thus need to be compatible.
I give a Green Light. Also, do not forget about Plugins... thus need to be compatible.
-
- Developers
- Posts: 1798
- Joined: 05 Dec 2008, 05:42
- Noob?: Yes
Re: Merge Receive and Send base modules
Code: Select all
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: Select all
sub reconstruct {
# ...
+ if (my $callback = $self->can("reconstruct_$name")) {
+ $self->$callback($args);
+ }
# ...
}
Re: Merge Receive and Send base modules
Great. So any Pack/Unpack could be overloaded.
RLY Good!
RLY Good!