}
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', '.', '<', '=', '>',
my $o = ord $char;
if($color_utf8_enable)
{
- return ($o & 0xFF00 == 0xE000) ? $text_qfont_table[$o & 0xFF] : $char;
+ return (($o & 0xFF00) == 0xE000) ? $text_qfont_table[$o & 0xFF] : $char;
}
else
{
# 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.
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($$)
{
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 => "",
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
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};
}
$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);
$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
# 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;
[ 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;
} ],
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";
}
# 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;
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 $store{slots_active}\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
# 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;