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
  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($rsnick, main_conf_diag, '+o', $rsnick);
  66
  67 addhandler('SEOS', undef, undef, 'core::ev_connect', 1);
  68
  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         my ($src, $dst, $msg) = @_;
  78         my $user = { NICK => $src, AGENT => $rsnick };
  79         if(!adminserv::is_ircop($user)) {
  80                 notice($user, 'Access Denied');
  81                 ircd::globops($rsnick, "\002$src\002 failed access to $rsnick $msg");
  82                 return;
  83         }
  84         if($msg =~ /^lsmod/i) {
  85                 notice($user, main_conf_load);
  86         }
  87
  88         if($msg =~ /^shutdown/i) {
  89                 if(!adminserv::is_svsop($user, adminserv::S_ADMIN() )) {
  90                         notice($user, 'You do not have sufficient rank for this command');
  91                         return;
  92                 }
  93
  94                 main_shutdown;
  95         }
  96         if($msg =~ /^raw/i) {
  97                 if(!adminserv::is_svsop($user, adminserv::S_ROOT() )) {
  98                         notice($user, 'You do not have sufficient rank for this command');
  99                         return;
 100                 }
 101                 my $cmd = $msg;
 102                 $cmd =~ s/raw\s+//i;
 103                 ircsend($cmd);
 104         }
 105         if($msg =~ /^help$/) {
 106                 sendhelp($user, lc 'core');
 107                 return;
 108         }
 109         if(main::DEBUG and $msg =~ /^eval\s+(.*)/) {
 110                 my $out = eval($1);
 111                 notice($user, split(/\n/, $out.$@));
 112         }
 113 }
 114
 115 sub init { }
 116 sub begin { }
 117 sub end { }
 118 sub unload { }
 119
 120 1;