API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Aug 30th, 2012
324
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 13.85 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl -w
  2.  
  3. # BattlEye rcon in perl, developed for Arma2 DayZ mod.
  4. # This tool is part of DayZ4linux project.
  5. # This software is licensed under GPLv3 license
  6. # Author contact: facoptere-at-gmail.com
  7.  
  8. use strict;
  9. use Socket;
  10. use Term::ReadPassword;
  11. # you may need to sudo perl -MCPAN -e 'install Term::ReadPassword'
  12. # also maybe perl -MCPAN -e 'install YAML::Any'
  13. use String::CRC32;
  14. # you may need to sudo perl -MCPAN -e 'install String::CRC32'
  15. use Getopt::Std;
  16. use vars qw( $opt_r $opt_i $opt_p $opt_k $opt_L $opt_b $opt_t);
  17.  
  18. my ($socket,$dataUDP,$onebyte,$seq,$select,$rout,$nfound,$timeleft);
  19. my $datain="";
  20. my $timeout=40;
  21. my $PASS=0;
  22. my $COMM=1;
  23. my $KA=2;
  24. my $MULTI=9;
  25. my $IDLE=-1;
  26. my $state=$PASS;
  27. my $unresponsiveCount=0;
  28. my $rin = ''; # bitfield for fd select
  29. my @mbuffer; # buffer for multiple packets server response
  30.  
  31. $SIG{'QUIT'} = sub { die "rcon.pl: SIGQUIT caught\n"; };
  32.  
  33. # encapsulate to BattlEye datagram
  34. sub enc {
  35. my ($s)=@_;
  36. $s=pack("C",255).$s;
  37. return 'BE'.pack("L",crc32($s)).$s;
  38. }
  39.  
  40. # decapsulate from BattlEye datagram
  41. sub dec {
  42. my ($s)=@_;
  43. my @r=unpack("a2LCa*",$s);
  44. #print STDERR $r[0].' '.$r[1].' '.crc32(pack("C",$r[2]).$r[3]).' '.$r[2]."\n";
  45. return $r[3] if ($r[0] eq 'BE' && $r[2] == 255 && crc32(pack("C",$r[2]).$r[3])==$r[1]);
  46. return pack("CCa*",0,99,"Can't connect");
  47. }
  48.  
  49. # prepare a send request (password, command or console acknoledge)
  50. sub sendbe {
  51. my ($c,$q, $s)=@_;
  52. if ($c==$PASS) {
  53. return pack("C",0).$s;
  54. }
  55. elsif ($c==$COMM) {
  56. return pack("CCa*",1,$q,$s) if (defined $s);
  57. return pack("CC",1,$q);
  58. }
  59. elsif ($c==$KA) {
  60. return pack("CC",2,$q);
  61. }
  62. }
  63.  
  64. # decode a response (password granted or not, command output, or console output)
  65. sub recvbe {
  66. my ($s)=@_;
  67. return (undef,undef,undef) if (!$s);
  68. my @r=unpack("CCCCCa*",$s);
  69. return ($MULTI, $r[1], $r[5], $r[4], $r[3]) if (scalar(@r)==6 && $r[0]==1 && $r[2]==0);
  70. @r=unpack("CCa*",$s);
  71. return ($r[0], $r[1], $r[2]);
  72. }
  73.  
  74. #####
  75. # high level function!!
  76. my %HIpl;
  77. my %HIconnecting;
  78. my $HIpolling=3; # polling players command
  79. my $HImaxBEKO=9; # max minutes of BattlEye KO to start kicking
  80. my $HImaxBadname=20; # max minutes of BattlEye KO to start kicking
  81. my $HIminLobby=20; # dont kick player stayed less than this
  82. my $date=0;
  83. my $datePlayersSent=0;
  84. sub HIreadPlayers {
  85. my $state=0;
  86. $date=time();
  87. my ($block) = @_;
  88. #syswrite STDOUT, sprintf ("block \"%s\" \n", $block);
  89. my $ret="";
  90. while( $block =~ /([^\r\n]+)[\r\n]*/gs ) {
  91. $_=$1;
  92. # horizontal line detection
  93. if ($state == 0 && /^-{50}$/) {
  94. $state = 1; # go to player line parsing
  95. $datePlayersSent=$date; # reset datePlayersSent, acts as an aknowledge of the 'players' command
  96. # sometime server does not answer to commands
  97. next;
  98. }
  99. # parsing a player line
  100. elsif ($state == 1 && /^(\d+) +[0-9.:]+ +(-?\d+) +([a-f0-9]{32})\((.+?)\) +(.*?)$/) {
  101. my ($no, $ping, $uid, $ok, $name) = (int($1), int($2), $3, $4, $5);
  102. my $p = $HIpl{$uid};
  103. my $lobby = '';
  104. ($name, $lobby) = $name =~ /^(.*?)(?:| ?\((Lobby|Admin)\))$/ ;
  105. #print ">>> $no $ping $uid $ok '$name' / $lobby\n";
  106. if (!$p) {
  107. $p = $HIpl{ $uid } = [ $date, 0,"",0,0,0,0 ];
  108. #syswrite STDOUT, "new p\n";
  109. }
  110. if ($p) {
  111. $p->[1] = $no; # player number
  112. $p->[2] = $name; # player name
  113. $p->[3] = ($ok cmp 'OK')==0 ? 0 : $p->[3]+$date-$p->[0] ; # amount of consecutive seconds Battleye check is non OK
  114. $p->[4] = (defined $lobby && $lobby eq 'Lobby') ? $p->[4]+$date-$p->[0] : 0 ; # amount of consecutive seconds player stays in the lobby
  115. $p->[5] = (defined $lobby && $lobby eq 'Admin') ? $p->[5]+$date-$p->[0] : 0 ; # amount of consecutive seconds player is admin
  116. $p->[6] = ($name =~ /(:?Adm[il!|]n|[0o]wner)/i) ? $p->[6]+$date-$p->[0] : 0 ; # amount of consecutive seconds player has forbidden name
  117. #syswrite STDOUT, sprintf("%d %d %s %s %s %s / %d %d %d date=%ld p0=%ld\n", $no,$ping,$uid,$ok,$name,$lobby,$p->[3],$p->[4],$p->[5],$date,$p->[0]);
  118. $p->[0] = $date;
  119. # we dont check the ping.
  120. }
  121. next;
  122. }
  123. # parsing footer
  124. elsif ($state==1 && /^\((\d+) players in total\)$/) {
  125. my $nb=$1;
  126. #print STDERR "##### N.PLayers=$nb / $opt_L // $HIminLobby\n";
  127. foreach my $k (sort { $HIpl{$b}->[3]-$HIpl{$a}->[4] } keys %HIpl)
  128. {
  129. my $p = $HIpl{$k};
  130. if ($date!=$p->[0]) {
  131. delete($HIpl{k}) ; # delete player which were not in lastest player list
  132. }
  133. #elsif ($p->[3] >= $HImaxBEKO*60-1) {
  134. # $ret.= sprintf ("kick %d Sorry, BattlEye did not manage to verify your game files for %d minutes;",
  135. # $p->[1], $p->[3]/60 );
  136. # delete($HIpl{$k});
  137. # $nb--;
  138. #}
  139. #elsif ($p->[3] > ($HImaxBEKO-$HIpolling)*60) {
  140. # $ret.= sprintf ("say %d %s, you will be kicked if BattlEye can't verify your game files;",
  141. # $p->[1], $p->[2] );
  142. #}
  143. if ($p->[6] >= $HImaxBadname*60) {
  144. $ret.= sprintf ("kick %d Sorry, %s is an invalid player name;",
  145. $p->[1], $p->[2] );
  146. delete($HIpl{$k});
  147. $nb--;
  148. }
  149. elsif ($p->[6] > ($HImaxBadname-$HIpolling)*60) {
  150. $ret.= sprintf ("say %d %s, you will be kicked your don't change your name;",
  151. $p->[1], $p->[2] );
  152. }
  153. }
  154. if (defined $opt_L && $nb > $opt_L) {
  155. foreach my $k (sort { $HIpl{$b}->[4]-$HIpl{$a}->[4] } keys %HIpl)
  156. {
  157. my $p = $HIpl{$k};
  158. if ($p->[4] >= $HIminLobby*60) {
  159. $ret.= sprintf ("kick %d Sorry, server is almost full and you were AFK for %d minutes;",
  160. $p->[1], $p->[4]/60 );
  161. delete($HIpl{$k});
  162. $nb--;
  163. }
  164. last if ($nb <= $opt_L);
  165. }
  166. }
  167. $state=0;
  168. next;
  169. }
  170. elsif (/^Player #(\d+) (.*?) \(([0-9.]+):[0-9]+\) connected/) {
  171. my ($no, $name,$ip) = (int($1),$2, $3);
  172. $HIconnecting{$no} = $ip;
  173. }
  174. elsif (/^Verified GUID \(([a-f0-9]{32})\) of player #(\d+) ([^\r\n]+)$/) {
  175. #Verified GUID (a768de690a42fb45e938990a02a01bc9) of player #3 Pridezor - YouTube
  176. my ($uid, $no, $name) = ($1, int($2), $3);
  177. my $p = $HIpl{$uid};
  178. if (!$p) {
  179. $p = $HIpl{ $uid } = [ $date, 0,"",0,0,0,0 ];
  180. }
  181. if ($p) {
  182. $p->[1] = $no; # player number
  183. $p->[2] = $name; # player name
  184. $p->[0] = $date;
  185. my $ip=$HIconnecting{$no};
  186. $p->[7] = $ip if defined $ip;
  187. delete $HIconnecting{$no} if defined $ip;
  188. }
  189. }
  190. #else {
  191. # syswrite STDOUT, "unkonwn $_\n";
  192. #}
  193. }
  194. #syswrite STDOUT, "$ret\n";
  195. return "$ret";
  196. }
  197.  
  198.  
  199.  
  200.  
  201. # reading command line arguments
  202. getopts('r:i:p:L:kbt'); # -r for rconpassword, -i for ip address, -p for port, -k keepalive, -t timeout
  203. $opt_p=2302 if(!$opt_p);
  204. die "BattelEye admin console for ArmA2 OA\n".
  205. "Usage: rcon.pl -i ip [-p port] [-r rcon-password] [-k] [-b] [-t] [-L number]\n".
  206. " or: echo 'commands;say -1 get off all of you!;kickall Mouhahhaha' | rcon.pl -r rcon-password -i ip [-p port]\n".
  207. "-k: keep connection alive. By default connection is closed if idle for 40 seconds.\n".
  208. "-b: Don't send bell signals.\n".
  209. "-t: Don't quit at Stdin EOF, but wait for timeout\n".
  210. "-L: kick some players who stay in the lobby if 'number' players are in.\n"
  211. if(!$opt_i);
  212.  
  213. $opt_k=1 if (defined $opt_L);
  214. $timeout=10 if (defined $opt_L); # TODO : the bes is to detect we are not on a terminal
  215.  
  216. # connect to server, register to 'read' events from socket
  217. socket(RCON, PF_INET, SOCK_DGRAM, getprotobyname('udp')) || die $!;
  218. connect (RCON, sockaddr_in ($opt_p, inet_aton($opt_i))) || die $!;
  219. vec($rin,fileno(RCON),1) = 1;
  220.  
  221. $opt_r = read_password('RConPassword: ') if (!$opt_r);
  222.  
  223. # WARNING: from now, function such print() eof() <> are banned in code, dont use them since we use low level functions: select syswrite recv send
  224. while (1) {
  225. $date=time();
  226. my @ltime = localtime($date);
  227.  
  228. #syswrite STDERR, "rcon.pl: $state datain: $datain\n";
  229. ## in this section, we should send something : PASS for a logon, COMM for a command, or KA to keep connection alive
  230. if ($state==$PASS) {
  231. $seq=0;
  232. syswrite STDERR, "Logging in...\n";
  233. send(RCON, enc(sendbe($PASS, undef, $opt_r)), 0);
  234. $datain="";
  235. }
  236. else { while ( $state!=$COMM && $datain =~ /^([^\r\t\n;]+)(?:$|[\r\t\n; ]+(.*)$)/ ) { # some commands in the buffer to send?
  237. my $cmd="$1";
  238. my $end= defined $2 ? "$2": "";
  239. if (substr($cmd,0,1) eq "!") {
  240. eval substr($cmd,1); # Warning: $cmd (such 'exit') is evaluated by Perl.
  241. $datain=$end;
  242. }
  243. elsif ($cmd =~ /^kickall +(.*)$/i) {
  244. %HIpl=();
  245. $datain="players;_kickall $1;$end";
  246. }
  247. # banbyname kickbyname saybyname
  248. elsif ($cmd =~ /^(?<cmd>[a-z]+)byname +(?:"(?<name>.*)"|'(?<name>.*)'|(?<name>[^ ]+)) +(?<msg>.*?)$/i) {
  249. my ($cmd,$name,$msg) = ($+{cmd},$+{name},$+{msg});
  250. $datain="";
  251. foreach my $k (keys %HIpl) {
  252. my $p = $HIpl{$k};
  253. $datain.="$cmd ".$p->[1]." $msg;" if ($p->[2] eq $name);
  254. }
  255. $datain.=$end;
  256. }
  257. elsif ($cmd =~ /^timeout +([0-9]+)$/i) {
  258. $timeout=$1;
  259. syswrite STDERR, "rcon.pl: timeout changed to $timeout\n";
  260. $datain=$end;
  261. }
  262. elsif ($cmd =~ /^_kickall +(.*)$/i) {
  263. $datain="";
  264. foreach my $k (keys %HIpl)
  265. {
  266. my $p = $HIpl{$k};
  267. $datain.="kick ".$p->[1]." $1;";
  268. }
  269. $datain.=$end;
  270. }
  271. else {
  272. syswrite STDERR, sprintf ("> %02d:%02d:%02d %s\n", $ltime[2],$ltime[1],$ltime[0], $cmd);
  273. send(RCON, enc(sendbe($COMM, $seq, $cmd)), 0) ;
  274. vec($rin,fileno(STDIN),1) = 0; ## switch off stdin to wait command response
  275. $state=$COMM;
  276. $datain=$end;
  277. last; # exit while
  278. }
  279. }}
  280. if ($state==$KA) {
  281. send(RCON, enc(sendbe($COMM, $seq, undef)), 0);
  282. syswrite STDOUT, "\a" if (! defined $opt_b) ; # Send a bell signal to the console
  283. $state=$IDLE;
  284. }
  285.  
  286. ## In this section, we wait something from streams. We should if we sent something!
  287. ($nfound,$timeleft) = select($rout=$rin, undef, undef, $timeout);
  288. $date=time();
  289. @ltime = localtime($date);
  290. #syswrite STDOUT, sprintf ( "select: %d %f\n", $nfound, $timeleft );
  291.  
  292. # select timed out? so no events during $timeout seconds...
  293. if ($timeleft==0) {
  294. die "rcon.pl: timeout\n" if (! defined $opt_k && ! defined $opt_L); # program exit if no keepalive
  295. # let's feed stdin with some evil commands if necessary
  296. if ( (defined $opt_L) && $date-$datePlayersSent>$HIpolling*60 ) {
  297. #syswrite STDERR, "(-L) Stdin fed with 'players' command\n";
  298. $datain="players;".$datain; # next loop, commands in the datain buffer will be processed
  299. }
  300. if ($state==$COMM) {
  301. syswrite STDERR, "rcon.pl: Hum, command timed out! Are we still logged on?\n";
  302. exit 18 if ($unresponsiveCount++>=2);
  303. $state=$PASS; # next loop, this will triger the logon process
  304. }
  305. elsif ($state==$PASS){
  306. syswrite STDERR, "rcon.pl: Hum, login timed out! Server unresponsive?\n";
  307. exit 17 if ($unresponsiveCount++>=2);
  308. }
  309. else { # we were idle
  310. $state=$KA; # next loop, this will trigger the sending of a keep-alive packet (if datain is empty)
  311. }
  312. next; # next loop...
  313. }
  314.  
  315. ## In this section, we had some events from UDP socket or from STDIN... Let's process them!
  316. if (vec($rout,fileno(RCON),1) == 1) { # read event on UDP socket
  317. recv(RCON, $dataUDP,65507, 0) ;
  318. my ($type, $srvseq, $response, $idx, $qty) = recvbe(dec($dataUDP));
  319. if ($type == $COMM) { # the small result of a command
  320. if (length($response)>=0) {
  321. syswrite STDOUT, sprintf("< %02d:%02d:%02d %s\n", $ltime[2],$ltime[1],$ltime[0], $response);
  322. $datain.=HIreadPlayers($response);
  323. $seq=($seq+1)%255;
  324. $state=$IDLE;
  325. vec($rin,fileno(STDIN),1) = 1; # switch on stdin to consume another command
  326. }
  327. ###last if (vec($rin,fileno(STDIN),1) == 0); # if stdin has been closed then it is time to die
  328. $unresponsiveCount=0;
  329. }
  330. elsif ($type == $PASS) { # the response of a logon request
  331. die "rcon.pl: Bad password\n" if ($srvseq==0); # BAD PASSWORD
  332. if ($srvseq == 99) { # we can't connect since it is the fake datagram built by sub 'dec'
  333. if (defined $opt_k) {
  334. sleep 5; # wait a little and retry a logon later
  335. syswrite STDERR, "rcon.pl: retrying to logon...\n";
  336. }
  337. else {
  338. die "rcon.pl: $response\n";
  339. }
  340. }
  341. else { # We are connected and logon successfull
  342. syswrite STDERR, "Logon successful!\n";
  343. $state=$IDLE;
  344. }
  345. }
  346. elsif ($type == $KA) { # a message the server gave to us, that requires an acknowledge
  347. syswrite STDOUT, sprintf("< %02d:%02d:%02d %s\n", $ltime[2],$ltime[1],$ltime[0], $response);
  348. $datain.=HIreadPlayers($response);
  349. send(RCON, enc(sendbe($KA, $srvseq, undef)), 0);
  350. vec($rin,fileno(STDIN),1) = 1; # switch on stdin to consume another command
  351. $state=$IDLE;
  352. }
  353. elsif ($type == $MULTI) { # the result of a command, in multiple packets
  354. @mbuffer=() if (!$idx); # buffer of packets is reset if index=0 (first packet)
  355. $mbuffer[$idx]=$response;
  356. # syswrite STDOUT, sprintf("%s%s%s", ($idx)?'':'# ', $response, ($idx==$qty-1)?"\n":'');
  357. send(RCON, enc(sendbe($KA, $srvseq, undef)), 0);
  358. if ($idx==$qty-1) { # if it was the last packet, reception is complete
  359. $response=join('',@mbuffer);
  360. syswrite STDOUT, sprintf("< %02d:%02d:%02d %s\n",$ltime[2],$ltime[1],$ltime[0], $response);
  361. $datain.=HIreadPlayers($response);
  362. vec($rin,fileno(STDIN),1) = 1; # switch on stdin to consume another command
  363. $seq=($seq+1)%255;
  364. $state=$IDLE;
  365. }
  366. else {
  367. $state=$COMM; # let's keep on receipt the others packets
  368. }
  369. $unresponsiveCount=0;
  370. }
  371. }
  372. if (vec($rout,fileno(STDIN),1) == 1) { # event from stdin (can be data to read, or EOF if data to read is empty)
  373. my $dateSTDIN="";
  374. my $res=sysread(STDIN, $dateSTDIN,65507) ;
  375. $datain.=$dateSTDIN;
  376. if (!length($datain)) {
  377. die "rcon.pl: EOF for STDIN\n" if !(defined $opt_t); # exit if EOF for stdin AND datain buffer is empty
  378. vec($rin,fileno(STDIN),1) = 0;
  379. }
  380. #syswrite STDOUT, sprintf ("> STDIN \"%s\"+\"%s\" %d \n", $datain, $dateSTDIN, $res );
  381. }
  382. }
  383.  
  384. close(RCON);
  385. exit 0;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!