开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 游戏 > 外挂编程 > 查看源码
XKoreProxy.pm
资源名称：openkore-2.0.7.zip　[点击查看]
上传用户：market2
上传日期：2018-11-18
资源大小：18786k
文件大小：15k
源码类别：

外挂编程

开发平台：

Windows_Unix

XKoreProxy.pm：源码内容
  1. #########################################################################
  2. #  OpenKore - X-Kore
  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. #  $Revision: 6168 $
  12. #  $Id: XKoreProxy.pm 6168 2008-01-11 16:26:53Z kaliwanagan $
  13. #
  14. #########################################################################
  15. # Note: the difference between XKore2 and XKoreProxy is that XKore2 can
  16. # work headless (it handles all server messages by itself), while
  17. # XKoreProxy lets the RO client handle many server messages.
  18. package Network::XKoreProxy;
  20. # FIXME: $syncSync is not set correctly (required for ropp)
  22. use strict;
  23. use base qw(Exporter);
  24. use Exporter;
  25. use IO::Socket::INET;
  26. use Time::HiRes qw(time usleep);
  27. use encoding 'utf8';
  29. use Modules 'register';
  30. use Globals;
  31. use Log qw(message warning error debug);
  32. use Utils qw(dataWaiting timeOut makeIP encodeIP swrite existsInList);
  33. use Misc qw(configModify visualDump);
  34. use Translation qw(T TF);
  35. use I18N qw(bytesToString);
  36. use Interface;
  37. use Network;
  38. use Network::Send ();
  39. use Utils::Exceptions;
  41. my $clientBuffer;
  42. my %flushTimer;
  44. # Members:
  45. #
  46. # Socket proxy_listen
  47. #    A server socket which accepts new connections from the RO client.
  48. #    This is only defined when the RO client hasn't already connected
  49. #    to XKoreProxy.
  50. #
  51. # Socket proxy
  52. #    A client socket, which connects XKoreProxy with the RO client.
  53. #    This is only defined when the RO client has connected to XKoreProxy.
  55. ##
  56. # Network::XKoreProxy->new()
  57. #
  58. # Initialize X-Kore-Proxy mode.
  59. sub new {
  60. my $class = shift;
  61. my $ip = $config{XKore_listenIp} || '0.0.0.0';
  62. my $port = $config{XKore_listenPort} || 6901;
  63. my $self = bless {}, $class;
  65. # Reuse code from Network::DirectConnection to connect to the server
  66. require Network::DirectConnection;
  67. $self->{server} = new Network::DirectConnection($self);
  69. $self->{client_state} = 0;
  70. $self->{nextIp} = undef;
  71. $self->{nextPort} = undef;
  72. $self->{charServerIp} = undef;
  73. $self->{charServerPort} = undef;
  74. $self->{gotError} = 0;
  75. $self->{waitingClient} = 1;
  76. {
  77. no encoding 'utf8';
  78. $self->{packetPending} = '';
  79. $clientBuffer = '';
  80. }
  82. message T("X-Kore mode intialized.n"), "startup";
  84. if (defined($config{gameGuard}) && $config{gameGuard} ne '2') {
  85. require Poseidon::EmbedServer;
  86. Modules::register("Poseidon::EmbedServer");
  87. $self->{poseidon} = new Poseidon::EmbedServer;
  88. }
  90. return $self;
  91. }
  93. sub version {
  94. return 1;
  95. }
  97. sub DESTROY {
  98. my $self = shift;
  100. close($self->{proxy_listen});
  101. close($self->{proxy});
  102. }
  105. ######################
  106. ## Server Functions ##
  107. ######################
  109. sub serverAlive {
  110. my $self = shift;
  111. return $self->{server}->serverAlive;
  112. }
  114. sub serverConnect {
  115. my $self = shift;
  116. my $host = shift;
  117. my $port = shift;
  119. return $self->{server}->serverConnect($host, $port);
  120. }
  122. sub serverPeerHost {
  123. my $self = shift;
  124. return $self->{server}->serverPeerHost if ($self->serverAlive);
  125. return undef;
  126. }
  128. sub serverPeerPort {
  129. my $self = shift;
  130. return $self->{server}->serverPeerPort if ($self->serverAlive);
  131. return undef;
  132. }
  134. sub serverRecv {
  135. my $self = shift;
  136. return $self->{server}->serverRecv();
  137. }
  139. sub serverSend {
  140. my $self = shift;
  141. my $msg = shift;
  143. $self->{server}->serverSend($msg);
  144. }
  146. sub serverDisconnect {
  147. my $self = shift;
  148. my $preserveClient = shift;
  150. return unless ($self->serverAlive);
  152. close($self->{proxy}) unless $preserveClient;
  153. $self->{waitClientDC} = 1 if $preserveClient;
  155. # user has played with relog command.
  156. if ($timeout_ex{'master'}{'time'}) {
  157. undef $timeout_ex{'master'}{'time'};
  158. $self->{waitingClient} = 1;
  159. }
  160. return $self->{server}->serverDisconnect();
  161. }
  163. sub serverAddress {
  164. my ($self) = @_;
  165. return $self->{server}->serverAddress();
  166. }
  168. sub getState {
  169. my ($self) = @_;
  170. return $self->{server}->getState();
  171. }
  173. sub setState {
  174. my ($self, $state) = @_;
  175. $self->{server}->setState($state);
  176. }
  179. ######################
  180. ## Client Functions ##
  181. ######################
  183. sub clientAlive {
  184. my $self = shift;
  185. return $self->proxyAlive();
  186. }
  188. sub proxyAlive {
  189. my $self = shift;
  190. return $self->{proxy} && $self->{proxy}->connected;
  191. }
  193. sub clientPeerHost {
  194. my $self = shift;
  195. return $self->{proxy}->peerhost if ($self->proxyAlive);
  196. return undef;
  197. }
  199. sub clientPeerPort {
  200. my $self = shift;
  201. return $self->{proxy}->peerport if ($self->proxyAlive);
  202. return undef;
  203. }
  205. sub clientSend {
  206. my $self = shift;
  207. my $msg = shift;
  208. my $dontMod = shift;
  210. return unless ($self->proxyAlive);
  212. $msg = $self->modifyPacketIn($msg) unless ($dontMod);
  213. if ($config{debugPacket_ro_received}) {
  214. debug "Modified packet sent to clientn";
  215. visualDump($msg, 'clientSend');
  216. }
  218. # queue message instead of sending directly
  219. $clientBuffer .= $msg;
  220. }
  222. sub clientFlush {
  223. my $self = shift;
  225. return unless (length($clientBuffer));
  227. $self->{proxy}->send($clientBuffer);
  228. debug "Client network buffer flushed outn";
  229. $clientBuffer = '';
  230. }
  232. sub clientRecv {
  233. my $self = shift;
  234. my $msg;
  236. return undef unless ($self->proxyAlive && dataWaiting($self->{proxy}));
  238. $self->{proxy}->recv($msg, 1024 * 32);
  239. if (length($msg) == 0) {
  240. # Connection from client closed
  241. close($self->{proxy});
  242. return undef;
  243. }
  245. # return $self->realClientRecv;
  246. return $self->modifyPacketOut($msg);
  247. }
  251. sub checkConnection {
  252. my $self = shift;
  254. # Check connection to the client
  255. $self->checkProxy();
  257. # Check server connection
  258. $self->checkServer();
  260. # Check the Poseidon Embed Server
  261. if ($self->clientAlive() && $self->getState() == Network::IN_GAME
  262.  && defined($config{gameGuard}) && $config{gameGuard} ne '2') {
  263. $self->{poseidon}->iterate($self);
  264. }
  265. }
  267. sub checkProxy {
  268. my $self = shift;
  270. if (defined $self->{proxy_listen}) {
  271. # Listening for a client
  272. if (dataWaiting($self->{proxy_listen})) {
  273. # Client is connecting...
  274. $self->{proxy} = $self->{proxy_listen}->accept;
  276. # Tell 'em about the new client
  277. my $host = $self->clientPeerHost;
  278. my $port = $self->clientPeerPort;
  279. debug "XKore Proxy: RO Client connected ($host:$port).n", "connection";
  281. # Stop listening and clear errors.
  282. close($self->{proxy_listen});
  283. undef $self->{proxy_listen};
  284. $self->{gotError} = 0;
  285. }
  286. #return;
  288. } elsif (!$self->proxyAlive) {
  289. # Client disconnected... (or never existed)
  290. if ($self->serverAlive()) {
  291. message T("Client disconnectedn"), "connection";
  292. $self->setState(Network::NOT_CONNECTED) if ($self->getState() == Network::IN_GAME);
  293. $self->{waitingClient} = 1;
  294. $self->serverDisconnect();
  295. }
  297. close($self->{proxy});
  298. $self->{waitClientDC} = undef;
  299. debug "Removing pending packet from queuen" if (defined $self->{packetPending});
  300. $self->{packetPending} = '';
  302. # FIXME: there's a racing condition here. If the RO client tries to connect
  303. # to the listening port before we've set it up (this happens if sleepTime is
  304. # sufficiently high), then the client will freeze.
  306. # (Re)start listening...
  307. my $ip = $config{XKore_listenIp} || '127.0.0.1';
  308. my $port = $config{XKore_listenPort} || 6901;
  309. $self->{proxy_listen} = new IO::Socket::INET(
  310. LocalAddr => $ip,
  311. LocalPort => $port,
  312. Listen => 5,
  313. Proto => 'tcp',
  314. ReuseAddr   => 1);
  315. die "Unable to start the X-Kore proxy ($ip:$port): $@n" . 
  316. "You can only run one X-Kore session at the same time.n" .
  317. "And make sure no other servers are running on port $port." unless $self->{proxy_listen};
  319. # setup master server if necessary
  320. getMainServer();
  322. message TF("Waiting Ragnarok Client to connect on (%s:%s)n", ($ip eq '127.0.0.1' ? 'localhost' : $ip), $port), "startup" if ($self->{waitingClient} == 1);
  323. $self->{waitingClient} = 0;
  324. return;
  325. }
  327. if ($self->proxyAlive() && defined($self->{packetPending})) {
  328. checkPacketReplay();
  329. }
  330. }
  332. sub checkServer {
  333. my $self = shift;
  335. # Do nothing until the client has (re)connected to us
  336. return if (!$self->proxyAlive() || $self->{waitClientDC});
  338. # Connect to the next server for proxying the packets
  339. if (!$self->serverAlive()) {
  341. # Setup the next server to connect.
  342. if (!$self->{nextIp} || !$self->{nextPort}) {
  343. # if no next server was defined by received packets, setup a primary server.
  344. my $master = $masterServer = $masterServers{$config{'master'}};
  346. $self->{nextIp} = $master->{ip};
  347. $self->{nextPort} = $master->{port};
  348. message TF("Proxying to [%s]n", $config{master}), "connection" unless ($self->{gotError});
  349. eval {
  350. $packetParser = Network::Receive->create($config{serverType});
  351. $messageSender = Network::Send->create($self, $config{serverType});
  352. };
  353. if (my $e = caught('Exception::Class::Base')) {
  354. $interface->errorDialog($e->message());
  355. $quit = 1;
  356. return;
  357. }
  358. }
  360. $self->serverConnect($self->{nextIp}, $self->{nextPort}) unless ($self->{gotError});
  361. if (!$self->serverAlive()) {
  362. $self->{charServerIp} = undef;
  363. $self->{charServerPort} = undef;
  364. close($self->{proxy});
  365. error T("Invalid server specified or server does not exist...n"), "connection" if (!$self->{gotError});
  366. $self->{gotError} = 1;
  367. }
  369. # clean Next Server uppon connection
  370. $self->{nextIp} = undef;
  371. $self->{nextPort} = undef;
  372. }
  373. }
  375. ##
  376. # $Network_XKoreProxy->checkPacketReplay()
  377. #
  378. # Setup a timer to repeat the received logon/server change packet to the client
  379. # in case it didn't responded in an appropriate time.
  380. #
  381. # This is an internal function.
  382. sub checkPacketReplay {
  383. my $self = shift;
  385. #message "Pending packet checkn";
  387. if ($self->{replayTimeout}{time} && timeOut($self->{replayTimeout})) {
  388. if ($self->{packetReplayTrial} < 3) {
  389. warning TF("Client did not respond in time.n" . 
  390. "Trying to replay the packet for %s of 3 timesn", $self->{packetReplayTrial}++);
  391. $self->clientSend($self->{packetPending});
  392. $self->{replayTimeout}{time} = time;
  393. $self->{replayTimeout}{timeout} = 2.5;
  394. } else {
  395. error T("Client did not respond. Forcing disconnectionn");
  396. close($self->{proxy});
  397. return;
  398. }
  400. } elsif (!$self->{replayTimeout}{time}) {
  401. $self->{replayTimeout}{time} = time;
  402. $self->{replayTimeout}{timeout} = 2.5;
  403. } 
  404. }
  406. sub modifyPacketIn {
  407. my ($self, $msg) = @_;
  409. return undef if (length($msg) < 1);
  411. my $switch = uc(unpack("H2", substr($msg, 1, 1))) . uc(unpack("H2", substr($msg, 0, 1)));
  412. if ($switch eq "02AE") {
  413. $msg = ""; 
  414. }
  416. # packet replay check: reset status for every different packet received
  417. if ($self->{packetPending} && ($self->{packetPending} ne $msg)) {
  418. debug "Removing pending packet from queuen";
  419. use bytes; no encoding 'utf8';
  420. delete $self->{replayTimeout};
  421. $self->{packetPending} = '';
  422. $self->{packetReplayTrial} = 0;
  423. } elsif ($self->{packetPending} && ($self->{packetPending} eq $msg)) {
  424. # avoid doubled 0259 message: could mess the character selection and hang up the client
  425. if ($switch eq "0259") {
  426. debug T("Logon-grant packet received twice! Avoiding bug in client.n");
  427. $self->{packetPending} = undef;
  428. return undef;
  429. }
  430. }
  432. if ($switch eq "0069") {
  433. use bytes; no encoding 'utf8';
  435. # queue the packet as requiring client's response in time
  436. $self->{packetPending} = $msg;
  438. # Modify the server config'ed on Kore to point to proxy
  439. my $accountInfo = substr($msg, 0, 47);
  440. my $serverInfo = substr($msg, 47, length($msg));
  441. my $newServers = '';
  442. my $serverCount = 0;
  444. my $msg_size = length($serverInfo);
  445. debug "Modifying Account Info packet...";
  447. for (my $i = 0; $i < $msg_size; $i+=32) {
  448. if ($config{'server'} == $serverCount++) {
  449. $self->{nextIp} = makeIP(substr($serverInfo, $i, 4));
  450. $self->{nextIp} = $masterServer->{ip} if ($masterServer && $masterServer->{private});
  451. $self->{nextPort} = unpack("v1", substr($serverInfo, $i+4, 2));
  452. debug " next server to connect ($self->{nextIp}:$self->{nextPort})n", "connection";
  454. $self->{charServerIp} = $self->{nextIp};
  455. $self->{charServerPort} = $self->{nextPort};
  457. my $newName = unpack("Z*", substr($serverInfo, $i + 6, 20));
  458. #$newName = "$newName (proxied)";
  459. $newServers .= encodeIP($self->{proxy}->sockhost) . pack("v*", $self->{proxy}->sockport) . 
  460. pack("Z20", $newName) . substr($serverInfo, $i + 26, 4) . pack("v1", 0);
  462. } else {
  463. $newServers .= substr($serverInfo, $i, 32);
  464. }
  465. }
  467. message T("Closing connection to Account Servern"), 'connection' if (!$self->{packetReplayTrial});
  468. $self->serverDisconnect(1);
  469. $msg = $accountInfo . $newServers;
  471. } elsif ($switch eq "0071" || $switch eq "0092") {
  472. # queue the packet as requiring client's response in time
  473. $self->{packetPending} = $msg;
  475. # Proxy the Logon to Map server
  476. debug "Modifying Map Logon packet...", "connection";
  477. my $logonInfo = substr($msg, 0, 22);
  478. my @mapServer = unpack("x22 a4 v1", $msg);
  479. my $mapIP = $mapServer[0];
  480. my $mapPort = $mapServer[1];
  482. $self->{nextIp} = makeIP($mapIP);
  483. $self->{nextIp} = $masterServer->{ip} if ($masterServer && $masterServer->{private});
  484. $self->{nextPort} = $mapPort;
  485. debug " next server to connect ($self->{nextIp}:$self->{nextPort})n", "connection";
  487. if ($switch eq "0071") {
  488. message T("Closing connection to Character Servern"), 'connection' if (!$self->{packetReplayTrial});
  489. } else {
  490. message T("Closing connection to Map Servern"), "connection" if (!$self->{packetReplayTrial});
  491. }
  492. $self->serverDisconnect(1);
  494. $msg = $logonInfo . encodeIP($self->{proxy}->sockhost) . pack("v*", $self->{proxy}->sockport);
  496. } elsif ($switch eq "006A" || $switch eq "006C" || $switch eq "0081") {
  497. # An error occurred. Restart proxying
  498. $self->{gotError} = 1;
  499. $self->{nextIp} = undef;
  500. $self->{nextPort} = undef;
  501. $self->{charServerIp} = undef;
  502. $self->{charServerPort} = undef;
  503. $self->serverDisconnect(1);
  505. } elsif ($switch eq "00B3") {
  506. $self->{nextIp} = $self->{charServerIp};
  507. $self->{nextPort} = $self->{charServerPort};
  508. $self->serverDisconnect(1);
  510. } elsif ($switch eq "0259") {
  511. # queue the packet as requiring client's response in time
  512. $self->{packetPending} = $msg;
  513. }
  515. return $msg;
  516. }
  518. sub modifyPacketOut {
  519. my ($self, $msg) = @_;
  520. use bytes; no encoding 'utf8';
  522. return undef if (length($msg) < 1);
  524. my $switch = uc(unpack("H2", substr($msg, 1, 1))) . uc(unpack("H2", substr($msg, 0, 1)));
  526. if (($switch eq "007E" && (
  527. $config{serverType} == 0 ||
  528. $config{serverType} == 1 ||
  529. $config{serverType} == 2 ||
  530. $config{serverType} == 6 )) ||
  531. ($switch eq "0089" && (
  532. $config{serverType} == 3 ||
  533. $config{serverType} == 5 )) ||
  534. ($switch eq "0116" &&
  535. $config{serverType} == 4 ) ||
  536. ($switch eq "00F3" &&
  537.   $config{serverType} == 10)) { #for vRO
  538. # Intercept the RO client's sync
  540. $msg = "";
  541. $messageSender->sendSync() if ($messageSender);
  543. } if ($switch eq "0228" && $self->getState() == Network::IN_GAME && $config{gameGuard} ne '2') {
  544. if ($self->{poseidon}->awaitingResponse) {
  545. $self->{poseidon}->setResponse($msg);
  546. $msg = '';
  547. }
  548. } 
  550. return $msg;
  551. }
  555. sub getMainServer {
  556. if ($config{'master'} eq "" || $config{'master'} =~ /^d+$/ || !exists $masterServers{$config{'master'}}) {
  557. my @servers = sort { lc($a) cmp lc($b) } keys(%masterServers);
  558. my $choice = $interface->showMenu(
  559. T("Please choose a master server to connect to."),
  560. @servers,
  561. title => T("Master servers"));
  562. if ($choice == -1) {
  563. exit;
  564. } else {
  565. configModify('master', $servers[$choice], 1);
  566. }
  567. }
  568. }
  570. return 1;