Merge Receive and Send base modules

Forum closed. All further discussion to be discussed at https://github.com/OpenKore/

Moderator: Moderators

Message
Author
EternalHarvest
Developers
Developers
Posts: 1798
Joined: 05 Dec 2008, 05:42
Noob?: Yes

Merge Receive and Send base modules

#1 Post by EternalHarvest »

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

Technology
Super Moderators
Super Moderators
Posts: 801
Joined: 06 May 2008, 12:47
Noob?: No

Re: Merge Receive and Send base modules

#2 Post by Technology »

+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!

EternalHarvest
Developers
Developers
Posts: 1798
Joined: 05 Dec 2008, 05:42
Noob?: Yes

Re: Merge Receive and Send base modules

#3 Post by EternalHarvest »

Example usage, buyBulkVender:

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;
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: 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 {
Base changes:

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);
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.

User avatar
kLabMouse
Administrator
Administrator
Posts: 1301
Joined: 24 Apr 2008, 12:02

Re: Merge Receive and Send base modules

#4 Post by kLabMouse »

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.

EternalHarvest
Developers
Developers
Posts: 1798
Joined: 05 Dec 2008, 05:42
Noob?: Yes

Re: Merge Receive and Send base modules

#5 Post by EternalHarvest »

For now, unusual packets may be packed/unpacked using some packet-specific callbacks, or just be left in the current implementation.

User avatar
kLabMouse
Administrator
Administrator
Posts: 1301
Joined: 24 Apr 2008, 12:02

Re: Merge Receive and Send base modules

#6 Post by kLabMouse »

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 =)

EternalHarvest
Developers
Developers
Posts: 1798
Joined: 05 Dec 2008, 05:42
Noob?: Yes

Re: Merge Receive and Send base modules

#7 Post by EternalHarvest »

EternalHarvest wrote:be packed/unpacked using some packet-specific callbacks
kLabMouse wrote:some functions witch override usual pack/unpack
You described the same thing?

User avatar
kLabMouse
Administrator
Administrator
Posts: 1301
Joined: 24 Apr 2008, 12:02

Re: Merge Receive and Send base modules

#8 Post by kLabMouse »

OK. So You can Implement thus packets.Good.
I give a Green Light. Also, do not forget about Plugins... thus need to be compatible.

EternalHarvest
Developers
Developers
Posts: 1798
Joined: 05 Dec 2008, 05:42
Noob?: Yes

Re: Merge Receive and Send base modules

#9 Post by EternalHarvest »

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);
+	}
	# ...
}

User avatar
kLabMouse
Administrator
Administrator
Posts: 1301
Joined: 24 Apr 2008, 12:02

Re: Merge Receive and Send base modules

#10 Post by kLabMouse »

Great. So any Pack/Unpack could be overloaded.
RLY Good!

Locked