server/rcon2irc/rbiserver.pl

   1 sub out($$@);
   2
   3 sub markmap($$$$;$)
   4 {
   5         my ($state, $map, $pro, $total, $who) = @_;
   6         open my $fh, '>>', "$ENV{HOME}/.xonotic/__votelog.$config{irc_nick}.txt"
   7                 or die "votelog open: $!";
   8         print $fh "@{[time()]} $config{irc_nick} $state $map $pro $total" . (defined $who ? " $who" : "") . "\n";
   9         close $fh;
  10 }
  11
  12 # the AOL calendar
  13 [ dp => q{\001(.*?)\^7: d} => sub {
  14         my $aoltime = time() - 746748000;
  15         my $day = int($aoltime / 86400);
  16         my $wday = [qw[Tue Wed Thu Fri Sat Sun Mon]]->[$day % 7];
  17         my $hour = int($aoltime / 3600) % 24;
  18         my $minute = int($aoltime / 60) % 60;
  19         my $second = int($aoltime / 1) % 60;
  20         out dp => 0, sprintf 'rcon2irc_say_as "AOL service" "The time is %3s Sep %2d %02d:%02d:%02d 1993"',
  21                 $wday, $day, $hour, $minute, $second;
  22         return 1;
  23 } ],
  24
  25 # map vote logging
  26 [ dp => q{:vote:suggestion_accepted:(.*)} => sub {
  27         my ($map) = @_;
  28         markmap suggestion_accepted => $map, $store{rbi_winvotes}, $store{rbi_totalvotes};
  29         return 0;
  30 } ],
  31 [ dp => q{:vote:suggested:(.*?):\d+:(.*)} => sub {
  32         my ($map, $who) = @_;
  33         markmap suggested => $map, 1, 1, $who;
  34         return 0;
  35 } ],
  36 [ dp => q{\001\^2\* .*'s vote for \^1gotomap (.*)\^2 was accepted} => sub {
  37         my ($map) = @_;
  38         markmap voted => $map, 1, 1;
  39         return 0;
  40 } ],
  41 [ dp => q{\001\^2\* .*'s vote for \^1timelimit -1\^2 was accepted} => sub {
  42         markmap cancelled => $store{map}, 1, 1;
  43         return 0;
  44 } ],
  45 [ dp => q{:vote:(keeptwo|finished):(.*)} => sub {
  46         my ($status, $result) = @_;
  47         my @result = split /:/, $result;
  48         my $totalvotes = 0;
  49         my $cutoff = -1;
  50         my @allmaps = map
  51         {
  52                 $cutoff = $_ if $result[2*$_] eq '';
  53                 $totalvotes += int($result[2*$_+1] || 0);
  54                 [$result[2*$_], int($result[2*$_+1] || 0)]
  55         } 0..((@result-1)/2);
  56         die "Invalid vote result: $result" unless $cutoff >= 0;
  57         my @winners = @allmaps[0..($cutoff-1)];
  58         my @losers = @allmaps[($cutoff+1)..(@allmaps-1)];
  59         my $winvotes = 0;
  60         $winvotes += $_->[1] for @winners;
  61         if($status eq 'keeptwo')
  62         {
  63                 markmap irrelevant_relative => $_->[0], $winvotes, $totalvotes
  64                         for @losers;
  65         }
  66         elsif($status eq 'finished')
  67         {
  68                 markmap((@losers == 1 ? 'duel_winner' : 'winner_absolute') => $_->[0], $_->[1], $totalvotes)
  69                         for @winners;
  70                 markmap((@losers == 1 ? 'duel_loser' : 'irrelevant_absolute') => $_->[0], $winvotes, $totalvotes)
  71                         for @losers;
  72         }
  73         $store{rbi_winvotes} = $winvotes;
  74         $store{rbi_totalvotes} = $totalvotes;
  75         return 0;
  76 } ],
  77 [ dp => q{pure: -(\S+) (.*)} => sub {
  78         my ($status, $nick) = @_;
  79         $nick = color_dp2irc $nick;
  80         out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION thinks $nick is $status\001"
  81                 unless $status eq 'MODIFIED'; # in this case, either DETAIL_TIMEOUT or DETAIL_MISMATCH follows
  82         return 0;
  83 } ],
  84 [ dp => q{pure: \*DETAIL_MISMATCH (.*) (\S+)$} => sub {
  85         my ($nick, $file) = @_;
  86         $nick = color_dp2irc $nick;
  87         out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION thinks $nick has a modified $file\001";
  88         return 0;
  89 } ],
  90 [ dp => q{pure: \*DETAIL_TIMEOUT (.*)} => sub {
  91         my ($nick) = @_;
  92         $nick = color_dp2irc $nick;
  93         out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION thinks $nick refuses to tell us which file is modified\001";
  94         return 0;
  95 } ],
  96 [ dp => q{pure: \*DETAIL_CVAR (.*) (\S+) (.*)$} => sub {
  97         my ($nick, $cvar, $value) = @_;
  98         $nick = color_dp2irc $nick;
  99         out irc => 0, "PRIVMSG $config{irc_channel} :\001ACTION thinks $nick has changed $cvar to $value\001";
 100         return 0;
 101 } ],
 102 [ dp => q{:recordset:(\d+):.*} => sub {
 103         my ($id) = @_;
 104         my $ip = $store{"playerip_byid_$id"};
 105         my $slot = $store{"playerslot_byid_$id"};
 106         my $name = $config{irc_nick};
 107         $name =~ s/Xon//; # haggerXonCTF -> haggerCTF
 108         $name =~ s/^rm/hagger/g; # rmRace -> haggerRace
 109         my $map = $store{map};
 110         $map =~ s/^[a-z]*_//;
 111         $ip =~ s/\./-/g;
 112         my $pattern = "/home/xonotic/home-$name/data/sv_autodemos/????-??-??_??-??_${map}_${slot}_${ip}-*.dem";
 113         if(my @result = glob $pattern)
 114         {
 115                 for(@result)
 116                 {
 117                         my @l = stat $_;
 118                         next if $l[9] < time() - 60; # too old
 119                         print "Cleaning up demos: protecting $_\n";
 120                         chmod 0444, $_;
 121                         open my $fh, ">", "$_.nick";
 122                         printf $fh "%s\n", color_dp2none($store{"playernickraw_byid_$id"});
 123                         close $fh;
 124                         chmod 0444, "$_.nick";
 125                 }
 126         }
 127         else
 128         {
 129                 print "Record set but could not find the demo using $pattern\n";
 130         }
 131         return 0;
 132 } ],
 133 # delete demos at the end of the match
 134 [ dp => q{:end} => sub {
 135         my $name = $config{irc_nick};
 136         $name =~ s/Xon//; # haggerXonCTF -> haggerCTF
 137         my $pattern = "/home/xonotic/data/home-$name/data/sv_autodemos/*.dem";
 138         print "Checking $pattern...\n";
 139         for(glob $pattern)
 140         {
 141                 next if not -w $_;   # protected demo (by record, or other markers)
 142                 my @l = stat $_;
 143                 next if $l[9] >= time() - 60; # too new
 144                 print "Cleaning up demos: deleting $_\n";
 145                 unlink $_;
 146         }
 147         return 0;
 148 } ],