branches/erry-devel/SrSv/User.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::User;
  18
  19 =head1 NAME
  20
  21 SrSv::User - Track users
  22
  23 =head1 SYNOPSIS
  24
  25  use SrSv::User qw(get_user_id get_user_nick get_user_agent is_online chk_online get_user_flags set_user_flag chk_user_flag);
  26
  27 =cut
  28
  29 use strict;
  30 use SrSv::IRCd::UUID;
  31 use Exporter 'import';
  32 BEGIN {
  33         my %constants = (
  34                 UF_FINISHED => 1,
  35                 UF_ONLINE => 2, # not used yet
  36         );
  37
  38         our @EXPORT_OK = (qw(get_user_id get_user_nick get_user_agent is_online chk_online
  39                 $get_user_id $get_user_nick
  40                 get_user_ip
  41                 get_user_flags set_user_flag chk_user_flag set_user_flag_all
  42                 get_host get_vhost get_cloakhost get_user_info
  43                 flood_inc flood_check get_flood_level
  44                 __flood_expire
  45                 ),
  46                 keys(%constants));
  47         my @flood = qw( flood_inc flood_check get_flood_level );
  48         my @flags = qw( get_user_flags set_user_flag chk_user_flag set_user_flag_all );
  49         our %EXPORT_TAGS = (
  50                 flags => [keys(%constants)],
  51                 flood => [@flood],
  52                 user_flags => [@flags],
  53         );
  54
  55         require constant; import constant (\%constants);
  56 }
  57
  58 use SrSv::MySQL::Stub {
  59          __getIPV4 => ['SCALAR', "SELECT INET_NTOA(ip) FROM user WHERE id=?"],
  60 };
  61
  62
  63
  64 use SrSv::Process::Init;
  65 use SrSv::MySQL '$dbh';
  66 use SrSv::NickControl::Enforcer qw(%enforcers);
  67 use SrSv::IRCd::State qw(synced);
  68 use SrSv::Agent qw(is_agent);
  69 use SrSv::User::Notice;
  70 use SrSv::IRCd::Send qw (getUuid getRevUuid);
  71 use SrSv::Log;
  72
  73 our (
  74         $get_user_id, $get_user_nick, $get_nickchg, $is_online,
  75
  76         $get_user_flags, $set_user_flag, $unset_user_flag, $set_user_flag_all,
  77
  78         $get_host, $get_vhost, $get_cloakhost, $get_ip, $get_user_info,
  79 );
  80
  81 proc_init {
  82         $get_user_id = $dbh->prepare("SELECT id FROM user WHERE nick=?");
  83         $get_user_nick = $dbh->prepare("SELECT nick FROM user WHERE id=?");
  84         $get_nickchg = $dbh->prepare("SELECT nickchg.nickid, user.nick FROM nickchg, user WHERE user.id=nickchg.nickid AND nickchg.nick=?");
  85         $is_online = $dbh->prepare("SELECT 1 FROM user WHERE nick=? AND online=1");
  86
  87         $get_user_flags = $dbh->prepare("SELECT flags FROM user WHERE id=?");
  88         $set_user_flag = $dbh->prepare("UPDATE user SET flags=(flags | (?)) WHERE id=?");
  89         $unset_user_flag = $dbh->prepare("UPDATE user SET flags=(flags & ~(?)) WHERE id=?");
  90         $set_user_flag_all = $dbh->prepare("UPDATE user SET flags=flags | ?");
  91
  92         $get_host = $dbh->prepare("SELECT ident, host FROM user WHERE id=?");
  93         $get_vhost = $dbh->prepare("SELECT ident, vhost FROM user WHERE id=?");
  94         $get_cloakhost = $dbh->prepare("SELECT 1, cloakhost FROM user WHERE id=?");
  95         $get_user_info  = $dbh->prepare("SELECT ident, host, vhost, gecos, server FROM user WHERE id=?");
  96 };
  97 require SrSv::MySQL::Stub;
  98 import SrSv::MySQL::Stub {
  99         __flood_check => ['SCALAR', "SELECT flood FROM user WHERE id=?"],
 100         __flood_inc => ['NULL', "UPDATE user SET flood = flood + ? WHERE id=?"],
 101         __flood_expire => ['NULL', "UPDATE user SET flood = flood >> 1"], # shift is faster than mul
 102 };
 103
 104 sub get_flood_level($) {
 105         my ($user) = @_;
 106
 107         if(defined($user->{FLOOD})) {
 108                 return $user->{FLOOD};
 109         }
 110         my $flev = __flood_check(get_user_id($user));
 111         $user->{FLOOD} = $flev;
 112         return $flev;
 113 }
 114
 115 sub flood_inc($;$) {
 116         my ($user, $amount) = @_;
 117         $amount = 1 unless defined($amount);
 118
 119         get_flood_level($user);
 120         $user->{FLOOD} += $amount;
 121         __flood_inc($amount, get_user_id($user));
 122         return $user->{FLOOD};
 123 }
 124
 125 sub flood_check($;$) {
 126         my ($user, $amount) = @_;
 127
 128         if(adminserv::is_svsop($user, adminserv::S_HELP()) or adminserv::is_service($user)) {
 129                 return 0;
 130         }
 131         my $flev = flood_inc($user, $amount);
 132
 133         if($flev > 8) {
 134                 kill_user($user, "Flooding services.");
 135                 return 1;
 136         }
 137         elsif($flev > 6) {
 138                 notice($user, "You are flooding services.") if $amount == 1;
 139                 return 1;
 140         }
 141         else {
 142                 return 0;
 143         }
 144 }
 145
 146 sub get_user_id($) {
 147         my ($user) = @_;
 148         my ($id, $n);
 149         return undef if(is_agent($user->{NICK}) and not $enforcers{lc $user->{NICK}});
 150
 151         unless(ref($user) eq 'HASH') {
 152                 die("invalid get_user_nick call");
 153         }
 154         my $nick = $user->{NICK};
 155         if($nick eq '') {
 156                 die("get_user_id called on empty string");
 157         }
 158         my $properId = ircd::getUuid ($user->{NICK});
 159         if ($properId != "") {
 160                 print "Decoding $properId\n";
 161                 $properId = decodeUUID($properId);
 162                 return $user->{ID} = $properId;
 163         }
 164         else { print "Null properId. User->id" . $user->{ID} . "\n"; }
 165         if(exists($user->{ID})) { print "Returning user_>id " . $user->{ID} . "\n"; return $user->{ID}; }
 166
 167
 168
 169         # a cheat for isServer()
 170         if($user->{NICK} =~ /\./) {
 171                 return $user->{ID} = undef;
 172         }
 173
 174         my $nick2;
 175         while($n < 10 and !defined($id)) {
 176                 $n++;
 177                 $get_user_id->execute($nick);
 178                 ($id) = $get_user_id->fetchrow_array;
 179                 print "Finally got id from query: $id\n";
 180                 unless($id) {
 181                         $get_nickchg->execute($nick);
 182                         ($id, $nick2) = $get_nickchg->fetchrow_array;
 183                 }
 184         }
 185
 186         #unless($id) { log::wlog(__PACKAGE__, log::DEBUG(), "get_user_id($nick) failed."); }
 187
 188         if(defined($nick2) and lc $nick2 ne lc $user->{NICK}) {
 189                 $user->{OLDNICK} = $user->{NICK};
 190                 $user->{NICK} = $nick2;
 191         }
 192
 193         return $user->{ID} = $id;
 194 }
 195
 196 sub get_user_nick($) {
 197         my ($user) = @_;
 198
 199         unless(ref($user) eq 'HASH') {
 200                 die("invalid get_user_nick call");
 201         }
 202         if(exists($user->{NICK}) and is_online($user->{NICK})) {
 203                 my $realnick = ircd::getRevUuid($user->{NICK});
 204                 if ($realnick) {
 205                         $user->{ID} = $user->{NICK};
 206                         $user->{NICK} = $realnick;
 207                         return $realnick;
 208                 }
 209                 else {
 210                         return $user->{NICK};
 211                 }
 212         }
 213
 214         # Possible bug? This next bit only works to chase the nick-change
 215         # if the caller already did a get_user_id to find out
 216         # if the user exists in the user table, and thus get $user->{ID}
 217         # I don't know if calling get_user_id here is safe or not.
 218         my $nick;
 219         if($user->{ID}) {
 220                 $get_user_nick->execute($user->{ID});
 221                 ($nick) = $get_user_nick->fetchrow_array;
 222         }
 223
 224         # avoid returning an undef/NULL here. That's only legal for get_user_id
 225         # If the user does not exist, we must avoid modifying the input
 226         # so that it may be used for the error paths.
 227         return (defined $nick ? $user->{NICK} = $nick : $user->{NICK});
 228 }
 229
 230 sub get_user_agent($) {
 231         my ($user) = @_;
 232
 233 =cut
 234         eval { $user->{AGENT} };
 235         if($@) {
 236                 die("invalid get_user_agent call");
 237         }
 238 =cut
 239         die "invalid get_user_agent call" unless ref($user) eq 'HASH';
 240
 241         if(exists($user->{AGENT})) {
 242                 return $user->{AGENT}
 243         }
 244         else {
 245                 return undef;
 246         }
 247 }
 248
 249 sub is_online($) {
 250         my ($user) = @_;
 251         my $nick;
 252
 253         if(ref($user)) {
 254                 if(exists($user->{ONLINE})) { return $user->{ONLINE}; }
 255                 $nick = get_user_nick($user);
 256         } else {
 257                 $nick = $user;
 258         }
 259
 260         $is_online->execute($nick);
 261         my ($status) = $is_online->fetchrow_array;
 262         $is_online->finish();
 263         if(ref($user)) {
 264                 $user->{ONLINE} = ($status ? 1 : 0);
 265         }
 266
 267         return $status;
 268 }
 269
 270 sub chk_online($$) {
 271         my ($user, $target) = @_;
 272
 273         unless(is_online($target)) {
 274                 if(ref($target)) {
 275                         $target = get_user_nick($target);
 276                 }
 277
 278                 notice($user, "\002$target\002: No such user.");
 279                 return 0;
 280         }
 281
 282         return 1;
 283 }
 284
 285 sub set_user_flag($$;$) {
 286         my ($user, $flag, $sign) = @_;
 287         my $uid = get_user_id($user);
 288         $sign = 1 unless defined($sign);
 289
 290         if($sign) {
 291                 $user->{FLAGS} = ( ( defined $user->{FLAGS} ? $user->{FLAGS} : 0 ) | $flag );
 292                 $set_user_flag->execute($flag, $uid);
 293         } else {
 294                 $user->{FLAGS} = ( ( defined $user->{FLAGS} ? $user->{FLAGS} : 0 ) & ~($flag) );
 295                 $unset_user_flag->execute($flag, $uid);
 296         }
 297 }
 298
 299 sub chk_user_flag($$;$) {
 300         my ($user, $flag, $sign) = @_;
 301         my $flags = get_user_flags($user);
 302         $sign = 1 unless defined($sign);
 303
 304         return ($sign ? ($flags & $flag) : !($flags & $flag));
 305 }
 306
 307 sub get_user_flags($) {
 308         my ($user) = @_;
 309         my $uid = get_user_id($user);
 310
 311         my $flags;
 312         unless (exists($user->{FLAGS})) {
 313                 $get_user_flags->execute($uid);
 314                 ($flags) = $get_user_flags->fetchrow_array;
 315                 $get_user_flags->finish();
 316         } else {
 317                 $flags = $user->{FLAGS};
 318         }
 319
 320         return $user->{FLAGS} = $flags;
 321 }
 322
 323 sub set_user_flag_all($) {
 324         my ($flags) = @_;
 325
 326         $set_user_flag_all->execute($flags);
 327         $set_user_flag_all->finish();
 328 }
 329
 330 sub get_host($) {
 331         my ($user) = @_;
 332
 333         my $id;
 334         if(ref($user)) {
 335                 $id = get_user_id($user);
 336         } else {
 337                 $id = get_user_id({ NICK => $user });
 338         }
 339         return undef unless $id;
 340
 341         $get_host->execute($id);
 342         my ($ident, $host) = $get_host->fetchrow_array;
 343
 344         return ($ident, $host);
 345 }
 346
 347 sub get_cloakhost($) {
 348         my ($user) = @_;
 349
 350         my $id;
 351         if(ref($user)) {
 352                 $id = get_user_id($user);
 353         } else {
 354                 $id = get_user_id({ NICK => $user });
 355         }
 356         return undef unless $id;
 357
 358         $get_cloakhost->execute($id);
 359         my ($valid, $cloakhost) = $get_cloakhost->fetchrow_array;
 360         $get_cloakhost->finish;
 361
 362         # Beware, $cloakhost may be NULL while the user entry exists
 363         # if $cloakhost == undef, check $valid before assuming no such user.
 364         return ($valid, $cloakhost);
 365 }
 366
 367 sub get_vhost($) {
 368         my ($user) = @_;
 369
 370         my $id;
 371         if(ref($user)) {
 372                 $id = get_user_id($user);
 373         } else {
 374                 $id = get_user_id({ NICK => $user });
 375         }
 376         return undef unless $id;
 377
 378         $get_vhost->execute($id);
 379         my ($ident, $vhost) = $get_vhost->fetchrow_array;
 380
 381         return ($ident, $vhost);
 382 }
 383
 384 sub get_user_info($) {
 385         my ($user) = @_;
 386
 387         my $uid = get_user_id($user);
 388         return undef() unless $uid;
 389
 390         $get_user_info->execute($uid);
 391         my ($ident, $host, $vhost, $gecos, $server) = $get_user_info->fetchrow_array();
 392         $get_user_info->finish;
 393
 394         return ($ident, $host, $vhost, $gecos, $server);
 395 }
 396
 397 sub get_user_ipv4($) {
 398         my ($user) = @_;
 399
 400         my $id;
 401         if(ref($user)) {
 402                 if(exists $user->{IP}) {
 403                         return $user->{IP};
 404                 }
 405                 $id = get_user_id($user);
 406         } else {
 407                 $id = get_user_id({ NICK => $user });
 408         }
 409         return undef unless $id;
 410
 411         my $ip = getIPV4($id);
 412         if(ref($user)) {
 413                 return $user->{IP} = $ip;
 414         } else {
 415                 return $ip;
 416         }
 417 }
 418
 419 sub get_user_ip($) {
 420         return get_user_ipv4(@_);
 421 }
 422
 423 1;