X-Git-Url: https://git.xonotic.org/?p=xonotic%2Fxonotic.git;a=blobdiff_plain;f=server%2Frcon2irc%2Frcon2irc.pl;h=312e36404771eb422cc0576be5fc1566f2305c24;hp=88a98ccc438c93dd4950f774248a8e99d34749b7;hb=b881f9fe2a65e180b86023b9aaba8325745c9c89;hpb=67a864dd70dca3a4533fe271622b1a044edc4503 diff --git a/server/rcon2irc/rcon2irc.pl b/server/rcon2irc/rcon2irc.pl index 88a98ccc..312e3640 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 (.*)(?:$|\0)/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,9 @@ our %config = ( dp_password => undef, dp_status_delay => 30, dp_server_from_wan => "", + dp_listen_from_server => "", + dp_utf8_enable => $color_utf8_enable, + dp_timinglog => "", irc_local => "", irc_admin_password => "", @@ -723,10 +760,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 +790,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 +820,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 +847,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,12 +915,12 @@ 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 { my ($timer) = @_; - out dp => 0, 'sv_cmd bans', 'status 1', 'log_dest_udp'; + out dp => 0, 'sv_cmd banlist', 'status 1', 'log_dest_udp'; $store{status_waiting} = -1; } => 1; # this will clear irc_error_active @@ -1011,10 +1064,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 +1109,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 +1388,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 +1441,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; @@ -1666,6 +1729,15 @@ sub cond($) my ($all, $cpu, $lost, $avg, $max, $sdev) = @_; return 0 # don't complain when just on the voting screen if !$store{playing}; + if(length $config{dp_timinglog}) + { + open my $fh, '>>', $config{dp_timinglog} + or warn "open >> $config{dp_timinglog}: $!"; + print $fh "@{[time]} $cpu $lost $avg $max $sdev\n" + or warn "print >> $config{dp_timinglog}: $!"; + close $fh + or warn "close >> $config{dp_timinglog}: $!"; + } return 0 # don't complain if it was less than 0.5% if $lost < 0.5; return 0 # don't complain if nobody is looking @@ -1713,7 +1785,7 @@ out dp => 0, 'echo "Unknown command \"rcon2irc_eval\""'; # assume the server has # not containing our own IP:port, or by rcon2irc_eval not being a defined command). schedule sub { my ($timer) = @_; - out dp => 0, 'sv_cmd bans', 'status 1', 'log_dest_udp', 'rcon2irc_eval set dummy 1'; + out dp => 0, 'sv_cmd banlist', 'status 1', 'log_dest_udp', 'rcon2irc_eval set dummy 1'; $store{status_waiting} = -1; schedule $timer => (exists $store{dp_hostname} ? $config{dp_status_delay} : 1);; } => 1;