X-Git-Url: https://git.xonotic.org/?p=xonotic%2Fxonotic.git;a=blobdiff_plain;f=server%2Frcon2irc%2Frcon2irc.pl;h=cb800e84a2876e3c0e19678343c448e5eaa4f7b5;hp=b5d3c89e859405277dbfec3c27d9d60cf4e6e3b4;hb=207cf23b36ad8a8583ffb3670dbb2ffd46f5c7b5;hpb=ae2d59dfe66fa0b479cc9f513b72a2499aab36bd

diff --git a/server/rcon2irc/rcon2irc.pl b/server/rcon2irc/rcon2irc.pl
index b5d3c89e..cb800e84 100755
--- a/server/rcon2irc/rcon2irc.pl
+++ b/server/rcon2irc/rcon2irc.pl
@@ -28,6 +28,7 @@ our $VERSION = '0.4.2 svn $Revision$';
 # MISC STRING UTILITY ROUTINES to convert between DarkPlaces and IRC conventions
 
 # convert mIRC color codes to DP color codes
+our $color_utf8_enable = 1;
 our @color_irc2dp_table = (7, 0, 4, 2, 1, 1, 6, 1, 3, 2, 5, 5, 4, 6, 7, 7);
 our @color_dp2irc_table = (-1, 4, 9, 8, 12, 11, 13, -1, -1, -1); # not accurate, but legible
 our @color_dp2ansi_table = ("m", "1;31m", "1;32m", "1;33m", "1;34m", "1;36m", "1;35m", "m", "1m", "1m"); # not accurate, but legible
@@ -57,7 +58,7 @@ sub color_irc2dp($)
 }
 
 our @text_qfont_table = ( # ripped from DP console.c qfont_table
-    "\0", '#',  '#',  '#',  '#',  '.',  '#',  '#',
+    '',   '#',  '#',  '#',  '#',  '.',  '#',  '#',
     '#',  9,    10,   '#',  ' ',  13,   '.',  '.',
     '[',  ']',  '0',  '1',  '2',  '3',  '4',  '5',
     '6',  '7',  '8',  '9',  '.',  '<',  '=',  '>',
@@ -90,16 +91,28 @@ our @text_qfont_table = ( # ripped from DP console.c qfont_table
     'p',  'q',  'r',  's',  't',  'u',  'v',  'w',
     'x',  'y',  'z',  '{',  '|',  '}',  '~',  '<'
 );
+sub text_qfont_table($)
+{
+	my ($char) = @_;
+	my $o = ord $char;
+	if($color_utf8_enable)
+	{
+		return (($o & 0xFF00) == 0xE000) ? $text_qfont_table[$o & 0xFF] : $char;
+	}
+	else
+	{
+		return $text_qfont_table[$o];
+	}
+}
 sub text_dp2ascii($)
 {
 	my ($message) = @_;
-	$message = join '', map { $text_qfont_table[ord $_] } split //, $message;
+	$message = join '', map { text_qfont_table $_ } split //, $message;
 }
 
 sub color_dp_transform(&$)
 {
 	my ($block, $message) = @_;
-
 	$message =~ s{(?:(\^\^)|\^x([0-9a-fA-F])([0-9a-fA-F])([0-9a-fA-F])|\^([0-9])|(.))(?=([0-9,]?))}{
 		defined $1 ? $block->(char => '^', $7) :
 		defined $2 ? $block->(rgb => [hex $2, hex $3, hex $4], $7) :
@@ -119,7 +132,7 @@ sub color_dp2none($)
 	{
 		my ($type, $data, $next) = @_;
 		$type eq 'char'
-			? $text_qfont_table[ord $data]
+			? text_qfont_table $data
 			: "";
 	}
 	$message;
@@ -196,7 +209,7 @@ sub color_dp2irc($)
 			$data = color_rgb2basic $data;
 		}
 
-		$type eq 'char'  ? $text_qfont_table[ord $data] :
+		$type eq 'char'  ? text_qfont_table $data :
 		$type eq 'color' ? do {
 			my $oldcolor = $color;
 			$color = $color_dp2irc_table[$data];
@@ -225,7 +238,7 @@ sub color_dp2ansi($)
 			$data = color_rgb2basic $data;
 		}
 
-		$type eq 'char'  ? $text_qfont_table[ord $data] :
+		$type eq 'char'  ? text_qfont_table $data :
 		$type eq 'color' ? do {
 			my $oldcolor = $color;
 			$color = $color_dp2ansi_table[$data];
@@ -253,6 +266,8 @@ sub color_dpfix($)
 #   Connection:
 #     $conn->sockname() returns a connection type specific representation
 #       string of the local address, or undef if not applicable.
+#     $conn->peername() returns a connection type specific representation
+#       string of the remote address, or undef if not applicable.
 #     $conn->send("string") sends something over the connection.
 #     $conn->recv() receives a string from the connection, or returns "" if no
 #       data is available.
@@ -306,6 +321,7 @@ sub new($$)
 		PeerAddr => $remote,
 		PeerPort => $defaultport
 	) or die "socket $proto/$local/$remote/$defaultport: $!";
+	binmode $sock;
 	$sock->blocking(0);
 	my $you = {
 		# Mortal fool! Release me from this wretched tomb! I must be set free
@@ -327,6 +343,14 @@ sub sockname($)
 	return "@{[inet_ntoa $addr]}:$port";
 }
 
+# $sock->peername() returns the remote address of the socket.
+sub peername($)
+{
+	my ($self) = @_;
+	my ($port, $addr) = sockaddr_in $self->{sock}->peername();
+	return "@{[inet_ntoa $addr]}:$port";
+}
+
 # $sock->send($data) sends some data over the socket; on success, 1 is returned.
 sub send($$)
 {
@@ -465,6 +489,8 @@ sub join_commands($@)
 sub send($$$)
 {
 	my ($self, $line, $nothrottle) = @_;
+	utf8::encode $line
+		if $color_utf8_enable;
 	if($self->{secure} > 1)
 	{
 		$self->{connector}->send("\377\377\377\377getchallenge");
@@ -514,7 +540,7 @@ sub recvchallenge($)
 					if not defined $s;
 				length $s
 					or last;
-				if($s =~ /^\377\377\377\377challenge (.*)$/s)
+				if($s =~ /^\377\377\377\377challenge (.*?)(?:$|\0)/s)
 				{
 					return $1;
 				}
@@ -544,7 +570,10 @@ sub recv($)
 	my @out = ();
 	while($self->{recvbuf} =~ s/^(.*?)(?:\r\n?|\n)//)
 	{
-		push @out, $1;
+		my $s = $1;
+		utf8::decode $s
+			if $color_utf8_enable;
+		push @out, $s;
 	}
 	return @out;
 }
@@ -611,6 +640,8 @@ sub throttle($$$)
 sub send($$$)
 {
 	my ($self, $line, $nothrottle) = @_;
+	utf8::encode $line
+		if $color_utf8_enable;
 	my $t = time();
 	if(defined $self->{capacity})
 	{
@@ -652,7 +683,10 @@ sub recv($)
 	my @out = ();
 	while($self->{recvbuf} =~ s/^(.*?)(?:\r\n?|\n)//)
 	{
-		push @out, $1;
+		my $s = $1;
+		utf8::decode $s
+			if $color_utf8_enable;
+		push @out, $s;
 	}
 	return @out;
 }
@@ -716,6 +750,8 @@ our %config = (
 	dp_password => undef,
 	dp_status_delay => 30,
 	dp_server_from_wan => "",
+	dp_listen_from_server => "", 
+	dp_utf8_enable => $color_utf8_enable,
 	irc_local => "",
 
 	irc_admin_password => "",
@@ -723,10 +759,24 @@ our %config = (
 	irc_admin_quote_re => "",
 
 	irc_reconnect_delay => 300,
+	irc_commands => "",
 
 	plugins => "",
 );
 
+sub pickip($$)
+{
+	my ($wan, $lan) = @_;
+	# $wan shall override $lan
+	return $lan
+		if not length $wan;
+	return $wan
+		if $wan =~ /:\d+$/; # full override
+	return $wan
+		if $lan !~ /:(\d+)$/;
+	return "$wan:$1";
+}
+
 
 
 # Xonotic specific parsing of some server messages
@@ -739,7 +789,7 @@ sub xon_slotsstring()
 		my $slots = $store{slots_max} - $store{slots_active};
 		my $slots_s = ($slots == 1) ? '' : 's';
 		$slotsstr = " ($slots free slot$slots_s)";
-		my $s = $config{dp_server_from_wan} || $config{dp_server};
+		my $s = pickip($config{dp_server_from_wan}, $config{dp_server});
 		$slotsstr .= "; join now: \002xonotic +connect $s"
 			if $slots >= 1 and not $store{lms_blocked};
 	}
@@ -769,6 +819,7 @@ my @missing = grep { !defined $config{$_} } keys %config;
 die "The following config items are missing: @missing"
 	if @missing;
 
+$color_utf8_enable = $config{dp_utf8_enable};
 
 
 # Create a channel for error messages and other internal status messages...
@@ -795,6 +846,7 @@ $SIG{TERM} = sub {
 $channels{irc} = new Channel::Line(new Connection::Socket(tcp => $config{irc_local} => $config{irc_server} => 6667));
 $channels{dp} = new Channel::QW(my $dpsock = new Connection::Socket(udp => $config{dp_listen} => $config{dp_server} => 26000), $config{dp_password}, $config{dp_secure}, $config{dp_secure_challengetimeout});
 $config{dp_listen} = $dpsock->sockname();
+$config{dp_server} = $dpsock->peername();
 print "Listening on $config{dp_listen}\n";
 
 $channels{irc}->throttle(0.5, 5);
@@ -862,7 +914,7 @@ sub irc_error()
 			return;
 			# this will keep irc_error_active
 		}
-		$channels{irc} = new Channel::Line(new Connection::Socket(tcp => "" => $config{irc_server} => 6667));
+		$channels{irc} = new Channel::Line(new Connection::Socket(tcp => $config{irc_local} => $config{irc_server} => 6667));
 		delete $store{$_} for grep { /^irc_/ } keys %store;
 		$store{irc_nick} = "";
 		schedule sub {
@@ -1011,10 +1063,17 @@ sub irc_joinstage($)
 			# we get here again when Q asks us
 		}
 	}
+
+	for(split / *; */, $store{irc_commands})
+	{
+		s/\$nick/$store{irc_nick}/g;
+		out irc => 1, $_;
+	}
 	
 	# if we get here, we are on IRC
 	$store{irc_joined_channel} = 1;
 	schedule sub {
+		# wait 1 sec to let stuff calm down
 		out irc => 1, "JOIN $config{irc_channel}";
 	} => 1;
 	return 0;
@@ -1049,8 +1108,8 @@ sub cond($)
 	[ dp => q{"log_dest_udp" is "([^"]*)" \["[^"]*"\]} => sub {
 		my ($dest) = @_;
 		my @dests = split ' ', $dest;
-		return 0 if grep { $_ eq $config{dp_listen} } @dests;
-		out dp => 0, 'log_dest_udp "' . join(" ", @dests, $config{dp_listen}) . '"';
+		return 0 if grep { $_ eq pickip($config{dp_listen_from_server}, $config{dp_listen}) } @dests;
+		out dp => 0, 'log_dest_udp "' . join(" ", @dests, pickip($config{dp_listen_from_server}, $config{dp_listen})) . '"';
 		return 0;
 	} ],
 
@@ -1328,7 +1387,10 @@ sub cond($)
 
 		if ($nick eq $store{irc_nick}) {
 			$store{irc_maxlen} = 510 - length($hostmask);
-			$store{irc_joined_channel} = 1;
+			if($store{irc_joined_channel} == 1)
+			{
+				$store{irc_joined_channel} = 2;
+			}
 			print "* detected maximum line length for channel messages: $store{irc_maxlen}\n";
 		}
 
@@ -1378,7 +1440,7 @@ sub cond($)
 	# remove myself from the log destinations and exit everything
 	[ dp => q{quitting rcon2irc (??{$store{quitcookie}}): log_dest_udp is (.*) *} => sub {
 		my ($dest) = @_;
-		my @dests = grep { $_ ne $config{dp_listen} } split ' ', $dest;
+		my @dests = grep { $_ ne pickip($config{dp_listen_from_server}, $config{dp_listen}) } split ' ', $dest;
 		out dp => 0, 'log_dest_udp "' . join(" ", @dests) . '"';
 		exit 0;
 		return 0;