· 6 years ago · Sep 14, 2019, 12:46 AM
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 $self->shuffle if $self->can( 'shuffle' );
143
144 $self->{hook_prefix} = $base;
145 $self->{net} = $net;
146 $self->{serverType} = $type; # TODO: eliminate {serverType} from there
147 Modules::register($class);
148
149 return $self;
150}
151
152### CATEGORY: Methods
153
154##
155# Bytes $packetParser->reconstruct(Hash* args)
156#
157# Reconstructs a raw packet from $args using {packet_list} and {packet_lut}.
158#
159# $args->{switch} may contain a packet switch or a handler name.
160sub reconstruct {
161 my ($self, $args) = @_;
162
163 my $switch = $args->{switch};
164 unless ($switch =~ /^[0-9A-F]{4}$/) {
165 # lookup by handler name
166 unless (exists $self->{packet_lut}{$switch}) {
167 # alternative (if any) isn't set yet, pick the first available
168 for (sort {$a cmp $b} keys %{$self->{packet_list}}) {
169 if ($self->{packet_list}{$_} && $self->{packet_list}{$_}[0] eq $switch) {
170 $self->{packet_lut}{$switch} = $_;
171 last;
172 }
173 }
174 }
175
176 $switch = $self->{packet_lut}{$switch} || $switch;
177 }
178
179 unless ($self->{packet_list}{$switch}) {
180 die "Can't reconstruct unknown packet: $switch";
181 }
182
183 my $packet = $self->{packet_list}{$switch};
184 my ($name, $packString, $varNames) = @{$packet};
185
186 if (my $custom_reconstruct = $self->can('reconstruct_'.$name)) {
187 $self->$custom_reconstruct($args);
188 }
189
190 if (DEBUG && $config{debugAssertOnNetwork}) {
191 # check if all values we're going to pack are defined
192 for (@$varNames) {
193 assert(defined $args->{$_}, "Argument $_ should be defined for packet $name");
194 }
195 }
196
197 my $packet = pack("v $packString", hex $switch, $packString && @{$args}{@$varNames});
198
199 if (exists $rpackets{$switch}) {
200 if ($rpackets{$switch}{length} > 0) {
201 # fixed length packet, pad/truncate to the correct length
202 $packet = pack('a'.(0+$rpackets{$switch}{length}), $packet);
203 } else {
204 # variable length packet, store its length in the packet
205 substr($packet, 2, 2) = pack('v', length $packet);
206 }
207 }
208
209 return $packet;
210}
211
212##
213# Hash* $packetParser->parse(Bytes msg)
214#
215# Parses a raw packet using {packet_list}.
216#
217# Result hashref would contain parsed arguments and the following information:
218# `l
219# - switch: packet switch
220# - RAW_MSG: original message passed
221# - RAW_MSG_SIZE: length of original message passed
222# - KEYS: list of argument names from {packet_list}
223# `l`
224sub parse {
225 my ($self, $msg, $handleContainer, @handleArguments) = @_;
226
227 $lastSwitch = Network::MessageTokenizer::getMessageID($msg);
228 my $handler = $self->{packet_list}{$lastSwitch};
229
230 unless ($handler) {
231 warning "Packet Parser: Unknown switch: $lastSwitch\n";
232 return undef;
233 }
234
235 # $handler->[0] may be (re)binded to $switch here for current serverType
236 # but all the distinct packets need a distinct names for that, even if they share the handler
237 # like actor_display = actor_exists + actor_connected + actor_moved
238 # if (DEBUG) {
239 # unless ($self->{packet_lut}{$handler->[0]} eq $switch) {
240 # $self->{packet_lut}{$handler->[0]} = $switch;
241 # if ((grep { $_ && $_->[0] eq $handler->[0] } values %{$self->{packet_list}}) > 1) {
242 # warning sprintf "Using %s to provide %s\n", $switch, $handler->[0];
243 # }
244 # }
245 # }
246
247 debug "Received packet: $lastSwitch Handler: $handler->[0]\n", "packetParser", 2;
248
249 # RAW_MSG is the entire message, including packet switch
250 my %args = (
251 switch => $lastSwitch,
252 RAW_MSG => $msg,
253 RAW_MSG_SIZE => length($msg),
254 KEYS => $handler->[2],
255 );
256 if ($handler->[1]) {
257 @args{@{$handler->[2]}} = unpack("x2 $handler->[1]", $msg);
258 }
259 if (my $custom_parse = $self->can('parse_'.$handler->[0])) {
260 $self->$custom_parse(\%args);
261 }
262
263 my $callback = $handleContainer->can($handler->[0]);
264 if ($callback) {
265 # Hook names can be made more uniform,
266 # but the ones for Receive must be kept for compatibility anyway.
267 # TODO: restrict to $Globals::packetParser and $Globals::messageSender?
268 if ($self->{hook_prefix} eq 'Network::Receive') {
269 Plugins::callHook("packet_pre/$handler->[0]", \%args);
270 } else {
271 Plugins::callHook("$self->{hook_prefix}/packet_pre/$handler->[0]", \%args);
272 }
273 Misc::checkValidity("Packet: " . $handler->[0] . " (pre)");
274
275 # If return is set in a packet_pre handler, the packet will be ignored.
276 unless($args{return}) {
277 $handleContainer->$callback(\%args, @handleArguments);
278 }
279
280 Misc::checkValidity("Packet: " . $handler->[0]);
281 } else {
282 $handleContainer->unhandledMessage(\%args, @handleArguments);
283 }
284
285 if ($self->{hook_prefix} eq 'Network::Receive') {
286 Plugins::callHook("packet/$handler->[0]", \%args);
287 } else {
288 Plugins::callHook("$self->{hook_prefix}/packet/$handler->[0]", \%args);
289 }
290 return \%args;
291}
292
293sub unhandledMessage {
294 my ($self, $args) = @_;
295
296 warning "Packet Parser: Unhandled Packet: $args->{switch} Handler: $self->{packet_list}{$args->{switch}}[0]\n";
297 debug ("Unpacked: " . join(', ', @{$args}{@{$args->{KEYS}}}) . "\n"), "packetParser", 2 if $args->{KEYS};
298}
299
300##
301# boolean $packetParser->willMangle(Bytes messageID)
302# messageID: a message ID, such as "008A".
303#
304# Check whether the message with the specified message ID will be mangled.
305# If the bot is running in X-Kore mode, then messages that will be mangled will not
306# be sent to the RO client.
307#
308# By default, a message will never be mangled. Plugins can register mangling procedures
309# though. This is done by using the following hooks:
310# `l
311# - "Network::Receive/willMangle" - This hook has arguments 'messageID' (Bytes) and 'name' (String).
312# 'name' is a human-readable description of the message, and may be undef. Plugins
313# should set the 'return' argument to 1 if they want willMangle() to return 1.
314# - "Network::Receive/mangle" - This hook has arguments 'messageArgs' and 'messageName' (the latter may be undef).
315# `l`
316# The following example demonstrates how this is done:
317# <pre class="example">
318# Plugins::addHook("Network::Receive/willMangle", \&willMangle);
319# Plugins::addHook("Network::Receive/mangle", \&mangle);
320#
321# sub willMangle {
322# my (undef, $args) = @_;
323# if ($args->{messageID} eq '008A') {
324# $args->{willMangle} = 1;
325# }
326# }
327#
328# sub mangle {
329# my (undef, $args) = @_;
330# my $message_args = $args->{messageArgs};
331# if ($message_args->{switch} eq '008A') {
332# ...Modify $message_args as necessary....
333# }
334# }
335# </pre>
336#
337# You can also mangle packets by defining $args->{mangle} in other plugin hooks. The options avalable are:
338# `l
339# - 0 = no mangle
340# - 1 = mangle (change packet and reconstruct)
341# - 2 = drop
342# `l`
343# The following example will drop all public chat messages:
344# <pre class="example">
345# Plugins::addHook("packet_pre/public_chat", \&mangleChat);
346#
347# sub mangleChat
348# {
349# my(undef, $args) = @_;
350# $args->{mangle} = 2;
351# }
352# </pre>
353
354sub willMangle {
355 my ($self, $messageID) = @_;
356 if (Plugins::hasHook("$self->{hook_prefix}/willMangle")) {
357 my $packet = $self->{packet_list}{$messageID};
358 my $name;
359 $name = $packet->[0] if ($packet);
360
361 my %args = (
362 messageID => $messageID,
363 name => $name
364 );
365 Plugins::callHook("$self->{hook_prefix}/willMangle", \%args);
366 return $args{return};
367 } else {
368 return undef;
369 }
370}
371
372##
373# boolean $packetParser->mangle(Array* args)
374#
375# Calls the appropriate plugin function to mangle the packet, which
376# destructively modifies $args.
377# Returns false if the packet should be suppressed.
378sub mangle {
379 my ($self, $args) = @_;
380
381 my %hook_args = (messageArgs => $args);
382 my $entry = $self->{packet_list}{$args->{switch}};
383 if ($entry) {
384 $hook_args{messageName} = $entry->[0];
385 }
386
387 Plugins::callHook("$self->{hook_prefix}/mangle", \%hook_args);
388 return $hook_args{return};
389}
390
391sub process {
392 my ($self, $tokenizer, $handleContainer, @handleArguments) = @_;
393
394 my @result;
395 my $type;
396 while (my $message = $tokenizer->readNext(\$type)) {
397 $handleContainer->{bytesProcessed} += length($message);
398 $handleContainer->{lastPacketTime} = time;
399
400 my $args;
401
402 if ($type == Network::MessageTokenizer::KNOWN_MESSAGE) {
403 my $switch = Network::MessageTokenizer::getMessageID($message);
404
405 # FIXME?
406 $self->parse_pre($handleContainer->{hook_prefix}, $switch, $message);
407
408 my $willMangle = $handleContainer->can('willMangle') && $handleContainer->willMangle($switch);
409
410 if ($args = $self->parse($message, $handleContainer, @handleArguments)) {
411 $args->{mangle} ||= $willMangle && $handleContainer->mangle($args);
412 } else {
413 $args = {
414 switch => $switch,
415 RAW_MSG => $message,
416 (mangle => 2) x!! $willMangle,
417 };
418 }
419
420 } elsif ($type == Network::MessageTokenizer::ACCOUNT_ID) {
421 $args = {
422 RAW_MSG => $message
423 };
424
425 } elsif ($type == Network::MessageTokenizer::UNKNOWN_MESSAGE) {
426 $args = {
427 switch => Network::MessageTokenizer::getMessageID($message),
428 RAW_MSG => $message,
429 # RAW_MSG_SIZE => length($message),
430 };
431 $handleContainer->unknownMessage($args, @handleArguments);
432
433 } else {
434 die "Packet Tokenizer: Unknown type: $type";
435 }
436
437 unless ($args->{mangle}) {
438 # Packet was not mangled
439 push @result, $args->{RAW_MSG};
440 #$result .= $args->{RAW_MSG};
441 } elsif ($args->{mangle} == 1) {
442 # Packet was mangled
443 push @result, $self->reconstruct($args);
444 #$result .= $self->reconstruct($args);
445 } else {
446 # Packet was suppressed
447 }
448 }
449
450 # If we're running in X-Kore mode, pass messages back to the RO client.
451
452 # It seems like messages can't be just concatenated safely
453 # (without "use bytes" pragma or messing with unicode stuff)
454 # http://perldoc.perl.org/perlunicode.html#The-%22Unicode-Bug%22
455 return @result;
456}
457
458sub parse_pre {
459 my ($self, $mode, $switch, $msg) = @_;
460 my $values = {
461 'Network::Receive' => ['<< Received packet:', 'received', 'Recv', 'parseMsg/pre'],
462 'Network::ClientReceive' => ['<< Sent by RO client:', 'ro_sent', 'ROSend', 'RO_sendMsg_pre'],
463 }->{$mode} or return;
464 my ($title, $config_suffix, $desc_key, $hook) = @$values;
465
466 if ($config{'debugPacket_'.$config_suffix} && !existsInList($config{'debugPacket_exclude'}, $switch) ||
467 $config{'debugPacket_include_dumpMethod'} && existsInList($config{'debugPacket_include'}, $switch))
468 {
469 #my $label = $packetDescriptions{$desc_key}{$switch} ? " - $packetDescriptions{$desc_key}{$switch}" : '';
470 my $label = $rpackets{$switch}{function}?" - ".$rpackets{$switch}{function}:($packetDescriptions{$desc_key}{$switch} ? " - $packetDescriptions{$desc_key}{$switch}" : '');
471 if ($config{'debugPacket_'.$config_suffix} == 1) {
472 debug sprintf("%-24s %-4s%s [%2d bytes]%s\n", $title, $switch, $label, length($msg)), 'parseMsg', 0;
473 } elsif ($config{'debugPacket_'.$config_suffix} == 2) {
474 Misc::visualDump($msg, sprintf('%-24s %-4s%s', $title, $switch, $label));
475 }
476 if ($config{debugPacket_include_dumpMethod} == 1) {
477 debug sprintf("%-24s %-4s%s\n", $title, $switch, $label), "parseMsg", 0;
478 } elsif ($config{debugPacket_include_dumpMethod} == 2) {
479 Misc::visualDump($msg, sprintf('%-24s %-4s%s', $title, $switch, $label));
480 } elsif ($config{debugPacket_include_dumpMethod} == 3) {
481 Misc::dumpData($msg, 1);
482 } elsif ($config{debugPacket_include_dumpMethod} == 4) {
483 open my $dump, '>>', 'DUMP_LINE.txt';
484 print $dump unpack('H*', $msg) . "\n";
485 } elsif ($config{debugPacket_include_dumpMethod} == 5) {
486 open my $dump, '>>', 'DUMP_HEAD.txt';
487 print $dump sprintf("%-4s %2d %s%s\n", $switch, length($msg), $desc_key, $label);
488 }
489 }
490
491 Plugins::callHook($hook, {switch => $switch, msg => $msg, msg_size => length($msg), realMsg => \$msg});
492}
493
494sub unknownMessage {
495 my ($self, $args) = @_;
496
497 # Unknown message - ignore it
498 unless (existsInList($config{debugPacket_exclude}, $args->{switch})) {
499 warning TF("Packet Tokenizer: Unknown switch: %s\n", $args->{switch}), 'connection';
500 Misc::visualDump($args->{RAW_MSG}, "<< Received unknown packet") if $config{debugPacket_unparsed};
501 }
502
503 # Pass it along to the client, whatever it is
504}
505
506# Utility methods used by both Receive and Send
507
508sub parseChat {
509 my ($self, $args) = @_;
510 $args->{message} = bytesToString($args->{message});
511 if ($args->{message} =~ /^(.*?)\s{1,2}:\s{1,2}(.*)$/) {
512 $args->{name} = $1;
513 $args->{message} = $2;
514 Misc::stripLanguageCode(\$args->{message});
515 }
516 if (exists $args->{ID}) {
517 $args->{actor} = Actor::get($args->{ID});
518 }
519}
520
521sub reconstructChat {
522 my ($self, $args) = @_;
523 $args->{message} = '|00' . $args->{message} if $masterServer->{chatLangCode};
524 $args->{message} = stringToBytes($char->{name}) . ' : ' . stringToBytes($args->{message});
525}
526
5271;