branches/0.5.0/modules/core.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 package core;
  17 use strict;
  18
  19 #use SrSv::Conf 'main';
  20 use SrSv::Conf2Consts 'main';
  21 use SrSv::RunLevel 'main_shutdown';
  22 use SrSv::IRCd::Event 'addhandler';
  23 use SrSv::IRCd::IO 'ircsend';
  24 use SrSv::Timer 'add_timer';
  25 use SrSv::Time 'time_rel_long_all';
  26 use SrSv::Agent;
  27 use SrSv::Process::Init; #FIXME - only needed for ccode
  28 use SrSv::User::Notice;
  29 use SrSv::Help;
  30
  31 my $startTime = time();
  32
  33 our %ccode; #FIXME - Split out
  34 proc_init {
  35         open ((my $COUNTRY), main::PREFIX()."/data/country-codes.txt");
  36         while(my $x = <$COUNTRY>) {
  37                 chomp $x;
  38                 my($code, $country) = split(/   /, $x);
  39                 $ccode{uc $code} = $country;
  40         }
  41         close $COUNTRY;
  42 };
  43
  44 our $rsnick = 'ServServ';
  45 our $rsUser = { NICK => $rsnick, ID => ircd::getAgentUuid($rsnick) };
  46 addhandler('STATS', undef, undef, 'core::stats');
  47 sub stats($$) {
  48         my ($src, $token) = @_;
  49         if($token eq 'u') {
  50                 ircsend('242 '.$src.' :Server up '.time_rel_long_all($startTime),
  51                         '219 '.$src.' u :End of /STATS report')
  52         }
  53 }
  54
  55 addhandler('PING', undef, undef, 'ircd::pong', 1);
  56
  57 sub pingtimer($) {
  58         ircd::ping();
  59         add_timer('perlserv__pingtimer', 60, __PACKAGE__,
  60                         "core::pingtimer");
  61 }
  62
  63 agent_connect($rsnick, 'service', undef, '+ABHSNaopqz', 'Services Control Agent');
  64 agent_join($rsnick, main_conf_diag);
  65 ircd::setmode($rsUser, main_conf_diag, '+o', $rsUser );
  66
  67 addhandler('SEOS', undef, undef, 'core::ev_connect', 1);
  68 addhandler('ENDBURST', undef, undef, 'core::ev_connect', 1);
  69 sub ev_connect {
  70         add_timer('perlserv__pingtimer', 60, __PACKAGE__,
  71                         "core::pingtimer");
  72 }
  73
  74 addhandler('PRIVMSG', undef, 'servserv', 'core::dispatch', 1);
  75
  76 sub dispatch {
  77         our $rsUser = { NICK => $rsnick, ID => ircd::getAgentUuid($rsnick) };
  78         my ($user, $dstUser, $msg) = @_;
  79         return unless (lc $dstUser->{NICK} eq lc $rsnick);
  80         $user->{AGENT} = $rsUser;
  81         my $src = $user->{NICK};
  82         my $dst = $dstUser->{NICK};
  83         if(!adminserv::is_ircop($user)) {
  84                 notice($user, 'Access Denied');
  85                 ircd::globops($rsnick, "\002$src\002 failed access to $rsnick $msg");
  86                 return;
  87         }
  88         if($msg =~ /^lsmod/i) {
  89                 notice($user, main_conf_load);
  90         }
  91
  92         if($msg =~ /^shutdown/i) {
  93                 if(!adminserv::is_svsop($user, adminserv::S_ADMIN() )) {
  94                         notice($user, 'You do not have sufficient rank for this command');
  95                         return;
  96                 }
  97
  98                 main_shutdown;
  99         }
 100         if($msg =~ /^raw/i) {
 101                 if(!adminserv::is_svsop($user, adminserv::S_ROOT() )) {
 102                         notice($user, 'You do not have sufficient rank for this command');
 103                         return;
 104                 }
 105                 my $cmd = $msg;
 106                 $cmd =~ s/raw\s+//i;
 107                 print "$cmd\n";
 108                 ircsend($cmd);
 109         }
 110         if($msg =~ /^help$/) {
 111                 sendhelp($user, lc 'core');
 112                 return;
 113         }
 114         if(main::DEBUG and $msg =~ /^eval\s+(.*)/) {
 115                 my $out = eval($1);
 116                 notice($user, split(/\n/, $out.$@));
 117         }
 118 }
 119
 120 sub init { $rsUser = { NICK => $rsnick, ID => ircd::getAgentUuid($rsnick) };}
 121 sub begin { }
 122 sub end { }
 123 sub unload { }
 124
 125 1;