branches/erry-devel/modules/country.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 #       Copyright tabris@surrealchat.net (C) 2005
  18 package country;
  19
  20 use strict;
  21
  22 use SrSv::MySQL '$dbh';
  23 use SrSv::Process::Init;
  24 use SrSv::IRCd::Event 'addhandler';
  25 use SrSv::IRCd::State 'initial_synced';
  26
  27 use SrSv::Log;
  28
  29 use SrSv::Shared qw(%unwhois);
  30
  31 use SrSv::User qw(get_user_id);
  32
  33 addhandler('USERIP', undef, undef, 'userip');
  34 addhandler('NICKCONN', undef, undef, 'nickconn');
  35
  36 our ($get_ip_country, $get_ip_country_aton, $get_user_country);
  37
  38 proc_init {
  39         $get_ip_country = $dbh->prepare_cached("SELECT country FROM country WHERE
  40                 ? BETWEEN low AND high");
  41         $get_ip_country_aton = $dbh->prepare_cached("SELECT country FROM country WHERE
  42                 INET_ATON(?) BETWEEN low AND high");
  43         $get_user_country = $dbh->prepare_cached("SELECT country FROM country, user WHERE
  44                 user.ip BETWEEN low AND high and user.id=?");
  45 };
  46
  47 sub get_ip_country($) {
  48         my ($ip) = @_;
  49
  50         $get_ip_country->execute($ip);
  51         my ($country) = $get_ip_country->fetchrow_array();
  52         $get_ip_country->finish();
  53
  54         return $country;
  55 }
  56
  57 sub get_ip_country_aton($) {
  58 # IP is expected to be a dotted quad string!
  59         my ($ip) = @_;
  60
  61         $get_ip_country_aton->execute($ip);
  62         my ($country) = $get_ip_country_aton->fetchrow_array();
  63         $get_ip_country_aton->finish();
  64         #my ($country)= $dbh->selectrow_array(
  65         #       "SELECT `country` FROM `country` WHERE `low` < INET_ATON('$ip') AND `high` > INET_ATON('$ip')");
  66         #$dbh->finish();
  67
  68         return $country;
  69 }
  70
  71 sub get_user_country($) {
  72 # Preferred to use this if you have a $user hash and you've set the IP.
  73 # it should return undef in the case of user.ip == 0
  74 # do check this case in the caller before assuming the return value is valid.
  75         my ($user) = @_;
  76
  77         $get_user_country->execute(get_user_id($user));
  78         my ($country) = $get_user_country->fetchrow_array();
  79         $get_user_country->finish();
  80
  81         return $country;
  82 }
  83
  84 sub get_country_long($) {
  85 # I'd prefer that this be used by the callers of get_user_country()
  86 # If they need the long country name,
  87 # they can use country::get_country_long(country::get_user_country($user))
  88 # that way the get_{user,ip}_country functions get back an easily parsed value.
  89         my ($country) = @_;
  90         $country = uc $country;
  91
  92         my $cname = $core::ccode{$country};
  93         $country .= " ($cname)" if $cname;
  94
  95         return $country if $cname;
  96         return 'Unknown';
  97 }
  98
  99 sub get_user_country_long($) {
 100         my ($user) = @_;
 101         return get_country_long(get_user_country($user));
 102 }
 103
 104 sub nickconn {
 105         my ($rnick, $time, $ident, $host, $vhost, $server, $modes, $gecos, $ip, $svsstamp) = @_[0,2..4,8,5,7,9,10,6];
 106         if(initial_synced() && !$svsstamp) {
 107                 if ($ip) {
 108                         wlog($main::rsnick, LOG_INFO(), "\002$rnick\002 is connecting from ".
 109                                 get_country_long(get_ip_country_aton($ip)));
 110                 }
 111                 else {
 112                         $unwhois{lc $rnick} = 1;
 113                 }
 114         }
 115         # we already depend on services being up for our SQL,
 116         # thus we know a USERIP will be sent.
 117         # However this IS avoidable if we make our own SQL connection
 118         # but would then require an additional %config and configfile
 119         return;
 120 }
 121
 122 sub userip($$$) {
 123         my($src, $nick, $ip) = @_;
 124
 125         return unless($unwhois{lc $nick});
 126         return unless($ip =~ /^\d{1,3}(\.\d{1,3}){3}$/);
 127
 128         wlog($main::rsnick, LOG_INFO(), "\002$nick\002 is connecting from ".
 129                 get_country_long(get_ip_country_aton($ip)));
 130         delete $unwhois{lc $nick};
 131 }
 132
 133 sub init() { }
 134 sub begin() { }
 135 sub end() { %unwhois = undef(); }
 136 sub unload() { }
 137
 138 1;