branches/0.5.0/SrSv/Agent.pm

   1 #       This file is part of SurrealServices.
   2 #
   3 #       SurrealServices is free software; you can redistribute it and/or modify
   4 #       it under the terms of the GNU General Public License as published by
   5 #       the Free Software Foundation; either version 2 of the License, or
   6 #       (at your option) any later version.
   7 #
   8 #       SurrealServices is distributed in the hope that it will be useful,
   9 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #       GNU General Public License for more details.
  12 #
  13 #       You should have received a copy of the GNU General Public License
  14 #       along with SurrealServices; if not, write to the Free Software
  15 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 package SrSv::Agent;
  18
  19 use strict;
  20
  21 use Exporter 'import';
  22 BEGIN { our @EXPORT = qw(
  23         is_agent is_agent_in_chan
  24         agent_connect agent_quit agent_quit_all
  25         agent_join agent_part set_agent_umode
  26         agent_sync is_invalid_agentname
  27 ); }
  28
  29 use SrSv::Process::InParent qw(
  30         is_agent is_agent_in_chan
  31         agent_connect agent_quit agent_quit_all
  32         agent_join agent_part agent_sync
  33         whois_callback kill_callback
  34 );
  35
  36 use SrSv::Conf2Consts qw(main);
  37
  38 use SrSv::Debug;
  39 use SrSv::Unreal::Tokens qw( :tokens );
  40 use SrSv::Unreal::Base64 qw(itob64);
  41 use SrSv::IRCd::State qw(synced $ircd_ready %IRCd_capabilities);
  42 use SrSv::IRCd::IO qw(ircsend ircsendimm );
  43 use SrSv::IRCd::Event qw(addhandler);
  44 use SrSv::IRCd::Validate qw(valid_nick);
  45 use SrSv::RunLevel 'main_shutdown';
  46 use SrSv::IRCd::Send;
  47 # FIXME
  48 BEGIN { *SJB64 = \&ircd::SJB64 }
  49 use Data::Dumper;
  50 our %agents;
  51 our @defer_join;
  52
  53 addhandler('WHOIS', undef(), undef(), 'whois_callback', 1);
  54 addhandler('KILL', undef(), undef(), 'kill_callback', 1);
  55
  56 sub is_agent($) {
  57         my ($nick) = @_;
  58         return (defined($agents{lc $nick}));
  59 }
  60
  61 sub is_agent_in_chan($$) {
  62         my ($agent, $chan) = @_;
  63         $agent = lc $agent; $chan = lc $chan;
  64
  65         if($agents{$agent} and $agents{$agent}{CHANS} and $agents{$agent}{CHANS}{$chan}) {
  66                 print "$agent is in $chan\n";
  67                 return 1;
  68         } else {
  69                 return 0;
  70         }
  71 }
  72 sub agent_connect($$$$$) {
  73         my ($nick, $ident, $host, $modes, $gecos) = @_;
  74         my $time = time();
  75
  76         my @chans;
  77         if(defined($agents{lc $nick}) and ref($agents{lc $nick}{CHANS})) {
  78                 @chans = keys(%{$agents{lc $nick}{CHANS}});
  79         }
  80
  81         $agents{lc $nick}{PARMS} = [ @_ ];
  82
  83         $host = main_conf_local unless $host;
  84         #ircsend("@{[TOK_NICK]} $nick 1 $time $ident $host ".
  85                 #(SJB64 ? itob64(main_conf_numeric) : main_conf_local).
  86                 #" 1 $modes * :$gecos");
  87         ircd::agent_doconn ($nick, $ident, $host, $modes, $gecos);
  88         foreach my $chan (@chans) {
  89                 ircsend(":$nick @{[TOK_JOIN]} $chan");
  90                 # If we tracked chanmodes for agents, that would go here as well.
  91         }
  92 }
  93
  94 sub agent_quit($$) {
  95         my ($nick, $msg) = @_;
  96
  97         delete($agents{lc $nick}{CHANS});
  98         delete($agents{lc $nick});
  99
 100         ircsendimm(":$nick @{[TOK_QUIT]} :$msg");
 101 }
 102
 103 sub agent_quit_all($) {
 104         my ($msg) = @_;
 105
 106         my @agents;
 107         @agents = keys(%agents);
 108
 109         foreach my $a (@agents) {
 110                 agent_quit($a, $msg);
 111         }
 112 }
 113
 114 sub is_invalid_agentname($$$) {
 115         my ($botnick, $botident, $bothost) = @_;
 116
 117         unless(valid_nick($botnick)) {
 118                 return "Invalid nickname.";
 119         }
 120         unless($botident =~ /^[[:alnum:]_]+$/) {
 121                 return "Invalid ident.";
 122         }
 123         unless($bothost =~ /^[[:alnum:].-]+$/) {
 124                 return "Invalid vhost.";
 125         }
 126         unless($bothost =~ /\./) {
 127                 return "A vhost must contain at least one dot.";
 128         }
 129         return undef;
 130 }
 131
 132
 133 sub agent_part($$$) {
 134         my ($agent, $chan, $reason) = @_;
 135         delete($agents{lc $agent}{CHANS}{lc $chan});
 136         ircd::agent_dopart ($agent, $chan, $reason);
 137 }
 138
 139 sub set_agent_umode($$) {
 140         my ($src, $modes) = @_;
 141
 142         ircsend(":$src @{[TOK_UMODE2]} $modes");
 143 }
 144 sub agent_join($$) {
 145         my ($agent, $chan) = @_;
 146         my $anick;
 147         if (ref ($agent) eq "HASH") {
 148                 $anick = $agent->{NICK};
 149         }
 150         else { $anick = $agent; }
 151         if($agents{lc $anick}) {
 152                 $agents{lc $anick}{CHANS}{lc $chan} = 1;
 153                 ircd::agent_dojoin($agent,$chan);
 154         }
 155 }
 156 sub agent_sync() {
 157         foreach my $j (@defer_join) {
 158                 print "Processing join: $j\n" if DEBUG;
 159                 my ($agent, $chan) = split(/ /, $j);
 160                 if($agents{lc $agent}) {
 161                         $agents{lc $agent}{CHANS}{lc $chan} = 1;
 162                         agent_join($agents{lc $agent}, $chan);
 163                 } else {
 164                         if($ircd_ready) {
 165                                 print "Tried to make nonexistent agent ($agent) join channel ($chan)" if DEBUG;
 166                         } else {
 167                                 print "Deferred join: $agent $chan\n" if DEBUG;
 168                                 push @defer_join, "$agent $chan";
 169                         }
 170                 }
 171         }
 172         undef(@defer_join);
 173 }
 174
 175 sub whois_callback {
 176 #:wyvern.surrealchat.net 311 blah2 tabris northman SCnet-E5870F84.dsl.klmzmi.ameritech.net * :Sponsored by Skuld
 177 #:wyvern.surrealchat.net 307 blah2 tabris :is a registered nick
 178 #:wyvern.surrealchat.net 312 blah2 tabris wyvern.surrealchat.net :SurrealChat - aphrodite.wcshells.com - Chicago.IL
 179 #:wyvern.surrealchat.net 671 blah2 tabris :is using a Secure Connection
 180 #:wyvern.surrealchat.net 317 blah2 tabris 54 1118217330 :seconds idle, signon time
 181 #:wyvern.surrealchat.net 401 blah2 nikanoru :No such nick/channel
 182 #:wyvern.surrealchat.net 311 blah2 somebot bot SCnet-DA158DBF.hsd1.nh.comcast.net * :Some sort of bot
 183 #:wyvern.surrealchat.net 312 blah2 somebot nascent.surrealchat.net :SurrealChat - Hub
 184 #:wyvern.surrealchat.net 335 blah2 somebot :is a Bot on SurrealChat.net
 185 #:wyvern.surrealchat.net 318 blah2 tabris,nikanoru,somebot :End of /WHOIS list.
 186
 187 # Also reference http://www.alien.net.au/irc/irc2numerics.html
 188
 189         my ($src, $nicklist) = @_;
 190
 191         my @nicks = split(/\,/, $nicklist);
 192         my @reply;
 193         foreach my $nick (@nicks) {
 194                 if (is_agent($nick)) {
 195                         my ($nick, $ident, $host, $modes, $gecos) = @{$agents{lc $nick}{PARMS}};
 196                         $host = main_conf_local unless $host;
 197                         push @reply, ':'.main_conf_local." 311 $src $nick $ident $host * :$gecos";
 198                         push @reply, ':'.main_conf_local." 312 $src $nick ".main_conf_local.' :'.main_conf_info;
 199                         foreach my $mode (split(//, $modes)) {
 200                                 if ($mode eq 'z') {
 201                                         push @reply, ':'.main_conf_local." 671 $src $nick :is using a Secure Connection";
 202                                 }
 203                                 elsif($mode eq 'S') {
 204                                         #313 tab ChanServ :is a Network Service
 205                                         push @reply, ':'.main_conf_local." 313 $src $nick :is a Network Service";
 206                                 }
 207                                 elsif($mode eq 'B') {
 208                                         #335 blah2 TriviaBot :is a Bot on SurrealChat.net
 209                                         push @reply, ':'.main_conf_local.
 210                                                 " 335 $src $nick :is a \002Bot\002 on ".$IRCd_capabilities{NETWORK};
 211                                 }
 212                         }
 213                 }
 214                 else {
 215                         push @reply, ':'.main_conf_local." 401 $src $nick :No such service";
 216                 }
 217
 218         }
 219         push @reply, ':'.main_conf_local." 318 $src $nicklist :End of /WHOIS list.";
 220         ircsend(@reply);
 221 }
 222
 223 sub kill_callback($$$$) {
 224         my ($srcUser, $dstUser, $path, $reason) = @_;
 225         my $src = $srcUser->{NICK};
 226         my $dst = $dstUser->{NICK};
 227         if (defined($agents{lc $dst})) {
 228                 if (defined ($agents{lc $dst}{KILLED}) and ($agents{lc $dst}{KILLED} == time())) {
 229                         if ($agents{lc $dst}{KILLCOUNT} > 3) {
 230                                 ircd::debug("Caught in a kill loop for $dst, dying now.");
 231                                 main_shutdown;
 232                         } else {
 233                                 $agents{lc $dst}{KILLCOUNT}++;
 234                         }
 235                 } else {
 236                         $agents{lc $dst}{KILLED} = time();
 237                         $agents{lc $dst}{KILLCOUNT} = 1;
 238                 }
 239
 240                 if($src =~ /\./) {
 241                         # let's NOT loopback this event
 242                         ircsendimm(':'.main_conf_local.' '."@{[TOK_KILL]} $dst :Nick Collision");
 243                 } elsif (defined($agents{lc $src})) {
 244                         # Do Nothing.
 245                 } else {
 246                         my $rsUser = {NICK=>$main::rsnick,ID=>"123AAAAAA"}; #FIXME - erry
 247                         ircd::irckill($rsUser, $srcUser, "Do not kill services agents.");
 248                 }
 249
 250                 &agent_connect(@{$agents{lc $dst}{PARMS}}) if synced();
 251         }
 252 }
 253
 254 1;