Send.pm
上传用户:market2
上传日期:2018-11-18
资源大小:18786k
文件大小:8k
源码类别:

外挂编程

开发平台:

Windows_Unix

  1. #########################################################################
  2. #  OpenKore - Message sending
  3. #  This module contains functions for sending messages to the RO server.
  4. #
  5. #  This software is open source, licensed under the GNU General Public
  6. #  License, version 2.
  7. #  Basically, this means that you're allowed to modify and distribute
  8. #  this software. However, if you distribute modified versions, you MUST
  9. #  also distribute the source code.
  10. #  See http://www.gnu.org/licenses/gpl.html for the full license.
  11. #
  12. #  $Revision: 6158 $
  13. #  $Id: Send.pm 6158 2008-01-02 02:56:19Z kaliwanagan $
  14. #
  15. #########################################################################
  16. ##
  17. # MODULE DESCRIPTION: Sending messages to RO server
  18. #
  19. # This class contains convenience methods for sending messages to the RO
  20. # server.
  21. #
  22. # Please also read <a href="http://www.openkore.com/wiki/index.php/Network_subsystem">the
  23. # network subsystem overview.</a>
  24. package Network::Send;
  25. use strict;
  26. use encoding 'utf8';
  27. use Carp::Assert;
  28. use Exception::Class (
  29. 'Network::Send::ServerTypeNotSupported',
  30. 'Network::Send::CreationException'
  31. );
  32. use Globals qw(%config $encryptVal $bytesSent $conState %packetDescriptions $enc_val1 $enc_val2);
  33. use I18N qw(stringToBytes);
  34. use Utils qw(existsInList);
  35. use Misc;
  36. use Log qw(debug);
  37. sub import {
  38. # This code is for backward compatibility reasons, so that you can still
  39. # write:
  40. #  sendFoo($remote_socket, args);
  41. my ($package) = caller;
  42. # This is necessary for some weird reason.
  43. return if ($package =~ /^Network::Send/);
  44. package Network::Send::Compatibility;
  45. require Exporter;
  46. our @ISA = qw(Exporter);
  47. require Network::Send::ServerType0;
  48. no strict 'refs';
  49. our @EXPORT_OK;
  50. @EXPORT_OK = ();
  51. my $class = shift;
  52. if (@_) {
  53. @EXPORT_OK = @_;
  54. } else {
  55. @EXPORT_OK = grep {/^send/} keys(%{Network::Send::ServerType0::});
  56. }
  57. foreach my $symbol (@EXPORT_OK) {
  58. *{$symbol} = sub {
  59. my $remote_socket = shift;
  60. my $func = $Globals::messageSender->can($symbol);
  61. if (!$func) {
  62. die "No such function: $symbol";
  63. } else {
  64. return $func->($Globals::messageSender, @_);
  65. }
  66. };
  67. }
  68. Network::Send::Compatibility->export_to_level(1, undef, @EXPORT_OK);
  69. }
  70. # Not not call this method directly, use create() instead.
  71. sub new {
  72. my ($class) = @_;
  73. return bless {}, $class;
  74. }
  75. ##
  76. # int $NetworkSend->{serverType}
  77. #
  78. # The server type for this message sender object, as passed to the
  79. # create() method.
  80. ##
  81. # Network::Send->create(net, int serverType)
  82. # net: An object compatible with the '@MODULE(Network)' class.
  83. # serverType: A server type.
  84. #
  85. # Create a new message sender object for the specified server type.
  86. #
  87. # Throws Network::Send::ServerTypeNotSupported if the specified server type
  88. # is not supported.
  89. # Throws Network::Send::CreationException if the server type is supported, but the
  90. # message sender object cannot be created.
  91. sub create {
  92. my (undef, $net, $serverType) = @_;
  93. ($serverType) = $serverType =~ /([0-9_]+)/;
  94. $serverType = 0 if ($serverType eq '');
  95. my $class = "Network::Send::ServerType" . $serverType;
  96. eval("use $class;");
  97. if ($@ =~ /Can't locate/) {
  98. Network::Send::ServerTypeNotSupported->throw(error => "Server type '$serverType' not supported.");
  99. } elsif ($@) {
  100. die $@;
  101. }
  102. my $instance = eval("new $class;");
  103. if (!$instance) {
  104. Network::Send::CreationException->throw(
  105. error => "Cannot create message sender object for server type '$serverType'.");
  106. }
  107. $instance->{net} = $net;
  108. $instance->{serverType} = $serverType;
  109. Modules::register($class);
  110. return $instance;
  111. }
  112. # This is an old method used back in the iRO beta 2 days when iRO had encrypted packets.
  113. # At the moment (December 20 2006) there are no servers that still use encrypted packets.
  114. sub encrypt {
  115. use bytes;
  116. my $r_msg = shift;
  117. my $themsg = shift;
  118. my @mask;
  119. my $newmsg;
  120. my ($in, $out);
  121. my $temp;
  122. my $i;
  123. if ($config{encrypt} == 1 && $conState >= 5) {
  124. $out = 0;
  125. for ($i = 0; $i < 13;$i++) {
  126. $mask[$i] = 0;
  127. }
  128. {
  129. use integer;
  130. $temp = ($encryptVal * $encryptVal * 1391);
  131. }
  132. $temp = ~(~($temp));
  133. $temp = $temp % 13;
  134. $mask[$temp] = 1;
  135. {
  136. use integer;
  137. $temp = $encryptVal * 1397;
  138. }
  139. $temp = ~(~($temp));
  140. $temp = $temp % 13;
  141. $mask[$temp] = 1;
  142. for($in = 0; $in < length($themsg); $in++) {
  143. if ($mask[$out % 13]) {
  144. $newmsg .= pack("C1", int(rand() * 255) & 0xFF);
  145. $out++;
  146. }
  147. $newmsg .= substr($themsg, $in, 1);
  148. $out++;
  149. }
  150. $out += 4;
  151. $newmsg = pack("v2", $out, $encryptVal) . $newmsg;
  152. while ((length($newmsg) - 4) % 8 != 0) {
  153. $newmsg .= pack("C1", (rand() * 255) & 0xFF);
  154. }
  155. } elsif ($config{encrypt} >= 2 && $conState >= 5) {
  156. $out = 0;
  157. for ($i = 0; $i < 17;$i++) {
  158. $mask[$i] = 0;
  159. }
  160. {
  161. use integer;
  162. $temp = ($encryptVal * $encryptVal * 34953);
  163. }
  164. $temp = ~(~($temp));
  165. $temp = $temp % 17;
  166. $mask[$temp] = 1;
  167. {
  168. use integer;
  169. $temp = $encryptVal * 2341;
  170. }
  171. $temp = ~(~($temp));
  172. $temp = $temp % 17;
  173. $mask[$temp] = 1;
  174. for($in = 0; $in < length($themsg); $in++) {
  175. if ($mask[$out % 17]) {
  176. $newmsg .= pack("C1", int(rand() * 255) & 0xFF);
  177. $out++;
  178. }
  179. $newmsg .= substr($themsg, $in, 1);
  180. $out++;
  181. }
  182. $out += 4;
  183. $newmsg = pack("v2", $out, $encryptVal) . $newmsg;
  184. while ((length($newmsg) - 4) % 8 != 0) {
  185. $newmsg .= pack("C1", (rand() * 255) & 0xFF);
  186. }
  187. } else {
  188. $newmsg = $themsg;
  189. }
  190. $$r_msg = $newmsg;
  191. }
  192. sub encryptMessageID {
  193. use bytes;
  194. my ($self, $r_message) = @_;
  195. if ($self->{net}->getState() != Network::IN_GAME) {
  196. $enc_val1 = 0;
  197. $enc_val2 = 0;
  198. return;
  199. }
  200. my $messageID = unpack("v", $$r_message);
  201. if ($enc_val1 != 0 && $enc_val2 != 0) {
  202. # Prepare encryption
  203. $enc_val1 = (0x000343FD * $enc_val1) + $enc_val2;
  204. $enc_val1 = $enc_val1 % 2 ** 32;
  205. debug (sprintf("enc_val1 = %x", $enc_val1) . "n", "sendPacket", 2);
  206. # Encrypt message ID
  207. $messageID = $messageID ^ (($enc_val1 >> 16) & 0x7FFF);
  208. $messageID &= 0xFFFF;
  209. $$r_message = pack("v", $messageID) . substr($$r_message, 2);
  210. }
  211. }
  212. sub injectMessage {
  213. my ($self, $message) = @_;
  214. my $name = stringToBytes("|");
  215. my $msg .= $name . stringToBytes(" : $message") . chr(0);
  216. # encrypt($msg, $msg);
  217. # Packet Prefix Encryption Support
  218. #$self->encryptMessageID($msg);
  219. $msg = pack("C*", 0x09, 0x01) . pack("v*", length($name) + length($message) + 12) . pack("C*",0,0,0,0) . $msg;
  220. ## encrypt($msg, $msg);
  221. $self->{net}->clientSend($msg);
  222. }
  223. sub injectAdminMessage {
  224. my ($self, $message) = @_;
  225. $message = stringToBytes($message);
  226. $message = pack("C*",0x9A, 0x00) . pack("v*", length($message)+5) . $message .chr(0);
  227. # encrypt($message, $message);
  228. # Packet Prefix Encryption Support
  229. #$self->encryptMessageID($message);
  230. $self->{net}->clientSend($message);
  231. }
  232. sub sendToServer {
  233. my ($self, $msg) = @_;
  234. my $net = $self->{net};
  235. shouldnt(length($msg), 0);
  236. return unless ($net->serverAlive);
  237. my $messageID = uc(unpack("H2", substr($msg, 1, 1))) . uc(unpack("H2", substr($msg, 0, 1)));
  238. my $hookName = "packet_send/$messageID";
  239. if (Plugins::hasHook($hookName)) {
  240. my %args = (
  241. switch => $messageID,
  242. data => $msg
  243. );
  244. Plugins::callHook($hookName, %args);
  245. return if ($args{return});
  246. }
  247. # encrypt($msg, $msg);
  248. # Packet Prefix Encryption Support
  249. $self->encryptMessageID($msg);
  250. $net->serverSend($msg);
  251. $bytesSent += length($msg);
  252. if ($config{debugPacket_sent} && !existsInList($config{debugPacket_exclude}, $messageID)) {
  253. my $label = $packetDescriptions{Send}{$messageID} ?
  254. "[$packetDescriptions{Send}{$messageID}]" : '';
  255. if ($config{debugPacket_sent} == 1) {
  256. debug(sprintf("Sent packet    : %-4s    [%2d bytes]  %sn", $messageID, length($msg), $label), "sendPacket", 0);
  257. } else {
  258. Misc::visualDump($msg, ">> Sent packet: $messageID  $label");
  259. }
  260. }
  261. }
  262. 1;