· 10 years ago · Sep 12, 2016, 09:14 PM
1#########################################################################
2# OpenKore - Server message parsing
3#
4# This software is open source, licensed under the GNU General Public
5# License, version 2.
6# Basically, this means that you're allowed to modify and distribute
7# this software. However, if you distribute modified versions, you MUST
8# also distribute the source code.
9# See http://www.gnu.org/licenses/gpl.html for the full license.
10#########################################################################
11##
12# MODULE DESCRIPTION: Server message parsing
13#
14# This class is responsible for parsing messages that are sent by the RO
15# server to Kore. Information in the messages are stored in global variables
16# (in the module Globals).
17#
18# Please also read <a href="http://wiki.openkore.com/index.php/Network_subsystem">the
19# network subsystem overview.</a>
20package Network::PacketParser;
21
22use strict;
23use utf8;
24use base qw(Exporter);
25use Carp::Assert;
26use Scalar::Util;
27use Time::HiRes qw(time);
28
29use Globals;
30#use Settings;
31use Log qw(message warning error debug);
32#use FileParsers;
33use I18N qw(bytesToString stringToBytes);
34use Interface;
35use Network;
36use Network::MessageTokenizer;
37use Misc;
38use Plugins;
39use Utils;
40use Utils::Exceptions;
41use Utils::Crypton;
42use Translation;
43
44our @EXPORT = qw(
45 ACTION_ATTACK ACTION_ITEMPICKUP ACTION_SIT ACTION_STAND
46 ACTION_ATTACK_NOMOTION ACTION_SPLASH ACTION_SKILL ACTION_ATTACK_REPEAT
47 ACTION_ATTACK_MULTIPLE ACTION_ATTACK_MULTIPLE_NOMOTION
48 ACTION_ATTACK_CRITICAL ACTION_ATTACK_LUCKY ACTION_TOUCHSKILL
49 STATUS_STR STATUS_AGI STATUS_VIT STATUS_INT STATUS_DEX STATUS_LUK
50);
51
52### CATEGORY: Ragnarok Online constants
53
54use constant {
55 ACTION_ATTACK => 0x0,
56 ACTION_ITEMPICKUP => 0x1, # pick up item
57 ACTION_SIT => 0x2, # sit down
58 ACTION_STAND => 0x3, # stand up
59 ACTION_ATTACK_NOMOTION => 0x4, # reflected/absorbed damage?
60 ACTION_SPLASH => 0x5,
61 ACTION_SKILL => 0x6,
62 ACTION_ATTACK_REPEAT => 0x7,
63 ACTION_ATTACK_MULTIPLE => 0x8, # double attack
64 ACTION_ATTACK_MULTIPLE_NOMOTION => 0x9, # don't display flinch animation (endure)
65 ACTION_ATTACK_CRITICAL => 0xa, # critical hit
66 ACTION_ATTACK_LUCKY => 0xb, # lucky dodge
67 ACTION_TOUCHSKILL => 0xc,
68 STATUS_STR => 0x0d,
69 STATUS_AGI => 0x0e,
70 STATUS_VIT => 0x0f,
71 STATUS_INT => 0x10,
72 STATUS_DEX => 0x11,
73 STATUS_LUK => 0x12,
74};
75
76### CATEGORY: Hash members
77
78##
79# Hash* {packet_list}
80#
81# A list of packet handlers and decoding information.
82#
83# 'packet switch' => ['handler function', 'unpack string', [qw(argument names)]]
84
85##
86# Hash* {packet_lut}
87#
88# Lookup table for currently used packet switches.
89# Used for constructing packets by handler name.
90#
91# 'handler function' => 'packet switch'
92
93######################################
94### CATEGORY: Class methods
95######################################
96
97# Do not call this directly. Use create() instead.
98sub new {
99 my ($class) = @_;
100 my $self;
101
102 # If you are wondering about those funny strings like 'x2 v1' read http://perldoc.perl.org/functions/pack.html
103 # and http://perldoc.perl.org/perlpacktut.html
104
105 $self->{packet_list} = {};
106 $self->{packet_lut} = {};
107 $self->{bytesProcessed} = 0;
108
109 return bless $self, $class;
110}
111
112##
113# Network::PacketParser->create(Network net, String serverType)
114# net: An object compatible with the '@MODULE(Network)' class.
115# serverType: A server type.
116#
117# Create a new server message parsing object for the specified server type.
118#
119# Throws FileNotFoundException, ModuleLoadException.
120sub create {
121 my ($base, $net, $serverType) = @_;
122
123 my ($mode, $type, $param) = Settings::parseServerType ($serverType);
124 my $class = join '::', $base, $type, (($param) || ()); #param like Thor in bRO_Thor
125
126 debug "[$base] $class ". " (mode: " . ($mode ? "new" : "old") .")\n";
127
128 undef $@;
129 eval("use $class;");
130 if ($@ =~ /^Can't locate /s) {
131 FileNotFoundException->throw(
132 TF("Cannot load server message parser for server type '%s'.", $type)
133 );
134 } elsif ($@) {
135 ModuleLoadException->throw(
136 TF("An error occured while loading the server message parser for server type '%s':\n%s",
137 $type, $@)
138 );
139 }
140
141 my $self = $class->new;
142
143 $self->{hook_prefix} = $base;
144 $self->{net} = $net;
145 $self->{serverType} = $type; # TODO: eliminate {serverType} from there
146 Modules::register($class);
147
148 return $self;
149}
150
151### CATEGORY: Methods
152
153##
154# Bytes $packetParser->reconstruct(Hash* args)
155#
156# Reconstructs a raw packet from $args using {packet_list} and {packet_lut}.
157#
158# $args->{switch} may contain a packet switch or a handler name.
159sub reconstruct {
160 my ($self, $args) = @_;
161
162 my $switch = $args->{switch};
163 unless ($switch =~ /^[0-9A-F]{4}$/) {
164 # lookup by handler name
165 unless (exists $self->{packet_lut}{$switch}) {
166 # alternative (if any) isn't set yet, pick the first available
167 for (sort {$a cmp $b} keys %{$self->{packet_list}}) {
168 if ($self->{packet_list}{$_} && $self->{packet_list}{$_}[0] eq $switch) {
169 $self->{packet_lut}{$switch} = $_;
170 last;
171 }
172 }
173 }
174
175 $switch = $self->{packet_lut}{$switch} || $switch;
176 }
177
178 unless ($self->{packet_list}{$switch}) {
179 die "Can't reconstruct unknown packet: $switch";
180 }
181
182 my $packet = $self->{packet_list}{$switch};
183 my ($name, $packString, $varNames) = @{$packet};
184
185 if (my $custom_reconstruct = $self->can('reconstruct_'.$name)) {
186 $self->$custom_reconstruct($args);
187 }
188 my $packet = pack("v $packString", hex $switch, $packString && @{$args}{@$varNames});
189
190 if (exists $rpackets{$switch}) {
191 if ($rpackets{$switch}{length} > 0) {
192 # fixed length packet, pad/truncate to the correct length
193 $packet = pack('a'.(0+$rpackets{$switch}{length}), $packet);
194 } else {
195 # variable length packet, store its length in the packet
196 substr($packet, 2, 2) = pack('v', length $packet);
197 }
198 }
199
200 return $packet;
201}
202
203##
204# Hash* $packetParser->parse(Bytes msg)
205#
206# Parses a raw packet using {packet_list}.
207#
208# Result hashref would contain parsed arguments and the following information:
209# `l
210# - switch: packet switch
211# - RAW_MSG: original message passed
212# - RAW_MSG_SIZE: length of original message passed
213# - KEYS: list of argument names from {packet_list}
214# `l`
215sub parse {
216 my ($self, $msg, $handleContainer, @handleArguments) = @_;
217
218 $lastSwitch = Network::MessageTokenizer::getMessageID($msg);
219 my $handler = $self->{packet_list}{$lastSwitch};
220
221 unless ($handler) {
222 warning "Packet Parser: Unknown switch: $lastSwitch\n";
223 return undef;
224 }
225
226 # $handler->[0] may be (re)binded to $switch here for current serverType
227 # but all the distinct packets need a distinct names for that, even if they share the handler
228 # like actor_display = actor_exists + actor_connected + actor_moved
229 # if (DEBUG) {
230 # unless ($self->{packet_lut}{$handler->[0]} eq $switch) {
231 # $self->{packet_lut}{$handler->[0]} = $switch;
232 # if ((grep { $_ && $_->[0] eq $handler->[0] } values %{$self->{packet_list}}) > 1) {
233 # warning sprintf "Using %s to provide %s\n", $switch, $handler->[0];
234 # }
235 # }
236 # }
237
238 debug "Received packet: $lastSwitch Handler: $handler->[0]\n", "packetParser", 2;
239
240 # RAW_MSG is the entire message, including packet switch
241 my %args = (
242 switch => $lastSwitch,
243 RAW_MSG => $msg,
244 RAW_MSG_SIZE => length($msg),
245 KEYS => $handler->[2],
246 );
247 if ($handler->[1]) {
248 @args{@{$handler->[2]}} = unpack("x2 $handler->[1]", $msg);
249 }
250 if (my $custom_parse = $self->can('parse_'.$handler->[0])) {
251 $self->$custom_parse(\%args);
252 }
253
254 my $callback = $handleContainer->can($handler->[0]);
255 if ($callback) {
256 # Hook names can be made more uniform,
257 # but the ones for Receive must be kept for compatibility anyway.
258 # TODO: restrict to $Globals::packetParser and $Globals::messageSender?
259 if ($self->{hook_prefix} eq 'Network::Receive') {
260 Plugins::callHook("packet_pre/$handler->[0]", \%args);
261 } else {
262 Plugins::callHook("$self->{hook_prefix}/packet_pre/$handler->[0]", \%args);
263 }
264 Misc::checkValidity("Packet: " . $handler->[0] . " (pre)");
265
266 # If return is set in a packet_pre handler, the packet will be ignored.
267 unless($args{return}) {
268 $handleContainer->$callback(\%args, @handleArguments);
269 }
270
271 Misc::checkValidity("Packet: " . $handler->[0]);
272 } else {
273 $handleContainer->unhandledMessage(\%args, @handleArguments);
274 }
275
276 if ($self->{hook_prefix} eq 'Network::Receive') {
277 Plugins::callHook("packet/$handler->[0]", \%args);
278 } else {
279 Plugins::callHook("$self->{hook_prefix}/packet/$handler->[0]", \%args);
280 }
281 return \%args;
282}
283
284sub unhandledMessage {
285 my ($self, $args) = @_;
286
287 warning "Packet Parser: Unhandled Packet: $args->{switch} Handler: $self->{packet_list}{$args->{switch}}[0]\n";
288 debug ("Unpacked: " . join(', ', @{$args}{@{$args->{KEYS}}}) . "\n"), "packetParser", 2 if $args->{KEYS};
289}
290
291##
292# boolean $packetParser->willMangle(Bytes messageID)
293# messageID: a message ID, such as "008A".
294#
295# Check whether the message with the specified message ID will be mangled.
296# If the bot is running in X-Kore mode, then messages that will be mangled will not
297# be sent to the RO client.
298#
299# By default, a message will never be mangled. Plugins can register mangling procedures
300# though. This is done by using the following hooks:
301# `l
302# - "Network::Receive/willMangle" - This hook has arguments 'messageID' (Bytes) and 'name' (String).
303# 'name' is a human-readable description of the message, and may be undef. Plugins
304# should set the 'return' argument to 1 if they want willMangle() to return 1.
305# - "Network::Receive/mangle" - This hook has arguments 'messageArgs' and 'messageName' (the latter may be undef).
306# `l`
307# The following example demonstrates how this is done:
308# <pre class="example">
309# Plugins::addHook("Network::Receive/willMangle", \&willMangle);
310# Plugins::addHook("Network::Receive/mangle", \&mangle);
311#
312# sub willMangle {
313# my (undef, $args) = @_;
314# if ($args->{messageID} eq '008A') {
315# $args->{willMangle} = 1;
316# }
317# }
318#
319# sub mangle {
320# my (undef, $args) = @_;
321# my $message_args = $args->{messageArgs};
322# if ($message_args->{switch} eq '008A') {
323# ...Modify $message_args as necessary....
324# }
325# }
326# </pre>
327#
328# You can also mangle packets by defining $args->{mangle} in other plugin hooks. The options avalable are:
329# `l
330# - 0 = no mangle
331# - 1 = mangle (change packet and reconstruct)
332# - 2 = drop
333# `l`
334# The following example will drop all public chat messages:
335# <pre class="example">
336# Plugins::addHook("packet_pre/public_chat", \&mangleChat);
337#
338# sub mangleChat
339# {
340# my(undef, $args) = @_;
341# $args->{mangle} = 2;
342# }
343# </pre>
344
345sub willMangle {
346 my ($self, $messageID) = @_;
347 if (Plugins::hasHook("$self->{hook_prefix}/willMangle")) {
348 my $packet = $self->{packet_list}{$messageID};
349 my $name;
350 $name = $packet->[0] if ($packet);
351
352 my %args = (
353 messageID => $messageID,
354 name => $name
355 );
356 Plugins::callHook("$self->{hook_prefix}/willMangle", \%args);
357 return $args{return};
358 } else {
359 return undef;
360 }
361}
362
363##
364# boolean $packetParser->mangle(Array* args)
365#
366# Calls the appropriate plugin function to mangle the packet, which
367# destructively modifies $args.
368# Returns false if the packet should be suppressed.
369sub mangle {
370 my ($self, $args) = @_;
371
372 my %hook_args = (messageArgs => $args);
373 my $entry = $self->{packet_list}{$args->{switch}};
374 if ($entry) {
375 $hook_args{messageName} = $entry->[0];
376 }
377
378 Plugins::callHook("$self->{hook_prefix}/mangle", \%hook_args);
379 return $hook_args{return};
380}
381
382sub process {
383 my ($self, $tokenizer, $handleContainer, @handleArguments) = @_;
384
385 my @result;
386 my $type;
387 while (my $message = $tokenizer->readNext(\$type)) {
388 $handleContainer->{bytesProcessed} += length($message);
389 $handleContainer->{lastPacketTime} = time;
390
391 my $args;
392
393 if ($type == Network::MessageTokenizer::KNOWN_MESSAGE) {
394 my $switch = Network::MessageTokenizer::getMessageID($message);
395
396 # FIXME?
397 $self->parse_pre($handleContainer->{hook_prefix}, $switch, $message);
398
399 my $willMangle = $handleContainer->can('willMangle') && $handleContainer->willMangle($switch);
400
401 if ($args = $self->parse($message, $handleContainer, @handleArguments)) {
402 $args->{mangle} ||= $willMangle && $handleContainer->mangle($args);
403 } else {
404 $args = {
405 switch => $switch,
406 RAW_MSG => $message,
407 (mangle => 2) x!! $willMangle,
408 };
409 }
410
411 } elsif ($type == Network::MessageTokenizer::ACCOUNT_ID) {
412 $args = {
413 RAW_MSG => $message
414 };
415
416 } elsif ($type == Network::MessageTokenizer::UNKNOWN_MESSAGE) {
417 $args = {
418 switch => Network::MessageTokenizer::getMessageID($message),
419 RAW_MSG => $message,
420 # RAW_MSG_SIZE => length($message),
421 };
422 $handleContainer->unknownMessage($args, @handleArguments);
423
424 } else {
425 die "Packet Tokenizer: Unknown type: $type";
426 }
427
428 unless ($args->{mangle}) {
429 # Packet was not mangled
430 push @result, $args->{RAW_MSG};
431 #$result .= $args->{RAW_MSG};
432 } elsif ($args->{mangle} == 1) {
433 # Packet was mangled
434 push @result, $self->reconstruct($args);
435 #$result .= $self->reconstruct($args);
436 } else {
437 # Packet was suppressed
438 }
439 }
440
441 # If we're running in X-Kore mode, pass messages back to the RO client.
442
443 # It seems like messages can't be just concatenated safely
444 # (without "use bytes" pragma or messing with unicode stuff)
445 # http://perldoc.perl.org/perlunicode.html#The-%22Unicode-Bug%22
446 return @result;
447}
448
449sub parse_pre {
450 my ($self, $mode, $switch, $msg) = @_;
451 my $values = {
452 'Network::Receive' => ['<< Received packet:', 'received', 'Recv', 'parseMsg/pre'],
453 'Network::ClientReceive' => ['<< Sent by RO client:', 'ro_sent', 'ROSend', 'RO_sendMsg_pre'],
454 }->{$mode} or return;
455 my ($title, $config_suffix, $desc_key, $hook) = @$values;
456
457 if ($config{'debugPacket_'.$config_suffix} && !existsInList($config{'debugPacket_exclude'}, $switch) ||
458 $config{'debugPacket_include_dumpMethod'} && existsInList($config{'debugPacket_include'}, $switch))
459 {
460 #my $label = $packetDescriptions{$desc_key}{$switch} ? " - $packetDescriptions{$desc_key}{$switch}" : '';
461 my $label = $rpackets{$switch}{function}?" - ".$rpackets{$switch}{function}:($packetDescriptions{$desc_key}{$switch} ? " - $packetDescriptions{$desc_key}{$switch}" : '');
462 if ($config{'debugPacket_'.$config_suffix} == 1) {
463 debug sprintf("%-24s %-4s%s [%2d bytes]%s\n", $title, $switch, $label, length($msg)), 'parseMsg', 0;
464 } elsif ($config{'debugPacket_'.$config_suffix} == 2) {
465 Misc::visualDump($msg, sprintf('%-24s %-4s%s', $title, $switch, $label));
466 }
467 if ($config{debugPacket_include_dumpMethod} == 1) {
468 debug sprintf("%-24s %-4s%s\n", $title, $switch, $label), "parseMsg", 0;
469 } elsif ($config{debugPacket_include_dumpMethod} == 2) {
470 Misc::visualDump($msg, sprintf('%-24s %-4s%s', $title, $switch, $label));
471 } elsif ($config{debugPacket_include_dumpMethod} == 3) {
472 Misc::dumpData($msg, 1);
473 } elsif ($config{debugPacket_include_dumpMethod} == 4) {
474 open my $dump, '>>', 'DUMP_LINE.txt';
475 print $dump unpack('H*', $msg) . "\n";
476 } elsif ($config{debugPacket_include_dumpMethod} == 5) {
477 open my $dump, '>>', 'DUMP_HEAD.txt';
478 print $dump sprintf("%-4s %2d %s%s\n", $switch, length($msg), $desc_key, $label);
479 }
480 }
481
482 Plugins::callHook($hook, {switch => $switch, msg => $msg, msg_size => length($msg), realMsg => \$msg});
483}
484
485sub unknownMessage {
486 my ($self, $args) = @_;
487
488 # Unknown message - ignore it
489 unless (existsInList($config{debugPacket_exclude}, $args->{switch})) {
490 warning TF("Packet Tokenizer: Unknown switch: %s\n", $args->{switch}), 'connection';
491 Misc::visualDump($args->{RAW_MSG}, "<< Received unknown packet") if $config{debugPacket_unparsed};
492 }
493
494 # Pass it along to the client, whatever it is
495}
496
497# Utility methods used by both Receive and Send
498
499sub parseChat {
500 my ($self, $args) = @_;
501 $args->{message} = bytesToString($args->{message});
502 if ($args->{message} =~ /^(.*?)\s{1,2}:\s{1,2}(.*)$/) {
503 $args->{name} = $1;
504 $args->{message} = $2;
505 Misc::stripLanguageCode(\$args->{message});
506 }
507 if (exists $args->{ID}) {
508 $args->{actor} = Actor::get($args->{ID});
509 }
510}
511
512sub reconstructChat {
513 my ($self, $args) = @_;
514 $args->{message} = '|00' . $args->{message} if $masterServer->{chatLangCode};
515 $args->{message} = stringToBytes($char->{name}) . ' : ' . stringToBytes($args->{message});
516}
517
5181;