User.pm 21.3 KB
Newer Older
sikeda's avatar
sikeda committed
1
2
3
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
4

5
6
7
8
9
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
10
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
11
12
13
# Copyright 2018 The Sympa Community. See the AUTHORS.md file at the
# top-level directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>.
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.

package Sympa::User;

use strict;
use warnings;
32
use Carp qw();
33
use Digest::MD5;
34
BEGIN { eval 'use Crypt::Eksblowfish::Bcrypt qw(bcrypt en_base64)'; }
35

36
use Conf;
37
use Sympa::DatabaseDescription;
38
use Sympa::DatabaseManager;
39
use Sympa::Language;
40
use Sympa::Log;
41
use Sympa::Tools::Data;
42
use Sympa::Tools::Password;
43
use Sympa::Tools::Text;
44

45
46
my $log = Sympa::Log->instance;

47
48
49
50
51
52
53
54
## Database and SQL statement handlers
my ($sth, @sth_stack);

## mapping between var and field names
my %db_struct = Sympa::DatabaseDescription::full_db_struct();
my %map_field;
foreach my $k (keys %{$db_struct{'user_table'}->{'fields'}}) {
    if ($k =~ /^(.+)_user$/) {
55
        $map_field{$1} = $k;
56
57
58
59
60
61
62
63
    }
}

## DB fields with numeric type
## We should not do quote() for these while inserting data
my %numeric_field;
foreach my $k (keys %{$db_struct{'user_table'}->{'fields'}}) {
    if ($db_struct{'user_table'}->{'fields'}{$k}{'struct'} =~ /^int/) {
64
        $numeric_field{$k} = 1;
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
    }
}

=encoding utf-8

=head1 NAME

Sympa::User - All Users Identified by Sympa

=head1 DESCRIPTION

=head2 CONSTRUCTOR

=over 4

=item new ( EMAIL, [ KEY => VAL, ... ] )

Create new Sympa::User object.

=back

=cut

sub new {
    my $pkg    = shift;
90
    my $who    = Sympa::Tools::Text::canonic_email(shift);
91
92
    my %values = @_;
    my $self;
93
    return undef unless defined $who;
94

95
    ## Canonicalize lang if possible
96
97
98
    $values{'lang'} = Sympa::Language::canonic_lang($values{'lang'})
        || $values{'lang'}
        if $values{'lang'};
99
100

    if (!($self = get_global_user($who))) {
101
102
103
104
105
106
107
108
        ## unauthenticated user would not be added to database.
        $values{'email'} = $who;
        if (scalar grep { $_ ne 'lang' and $_ ne 'email' } keys %values) {
            unless (defined add_global_user(\%values)) {
                return undef;
            }
        }
        $self = \%values;
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
    }

    bless $self => $pkg;
}

=head2 METHODS

=over 4

=item expire

Remove user information from user_table.

=back

=cut

sub expire {
    delete_global_user(shift->email);
}

=over 4

=item get_id

Get unique identifier of object.

=back

=cut

sub get_id {
    ## DO NOT use accessors since $self may not have been fully initialized.
    shift->{'email'} || '';
}

=over 4

=item moveto

Change email of user.

=back

=cut

sub moveto {
sikeda's avatar
sikeda committed
156
    my $self     = shift;
157
    my $newemail = Sympa::Tools::Text::canonic_email(shift);
158

159
    unless (defined $newemail) {
160
        $log->syslog('err', 'No email');
161
        return undef;
162
163
    }
    if ($self->email eq $newemail) {
164
        return 0;
165
166
167
    }

    push @sth_stack, $sth;
168
    my $sdm = Sympa::DatabaseManager->instance;
169

170
171
    unless (
        $sdm
172
        and $sth = $sdm->do_prepared_query(
173
            q{UPDATE user_table
174
175
              SET email_user = ?
              WHERE email_user = ?},
176
177
            $newemail, $self->email
        )
Luc Didry's avatar
Luc Didry committed
178
    ) {
179
        $log->syslog('err', 'Can\'t move user %s to %s', $self, $newemail);
180
181
        $sth = pop @sth_stack;
        return undef;
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
    }

    $sth = pop @sth_stack;

    $self->{'email'} = $newemail;

    return 1;
}

=over 4

=item save

Save user information to user_table.

=back

=cut

sub save {
    my $self = shift;
203
204
    unless (add_global_user('email' => $self->email, %$self)
        or update_global_user($self->email, %$self)) {
205
        $log->syslog('err', 'Cannot save user %s', $self);
206
        return undef;
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
    }

    return 1;
}

=head3 ACCESSORS

=over 4

=item E<lt>attributeE<gt>

=item E<lt>attributeE<gt>C<( VALUE )>

I<Getters/Setters>.
Get or set user attributes.
For example C<$user-E<gt>gecos> returns "gecos" parameter of the user,
and C<$user-E<gt>gecos("foo")> also changes it.
Basic user profile "email" have only getter,
so it is read-only.

=back

=cut

our $AUTOLOAD;

sub DESTROY { }   # "sub DESTROY;" may cause segfault with Perl around 5.10.1.

sub AUTOLOAD {
    $AUTOLOAD =~ m/^(.*)::(.*)/;

    my $attr = $2;

    if (scalar grep { $_ eq $attr } qw(email)) {
241
242
243
244
245
246
247
248
249
250
251
252
        ## getter for user attribute.
        no strict "refs";
        *{$AUTOLOAD} = sub {
            my $self = shift;
            Carp::croak "Can't call method \"$attr\" on uninitialized "
                . ref($self)
                . " object"
                unless $self->{'email'};
            Carp::croak "Can't modify \"$attr\" attribute"
                if scalar @_ > 1;
            $self->{$attr};
        };
253
    } elsif (exists $map_field{$attr}) {
254
255
256
257
258
259
260
261
262
263
264
265
        ## getter/setter for user attributes.
        no strict "refs";
        *{$AUTOLOAD} = sub {
            my $self = shift;
            Carp::croak "Can't call method \"$attr\" on uninitialized "
                . ref($self)
                . " object"
                unless $self->{'email'};
            $self->{$attr} = shift
                if scalar @_ > 1;
            $self->{$attr};
        };
266
    } else {
267
        Carp::croak "Can't locate object method \"$2\" via package \"$1\"";
268
269
270
271
272
273
274
275
276
277
    }
    goto &$AUTOLOAD;
}

=head2 FUNCTIONS

=over 4

=item get_users ( ... )

278
279
Not yet implemented.

280
281
282
283
284
=back

=cut

sub get_users {
285
    die;
286
287
}

288
289
290
291
292
293
294
295
296
297
298
=over 4

=item password_fingerprint ( )

Returns the password finger print.

=back

=cut

# Old name: Sympa::Auth::password_fingerprint().
299
300
301
302
303
304
305
306
307
308
309
310
311
#
# Password fingerprint functions are stored in a table. Currently supported
# algorithms are the default 'md5', and 'bcrypt'.
#
# If the algorithm uses a salt (e.g. bcrypt) and the second parameter $salt
# is not provided, a random one will be generated.
#

my %fingerprint_hashes = (
    # default is to use MD5, which does not use a salt
    'md5' => sub {
        my ($pwd, $salt) = @_;

312
313
        $salt = '' unless defined $salt;

314
        # salt parameter is not used for MD5 hashes
315
316
317
        my $fingerprint = Digest::MD5::md5_hex($pwd);
        my $match = ($fingerprint eq $salt) ? "yes" : "no";

Luc Didry's avatar
Luc Didry committed
318
319
        $log->syslog('debug',
            "md5: match $match salt \"$salt\" fingerprint $fingerprint");
320

Luc Didry's avatar
Luc Didry committed
321
        return $fingerprint;
322
323
324
325
326
327
328
329
330
331
    },
    # bcrypt uses a salt and has a configurable "cost" parameter
    'bcrypt' => sub {
        my ($pwd, $salt) = @_;

        die "bcrypt support unavailable: install Crypt::Eksblowfish::Bcrypt"
            unless $Crypt::Eksblowfish::Bcrypt::VERSION;

        # A bcrypt-encrypted password contains the settings at the front.
        # If this not look like a settings string, create one.
Luc Didry's avatar
Luc Didry committed
332
333
        unless (defined($salt)
            && $salt =~ m#\A\$2(a?)\$([0-9]{2})\$([./A-Za-z0-9]{22})#x) {
334
335
            my $bcrypt_cost = Conf::get_robot_conf('*', 'bcrypt_cost');
            my $cost = sprintf("%02d", 0 + $bcrypt_cost);
Luc Didry's avatar
Luc Didry committed
336
            my $newsalt = "";
337

Luc Didry's avatar
Luc Didry committed
338
            for my $i (0 .. 15) {
339
340
341
                $newsalt .= chr(rand(256));
            }
            $newsalt = '$2a$' . $cost . '$' . en_base64($newsalt);
Luc Didry's avatar
Luc Didry committed
342
343
            $log->syslog('debug',
                "bcrypt: create new salt: cost $cost \"$newsalt\"");
344

Luc Didry's avatar
Luc Didry committed
345
            $salt = $newsalt;
346
347
348
349
350
        }

        my $fingerprint = bcrypt($pwd, $salt);
        my $match = ($fingerprint eq $salt) ? "yes" : "no";

Luc Didry's avatar
Luc Didry committed
351
352
        $log->syslog('debug',
            "bcrypt: match $match salt $salt fingerprint $fingerprint");
353
354
355
356
357

        return $fingerprint;
    }
);

358
359
sub password_fingerprint {

360
361
    my ($pwd, $salt) = @_;

Mic Kaczmarczik's avatar
Mic Kaczmarczik committed
362
363
364
    $log->syslog('debug', "salt \"%s\"", $salt);

    my $password_hash = Conf::get_robot_conf('*', 'password_hash');
Luc Didry's avatar
Luc Didry committed
365
    my $password_hash_update =
Mic Kaczmarczik's avatar
Mic Kaczmarczik committed
366
        Conf::get_robot_conf('*', 'password_hash_update');
367
368

    if (Conf::get_robot_conf('*', 'password_case') eq 'insensitive') {
369
        $pwd = lc($pwd);
370
    }
371

Mic Kaczmarczik's avatar
Mic Kaczmarczik committed
372
373
    # If updating hashes, honor the hash type implied by $salt. This lets
    # the user successfully log in, after which the hash can be updated
374

Mic Kaczmarczik's avatar
Mic Kaczmarczik committed
375
376
377
378
379
380
    if ($password_hash_update) {
        if (defined($salt) && defined(my $hash_type = hash_type($salt))) {
            $log->syslog('debug', "honoring  hash_type %s", $hash_type);
            $password_hash = $hash_type;
        }
    }
381

382
383
384
385
    die "password_fingerprint: unknown password_hash \"$password_hash\""
        unless defined($fingerprint_hashes{$password_hash});

    return $fingerprint_hashes{$password_hash}->($pwd, $salt);
386
387
}

388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
=over 4

=item hash_type ( )

detect the type of password fingerprint used for a hashed password

Returns undef if no supported hash type is detected

=back

=cut

sub hash_type {
    my $hash = shift;

Luc Didry's avatar
Luc Didry committed
403
404
405
    return 'md5' if ($hash =~ /^[a-f0-9]{32}$/i);
    return 'bcrypt'
        if ($hash =~ m#\A\$2(a?)\$([0-9]{2})\$([./A-Za-z0-9]{22})#);
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
    return undef;
}

=over 4

=item update_password_hash ( )

If needed, update the hash used for the user's encrypted password entry

=back

=cut

sub update_password_hash {
    my ($user, $pwd) = @_;

    return unless (Conf::get_robot_conf('*', 'password_hash_update'));

    # here if configured to check and update the password hash algorithm

    my $user_hash = hash_type($user->{'password'});
    my $system_hash = Conf::get_robot_conf('*', 'password_hash');

    return if (defined($user_hash) && ($user_hash eq $system_hash));

    # note that we directly use the callback for the hash type
    # instead of using any other logic to determine which to call

    $log->syslog('debug', 'update password hash for %s from %s to %s',
Luc Didry's avatar
Luc Didry committed
435
        $user->{'email'}, $user_hash, $system_hash);
436
437
438
439
440
441

    # note that we use the cleartext password here, not the hash
    update_global_user($user->{'email'}, {password => $pwd});

}

442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
############################################################################
## Old-style functions
############################################################################

=head2 OLD STYLE FUNCTIONS

=over 4

=item add_global_user

=item delete_global_user

=item is_global_user

=item get_global_user

=item get_all_global_user

460
461
I<Obsoleted>.

462
463
464
465
466
467
468
469
470
471
=item update_global_user

=back

=cut

## Delete a user in the user_table
sub delete_global_user {
    my @users = @_;

472
    $log->syslog('debug2', '');
473

474
    return undef unless @users;
475

476
    my $sdm = Sympa::DatabaseManager->instance;
477
    foreach my $who (@users) {
478
        $who = Sympa::Tools::Text::canonic_email($who);
479

480
        # Update field
481
        unless (
482
483
            $sdm
            and $sdm->do_prepared_query(
484
485
                q{DELETE FROM user_table WHERE email_user = ?}, $who
            )
Luc Didry's avatar
Luc Didry committed
486
        ) {
487
            $log->syslog('err', 'Unable to delete user %s', $who);
488
489
            next;
        }
490
491
    }

492
    return scalar @users;
493
494
495
496
}

## Returns a hash for a given user
sub get_global_user {
497
    $log->syslog('debug2', '(%s)', @_);
498
    my $who = Sympa::Tools::Text::canonic_email(shift);
499
500
501

    ## Additional subscriber fields
    my $additional = '';
sikeda's avatar
sikeda committed
502
    if ($Conf::Conf{'db_additional_user_fields'}) {
503
        $additional = ', ' . $Conf::Conf{'db_additional_user_fields'};
504
505
506
    }

    push @sth_stack, $sth;
507
    my $sdm = Sympa::DatabaseManager->instance;
508
509

    unless (
510
511
        $sdm
        and $sth = $sdm->do_prepared_query(
512
513
            sprintf(
                q{SELECT email_user AS email, gecos_user AS gecos,
514
515
516
517
518
519
520
521
                         password_user AS password,
                         cookie_delay_user AS cookie_delay, lang_user AS lang,
                         attributes_user AS attributes, data_user AS data,
                         last_login_date_user AS last_login_date,
                         wrong_login_count_user AS wrong_login_count,
                         last_login_host_user AS last_login_host%s
                  FROM user_table
                  WHERE email_user = ?},
522
523
524
525
                $additional
            ),
            $who
        )
Luc Didry's avatar
Luc Didry committed
526
    ) {
527
        $log->syslog('err', 'Failed to prepare SQL query');
528
529
        $sth = pop @sth_stack;
        return undef;
530
531
532
533
534
535
536
537
    }

    my $user = $sth->fetchrow_hashref('NAME_lc');
    $sth->finish();

    $sth = pop @sth_stack;

    if (defined $user) {
538
539
540
        ## decrypt password
        if ($user->{'password'}) {
            $user->{'password'} =
541
                Sympa::Tools::Password::decrypt_password($user->{'password'});
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
        }

        ## Canonicalize lang if possible
        if ($user->{'lang'}) {
            $user->{'lang'} = Sympa::Language::canonic_lang($user->{'lang'})
                || $user->{'lang'};
        }

        ## Turn user_attributes into a hash
        my $attributes = $user->{'attributes'};
        if (defined $attributes and length $attributes) {
            $user->{'attributes'} = {};
            foreach my $attr (split(/__ATT_SEP__/, $attributes)) {
                my ($key, $value) = split(/__PAIRS_SEP__/, $attr);
                $user->{'attributes'}{$key} = $value;
            }
            delete $user->{'attributes'}
                unless scalar keys %{$user->{'attributes'}};
        } else {
            delete $user->{'attributes'};
        }
        ## Turn data_user into a hash
        if ($user->{'data'}) {
565
            my %prefs = Sympa::Tools::Data::string_2_hash($user->{'data'});
566
567
            $user->{'prefs'} = \%prefs;
        }
568
569
570
571
572
573
    }

    return $user;
}

## Returns an array of all users in User table hash for a given user
574
# OBSOLETED: No longer used.
575
sub get_all_global_user {
576
    $log->syslog('debug2', '');
577
578
579
580

    my @users;

    push @sth_stack, $sth;
581
    my $sdm = Sympa::DatabaseManager->instance;
582

583
584
585
    unless ($sdm
        and $sth =
        $sdm->do_prepared_query('SELECT email_user FROM user_table')) {
586
        $log->syslog('err', 'Unable to gather all users in DB');
587
588
        $sth = pop @sth_stack;
        return undef;
589
590
591
    }

    while (my $email = ($sth->fetchrow_array)[0]) {
592
        push @users, $email;
593
594
595
596
597
598
599
600
601
602
    }
    $sth->finish();

    $sth = pop @sth_stack;

    return @users;
}

## Is the person in user table (db only)
sub is_global_user {
603
    my $who = Sympa::Tools::Text::canonic_email(pop);
604
    $log->syslog('debug3', '(%s)', $who);
605

606
    return undef unless defined $who;
607
608

    push @sth_stack, $sth;
609
    my $sdm = Sympa::DatabaseManager->instance;
610
611
612

    ## Query the Database
    unless (
613
614
615
        $sdm
        and $sth = $sdm->do_prepared_query(
            q{SELECT COUNT(*) FROM user_table WHERE email_user = ?}, $who
616
        )
Luc Didry's avatar
Luc Didry committed
617
    ) {
618
        $log->syslog('err',
619
            'Unable to check whether user %s is in the user table');
620
621
        $sth = pop @sth_stack;
        return undef;
622
623
624
625
626
627
628
629
630
631
632
633
    }

    my $is_user = $sth->fetchrow();
    $sth->finish();

    $sth = pop @sth_stack;

    return $is_user;
}

## Sets new values for the given user in the Database
sub update_global_user {
634
    $log->syslog('debug', '(%s, ...)', @_);
635
636
637
    my $who    = shift;
    my $values = $_[0];
    if (ref $values) {
638
        $values = {%$values};
639
    } else {
640
        $values = {@_};
641
642
    }

643
    $who = Sympa::Tools::Text::canonic_email($who);
644

645
646
    ## use hash fingerprint to store password
    ## hashes that use salts will randomly generate one
647
648
649
    ## avoid rehashing passwords that are already hash strings
    if ($values->{'password'}) {
        if (defined(hash_type($values->{'password'}))) {
650
            $log->syslog(
651
652
                'debug',
                'password is in %s format, not rehashing',
653
654
                hash_type($values->{'password'})
            );
655
656
        } else {
            $values->{'password'} =
657
658
                Sympa::User::password_fingerprint($values->{'password'},
                undef);
659
660
        }
    }
661

662
    ## Canonicalize lang if possible.
663
664
665
    $values->{'lang'} = Sympa::Language::canonic_lang($values->{'lang'})
        || $values->{'lang'}
        if $values->{'lang'};
666

667
668
669
670
671
672
    my $sdm = Sympa::DatabaseManager->instance;
    unless ($sdm) {
        $log->syslog('err', 'Unavailable database connection');
        return undef;
    }

673
674
675
676
677
678
    my ($field, $value);

    ## Update each table
    my @set_list;

    while (($field, $value) = each %{$values}) {
679
        unless ($map_field{$field}) {
680
681
            $log->syslog('err',
                'Unknown field %s in map_field internal error', $field);
682
683
684
685
686
687
688
689
            next;
        }
        my $set;

        if ($numeric_field{$map_field{$field}}) {
            $value ||= 0;    ## Can't have a null value
            $set = sprintf '%s=%s', $map_field{$field}, $value;
        } else {
690
            $set = sprintf '%s=%s', $map_field{$field}, $sdm->quote($value);
691
692
        }
        push @set_list, $set;
693
694
695
696
697
698
699
700
    }

    return undef unless @set_list;

    ## Update field

    push @sth_stack, $sth;

701
    $sth = $sdm->do_query(
702
703
        "UPDATE user_table SET %s WHERE (email_user=%s)",
        join(',', @set_list),
704
        $sdm->quote($who)
705
706
    );
    unless (defined $sth) {
707
        $log->syslog('err',
708
            'Could not update information for user %s in user_table', $who);
709
710
        $sth = pop @sth_stack;
        return undef;
711
712
713
714
715
716
717
718
719
    }

    $sth = pop @sth_stack;

    return 1;
}

## Adds a user to the user_table
sub add_global_user {
720
    $log->syslog('debug3', '(...)');
721
722
    my $values = $_[0];
    if (ref $values) {
723
        $values = {%$values};
724
    } else {
725
        $values = {@_};
726
727
    }

728
729
    my $sdm = Sympa::DatabaseManager->instance;
    unless ($sdm) {
730
        $log->syslog('err', 'Unavailable database connection');
731
732
733
        return undef;
    }

734
735
    my ($field, $value);

736
    ## encrypt password with the configured password hash algorithm
737
    ## an salt of 'undef' means generate a new random one
738
739
740
    ## avoid rehashing passwords that are already hash strings
    if ($values->{'password'}) {
        if (defined(hash_type($values->{'password'}))) {
741
            $log->syslog(
742
743
                'debug',
                'password is in %s format, not rehashing',
744
745
                hash_type($values->{'password'})
            );
746
747
        } else {
            $values->{'password'} =
748
749
                Sympa::User::password_fingerprint($values->{'password'},
                undef);
750
751
        }
    }
752

753
    ## Canonicalize lang if possible
754
755
756
    $values->{'lang'} = Sympa::Language::canonic_lang($values->{'lang'})
        || $values->{'lang'}
        if $values->{'lang'};
757

758
759
    my $who = Sympa::Tools::Text::canonic_email($values->{'email'});
    return undef unless defined $who;
760
761
762
763
764
765
    return undef if (is_global_user($who));

    ## Update each table
    my (@insert_field, @insert_value);
    while (($field, $value) = each %{$values}) {

766
767
768
769
770
771
772
        next unless ($map_field{$field});

        my $insert;
        if ($numeric_field{$map_field{$field}}) {
            $value ||= 0;    ## Can't have a null value
            $insert = $value;
        } else {
773
            $insert = $sdm->quote($value);
774
775
776
        }
        push @insert_value, $insert;
        push @insert_field, $map_field{$field};
777
778
779
    }

    unless (@insert_field) {
780
        $log->syslog(
781
782
783
784
785
            'err',
            'The fields (%s) do not correspond to anything in the database',
            join(',', keys(%{$values}))
        );
        return undef;
786
787
788
789
790
    }

    push @sth_stack, $sth;

    ## Update field
791
    $sth = $sdm->do_query(
792
793
794
        "INSERT INTO user_table (%s) VALUES (%s)",
        join(',', @insert_field),
        join(',', @insert_value)
795
796
    );
    unless (defined $sth) {
797
798
        $log->syslog('err',
            'Unable to add user %s to the DB table user_table',
799
800
801
            $values->{'email'});
        $sth = pop @sth_stack;
        return undef;
802
803
    }
    unless ($sth->rows) {
804
805
        $sth = pop @sth_stack;
        return 0;
806
807
808
809
810
811
812
    }

    $sth = pop @sth_stack;

    return 1;
}

813
=head2 Miscellaneous
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836

=over 4

=item clean_user ( USER_OR_HASH )

=item clean_users ( ARRAYREF_OF_USERS_OR_HASHES )

I<Function>.
Warn if the argument is not a Sympa::User object.
Return Sympa::User object, if any.

I<TENTATIVE>.
These functions will be used during transition between old and object-oriented
styles.  At last modifications have been done, they shall be removed.

=back

=cut

sub clean_user {
    my $user = shift;

    unless (ref $user eq 'Sympa::User') {
837
        local $Carp::CarpLevel = 1;
838
839
840
841
842
843
844
        Carp::carp("Deprecated usage: user should be a Sympa::User object");

        if (ref $user eq 'HASH') {
            $user = bless $user => __PACKAGE__;
        } else {
            $user = undef;
        }
845
846
847
848
849
850
851
852
853
854
    }
    $user;
}

sub clean_users {
    my $users = shift;
    return $users unless ref $users eq 'ARRAY';

    my $warned = 0;
    foreach my $user (@$users) {
855
856
        unless (ref $user eq 'Sympa::User') {
            unless ($warned) {
857
                local $Carp::CarpLevel = 1;
858
859
860
861
862
863
864
865
866
867
868
                Carp::carp(
                    "Deprecated usage: user should be a Sympa::User object");

                $warned = 1;
            }
            if (ref $user eq 'HASH') {
                $user = bless $user => __PACKAGE__;
            } else {
                $user = undef;
            }
        }
869
870
871
872
873
    }
    return $users;
}

1;