r3561 - in trunk/Docs/server: . rcon2irc
DONOTREPLY at icculus.org
DONOTREPLY at icculus.org
Sun Mar 30 14:10:18 EDT 2008
Author: div0
Date: 2008-03-30 14:10:15 -0400 (Sun, 30 Mar 2008)
New Revision: 3561
Added:
trunk/Docs/server/rcon2irc/
trunk/Docs/server/rcon2irc/rbiserver.pl
trunk/Docs/server/rcon2irc/rcon2irc-example.conf
trunk/Docs/server/rcon2irc/rcon2irc.pl
trunk/Docs/server/rcon2irc/rcon2irc.txt
Removed:
trunk/Docs/server/rcon2irc-0.4.1.tar.bz2
Modified:
trunk/Docs/server/rcon.pl
Log:
fix color code bug in rcon2irc (this time for real)
Modified: trunk/Docs/server/rcon.pl
===================================================================
--- trunk/Docs/server/rcon.pl 2008-03-29 12:11:50 UTC (rev 3560)
+++ trunk/Docs/server/rcon.pl 2008-03-30 18:10:15 UTC (rev 3561)
@@ -120,12 +120,16 @@
$c = 0 if $c >= 7; # map 0, 7, 8, 9 to default (no bright white or such stuff)
$color = $color_dp2irc_table[$c];
($color == $oldcolor) ? '' :
- $c == 0 ? "\017" :
- $f eq ',' ? "\003$color\002\002" :
- $f ne '' ? sprintf "\003%02d", $color : "\003$color";
+ $c == 0 ? "\0001" :
+ $f eq ',' ? "\0003$color\0002\0002" :
+ $f ne '' ? sprintf "\0003%02d", $color : "\0003$color";
} : "^$c";
}esg;
- return text_dp2ascii $message;
+ $message = text_dp2ascii $message;
+ $message =~ s/\0001/\017/g;
+ $message =~ s/\0002/\002/g;
+ $message =~ s/\0003/\003/g;
+ return $message;
}
sub color_dp2ansi($)
Added: trunk/Docs/server/rcon2irc/rbiserver.pl
===================================================================
--- trunk/Docs/server/rcon2irc/rbiserver.pl (rev 0)
+++ trunk/Docs/server/rcon2irc/rbiserver.pl 2008-03-30 18:10:15 UTC (rev 3561)
@@ -0,0 +1,112 @@
+sub out($$@);
+
+sub markmap($$$$;$)
+{
+ my ($state, $map, $pro, $total, $who) = @_;
+ open my $fh, '>>', "$ENV{HOME}/.nexuiz/__votelog.$config{irc_nick}.txt"
+ or die "votelog open: $!";
+ print $fh "@{[time()]} $config{irc_nick} $state $map $pro $total" . (defined $who ? " $who" : "") . "\n";
+ close $fh;
+}
+
+# call the log analyzer at the end of a match
+[ dp => q{:end} => sub {
+ system(q{
+ for X in ~/Nexuiz/home/.nexuiz/extramaps/data/*.log; do
+ if [ x"`tail -n 1 "$X"`" = x":gameover" ]; then
+ ssh hector 'l=$HOME/.nexuiz/server-remote-$RANDOM.log; cat >"$l"; ~/.nexuiz/logspam/addlogs-processonly.sh "$l"' < "$X"
+ rm -f "$X"
+ fi
+ done
+ });
+ return 0;
+} ],
+
+# the AOL calendar
+[ dp => q{\001(.*?)\^7: d} => sub {
+ my $aoltime = time() - 746748000;
+ my $day = int($aoltime / 86400);
+ my $wday = [qw[Tue Wed Thu Fri Sat Sun Mon]]->[$day % 7];
+ my $hour = int($aoltime / 3600) % 24;
+ my $minute = int($aoltime / 60) % 60;
+ my $second = int($aoltime / 1) % 60;
+ out dp => 0, sprintf 'rcon2irc_say_as "AOL service" "The time is %3s Sep %2d %02d:%02d:%02d 1993"',
+ $wday, $day, $hour, $minute, $second;
+ return 1;
+} ],
+
+# map vote logging
+[ dp => q{:vote:suggestion_accepted:(.*)} => sub {
+ my ($map) = @_;
+ markmap suggestion_accepted => $map, $store{rbi_winvotes}, $store{rbi_totalvotes};
+ return 0;
+} ],
+[ dp => q{:vote:suggested:(.*?):\d+:(.*)} => sub {
+ my ($map, $who) = @_;
+ markmap suggested => $map, 1, 1, $who;
+ return 0;
+} ],
+[ dp => q{\001\^2\* .*'s vote for \^1gotomap (.*)\^2 was accepted} => sub {
+ my ($map) = @_;
+ markmap voted => $map, 1, 1;
+ return 0;
+} ],
+[ dp => q{\001\^2\* .*'s vote for \^1timelimit -1\^2 was accepted} => sub {
+ markmap cancelled => $store{map}, 1, 1;
+ return 0;
+} ],
+[ dp => q{:vote:(keeptwo|finished):(.*)} => sub {
+ my ($status, $result) = @_;
+ my @result = split /:/, $result;
+ my $totalvotes = 0;
+ my $cutoff = -1;
+ my @allmaps = map
+ {
+ $cutoff = $_ if $result[2*$_] eq '';
+ $totalvotes += int($result[2*$_+1] || 0);
+ [$result[2*$_], int($result[2*$_+1] || 0)]
+ } 0..((@result-1)/2);
+ die "Invalid vote result: $result" unless $cutoff >= 0;
+ my @winners = @allmaps[0..($cutoff-1)];
+ my @losers = @allmaps[($cutoff+1)..(@allmaps-1)];
+ my $winvotes = 0;
+ $winvotes += $_->[1] for @winners;
+ if($status eq 'keeptwo')
+ {
+ markmap irrelevant_relative => $_->[0], $winvotes, $totalvotes
+ for @losers;
+ }
+ elsif($status eq 'finished')
+ {
+ markmap((@losers == 1 ? 'duel_winner' : 'winner_absolute') => $_->[0], $_->[1], $totalvotes)
+ for @winners;
+ markmap((@losers == 1 ? 'duel_loser' : 'irrelevant_absolute') => $_->[0], $winvotes, $totalvotes)
+ for @losers;
+ }
+ $store{rbi_winvotes} = $winvotes;
+ $store{rbi_totalvotes} = $totalvotes;
+ return 0;
+} ],
+
+# retrieve system load data
+[ dp => q{timing: (([0-9.]*)% CPU, ([0-9.]*)% lost, offset avg ([0-9.]*)ms, max ([0-9.]*)ms, sdev ([0-9.]*)ms)} => sub {
+ my ($all, $cpu, $lost, $avg, $max, $sdev) = @_;
+ return 0 # don't complain when just on the voting screen
+ if !$store{playing};
+ 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
+ if $store{slots_active} == 0;
+ return 0 # don't complain in the first two minutes
+ if time() - $store{map_starttime} < 120;
+ return 0 # don't complain if it was already at least half as bad in this round
+ if $store{map_starttime} == $store{timingerror_map_starttime} and $lost <= 2 * $store{timingerror_lost};
+ $store{timingerror_map_starttime} = $store{map_starttime};
+ $store{timingerror_lost} = $lost;
+ out dp => 0, 'rcon2irc_say_as server "There are currently some severe system load problems. A log file has been written."';
+ #my $subj = "slow $lost% on $store{slots_active}p $store{map} @{[int(time() - $store{map_starttime})]}s on $config{dp_server}";
+ #system "{ echo '$subj'; echo '$cpu% CPU, $lost% lost, offset ms: $avg max $max sdev $sdev'; top -b -n 1; } | mail -s 'Nexuiz: $subj' divVerent\@alientrap.org";
+ out irc => 1, "PRIVMSG $config{irc_channel} :\001ACTION has big trouble on $store{map} after @{[int(time() - $store{map_starttime})]}s: $all\001";
+ out irc => 1, "PRIVMSG OpBaI :\001ACTION has big trouble on $store{map} after @{[int(time() - $store{map_starttime})]}s: $all\001";
+ return 0;
+} ],
Added: trunk/Docs/server/rcon2irc/rcon2irc-example.conf
===================================================================
--- trunk/Docs/server/rcon2irc/rcon2irc-example.conf (rev 0)
+++ trunk/Docs/server/rcon2irc/rcon2irc-example.conf 2008-03-30 18:10:15 UTC (rev 3561)
@@ -0,0 +1,37 @@
+# DarkPlaces server data
+dp_server = 172.23.42.54
+dp_password = hackme
+
+# IRC configuration
+irc_server = irc.oftc.net
+irc_nick = testNex
+irc_user = banme
+irc_channel = #Nexuiz-Pwayers
+
+# IRC NickServ authentication (optional)
+#irc_nickserv_password = hackme
+
+# IRC Quakenet challenge/response authentication (optional)
+#irc_quakenet_authname = hack
+#irc_quakenet_password = me
+
+# Extra plug-ins to load
+#plugins =
+
+# Tuning
+#dp_server_from_wan =
+#dp_listen = 141.2.16.23:27771
+#dp_status_delay = 30
+#irc_ping_delay = 120
+#irc_nickserv_identify = PRIVMSG NickServ :IDENTIFY %2$s
+#irc_nickserv_ghost = PRIVMSG NickServ :GHOST %1$s %2$s
+#irc_nickserv_ghost_attempts = 3
+#irc_quakenet_getchallenge = PRIVMSG Q at CServe.quakenet.org :CHALLENGE
+#irc_quakenet_challengeauth = PRIVMSG Q at CServe.quakenet.org :CHALLENGEAUTH
+#irc_quakenet_challengeprefix = :Q!TheQBot at CServe.quakenet.org NOTICE [^:]+ :CHALLENGE
+
+# Example: Gamesurge AuthServ (does not provide ghosting)
+#irc_nickserv_password = mypassword
+#irc_nickserv_identify = AUTHSERV AUTH myauthname %2$s
+#irc_nickserv_ghost =
+#irc_nickserv_ghost_attempts = 0
Added: trunk/Docs/server/rcon2irc/rcon2irc.pl
===================================================================
--- trunk/Docs/server/rcon2irc/rcon2irc.pl (rev 0)
+++ trunk/Docs/server/rcon2irc/rcon2irc.pl 2008-03-30 18:10:15 UTC (rev 3561)
@@ -0,0 +1,1279 @@
+#!/usr/bin/perl
+
+our $VERSION = '0.4.2 svn $Revision$';
+
+# Copyright (c) 2008 Rudolf "divVerent" Polzer
+#
+# Permission is hereby granted, free of charge, to any person
+# obtaining a copy of this software and associated documentation
+# files (the "Software"), to deal in the Software without
+# restriction, including without limitation the rights to use,
+# copy, modify, merge, publish, distribute, sublicense, and/or sell
+# copies of the Software, and to permit persons to whom the
+# Software is furnished to do so, subject to the following
+# conditions:
+#
+# The above copyright notice and this permission notice shall be
+# included in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+# OTHER DEALINGS IN THE SOFTWARE.
+
+# Interfaces:
+# Connection:
+# $conn->sockname() returns a connection type specific representation
+# string of the local 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.
+# $conn->fds() returns all file descriptors used by the connection, so one
+# can use select() on them.
+# Channel:
+# Usually wraps around a connection and implements a command based
+# structure over it. It usually is constructed using new
+# ChannelType($connection, someparameters...)
+# @cmds = $chan->join_commands(@cmds) joins multiple commands to a single
+# command string if the protocol supports it, or does nothing and leaves
+# @cmds unchanged if the protocol does not support that usage (this is
+# meant to save send() invocations).
+# $chan->send($command, $nothrottle) sends a command over the channel. If
+# $nothrottle is sent, the command must not be left out even if the channel
+# is saturated (for example, because of IRC's flood control mechanism).
+# $chan->quote($str) returns a string in a quoted form so it can safely be
+# inserted as a substring into a command, or returns $str as is if not
+# applicable. It is assumed that the result of the quote method is used
+# as part of a quoted string, if the protocol supports that.
+# $chan->recv() returns a list of received commands from the channel, or
+# the empty list if none are available.
+# $conn->fds() returns all file descriptors used by the channel's
+# connections, so one can use select() on them.
+
+
+
+
+
+
+
+# Socket connection.
+# Represents a connection over a socket.
+# Mainly used to wrap a channel around it for, in this case, line based or rcon-like operation.
+package Connection::Socket;
+use strict;
+use warnings;
+use IO::Socket::INET;
+use IO::Handle;
+
+# Constructor:
+# my $conn = new Connection::Socket(tcp => "localaddress" => "remoteaddress" => 6667);
+# If the remote address does not contain a port number, the numeric port is
+# used (it serves as a default port).
+sub new($$)
+{
+ my ($class, $proto, $local, $remote, $defaultport) = @_;
+ my $sock = IO::Socket::INET->new(
+ Proto => $proto,
+ (length($local) ? (LocalAddr => $local) : ()),
+ PeerAddr => $remote,
+ PeerPort => $defaultport
+ ) or die "socket $proto/$local/$remote: $!";
+ $sock->blocking(0);
+ my $you = {
+ # Mortal fool! Release me from this wretched tomb! I must be set free
+ # or I will haunt you forever! I will hide your keys beneath the
+ # cushions of your upholstered furniture... and NEVERMORE will you be
+ # able to find socks that match!
+ sock => $sock,
+ # My demonic powers have made me OMNIPOTENT! Bwahahahahahahaha!
+ };
+ return
+ bless $you, 'Connection::Socket';
+}
+
+# $sock->sockname() returns the local address of the socket.
+sub sockname($)
+{
+ my ($self) = @_;
+ my ($port, $addr) = sockaddr_in $self->{sock}->sockname();
+ return "@{[inet_ntoa $addr]}:$port";
+}
+
+# $sock->send($data) sends some data over the socket; on success, 1 is returned.
+sub send($$)
+{
+ my ($self, $data) = @_;
+ return 1
+ if not length $data;
+ if(not eval { $self->{sock}->send($data); })
+ {
+ warn "$@";
+ return 0;
+ }
+ return 1;
+}
+
+# $sock->recv() receives as much as possible from the socket (or at most 32k). Returns "" if no data is available.
+sub recv($)
+{
+ my ($self) = @_;
+ my $data = "";
+ $self->{sock}->recv($data, 32768, 0);
+ return $data;
+}
+
+# $sock->fds() returns the socket file descriptor.
+sub fds($)
+{
+ my ($self) = @_;
+ return fileno $self->{sock};
+}
+
+
+
+
+
+
+
+# Line-based buffered connectionless FIFO channel.
+# Whatever is sent to it using send() is echoed back when using recv().
+package Channel::FIFO;
+use strict;
+use warnings;
+
+# Constructor:
+# my $chan = new Channel::FIFO();
+sub new($)
+{
+ my ($class) = @_;
+ my $you = {
+ buffer => []
+ };
+ return
+ bless $you, 'Channel::FIFO';
+}
+
+sub join_commands($@)
+{
+ my ($self, @data) = @_;
+ return @data;
+}
+
+sub send($$$)
+{
+ my ($self, $line, $nothrottle) = @_;
+ push @{$self->{buffer}}, $line;
+}
+
+sub quote($$)
+{
+ my ($self, $data) = @_;
+ return $data;
+}
+
+sub recv($)
+{
+ my ($self) = @_;
+ my $r = $self->{buffer};
+ $self->{buffer} = [];
+ return @$r;
+}
+
+sub fds($)
+{
+ my ($self) = @_;
+ return ();
+}
+
+
+
+
+
+
+
+# QW rcon protocol channel.
+# Wraps around a UDP based Connection and sends commands as rcon commands as
+# well as receives rcon replies. The quote and join_commands methods are using
+# DarkPlaces engine specific rcon protocol extensions.
+package Channel::QW;
+use strict;
+use warnings;
+
+# Constructor:
+# my $chan = new Channel::QW($connection, "password");
+sub new($$)
+{
+ my ($class, $conn, $password) = @_;
+ my $you = {
+ connector => $conn,
+ password => $password,
+ recvbuf => "",
+ };
+ return
+ bless $you, 'Channel::QW';
+}
+
+# Note: multiple commands in one rcon packet is a DarkPlaces extension.
+sub join_commands($@)
+{
+ my ($self, @data) = @_;
+ return join "\0", @data;
+}
+
+sub send($$$)
+{
+ my ($self, $line, $nothrottle) = @_;
+ return $self->{connector}->send("\377\377\377\377rcon $self->{password} $line");
+}
+
+# Note: backslash and quotation mark escaping is a DarkPlaces extension.
+sub quote($$)
+{
+ my ($self, $data) = @_;
+ $data =~ s/[\000-\037]//g;
+ $data =~ s/([\\"])/\\$1/g;
+ $data =~ s/\$/\$\$/g;
+ return $data;
+}
+
+sub recv($)
+{
+ my ($self) = @_;
+ for(;;)
+ {
+ length(my $s = $self->{connector}->recv())
+ or last;
+ next
+ if $s !~ /^\377\377\377\377n(.*)$/s;
+ $self->{recvbuf} .= $1;
+ }
+ my @out = ();
+ while($self->{recvbuf} =~ s/^(.*?)(?:\r\n?|\n)//)
+ {
+ push @out, $1;
+ }
+ return @out;
+}
+
+sub fds($)
+{
+ my ($self) = @_;
+ return $self->{connector}->fds();
+}
+
+
+
+
+
+
+
+# Line based protocol channel.
+# Wraps around a TCP based Connection and sends commands as text lines
+# (separated by CRLF). When reading responses from the Connection, any type of
+# line ending is accepted.
+# A flood control mechanism is implemented.
+package Channel::Line;
+use strict;
+use warnings;
+use Time::HiRes qw/time/;
+
+# Constructor:
+# my $chan = new Channel::Line($connection);
+sub new($$)
+{
+ my ($class, $conn) = @_;
+ my $you = {
+ connector => $conn,
+ recvbuf => "",
+ capacity => undef,
+ linepersec => undef,
+ maxlines => undef,
+ lastsend => time()
+ };
+ return
+ bless $you, 'Channel::Line';
+}
+
+sub join_commands($@)
+{
+ my ($self, @data) = @_;
+ return @data;
+}
+
+# Sets new flood control parameters:
+# $chan->throttle(maximum lines per second, maximum burst length allowed to
+# exceed the lines per second limit);
+# RFC 1459 describes these parameters to be 0.5 and 5 for the IRC protocol.
+# If the $nothrottle flag is set while sending, the line is sent anyway even
+# if flooding would take place.
+sub throttle($$$)
+{
+ my ($self, $linepersec, $maxlines) = @_;
+ $self->{linepersec} = $linepersec;
+ $self->{maxlines} = $maxlines;
+ $self->{capacity} = $maxlines;
+}
+
+sub send($$$)
+{
+ my ($self, $line, $nothrottle) = @_;
+ my $t = time();
+ if(defined $self->{capacity})
+ {
+ $self->{capacity} += ($t - $self->{lastsend}) * $self->{linepersec};
+ $self->{lastsend} = $t;
+ $self->{capacity} = $self->{maxlines}
+ if $self->{capacity} > $self->{maxlines};
+ if(!$nothrottle)
+ {
+ return -1
+ if $self->{capacity} < 0;
+ }
+ $self->{capacity} -= 1;
+ }
+ $line =~ s/\r|\n//g;
+ return $self->{connector}->send("$line\r\n");
+}
+
+sub quote($$)
+{
+ my ($self, $data) = @_;
+ $data =~ s/\r\n?/\n/g;
+ $data =~ s/\n/*/g;
+ return $data;
+}
+
+sub recv($)
+{
+ my ($self) = @_;
+ for(;;)
+ {
+ length(my $s = $self->{connector}->recv())
+ or last;
+ $self->{recvbuf} .= $s;
+ }
+ my @out = ();
+ while($self->{recvbuf} =~ s/^(.*?)(?:\r\n?|\n)//)
+ {
+ push @out, $1;
+ }
+ return @out;
+}
+
+sub fds($)
+{
+ my ($self) = @_;
+ return $self->{connector}->fds();
+}
+
+
+
+
+
+
+# main program... a gateway between IRC and DarkPlaces servers
+package main;
+
+use strict;
+use warnings;
+use IO::Select;
+use Digest::MD5;
+use Time::HiRes qw/time/;
+
+our @handlers = (); # list of [channel, expression, sub to handle result]
+our @tasks = (); # list of [time, sub]
+our %channels = ();
+our %store = (
+ irc_nick => "",
+);
+our %config = (
+ irc_server => undef,
+ irc_nick => undef,
+ irc_user => undef,
+ irc_channel => undef,
+ irc_ping_delay => 120,
+
+ irc_nickserv_password => "",
+ irc_nickserv_identify => 'PRIVMSG NickServ :IDENTIFY %2$s',
+ irc_nickserv_ghost => 'PRIVMSG NickServ :GHOST %1$s %2$s',
+ irc_nickserv_ghost_attempts => 3,
+
+ irc_quakenet_authname => "",
+ irc_quakenet_password => "",
+ irc_quakenet_getchallenge => 'PRIVMSG Q at CServe.quakenet.org :CHALLENGE',
+ irc_quakenet_challengeauth => 'PRIVMSG Q at CServe.quakenet.org :CHALLENGEAUTH',
+ irc_quakenet_challengeprefix => ':Q!TheQBot at CServe.quakenet.org NOTICE [^:]+ :CHALLENGE',
+
+ dp_server => undef,
+ dp_listen => "",
+ dp_password => undef,
+ dp_status_delay => 30,
+ dp_server_from_wan => "",
+
+ plugins => "",
+);
+
+
+
+# MISC STRING UTILITY ROUTINES to convert between DarkPlaces and IRC conventions
+
+# convert mIRC color codes to DP color codes
+our @color_irc2dp_table = (7, 0, 4, 2, 1, 1, 6, 1, 3, 2, 5, 5, 4, 6, 7, 7);
+our @color_dp2irc_table = (14, 4, 9, 8, 12, 11, 13, 14, 15, 15); # 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
+our %color_team2dp_table = (5 => 1, 14 => 4, 13 => 3, 10 => 6);
+our %color_team2irc_table = (5 => 4, 14 => 12, 13 => 8, 10 => 13);
+sub color_irc2dp($)
+{
+ my ($message) = @_;
+ $message =~ s/\^/^^/g;
+ my $color = 7;
+ $message =~ s{\003(\d\d?)(?:,(\d?\d?))?|(\017)}{
+ # $1 is FG, $2 is BG, but let's ignore BG
+ my $oldcolor = $color;
+ if($3)
+ {
+ $color = 7;
+ }
+ else
+ {
+ $color = $color_irc2dp_table[$1];
+ $color = $oldcolor if not defined $color;
+ }
+ ($color == $oldcolor) ? '' : '^' . $color;
+ }esg;
+ $message =~ s{[\000-\037]}{}gs; # kill bold etc. for now
+ return $message;
+}
+
+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', '.', '<', '=', '>',
+ ' ', '!', '"', '#', '$', '%', '&', '\'',
+ '(', ')', '*', '+', ',', '-', '.', '/',
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', ':', ';', '<', '=', '>', '?',
+ '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+ 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
+ 'X', 'Y', 'Z', '[', '\\', ']', '^', '_',
+ '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
+ 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
+ 'x', 'y', 'z', '{', '|', '}', '~', '<',
+ '<', '=', '>', '#', '#', '.', '#', '#',
+ '#', '#', ' ', '#', ' ', '>', '.', '.',
+ '[', ']', '0', '1', '2', '3', '4', '5',
+ '6', '7', '8', '9', '.', '<', '=', '>',
+ ' ', '!', '"', '#', '$', '%', '&', '\'',
+ '(', ')', '*', '+', ',', '-', '.', '/',
+ '0', '1', '2', '3', '4', '5', '6', '7',
+ '8', '9', ':', ';', '<', '=', '>', '?',
+ '@', 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+ 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
+ 'X', 'Y', 'Z', '[', '\\', ']', '^', '_',
+ '`', 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
+ 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
+ 'x', 'y', 'z', '{', '|', '}', '~', '<'
+);
+sub text_dp2ascii($)
+{
+ my ($message) = @_;
+ $message = join '', map { $text_qfont_table[ord $_] } split //, $message;
+}
+
+sub color_dp2none($)
+{
+ my ($message) = @_;
+ my $color = -1;
+ $message =~ s{\^(.)(?=([0-9,]?))}{
+ my $c = $1;
+ $c eq '^' ? '^' :
+ $c =~ /^[0-9]$/ ? '' : "^$c";
+ }esg;
+ return text_dp2ascii $message;
+}
+
+sub color_dp2irc($)
+{
+ my ($message) = @_;
+ my $color = -1;
+ $message =~ s{\^(.)(?=([0-9,]?))}{
+ my $c = $1;
+ my $f = $2;
+ $c eq '^' ? '^' :
+ $c =~ /^[0-9]$/ ? do {
+ my $oldcolor = $color;
+ $c = 0 if $c >= 7; # map 0, 7, 8, 9 to default (no bright white or such stuff)
+ $color = $color_dp2irc_table[$c];
+ ($color == $oldcolor) ? '' :
+ $c == 0 ? "\0001" :
+ $f eq ',' ? "\0003$color\0002\0002" :
+ $f ne '' ? sprintf "\0003%02d", $color : "\0003$color";
+ } : "^$c";
+ }esg;
+ $message = text_dp2ascii $message;
+ $message =~ s/\0001/\017/g;
+ $message =~ s/\0002/\002/g;
+ $message =~ s/\0003/\003/g;
+ return $message;
+}
+
+sub color_dp2ansi($)
+{
+ my ($message) = @_;
+ my $color = -1;
+ $message =~ s{\^(.)}{
+ my $c = $1;
+ $c eq '^' ? '^' :
+ $c =~ /^[0-9]$/ ? do {
+ my $oldcolor = $color;
+ $color = $color_dp2ansi_table[$c];
+ ($color == $oldcolor) ? '' :
+ "\000[${color}" # "
+ } : "^$c";
+ }esg;
+ $message = text_dp2ascii $message;
+ $message =~ s/\000/\033/g;
+ return $message;
+}
+
+sub color_dpfix($)
+{
+ my ($message) = @_;
+ # if the message ends with an odd number of ^, kill one
+ chop $message if $message =~ /(?:^|[^\^])\^(\^\^)*$/;
+ return $message;
+}
+
+
+
+# Nexuiz specific parsing of some server messages
+
+sub nex_is_teamplay($)
+{
+ my ($map) = @_;
+ return $map =~ /^(?:kh|ctf|tdm|dom)_/;
+}
+
+sub nex_slotsstring()
+{
+ my $slotsstr = "";
+ if(defined $store{slots_max})
+ {
+ 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};
+ $slotsstr .= "; join now: \002nexuiz +connect $s"
+ if $slots >= 1 and not $store{lms_blocked};
+ }
+ return $slotsstr;
+}
+
+
+
+# Do we have a config file? If yes, read and parse it (syntax: key = value
+# pairs, separated by newlines), if not, complain.
+die "Usage: $0 configfile\n"
+ unless @ARGV == 1;
+
+open my $fh, "<", $ARGV[0]
+ or die "open $ARGV[0]: $!";
+while(<$fh>)
+{
+ chomp;
+ /^#/ and next;
+ /^(.*?)\s+=(?:\s+(.*))?$/ or next;
+ warn "Undefined config item: $1"
+ unless exists $config{$1};
+ $config{$1} = defined $2 ? $2 : "";
+}
+close $fh;
+my @missing = grep { !defined $config{$_} } keys %config;
+die "The following config items are missing: @missing"
+ if @missing;
+
+
+
+# Create a channel for error messages and other internal status messages...
+
+$channels{system} = new Channel::FIFO();
+
+# for example, quit messages caused by signals (if SIGTERM or SIGINT is first
+# received, try to shut down cleanly, and if such a signal is received a second
+# time, just exit)
+my $quitting = 0;
+$SIG{INT} = sub {
+ exit 1 if $quitting++;
+ $channels{system}->send("quit SIGINT");
+};
+$SIG{TERM} = sub {
+ exit 1 if $quitting++;
+ $channels{system}->send("quit SIGTERM");
+};
+
+
+
+# Create the two channels to gateway between...
+
+$channels{irc} = new Channel::Line(new Connection::Socket(tcp => "" => $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_listen} = $dpsock->sockname();
+print "Listening on $config{dp_listen}\n";
+
+
+
+# Utility routine to write to a channel by name, also outputting what's been written and some status
+sub out($$@)
+{
+ my $chanstr = shift;
+ my $nothrottle = shift;
+ my $chan = $channels{$chanstr};
+ if(!$chan)
+ {
+ print "UNDEFINED: $chanstr, ignoring message\n";
+ return;
+ }
+ @_ = $chan->join_commands(@_);
+ for(@_)
+ {
+ my $result = $chan->send($_, $nothrottle);
+ if($result > 0)
+ {
+ print " $chanstr << $_\n";
+ }
+ elsif($result < 0)
+ {
+ print "FLOOD: $chanstr << $_\n";
+ }
+ else
+ {
+ print "ERROR: $chanstr << $_\n";
+ $channels{system}->send("error $chanstr", 0);
+ }
+ }
+}
+
+
+
+# Schedule a task for later execution by the main loop; usage: schedule sub {
+# task... }, $time; When a scheduled task is run, a reference to the task's own
+# sub is passed as first argument; that way, the task is able to re-schedule
+# itself so it gets periodically executed.
+sub schedule($$)
+{
+ my ($sub, $time) = @_;
+ push @tasks, [time() + $time, $sub];
+}
+
+# Build up an IO::Select object for all our channels.
+my $s = IO::Select->new();
+for my $chan(values %channels)
+{
+ $s->add($_) for $chan->fds();
+}
+
+# On IRC error, delete some data store variables of the connection, and
+# reconnect to the IRC server soon (but only if someone is actually playing)
+sub irc_error()
+{
+ # prevent multiple instances of this timer
+ return if $store{irc_error_active};
+ $store{irc_error_active} = 1;
+
+ delete $channels{irc};
+ schedule sub {
+ my ($timer) = @_;
+ if(!defined $store{slots_full})
+ {
+ # DP is not running, then delay IRC reconnecting
+ #use Data::Dumper; print Dumper \$timer;
+ schedule $timer => 1;;
+ return;
+ # this will keep irc_error_active
+ }
+ $channels{irc} = new Channel::Line(new Connection::Socket(tcp => "" => $config{irc_server}));
+ delete $store{$_} for grep { /^irc_/ } keys %store;
+ $store{irc_nick} = "";
+ schedule sub {
+ my ($timer) = @_;
+ out dp => 0, 'status', 'log_dest_udp';
+ } => 1;
+ # this will clear irc_error_active
+ } => 30;
+ return 0;
+}
+
+# IRC joining (if this is called as response to a nick name collision, $is433 is set);
+# among other stuff, it performs NickServ or Quakenet authentication. This is to be called
+# until the channel has been joined for every message that may be "interesting" (basically,
+# IRC 001 hello messages, 443 nick collision messages and some notices by services).
+sub irc_joinstage($)
+{
+ my($is433) = @_;
+
+ return 0
+ if $store{irc_joined_channel};
+
+ #use Data::Dumper; print Dumper \%store;
+
+ if($is433)
+ {
+ if(length $store{irc_nick})
+ {
+ # we already have another nick, but couldn't change to the new one
+ # try ghosting and then get the nick again
+ if(length $config{irc_nickserv_password})
+ {
+ if(++$store{irc_nickserv_ghost_attempts} <= $config{irc_nickserv_ghost_attempts})
+ {
+ $store{irc_nick_requested} = $config{irc_nick};
+ out irc => 1, sprintf($config{irc_nickserv_ghost}, $config{irc_nick}, $config{irc_nickserv_password});
+ schedule sub {
+ out irc => 1, "NICK $config{irc_nick}";
+ } => 1;
+ return; # we'll get here again for the NICK success message, or for a 433 failure
+ }
+ # otherwise, we failed to ghost and will continue with the wrong
+ # nick... also, no need to try to identify here
+ }
+ # otherwise, we can't handle this and will continue with our wrong nick
+ }
+ else
+ {
+ # we failed to get an initial nickname
+ # change ours a bit and try again
+ if(length $store{irc_nick_requested} < 9)
+ {
+ $store{irc_nick_requested} .= '_';
+ }
+ else
+ {
+ substr $store{irc_nick_requested}, int(rand length $store{irc_nick_requested}), 1, chr(97 + int rand 26);
+ }
+ out irc => 1, "NICK $store{irc_nick_requested}";
+ return; # when it fails, we'll get here again, and when it succeeds, we will continue
+ }
+ }
+
+ # we got a 001 or a NICK message, so $store{irc_nick} has been updated
+ if(length $config{irc_nickserv_password})
+ {
+ if($store{irc_nick} eq $config{irc_nick})
+ {
+ # identify
+ out irc => 1, sprintf($config{irc_nickserv_identify}, $config{irc_nick}, $config{irc_nickserv_password});
+ }
+ else
+ {
+ # ghost
+ if(++$store{irc_nickserv_ghost_attempts} <= $config{irc_nickserv_ghost_attempts})
+ {
+ $store{irc_nick_requested} = $config{irc_nick};
+ out irc => 1, sprintf($config{irc_nickserv_ghost}, $config{irc_nick}, $config{irc_nickserv_password});
+ schedule sub {
+ out irc => 1, "NICK $config{irc_nick}";
+ } => 1;
+ return; # we'll get here again for the NICK success message, or for a 433 failure
+ }
+ # otherwise, we failed to ghost and will continue with the wrong
+ # nick... also, no need to try to identify here
+ }
+ }
+
+ # we are on Quakenet. Try to authenticate.
+ if(length $config{irc_quakenet_password} and length $config{irc_quakenet_authname})
+ {
+ if(defined $store{irc_quakenet_challenge})
+ {
+ if($store{irc_quakenet_challenge} =~ /^MD5 (.*)/)
+ {
+ out irc => 1, "$config{irc_quakenet_challengeauth} $config{irc_quakenet_authname} " . Digest::MD5::md5_hex("$config{irc_quakenet_password} $1");
+ }
+ }
+ else
+ {
+ out irc => 1, $config{irc_quakenet_getchallenge};
+ return;
+ # we get here again when Q asks us
+ }
+ }
+
+ # if we get here, we are on IRC
+ $store{irc_joined_channel} = 1;
+ schedule sub {
+ out irc => 1, "JOIN $config{irc_channel}";
+ } => 1;
+ return 0;
+}
+
+
+
+# List of all handlers on the various sockets. Additional handlers can be added by a plugin.
+ at handlers = (
+ # detect a server restart and set it up again
+ [ dp => q{ *(?:Warning: Could not expand \$|Unknown command ")(?:rcon2irc_[a-z0-9_]*)[" ]*} => sub {
+ out dp => 0,
+ 'alias rcon2irc_eval "$*"',
+ 'log_dest_udp',
+ 'sv_logscores_console 0',
+ 'sv_logscores_bots 1',
+ 'sv_eventlog 1',
+ 'sv_eventlog_console 1',
+ 'alias rcon2irc_say_as "set say_as_restorenick \"$sv_adminnick\"; sv_adminnick \"$1^3\"; say \"^7$2\"; rcon2irc_say_as_restore"',
+ 'alias rcon2irc_say_as_restore "set sv_adminnick \"$say_as_restorenick\""',
+ 'alias rcon2irc_quit "echo \"quitting rcon2irc $1: log_dest_udp is $log_dest_udp\""'; # note: \\\\\\" ->perl \\\" ->console \"
+ return 0;
+ } ],
+
+ # detect missing entry in log_dest_udp and fix it
+ [ 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;
+ } ],
+
+ # retrieve hostname from status replies
+ [ dp => q{host: (.*)} => sub {
+ my ($name) = @_;
+ $store{dp_hostname} = $name;
+ return 0;
+ } ],
+
+ # retrieve version from status replies
+ [ dp => q{version: (.*)} => sub {
+ my ($version) = @_;
+ $store{dp_version} = $version;
+ return 0;
+ } ],
+
+ # retrieve number of open player slots
+ [ dp => q{players: (\d+) active \((\d+) max\)} => sub {
+ my ($active, $max) = @_;
+ my $full = ($active >= $max);
+ $store{slots_max} = $max;
+ $store{slots_active} = $active;
+ if($full != ($store{slots_full} || 0))
+ {
+ $store{slots_full} = $full;
+ return 0
+ if $store{lms_blocked};
+ if($full)
+ {
+ out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION is full!\001";
+ }
+ else
+ {
+ my $slotsstr = nex_slotsstring();
+ out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION can be joined again$slotsstr!\001";
+ }
+ }
+ return 0;
+ } ],
+
+ # LMS: detect "no more lives" message
+ [ dp => q{\^4.*\^4 has no more lives left} => sub {
+ if(!$store{lms_blocked})
+ {
+ $store{lms_blocked} = 1;
+ if(!$store{slots_full})
+ {
+ schedule sub {
+ if($store{lms_blocked})
+ {
+ out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION can't be joined until next round (a player has no more lives left)\001";
+ }
+ } => 1;
+ }
+ }
+ } ],
+
+ # detect IRC errors and reconnect
+ [ irc => q{ERROR .*} => \&irc_error ],
+ [ system => q{error irc} => \&irc_error ],
+
+ # IRC nick in use
+ [ irc => q{:[^ ]* 433 .*} => sub {
+ return irc_joinstage(433);
+ } ],
+
+ # IRC welcome
+ [ irc => q{:[^ ]* 001 .*} => sub {
+ $store{irc_seen_welcome} = 1;
+ $store{irc_nick} = $store{irc_nick_requested};
+ return irc_joinstage(0);
+ } ],
+
+ # IRC my nickname changed
+ [ irc => q{:(?i:(??{$store{irc_nick}}))![^ ]* (?i:NICK) :(.*)} => sub {
+ my ($n) = @_;
+ $store{irc_nick} = $n;
+ return irc_joinstage(0);
+ } ],
+
+ # Quakenet: challenge from Q
+ [ irc => q{(??{$config{irc_quakenet_challengeprefix}}) (.*)} => sub {
+ $store{irc_quakenet_challenge} = $1;
+ return irc_joinstage(0);
+ } ],
+
+ # shut down everything on SIGINT
+ [ system => q{quit (.*)} => sub {
+ my ($cause) = @_;
+ out irc => 1, "QUIT :$cause";
+ $store{quitcookie} = int rand 1000000000;
+ out dp => 0, "rcon2irc_quit $store{quitcookie}";
+ } ],
+
+ # 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;
+ out dp => 0, 'log_dest_udp "' . join(" ", @dests) . '"';
+ exit 0;
+ return 0;
+ } ],
+
+ # IRC PING
+ [ irc => q{PING (.*)} => sub {
+ my ($data) = @_;
+ out irc => 1, "PONG $data";
+ return 1;
+ } ],
+
+ # IRC PONG
+ [ irc => q{:[^ ]* PONG .* :(.*)} => sub {
+ my ($data) = @_;
+ return 0
+ if not defined $store{irc_pingtime};
+ return 0
+ if $data ne $store{irc_pingtime};
+ print "* measured IRC line delay: @{[time() - $store{irc_pingtime}]}\n";
+ undef $store{irc_pingtime};
+ return 0;
+ } ],
+
+ # detect channel join message and note hostname length to get the maximum allowed line length
+ [ irc => q{(:(?i:(??{$store{irc_nick}}))![^ ]* )(?i:JOIN) :(?i:(??{$config{irc_channel}}))} => sub {
+ $store{irc_maxlen} = 510 - length($1);
+ $store{irc_joined_channel} = 1;
+ print "* detected maximum line length for channel messages: $store{irc_maxlen}\n";
+ return 0;
+ } ],
+
+ # chat: Nexuiz server -> IRC channel
+ [ dp => q{\001(.*?)\^7: (.*)} => sub {
+ my ($nick, $message) = map { color_dp2irc $_ } @_;
+ out irc => 0, "PRIVMSG $config{irc_channel} :<$nick\017> $message";
+ return 0;
+ } ],
+
+ # chat: IRC channel -> Nexuiz server
+ [ irc => q{:([^! ]*)![^ ]* (?i:PRIVMSG) (?i:(??{$config{irc_channel}})) :(?i:(??{$store{irc_nick}}))(?: |: ?)(.*)} => sub {
+ my ($nick, $message) = @_;
+ $nick = color_dpfix $nick;
+ # allow the nickname to contain colors in DP format! Therefore, NO color_irc2dp on the nickname!
+ $message = color_irc2dp $message;
+ $message =~ s/(["\\])/\\$1/g;
+ out dp => 0, "rcon2irc_say_as \"$nick on IRC\" \"$message\"";
+ return 0;
+ } ],
+
+ # irc: CTCP VERSION reply
+ [ irc => q{:([^! ]*)![^ ]* (?i:PRIVMSG) (?i:(??{$store{irc_nick}})) :\001VERSION( .*)?\001} => sub {
+ my ($nick) = @_;
+ my $ver = $store{dp_version} or return 0;
+ $ver .= ", rcon2irc $VERSION";
+ out irc => 0, "NOTICE $nick :\001VERSION $ver\001";
+ } ],
+
+ # on game start, notify the channel
+ [ dp => q{:gamestart:(.*):[0-9.]*} => sub {
+ my ($map) = @_;
+ $store{playing} = 1;
+ $store{map} = $map;
+ $store{map_starttime} = time();
+ my $slotsstr = nex_slotsstring();
+ out irc => 0, "PRIVMSG $config{irc_channel} :\00304" . $map . "\017 has begun$slotsstr";
+ delete $store{lms_blocked};
+ return 0;
+ } ],
+
+ # on game over, clear the current map
+ [ dp => q{:gameover} => sub {
+ $store{playing} = 0;
+ return 0;
+ } ],
+
+ # scores: Nexuiz server -> IRC channel (start)
+ [ dp => q{:scores:(.*):(\d+)} => sub {
+ my ($map, $time) = @_;
+ $store{scores} = {};
+ $store{scores}{map} = $map;
+ $store{scores}{time} = $time;
+ $store{scores}{players} = [];
+ delete $store{lms_blocked};
+ return 0;
+ } ],
+
+ # scores: Nexuiz server -> IRC channel
+ [ dp => q{:player:(-?\d+):(\d+):(\d+):(\d+):(\d+):(.*)} => sub {
+ my ($frags, $deaths, $time, $team, $id, $name) = @_;
+ return if not exists $store{scores};
+ push @{$store{scores}{players}}, [$frags, $team, $name]
+ unless $frags <= -666; # no spectators
+ return 0;
+ } ],
+
+ # scores: Nexuiz server -> IRC channel
+ [ dp => q{:end} => sub {
+ return if not exists $store{scores};
+ my $s = $store{scores};
+ delete $store{scores};
+ my $teams_matter = nex_is_teamplay($s->{map});
+
+ my @t = ();
+ my @p = ();
+
+ if($teams_matter)
+ {
+ # put players into teams
+ my %t = ();
+ for(@{$s->{players}})
+ {
+ my $thisteam = ($t{$_->[1]} ||= {score => 0, team => $_->[1], players => []});
+ push @{$thisteam->{players}}, [$_->[0], $_->[1], $_->[2]];
+ $thisteam->{score} += $_->[0];
+ }
+
+ # sort by team score
+ @t = sort { $b->{score} <=> $a->{score} } values %t;
+
+ # sort by player score
+ @p = ();
+ for(@t)
+ {
+ @{$_->{players}} = sort { $b->[0] <=> $a->[0] } @{$_->{players}};
+ push @p, @{$_->{players}};
+ }
+ }
+ else
+ {
+ @p = sort { $b->[0] <=> $a->[0] } @{$s->{players}};
+ }
+
+ # no display for empty server
+ return 0
+ if !@p;
+
+ # make message fit somehow
+ for my $maxnamelen(reverse 3..64)
+ {
+ my $scores_string = "PRIVMSG $config{irc_channel} :\00304" . $s->{map} . "\017 ended:";
+ if($teams_matter)
+ {
+ my $sep = ' ';
+ for(@t)
+ {
+ $scores_string .= $sep . sprintf "\003%02d\%d\017", $color_team2irc_table{$_->{team}}, $_->{score};
+ $sep = ':';
+ }
+ }
+ my $sep = '';
+ for(@p)
+ {
+ my ($frags, $team, $name) = @$_;
+ $name = color_dpfix substr($name, 0, $maxnamelen);
+ if($teams_matter)
+ {
+ $name = "\003" . $color_team2irc_table{$team} . " " . color_dp2none $name;
+ }
+ else
+ {
+ $name = " " . color_dp2irc $name;
+ }
+ $scores_string .= "$sep$name\017 $frags";
+ $sep = ',';
+ }
+ if(length($scores_string) <= ($store{irc_maxlen} || 256))
+ {
+ out irc => 0, $scores_string;
+ return 0;
+ }
+ }
+ out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION would have LIKED to put the scores here, but they wouldn't fit :(\001";
+ return 0;
+ } ],
+);
+
+
+
+# Load plugins and add them to the handler list in the front.
+for my $p(split ' ', $config{plugins})
+{
+ my @h = eval { do $p; }
+ or die "Invalid plugin $p: $@";
+ for(reverse @h)
+ {
+ ref $_ eq 'ARRAY' or die "Invalid plugin $p: did not return a list of arrays";
+ @$_ == 3 or die "Invalid plugin $p: did not return a list of three-element arrays";
+ !ref $_->[0] && !ref $_->[1] && ref $_->[2] eq 'CODE' or die "Invalid plugin $p: did not return a list of string-string-sub arrays";
+ unshift @handlers, $_;
+ }
+}
+
+
+
+# verify that the server is up by letting it echo back a string that causes
+# re-initialization of the required aliases
+out dp => 0, 'echo "Unknown command \"rcon2irc_eval\""'; # assume the server has been restarted
+
+
+
+# regularily, query the server status and if it still is connected to us using
+# the log_dest_udp feature. If not, we will detect the response to this rcon
+# command and re-initialize the server's connection to us (either by log_dest_udp
+# not containing our own IP:port, or by rcon2irc_eval not being a defined command).
+schedule sub {
+ my ($timer) = @_;
+ out dp => 0, 'status', 'log_dest_udp', 'rcon2irc_eval set dummy 1';
+ schedule $timer => (exists $store{dp_hostname} ? $config{dp_status_delay} : 1);;
+} => 1;
+
+
+
+# Continue with connecting to IRC as soon as we get our first status reply from
+# the DP server (which contains the server's hostname that we'll use as
+# realname for IRC).
+schedule sub {
+ my ($timer) = @_;
+
+ # log on to IRC when needed
+ if(exists $store{dp_hostname} && !exists $store{irc_logged_in})
+ {
+ $store{irc_nick_requested} = $config{irc_nick};
+ out irc => 1, "NICK $config{irc_nick}", "USER $config{irc_user} localhost localhost :$store{dp_hostname}";
+ $store{irc_logged_in} = 1;
+ undef $store{irc_maxlen};
+ undef $store{irc_pingtime};
+ }
+
+ schedule $timer => 1;;
+} => 1;
+
+
+
+# Regularily ping the IRC server to detect if the connection is down. If it is,
+# schedule an IRC error that will cause reconnection later.
+schedule sub {
+ my ($timer) = @_;
+
+ if($store{irc_logged_in})
+ {
+ if(defined $store{irc_pingtime})
+ {
+ # IRC connection apparently broke
+ # so... KILL IT WITH FIRE
+ channels{system}->send("error irc", 0);
+ }
+ else
+ {
+ # everything is fine, send a new ping
+ $store{irc_pingtime} = time();
+ out irc => 1, "PING $store{irc_pingtime}";
+ }
+ }
+
+ schedule $timer => $config{irc_ping_delay};;
+} => 1;
+
+
+
+# Main loop.
+for(;;)
+{
+ # wait for something to happen on our sockets, or wait 2 seconds without anything happening there
+ $s->can_read(2);
+ my @errors = $s->has_exception(0);
+
+ # on every channel, look for incoming messages
+ CHANNEL:
+ for my $chanstr(keys %channels)
+ {
+ my $chan = $channels{$chanstr};
+ my @chanfds = $chan->fds();
+
+ for my $chanfd(@chanfds)
+ {
+ if(grep { $_ == $chanfd } @errors)
+ {
+ # STOP! This channel errored!
+ $channels{system}->send("error $chanstr", 0);
+ next CHANNEL;
+ }
+ }
+
+ for my $line($chan->recv())
+ {
+ # found one! Check if it matches the regular expression of one of
+ # our handlers...
+ my $handled = 0;
+ for my $h(@handlers)
+ {
+ my ($chanstr_wanted, $re, $sub) = @$h;
+ next
+ if $chanstr_wanted ne $chanstr;
+ use re 'eval';
+ my @matches = ($line =~ /^$re$/s);
+ no re 'eval';
+ next
+ unless @matches;
+ # and if it is a match, handle it.
+ ++$handled;
+ my $result = $sub->(@matches);
+ last
+ if $result;
+ }
+ # print the message, together with info on whether it has been handled or not
+ if($handled)
+ {
+ print " $chanstr >> $line\n";
+ }
+ else
+ {
+ print "unhandled: $chanstr >> $line\n";
+ }
+ }
+ }
+
+ # handle scheduled tasks...
+ my @t = @tasks;
+ my $t = time();
+ # by emptying the list of tasks...
+ @tasks = ();
+ for(@t)
+ {
+ my ($time, $sub) = @$_;
+ if($t >= $time)
+ {
+ # calling them if they are schedled for the "past"...
+ $sub->($sub);
+ }
+ else
+ {
+ # or re-adding them to the task list if they still are scheduled for the "future"
+ push @tasks, [$time, $sub];
+ }
+ }
+}
Property changes on: trunk/Docs/server/rcon2irc/rcon2irc.pl
___________________________________________________________________
Name: svn:executable
+ *
Added: trunk/Docs/server/rcon2irc/rcon2irc.txt
===================================================================
--- trunk/Docs/server/rcon2irc/rcon2irc.txt (rev 0)
+++ trunk/Docs/server/rcon2irc/rcon2irc.txt 2008-03-30 18:10:15 UTC (rev 3561)
@@ -0,0 +1,96 @@
+rcon2irc - IRC gateway for Nexuiz servers, using rcon authorization
+
+
+Quick installation guide:
+
+1. Set up rcon access on your Nexuiz server, by adding some line like
+ rcon_password hackme
+ in your server.cfg. This password gives anyone FULL access to your server,
+ so do not give it away! This IRC gateway does not work with a
+ rcon_restricted_password.
+
+2. Copy rcon2irc-example.conf to another name (e.g. rcon2irc.conf), and edit
+ the settings to match your setup. At the very least:
+ - change dp_server to the IP (or IP:port) of your Nexuiz server
+ - change dp_password to the rcon password set above
+ - change irc_server to the IRC server to connect to
+ - change irc_nick to the nick name to use
+ - change irc_channel to the channel to join
+
+3. Run it:
+ perl rcon2irc.pl rcon2irc.conf
+ You may possibly want to run it in nohup so you can disconnect from your ssh
+ connection, like this:
+ nohup perl rcon2irc.pl rcon2irc.conf &
+ Logging will then go to a file nohup.out in the same directory. Another way
+ to run it permanently and to see its output is to run it inside a screen(1).
+
+
+Features:
+
+- Show results of matches in the IRC channel
+
+- Act as a gateway to allow chat between Nexuiz server and IRC users, useful
+ for making the server more interesting to the public, but also useful as a
+ mere helper for the server admin to watch what's happening in game (like, if
+ people complain about a problem):
+ - Any line written in game using say (not say_team) goes to the IRC channel.
+ - Any line written in the channel, prefixed by the bot's nick name and a :,
+ goes into the Nexuiz game.
+ - Example:
+ View in game:
+ XSAX LTU: GREAT WIN AHAHAHAHAHAHAHAHAH))
+ (RedAlert) stop teamkilling!
+ .ThreeHeadedMonkey.: I am behind you!
+ View on IRC, assuming the IRC gateway has the nick noobNex and is voiced:
+ <+noobNex> <XSAX LTU> GREAT WIN AHAHAHAHAHAHAHAHAH))
+ <+noobNex> <.ThreeHeadedMonkey.> I am behind you!
+
+- Notify about free slots on the server. Example:
+ * noobNex is full!
+ * noobNex can be joined again (2 free slots); join now: nexuiz +connect 172.23.42.54!
+ <+noobNex> ctf_capturecity_v2r1 has begun (2 free slots); join now: nexuiz +connect 172.23.42.54
+
+- Display scores at the end of a match in the IRC channel. Example:
+ <+noobNex> ctf_capturecity_v2r1 ended: 301:78 Nicole 115, elsteer BLD {Y} 77,
+ CensoredNickname 57, 0grueN# 29, Bigus 23, ZeroA 36, ricer 22,
+ Treey at suse8 12, cZaR6RUSS7 8, BrightDev1l 0
+
+- Authenticate to the IRC services by Nickserv or Quakenet protocol, so the
+ server bot can be set up to always get voice when entering the channel, and
+ in case of Nickserv, make sure nobody else prevents it from using its
+ configured nick. Other authentication protocols can often be set up using
+ configuration, and if not, as plugin.
+
+- Support for /whois queries: the server hostname is put into the real name
+ field for /whois, so people can see how to find the server in the server
+ list.
+
+- Plugin interface for plugins written in Perl. See included rbiserver.pl for
+ an example.
+
+
+License:
+
+Copyright (c) 2008 Rudolf "divVerent" Polzer
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the "Software"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
Deleted: trunk/Docs/server/rcon2irc-0.4.1.tar.bz2
===================================================================
(Binary files differ)
More information about the nexuiz-commits
mailing list