User.pm 21.2 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
312
#
# 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) = @_;

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

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

Luc Didry's avatar
Luc Didry committed
319
        return $fingerprint;
320
321
322
323
324
325
326
327
328
329
    },
    # 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
330
331
        unless (defined($salt)
            && $salt =~ m#\A\$2(a?)\$([0-9]{2})\$([./A-Za-z0-9]{22})#x) {
332
333
            my $bcrypt_cost = Conf::get_robot_conf('*', 'bcrypt_cost');
            my $cost = sprintf("%02d", 0 + $bcrypt_cost);
Luc Didry's avatar
Luc Didry committed
334
            my $newsalt = "";
335

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

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

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

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

        return $fingerprint;
    }
);

356
357
sub password_fingerprint {

358
359
    my ($pwd, $salt) = @_;

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

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

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

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

Mic Kaczmarczik's avatar
Mic Kaczmarczik committed
373
374
375
376
377
378
    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;
        }
    }
379

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

    return $fingerprint_hashes{$password_hash}->($pwd, $salt);
384
385
}

386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
=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
401
402
403
    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})#);
404
405
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
    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
433
        $user->{'email'}, $user_hash, $system_hash);
434
435
436
437
438
439

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

}

440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
############################################################################
## 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

458
459
I<Obsoleted>.

460
461
462
463
464
465
466
467
468
469
=item update_global_user

=back

=cut

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

470
    $log->syslog('debug2', '');
471

472
    return undef unless @users;
473

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

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

490
    return scalar @users;
491
492
493
494
}

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

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

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

    unless (
508
509
        $sdm
        and $sth = $sdm->do_prepared_query(
510
511
            sprintf(
                q{SELECT email_user AS email, gecos_user AS gecos,
512
513
514
515
516
517
518
519
                         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 = ?},
520
521
522
523
                $additional
            ),
            $who
        )
Luc Didry's avatar
Luc Didry committed
524
    ) {
525
        $log->syslog('err', 'Failed to prepare SQL query');
526
527
        $sth = pop @sth_stack;
        return undef;
528
529
530
531
532
533
534
535
    }

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

    $sth = pop @sth_stack;

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

        ## 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'}) {
563
            my %prefs = Sympa::Tools::Data::string_2_hash($user->{'data'});
564
565
            $user->{'prefs'} = \%prefs;
        }
566
567
568
569
570
571
    }

    return $user;
}

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

    my @users;

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

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

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

    $sth = pop @sth_stack;

    return @users;
}

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

604
    return undef unless defined $who;
605
606

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

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

    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 {
632
    $log->syslog('debug', '(%s, ...)', @_);
633
634
635
    my $who    = shift;
    my $values = $_[0];
    if (ref $values) {
636
        $values = {%$values};
637
    } else {
638
        $values = {@_};
639
640
    }

641
    $who = Sympa::Tools::Text::canonic_email($who);
642

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

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

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

671
672
673
674
675
676
    my ($field, $value);

    ## Update each table
    my @set_list;

    while (($field, $value) = each %{$values}) {
677
        unless ($map_field{$field}) {
678
679
            $log->syslog('err',
                'Unknown field %s in map_field internal error', $field);
680
681
682
683
684
685
686
687
            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 {
688
            $set = sprintf '%s=%s', $map_field{$field}, $sdm->quote($value);
689
690
        }
        push @set_list, $set;
691
692
693
694
695
696
697
698
    }

    return undef unless @set_list;

    ## Update field

    push @sth_stack, $sth;

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

    $sth = pop @sth_stack;

    return 1;
}

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

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

732
733
    my ($field, $value);

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

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

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

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

764
765
766
767
768
769
770
        next unless ($map_field{$field});

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

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

    push @sth_stack, $sth;

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

    $sth = pop @sth_stack;

    return 1;
}

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

=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') {
835
        local $Carp::CarpLevel = 1;
836
837
838
839
840
841
842
        Carp::carp("Deprecated usage: user should be a Sympa::User object");

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

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

    my $warned = 0;
    foreach my $user (@$users) {
853
854
        unless (ref $user eq 'Sympa::User') {
            unless ($warned) {
855
                local $Carp::CarpLevel = 1;
856
857
858
859
860
861
862
863
864
865
866
                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;
            }
        }
867
868
869
870
871
    }
    return $users;
}

1;