source: LATMOS-Accounts/lib/LATMOS/Accounts/Bases/Sql/objects.pm @ 504

Last change on this file since 504 was 504, checked in by nanardon, 15 years ago
  • check login user can chang password of the user
  • Property svn:keywords set to Id Rev
File size: 16.2 KB
Line 
1package LATMOS::Accounts::Bases::Sql::objects;
2
3use 5.010000;
4use strict;
5use warnings;
6
7use base qw(LATMOS::Accounts::Bases::Objects);
8use LATMOS::Accounts::Log;
9use Crypt::RSA;
10use Crypt::RSA::Key::Public::SSH;
11
12our $VERSION = (q$Rev$ =~ /^Rev: (\d+) /)[0];
13
14=head1 NAME
15
16LATMOS::Ad - Perl extension for blah blah blah
17
18=head1 SYNOPSIS
19
20  use LATMOS::Accounts::Bases;
21  my $base = LATMOS::Accounts::Bases->new('unix');
22  ...
23
24=head1 DESCRIPTION
25
26Account base access over standard unix file format.
27
28=cut
29
30# This fields are special in sense they may come from site field
31sub _address_fields { qw(co l postalCode streetAddress postOfficeBox st
32    facsimileTelephoneNumber o) }
33
34=head1 FUNCTIONS
35
36=cut
37
38=head2 new(%options)
39
40Create a new LATMOS::Ad object for windows AD $domain.
41
42domain / server: either the Ad domain or directly the server
43
44ldap_args is an optionnal list of arguments to pass to L<Net::LDAP>.
45
46=cut
47
48sub list {
49    my ($class, $base) = @_;
50
51    my $sth = $base->db->prepare_cached(
52        sprintf(
53            q{select %s as k from %s %s order by %s},
54            $base->db->quote_identifier($class->key_field),
55            $base->db->quote_identifier($class->object_table),
56            ($base->{wexported} ? '' : 'where exported = true'),
57            $base->db->quote_identifier($class->key_field),
58        )
59    );
60    $sth->execute;
61    my @keys;
62    while(my $res = $sth->fetchrow_hashref) {
63        push(@keys, $res->{k});
64    }
65    @keys
66}
67
68sub list_from_rev {
69    my ($class, $base, $rev) = @_;
70    my $sth = $base->db->prepare_cached(
71        sprintf(
72            q{select %s as k from %s where rev > ? %s order by %s},
73            $base->db->quote_identifier($class->key_field),
74            $base->db->quote_identifier($class->object_table),
75            ($base->{wexported} ? '' : 'and exported = true'),
76            $base->db->quote_identifier($class->key_field),
77        )
78    );
79    $sth->execute($rev);
80    my @keys;
81    while(my $res = $sth->fetchrow_hashref) {
82        push(@keys, $res->{k});
83    }
84    @keys
85}
86
87sub has_extended_attributes { 0 }
88
89# Work only for very simple case, must be override
90
91sub _inline_fields {
92    my ($self, $for, $base) = @_;
93    my @res;
94    my $sth = $base->db->prepare(
95        q{SELECT column_name FROM information_schema.columns
96          WHERE table_name = ?}
97    );
98    $sth->execute($self->object_table);
99    while (my $res = $sth->fetchrow_hashref) {
100        if ($for =~ 'w') {
101            next if($res->{column_name} =~ /^(rev|date|create|ikey)$/);
102            next if($res->{column_name} eq $self->key_field);
103        }
104        push(@res, $res->{column_name});
105    }
106    my %fields = map { $_ => $_ } @res;
107    %fields
108}
109
110# Everything managed by the perl code
111
112sub _managed_fields {
113    my ($class, $for, $base) = @_;
114    return();
115}
116
117# Everything from attributes_list table
118# $for is uneeded here as all this attributes are rw
119
120sub _extended_field {
121    my ($class, $for, $base) = @_;
122    my @attr;
123    if ($class->has_extended_attributes) {
124        my $sth = $base->db->prepare_cached(
125            sprintf(
126                q{select canonical from %s order by canonical},
127                $base->db->quote_identifier($class->object_table . '_attributes_list'),
128            )
129        );
130        $sth->execute;
131        while (my $res = $sth->fetchrow_hashref) {
132            push(@attr, $res->{canonical});
133        }
134        return map { $_ => $_ } @attr;
135    } else {
136        return ()
137    }
138}
139
140sub _canonical_fields {
141    my ($class, $base, $for) = @_;
142    $for ||= 'rw';
143    my %inl = (
144        ($class->_inline_fields($for, $base)),
145        ($class->_managed_fields($for, $base)),
146        ($class->_extended_field($for, $base)),
147    );
148    return sort keys %inl;
149}
150
151sub _get_field_name_db {
152    my ($class, $c_field, $base) = @_;
153    $class->has_extended_attributes or return;
154    $class->object_table or return;
155    my $sth = $base->db->prepare_cached(
156        sprintf(
157            q{select ikey from %s where canonical = ?},
158            $base->db->quote_identifier($class->object_table . '_attributes_list'),
159        )
160    );
161    $sth->execute($c_field);
162   
163    my $res = $sth->fetchrow_hashref;
164    $sth->finish;
165    return $c_field if($res->{ikey});
166}
167
168sub _get_field_name {
169    my ($class, $c_field, $base, $for) = @_;
170    $c_field or return;
171    $for ||= 'rw';
172    my %fields = $class->_managed_fields($for, $base);
173    return $fields{$c_field} if ($fields{$c_field});
174    %fields = $class->_inline_fields($for, $base);
175    return $fields{$c_field} if ($fields{$c_field});
176    %fields = $class->_extended_field($for, $base);
177    return $fields{$c_field}
178}
179
180sub new {
181    my ($class, $base, $id) = @_;
182    my $sth = $base->db->prepare_cached(
183        sprintf(q{select 1 from %s where %s = ? %s},
184            $base->db->quote_identifier($class->object_table),
185            $base->db->quote_identifier($class->key_field),
186            ($base->{wexported} ? '' : 'and exported = true'),
187        ),
188    );
189    my $count = $sth->execute($id);
190    $sth->finish;
191    $count == 1 or return;
192    $class->SUPER::new($base, $id);
193}
194
195sub _get_ikey {
196    my ($class, $base, $id) = @_;
197    $base ||= $class->base;
198    $id ||= $class->id;
199    my $sth = $base->db->prepare_cached(
200        sprintf(
201            q{select ikey from %s where %s = ?},
202            $base->db->quote_identifier($class->object_table),
203            $base->db->quote_identifier($class->key_field),
204        )
205    );
206    $sth->execute($id);
207    my $res = $sth->fetchrow_hashref;
208    $sth->finish;
209    $res->{ikey}
210}
211
212sub _create {
213    my ($class, $base, $id, %data) = @_;
214
215    # splitting inline from extended
216    my %inlined = $class->_inline_fields('w', $base);
217    my %inl = map { $_ => 1 } values %inlined;
218    my (%first, %second);
219    foreach (keys %data) {
220        if ($inl{$_}) {
221            $first{$_} = $data{$_};
222        } else {
223            $second{$_} = $data{$_};
224        }
225    }
226    $first{$class->key_field} = $id;
227
228    my $sth = $base->db->prepare(
229        sprintf(
230            q{insert into %s (%s) values (%s)},
231            $base->db->quote_identifier($class->object_table),
232            join(', ', map { $base->db->quote_identifier($_) } sort keys %first),
233            join(',', qw(?) x scalar(keys %first)),
234        )
235    );
236    $sth->execute(map { $first{$_} } sort keys %first) or return;
237
238    $class->new($base, $id)->set_fields(%second);
239
240    1;
241}
242
243sub _delete {
244    my ($class, $base, $id) = @_;
245
246    my $sthd = $base->db->prepare_cached(
247        sprintf(
248            q{delete from %s where %s = ?},
249            $base->db->quote_identifier($class->object_table),
250            $base->db->quote_identifier($class->key_field),
251        )
252    );
253    $sthd->execute($id);
254}
255
256sub db {
257    return $_[0]->base->db;
258}
259
260sub quote_object_table {
261    my ($self) = @_;
262    my $table = $self->object_table or return;
263    $self->db->quote_identifier($table);
264}
265sub quote_key_field { 
266    my ($self) = @_;
267    my $key_field = $self->key_field or return;
268    $self->db->quote_identifier($key_field);
269}
270
271sub get_field {
272    my ($self, $field) = @_;
273    my %inl = $self->_inline_fields('r', $self->base);
274    my %inline = map { $_ => 1 } values %inl;
275    if ($inline{$field}) {
276    my $sth = $self->db->prepare_cached(
277        sprintf(
278            q{select %s from %s where %s = ?},
279            $self->db->quote_identifier(lc($field)),
280            $self->quote_object_table,
281            $self->quote_key_field,
282        )
283    );
284    $sth->execute($self->id);
285    my $res = $sth->fetchrow_hashref;
286    $sth->finish;
287    return $res->{$field};
288    } elsif ($self->has_extended_attributes) { # else, then we mandatory have extend attr
289        my $sth = $self->db->prepare_cached(
290            sprintf(
291                q{
292                select value from %s
293                join %s on okey = ikey
294                where %s = ? and attr = ?
295                },
296                $self->db->quote_identifier($self->object_table. '_attributes'),
297                $self->db->quote_identifier($self->object_table),
298                $self->db->quote_identifier($self->key_field),
299            )
300        );
301        $sth->execute($self->id, $field);
302        my $res = $sth->fetchrow_hashref;
303        $sth->finish;
304        return $res->{value};
305    }
306}
307
308sub set_fields {
309    my ($self, %data) = @_;
310    my $updated_attributes = 0;
311    my @fields;
312    my @vals;
313    my %ext;
314    my %inl = $self->_inline_fields('w', $self->base);
315    my %inline = map { $_ => 1 } values %inl;
316    foreach my $field (keys %data) {
317        $data{$field} = $data{$field} ? 1 : 0 if($field eq 'exported');
318        my $oldval = $self->get_field($field);
319        next if (($data{$field} || '') eq ($oldval || ''));
320        if ($inline{$field}) {
321        # TODO check fields exists !
322            push(@fields, sprintf("%s = ?", $self->db->quote_identifier($field)));
323            push(@vals, $data{$field});
324        } else {
325            $ext{$field} = $data{$field};
326        }
327    }
328    if (@fields) {
329        my $sth = $self->db->prepare_cached(
330            sprintf(
331                q{update %s set %s where %s = ?},
332                $self->quote_object_table,
333                join(', ', @fields),
334                $self->quote_key_field,
335            )
336        );
337        $sth->execute(@vals, $self->id) or do {
338            $self->base->log(LA_ERR, "Cannot update inline field %s" .
339                $self->base->db->strerr);
340            return;
341        };
342        $updated_attributes = scalar(@fields);
343    }
344   
345    if ($self->has_extended_attributes) {
346        my $sthd = $self->db->prepare_cached(
347            sprintf(
348                q{delete from %s where okey = ? and attr = ?},
349                $self->db->quote_identifier($self->object_table. '_attributes'),
350            ),
351        );
352        my $sthx = $self->db->prepare_cached(
353            sprintf(
354                q{insert into %s (okey, attr, value) values (?,?,?)},
355                $self->db->quote_identifier($self->object_table. '_attributes'),
356            )
357        );
358        my $sthu = $self->db->prepare_cached(
359            sprintf(
360                q{update %s set value = ? where okey = ? and attr = ?},
361                $self->db->quote_identifier($self->object_table. '_attributes'),
362            )
363        );
364
365        my $okey = $self->_get_ikey($self->base, $self->id);
366        foreach (keys %ext) {
367            if ($ext{$_}) {
368                my $res = $sthu->execute($ext{$_}, $okey, $_);
369                defined($res) or do {
370                    $self->base->log(LA_ERR,
371                        "Error while udapting attributes: %s",
372                        $self->base->db->strerr
373                    );
374                    return;
375                };
376                if ($res == 0) {
377                    $res = $sthx->execute($okey, $_, $ext{$_});
378                    defined($res) or do {
379                        $self->base->log(LA_ERR,
380                            "Error while udapting attributes: %s",
381                            $self->base->db->strerr
382                        );
383                        return;
384                    };
385                }
386            } else {
387                defined($sthd->execute($okey, $_)) or do {
388                    $self->base->log(LA_ERR,
389                        "Error while deleting attributes: %s",
390                        $self->base->db->strerr
391                    );
392                    return;
393                };
394            }
395            $updated_attributes++;
396        }
397    }
398
399    $updated_attributes;
400}
401
402sub attributes_summary {
403    my ($class, $base, $attribute) = @_;
404    $class->has_extended_attributes && $class->object_table or
405        return $class->SUPER::attributes_summary($base, $attribute);
406    my $sth = $base->db->prepare_cached(
407        sprintf(
408            q{select value from %s where attr = ? group by value},
409            $base->db->quote_identifier($class->object_table .
410                '_attributes'),
411        )
412    );
413    $sth->execute($attribute);
414
415    my @values;
416    while (my $res = $sth->fetchrow_hashref) {
417        push(@values, $res->{value});
418    }
419    @values
420}
421
422sub _set_password {
423    my ($self, $clear_pass) = @_;
424    if (my $field = $self->base->get_field_name($self->type, 'userPassword')) {
425        my @salt_char = (('a' .. 'z'), ('A' .. 'Z'), (0 .. 9), '/', '.');
426        my $salt = join('', map { $salt_char[rand(scalar(@salt_char))] } (1 .. 8));
427        my $res = $self->set_fields($field, crypt($clear_pass, '$1$' . $salt));
428
429        if (my $serialize = $self->base->get_global_value('rsa_public_key')) {
430            my $public = Crypt::RSA::Key::Public::SSH->new;
431            $public->deserialize(String => [ $serialize ]);
432            my $rsa = new Crypt::RSA ES => 'PKCS1v15';
433            my $rsa_password = $rsa->encrypt (
434                Message    => $clear_pass,
435                Key        => $public,
436                Armour     => 1,
437            ) || die $self->poll->rsa->errstr();
438            $self->set_c_fields('encryptedPassword', $rsa_password);
439        }
440    } else {
441        $self->log(LA_WARN,
442            "Cannot set password: userPassword attributes is unsupported");
443    }
444}
445
446sub search {
447    my ($class, $base, @filter) = @_;
448
449    if ($class->has_extended_attributes) {
450        my @sqlintersec;
451        my @bind;
452        while (my $item = shift(@filter)) {
453            # attr=foo => no extra white space !
454            # \W is false, it is possible to have two char
455            my ($attr, $mode, $val) = $item =~ /^(\w+)(?:(\W)(.+))?$/ or next;
456            if (!$mode) {
457                $mode = '~';
458                $val = shift(@filter);
459            }
460            $val ||= '';
461            push(@sqlintersec,
462                sprintf(q{select okey from %s where attr=? %s},
463                    $base->db->quote_identifier($class->object_table .
464                        '_attributes'),
465                    $val eq '*'
466                        ? ''
467                        : ($mode eq '~'
468                            ? q{and value ILIKE ?}
469                            : q{and value = ?} )
470                )
471            );
472            push(@bind, $base->get_field_name($class->type, $attr, 'r'));
473            push(@bind, $val) unless($val eq '*');
474        }
475        my $sth = $base->db->prepare(
476            sprintf(q{
477                select name from %s
478                %s
479                },
480                $base->db->quote_identifier($class->object_table),
481                @sqlintersec ? 'where ikey in (' . join("\n intersect\n",
482                    @sqlintersec) . ')' : '',
483            )
484        );
485        $sth->execute(@bind);
486        my @results;
487        while (my $res = $sth->fetchrow_hashref) {
488            push(@results, $res->{name});
489        }
490        return(@results);
491    } else {
492        my @bind;
493        my @where;
494        while (my $item = shift(@filter)) {
495            # attr=foo => no extra white space !
496            # \W is false, it is possible to have two char
497            my ($attr, $mode, $val) = $item =~ /^(\w+)(?:(\W)(.+))?$/ or next;
498            if (!$mode) {
499                $mode = '~';
500                $val = shift(@filter);
501            }
502            if ($val eq '*') {
503                push(@where, sprintf("%s is not NULL",
504                        $base->db->quote_identifier($base->get_field_name($class->type,
505                                $attr, 'r'))
506                    )
507                );
508            } else {
509                push(@where, sprintf("%s %s ?",
510                        $base->db->quote_identifier(
511                            $base->get_field_name($class->type, $attr, 'r')
512                        ),
513                        $mode eq '~' ? 'ILIKE' : '=',
514                    ));
515                push(@bind, lc($val));
516            }
517        }
518        my $sth = $base->db->prepare(
519            sprintf(q{select name from %s where %s},
520                $base->db->quote_identifier($class->object_table),
521                join(' and ', @where),
522            )
523        );
524        $sth->execute(@bind);
525        my @results;
526        while (my $res = $sth->fetchrow_hashref) {
527            push(@results, $res->{name});
528        }
529        return(@results);
530    }
531}
532
5331;
534
535__END__
536
537=head1 SEE ALSO
538
539=head1 AUTHOR
540
541Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
542
543=head1 COPYRIGHT AND LICENSE
544
545Copyright (C) 2008, 2009 CNRS SA/CETP/LATMOS
546
547This library is free software; you can redistribute it and/or modify
548it under the same terms as Perl itself, either Perl version 5.10.0 or,
549at your option, any later version of Perl 5 you may have available.
550
551
552=cut
Note: See TracBrowser for help on using the repository browser.