src/newslash_web/lib/Newslash/Model/Users.pm

   1 package Newslash::Model::Users;
   2 use Newslash::Model::Base -base;
   3
   4 use Digest::MD5 qw(md5_hex md5_base64);
   5 use Email::Valid;
   6 use Data::Dumper;
   7
   8 sub authentification {
   9     my ($self, $nickname, $passwd) = @_;
  10
  11     my $dbh = $self->connect_db;
  12     my $sql = "SELECT * FROM users WHERE nickname = ?";
  13     my $sth = $dbh->prepare($sql);
  14
  15     $sth->execute($nickname);
  16
  17     my $rs = $sth->fetchall_arrayref(+{});
  18
  19     $sth->finish;
  20     $dbh->disconnect();
  21
  22     if (@$rs == 0) {
  23         return undef;
  24     }
  25
  26     my $u = $rs->[0];
  27     if ($self->comparePassword($passwd, $u->{passwd}, $u->{uid}, 0, 0)) {
  28         my $user = $self->_create_user_object($u);
  29         return $user;
  30     }
  31     return undef;
  32 }
  33
  34 sub anonymous_user {
  35     my $self = shift;
  36     return  $self->select(uid => 1);
  37 }
  38
  39 sub _create_user_object {
  40     my ($self, $user) = @_;
  41
  42     my $_fn = sub {
  43         my $user = shift;
  44         my $result = {};
  45         for my $k (qw{uid nickname fakeemail homepage sig seclev matchname author}) {
  46             $result->{$k} = $user->{$k};
  47         }
  48         # if seclev is greater than 10000, the user is admin
  49         # if seclev is 0, the user is Anonymous user
  50         $result->{admin} = $result->{seclev} >= 10000 ? 1 : 0;
  51         $result->{login} = $result->{seclev} != 0 ? 1 : 0;
  52
  53         return $result;
  54     };
  55
  56     if (ref($user) eq 'ARRAY') {
  57         my @ret = map { $_fn->($_) } @$user;
  58         return \@ret;
  59     }
  60     else {
  61         return $_fn->($user);
  62     }
  63 }
  64
  65 sub select {
  66     my $self = shift @_;
  67     my %params = @_;
  68
  69     my $type = $params{target} || 'user';
  70
  71     # select from `users` table
  72     if ($type eq 'user') {
  73         my $user;
  74         if (exists $params{nickname}) {
  75             my $u = $self->_select("users", nickname => $params{nickname});
  76             $user = $u->[0] if $u;
  77         }
  78         elsif (exists $params{uid}) {
  79             my $u = $self->_select("users", uid => $params{uid});
  80             $user = $u->[0] if $u;
  81         }
  82         elsif (exists $params{matchname}) {
  83             my $u = $self->_select("users", matchname => $params{matchname});
  84             $user = $u->[0] if $u;
  85         }
  86         elsif (exists $params{email}) {
  87             my $u = $self->_select("users", realemail => $params{email});
  88             $user = $u->[0] if $u;
  89         }
  90         elsif (exists $params{author}) {
  91             $user = $self->_select("users", author => $params{author});
  92         }
  93
  94         if ($user) {
  95             return $self->_create_user_object($user);
  96         }
  97         return;
  98     }
  99
 100     # select from other table
 101     my $ret;
 102     if ($type eq 'acl') {
 103         if (exists $params{uid}) {
 104             $ret = $self->_select("users_acl", uid => $params{uid});
 105         }
 106     }
 107
 108     if ($type eq 'info') {
 109         if (exists $params{uid}) {
 110             $ret = $self->_select("users_info", uid => $params{uid});
 111         }
 112     }
 113
 114     if ($type eq 'comments') {
 115         if (exists $params{uid}) {
 116             $ret = $self->_select("users_comments", uid => $params{uid});
 117         }
 118     }
 119
 120     if ($type eq 'param') {
 121         if (exists $params{uid}) {
 122             $ret = $self->_select("users_param", uid => $params{uid});
 123         }
 124     }
 125     return if !$ret;
 126     return $ret->[0];
 127 }
 128
 129 sub _select {
 130     my ($self, $table, $key, $value) = @_;
 131     my $sql = "SELECT * FROM $table WHERE $key = ?";
 132     my $dbh = $self->connect_db;
 133     my $sth = $dbh->prepare($sql);
 134     $sth->execute($value);
 135     my $rs = $sth->fetchall_arrayref(+{});
 136     $dbh->disconnect();
 137
 138     return $rs;
 139 }
 140
 141 #========================================================================
 142
 143 =head2 _get_salt
 144
 145 Returns salt value. This function exists because of historical reason.
 146
 147 =cut
 148
 149 sub _get_salt {
 150     my $self = shift;
 151     return '';
 152 }
 153
 154
 155 =head2 comparePassword(PASSWD, MD5, ISPLAIN, ISENC)
 156
 157 (imported from Slash)
 158
 159 Given a password and an MD5 hex string, compares the two to see if they
 160 represent the same value.  To be precise:
 161
 162 If the password given is equal to the MD5 string, it must already be
 163 in MD5 format and be correct, so return true
 164
 165 Otherwise, the password is assumed to be plaintext.  Each possible
 166 salt-encryption of it (including the encryption with empty salt) is
 167 compared against the MD5 string.  True is returned if there is any
 168 match.
 169
 170 If ISPLAIN is true, PASSWD is assumed to be plaintext, so the
 171 (trivial equality) test against the encrypted MD5 is not performed.
 172
 173 If ISENC is true, PASSWD is assumed to be already encrypted, so the
 174 tests of salting and encrypting it are not performed.
 175
 176 (If neither is true, all tests are performed.  If both are true, no
 177 tests are performed and 0 is returned.)
 178
 179 =over 4
 180
 181 =item Parameters
 182
 183 =over 4
 184
 185 =item PASSWD
 186
 187 Possibly-correct password, either plaintext or already-MD5's,
 188 to be checked.
 189
 190 =item MD5
 191
 192 Encrypted correct password.
 193
 194 =back
 195
 196 =item Return value
 197
 198 0 or 1.
 199
 200 =back
 201
 202 =cut
 203
 204 sub comparePassword {
 205   my ($self, $passwd, $md5, $uid, $is_plain, $is_enc) = @_;
 206
 207   if (!$is_plain) {
 208     return 1 if $passwd eq $md5;
 209   }
 210   if (!$is_enc) {
 211     # An old way of encrypting a user's password, which we have
 212     # to check for reverse compatibility.
 213     return 1 if md5_hex($passwd) eq $md5;
 214
 215     my $salt_ar = [];
 216     $salt_ar = [$self->_get_salt,];
 217
 218     # No?  OK let's see if it matches any of the salts.
 219     #my $slashdb = getCurrentDB();
 220     #my $vu = $slashdb->{virtual_user};
 221     #my $salt_ar = Slash::Apache::User::PasswordSalt::getPwSalts($vu);
 222     #unshift @$salt_ar, ''; # always test the case of no salt
 223     for my $salt (reverse @$salt_ar) {
 224       # The current way of encrypting a user's password.
 225       return 1 if md5_hex("$salt:$uid:$passwd") eq $md5;
 226       # An older way, which we have to check for reverse
 227       # compatibility.
 228       return 1 if length($salt) && md5_hex("$salt$passwd") eq $md5;
 229     }
 230   }
 231   return 0;
 232 }
 233
 234
 235
 236 #========================================================================
 237
 238 =head2 _nickname_to_matchname
 239
 240 Convert nickname to matchname.
 241
 242 nickname consists of almost all alphabet, number, symbol.
 243
 244 matchname consists of lower alphabet and number.
 245
 246 =cut
 247
 248 sub _nickname_to_matchname {
 249     my ($self, $nick) = @_;
 250     $nick = lc $nick;
 251     $nick =~ s/[^a-zA-Z0-9]//g;
 252     return $nick;
 253 }
 254
 255 #========================================================================
 256
 257 =head2 random_password
 258
 259 (import from: changePassword)
 260
 261 Return new random 8-character password composed of 0..9, A..Z, a..z
 262 (but not including possibly hard-to-read characters [0O1Iil]).
 263
 264 =over 4
 265
 266 =item Return value
 267
 268 Random password.
 269
 270 =back
 271
 272 =cut
 273
 274 sub random_password {
 275     my @chars = grep !/[0O1Iil]/, 0..9, 'A'..'Z', 'a'..'z';
 276     return join '', map { $chars[rand @chars] } 0 .. 7;
 277 }
 278
 279 #========================================================================
 280
 281 =head2 encrypt_password
 282
 283 (import from: encryptPassword)
 284
 285 Encrypts given password, using the most recent salt (if any) in
 286 Slash::Apache::User::PasswordSalt for the current virtual user.
 287 Currently uses MD5, but could change in the future, so do not
 288 depend on the implementation.
 289
 290 =over 4
 291
 292 =item Parameters
 293
 294 =over 4
 295
 296 =item PASSWD
 297
 298 Password to be encrypted.
 299
 300 =back
 301
 302 =item Return value
 303
 304 Encrypted password.
 305
 306 =back
 307
 308 =cut
 309
 310 sub encrypt_password {
 311     my ($self, $passwd, $uid) = @_;
 312     $uid ||= '';
 313
 314     #my $slashdb = getCurrentDB();
 315     #my $vu = $slashdb->{virtual_user};
 316     #my $salt = Slash::Apache::User::PasswordSalt::getCurrentPwSalt($vu);
 317     #$passwd = Encode::encode_utf8($passwd) if getCurrentStatic('utf8');
 318
 319     my $salt = $self->_get_salt;
 320     if ($uid) {
 321         return md5_hex("$salt:$uid:$passwd");
 322     } else {
 323         return md5_hex("$salt$passwd");
 324     }
 325 }
 326
 327 #========================================================================
 328
 329 =head2 create_user
 330
 331 Create new user.
 332
 333 =over 4
 334
 335 =item Return value
 336
 337 HASH
 338
 339 =back
 340
 341 =cut
 342
 343 use constant ERROR_BASE => 1000;
 344 use constant {
 345     ERROR_INVALID_ADDRESS    => ERROR_BASE + 10,
 346     ERROR_NICKNAME_NOT_GIVEN => ERROR_BASE + 20,
 347     ERROR_USER_EXISTS        => ERROR_BASE + 30,
 348     ERROR_INSERT_USER_FAILED => ERROR_BASE + 40,
 349     ERROR_MAIL_REGISTERED => ERROR_BASE + 50,
 350     ERROR_DO_SQL => ERROR_BASE + 50,
 351 };
 352
 353 sub create_user {
 354     my ($self, $nickname, $email, $opts) = @_;
 355     $opts ||= {};
 356
 357     # check: nickname is given?
 358     if ($nickname =~ m/\A\s+\z/) {
 359         return { error => ERROR_NICKNAME_NOT_GIVEN };
 360     }
 361
 362     my $matchname = $self->_nickname_to_matchname($nickname);
 363
 364     # check: email is valid?
 365     if (!Email::Valid->address($email)) {
 366         return { error => ERROR_INVALID_ADDRESS };
 367     }
 368
 369     # check: nickname already exists?
 370     my $user = $self->select(nickname => $nickname);
 371     if ($user) {
 372         return { error => ERROR_USER_EXISTS };
 373     }
 374
 375     # check: mail already registered?
 376     $user = $self->select(email => $email);
 377     if ($user) {
 378         return { error => ERROR_MAIL_REGISTERED };
 379     }
 380
 381     # start transaction
 382     my $dbh = $self->connect_db({AutoCommit => 0,});
 383     my $sql;
 384     my $sth;
 385
 386     # create user and set temporary password
 387     my $passwd = $self->random_password;
 388     my $enc_passwd = $self->encrypt_password($passwd, '');
 389     $sql = <<"EOSQL";
 390 INSERT INTO users (realemail, nickname, matchname,  seclev,  passwd)
 391   VALUES          (?,         ?,        ?,          ?,       ?)
 392 EOSQL
 393     $dbh->do($sql, undef, $email, $nickname, $matchname, 1, $enc_passwd);
 394     my $uid = $dbh->last_insert_id(undef, undef, undef, undef);
 395
 396     if (!$uid) {
 397         $dbh->rollback;
 398         $dbh->disconnect;
 399         return { error => ERROR_INSERT_USER_FAILED };
 400     }
 401
 402     # create users_info, etc.
 403     my $result;
 404     $sql = <<"EOSQL";
 405 INSERT INTO users_info (uid, lastaccess, created_at, bio)
 406   VALUES               (?,   NOW(),      NOW(),      ?)
 407 EOSQL
 408     $result = $dbh->do($sql, undef, $uid, '');
 409     if (!$result) {
 410         $dbh->rollback;
 411         $dbh->disconnect;
 412         return { error => ERROR_DO_SQL };
 413     }
 414
 415     for my $table (qw{users_prefs users_comments users_hits users_class}) {
 416         $sql = "INSERT INTO $table (uid) VALUES (?)";
 417         $result = $dbh->do($sql, undef, $uid);
 418         if (!$result) {
 419             $dbh->rollback;
 420             $dbh->disconnect;
 421             return { error => ERROR_DO_SQL };
 422         }
 423     }
 424
 425     $sql = <<"EOSQL";
 426 INSERT INTO users_index (uid, story_never_topic, slashboxes, story_always_topic)
 427   VALUES                (?,   ?,                 ?,          ?)
 428 EOSQL
 429     $result = $dbh->do($sql, undef, $uid, '', '', '');
 430     if (!$result) {
 431         $dbh->rollback;
 432         $dbh->disconnect;
 433         return { error => ERROR_DO_SQL };
 434     }
 435
 436     # finish
 437     $dbh->commit;
 438     $dbh->disconnect;
 439
 440     return { error => 0, uid => $uid, password => $passwd };
 441 }
 442
 443 =head2 clearRookie($uid, $time)
 444
 445 clear Rookie flag.
 446
 447 =over 4
 448
 449 =item Return value
 450
 451 1/0
 452
 453 =back
 454
 455 =cut
 456
 457 sub clearRookie {
 458     my ($self, $uid, $time) = @_;
 459     return if !$uid || $uid == 1; # uid 1 is anonymous
 460
 461     my $dbh = $self->connect_db;
 462
 463     if ($time) {
 464         my $sql = <<"EOSQL";
 465 UPDATE users_class SET rookie = 0, rookie_cleared = NOW() WHERE uid = ?
 466 EOSQL
 467         my $rs = $dbh->do($sql, undef, $uid);
 468         return if !$rs;
 469     }
 470     else {
 471         my $sql = <<"EOSQL";
 472 UPDATE users_class SET rookie = 0, rookie_cleared = ? WHERE uid = ?
 473 EOSQL
 474         my $rs = $dbh->do($sql, undef,$time,  $uid);
 475         return if !$rs;
 476     }
 477     return 1;
 478 }
 479
 480 #========================================================================
 481
 482 =head2 update
 483
 484 update user infomation.
 485
 486 =over 4
 487
 488 =item Return value
 489
 490 HASH
 491
 492 =back
 493
 494 =cut
 495
 496 sub update {
 497     my $self = shift;
 498     my %params = @_;
 499
 500     my $uid = $params{uid};
 501     if (!$uid) {
 502         return;
 503     }
 504
 505     if ($params{target} eq 'info') {
 506         if (exists $params{add}) {
 507             return $self->_update_users_info_add($uid, $params{field}, $params{add});
 508         }
 509     }
 510     elsif ($params{target} eq 'class') {
 511         if (exists $params{field} && exists $params{value}) {
 512             return $self->_update_users_class($uid, $params{field}, $params{value});
 513         }
 514         elsif (exists $params{field} && $params{now}) {
 515             return $self->_update_users_class_now($uid, $params{field});
 516         }
 517     }
 518     return;
 519 }
 520
 521 sub _update_users_class_now {
 522     my ($self, $uid, $column) = @_;
 523     my $sql = "UPDATE users_class SET ? = NOW() WHERE uid = ?";
 524     my $dbh = $self->connect_db();
 525     my $rs = $dbh->do($sql, undef, $column, $uid);
 526     if (!$rs) {
 527         return;
 528     }
 529     $dbh->disconnect;
 530     return 1;
 531 }
 532
 533 sub _update_users_class {
 534     my ($self, $uid, $column, $value) = @_;
 535     my $sql = "UPDATE users_class SET ? = ? WHERE uid = ?";
 536     my $dbh = $self->connect_db();
 537     my $rs = $dbh->do($sql, undef, $column, $value, $uid);
 538     if (!$rs) {
 539         return;
 540     }
 541     $dbh->disconnect;
 542     return 1;
 543 }
 544
 545 sub _update_users_info_add {
 546     my ($self, $uid, $field, $value) = @_;
 547
 548     my $sql = "UPDATE users_info SET $field = $field + ? WHERE uid = ?";
 549     my $dbh = $self->connect_db();
 550     my $rs = $dbh->do($sql, undef, $value, $uid);
 551     if (!$rs) {
 552         return;
 553     }
 554     $dbh->disconnect;
 555     return 1;
 556 }
 557
 558 1;