source: trunk/LATMOS-Accounts/lib/LATMOS/Accounts/Cli.pm @ 2456

Last change on this file since 2456 was 2456, checked in by nanardon, 3 years ago

Ajout testpass à la-cli
  • Property svn:keywords set to Id
File size: 16.9 KB
Line 
1package LATMOS::Accounts::Cli;
2
3# $Id: Cli.pm 2145 2018-08-29 18:15:46Z nanardon $
4
5use strict;
6use warnings;
7use Moose;
8use LATMOS::Accounts::Log;
9use LATMOS::Accounts::Utils;
10use Term::ReadLine;
11use Text::ParseWords;
12use Getopt::Long;
13use LATMOS::Accounts::Cli::Object;
14
15extends 'LATMOS::Accounts::Cli::Base';
16
17=head1 NAME
18
19LATMOS::Accounts::Cli - Command line interface functions
20
21=head1 DESCRIPTION
22
23This module handle envirronment and functons for L<la-cli> tools.
24
25=cut
26
27=head1 FUNCTIONS
28
29=cut
30
31=head2 globalenv
32
33Return the main envirronement object
34
35=cut
36
37sub _create_from_handle {
38    my ($self, $fh, $otype, $objname) = @_;
39
40    my $labase = $self->base;
41
42    my %attr = LATMOS::Accounts::Utils::parse_obj_file($fh);
43    if ($objname && (my $obj = $labase->get_object($otype, $objname))) {
44         warn "Object $otype $objname already exists, aborting\n";
45         return;
46    } else {
47        if ($objname) {
48            my $res = $labase->create_c_object($otype, $objname, %attr);
49            if($res) {
50                $self->print("Changes applied\n");
51                $labase->commit;
52                return 1;
53            }
54            return 0;
55        } else {
56            my $ochelper = $labase->ochelper($otype);
57
58            my $info = {
59                contents => { %attr },
60            };
61            if ($attr{name}) {
62                $info->{name}{content} = $attr{name};
63            }
64
65            $ochelper->Automate($info) or do {
66                warn "Cannot create object:" . LATMOS::Accounts::Log::lastmessage() . "\n";
67                return;
68            };
69            return 1;
70        } 
71    }
72}
73
74=head1 CLI FUNCTIONS
75
76=head2 GLOBAL FUNCTIONS
77
78=cut
79
80sub BUILD {
81    my ( $self ) = @_;
82
83    my $labase = $self->base;
84
85    $self->add_func('ls', {
86            help => 'ls object_type - list object of type object_type', 
87            completion => sub {
88                if(!$_[2]) {
89                    return $_[0]->base->list_supported_objects
90                } else { () }
91            },
92            code => sub {
93                my $env = shift;
94                my @args = $self->getoption(
95                    {
96                        'fmt=s'      => \my $fmt,
97                        'filefmt=s'  => \my $filefmt,
98                    }, @_
99                );
100
101                my $otype = $args[0] or do {
102                    $self->print("Object type missing\n");
103                    return 1;
104                };
105
106                if ($filefmt){
107                    open(my $hfmt, '<', $filefmt) or do {
108                       warn "Cannot open $filefmt\n";
109                       return;
110                    };
111                    $fmt ||= ''; # avoid undef warning
112                    while (<$hfmt>) {
113                        chomp($fmt .= $_);
114                    }
115                    close $hfmt;
116                }
117
118                if ($fmt) {
119                    foreach ($env->base->list_objects($otype)) {
120                        my $obj = $env->base->get_object($otype, $_) or next;
121                        $self->print($obj->queryformat($fmt));
122                    }
123                    $self->print("\n");
124                } else {
125                    $self->print(map { "$_\n" } $env->base->list_objects($otype));
126                }
127            },
128        });
129    $self->add_func('search', {
130            help => 'search objecttype filter1 [filter2...] - search object according filter',
131            completion => sub {
132                my ($self, $ritem, $rotype) = @_;
133                if(!$_[2]) {
134                    return $self->base->list_supported_objects
135                } else {
136                    my $parse;
137                    $parse = sub {
138                        my ($otype, $item) = @_;
139                        $item ||= '';
140                        my ($NegFilter, $attr, $dot, $attrref, $operator, $val) = $item =~ /^([\!\+\-]?)(\w+)(?:(\.)([\.\w]+))?(?:([^\w*]+)(.+))?$/;
141                        if ($dot) {
142                            my $attribute = $self->base->attribute($otype, $attr) or
143                                return ($self->base->list_canonical_fields( $otype, 'r' ) );
144                            my $refotype  = $attribute->reference;
145                            return map { "$attr." . $_ } $parse->($refotype, "$attrref$operator$val" );
146                        } else {
147                            return($self->base->list_canonical_fields($otype, 'r'));
148                        }
149
150                    };
151                    return(
152                        map { $_, "!$_", "-$_", "+$_" }
153                        map { ( $_ . '=', $_ . '~' ) } $parse->( $rotype, $ritem )
154                    );
155                }
156            },
157            code => sub {
158                my ($self, @args) = @_;
159                if ($args[0]) {
160                    if (!$self->base->is_supported_object($args[0])) {
161                        $self->print("$args[0] is an usupported object type\n");
162                    } else {
163                        my @res = $self->base->search_objects(@args);
164                        $self->print(map { "$_\n" } @res);
165                        $self->{_lastsearch} = \@res;
166                        $self->{_lastsearchtype} = $args[0];
167                    }
168                } else {
169                    $self->print("Object type missing\n");
170                }
171            },
172        });
173    $self->add_func('expired', {
174        help => 'expired [delay] - list expired account more than delay (default is now)',
175        code => sub {
176            my ($self, $expire) = @_;
177            my @users = $self->base->find_expired_users($expire);
178            $self->print(map { "$_\n" } @users);
179            $self->{_lastsearchtype} = 'user';
180            $self->{_lastsearch} = \@users;
181        },
182    }) if ($self->base->can('find_expired_users'));
183    $self->add_func('expires', {
184        help => 'expires [delay] - list account expiring before delay (default is 1 month)',
185        code => sub {
186            my ($self, $expire) = @_;
187            my @users = $self->base->find_next_expire_users($expire);
188            $self->print(map { "$_\n" } @users);
189            $self->{_lastsearchtype} = 'user';
190            $self->{_lastsearch} = \@users;
191        },
192    }) if ($self->base->can('find_next_expire_users'));
193    $self->add_func('select', {
194            help => 'select object_type - select objects to perform action on it',
195            completion => sub {
196                if ($_[2]) {
197                    return $_[0]->base->list_objects($_[2]);
198                } else {
199                    return '@', $_[0]->base->list_supported_objects;
200                }
201            },
202            code => sub {
203                my ($self, $otype, @ids) = @_;
204                my @objs;
205                if ($otype eq '@') {
206                    if (@{$self->{_lastsearch} || []}) {
207                        $otype = $self->{_lastsearchtype};
208                        @ids = @{$self->{_lastsearch}};
209                    } else {
210                        $self->print("No results store from previous search\n");
211                        return;
212                    }
213                }
214                if (!@ids) {
215                    $self->print('not enough arguments' . "\n");
216                    return;
217                }
218                foreach (@ids) {
219                    my $obj = $self->base->get_object($otype, $_) or do {
220                        $self->print("Cannot get $otype $_\n");
221                        return;
222                    };
223                    push(@objs, $obj);
224                }
225                $self->print("Selecting $otype " . join(', ', map { $_->id } @objs) . "\n");
226                LATMOS::Accounts::Cli::Object->new(
227                    Parent  => $self,
228                    Context => $self->Context,
229                    otype   => $otype,
230                    objs    => \@objs,
231                )->cli();
232            },
233        });
234=head2 testpass
235
236=cut
237
238    $self->add_func('testpass', {
239            help => 'Test password for given user',
240            completion => sub {
241                if (! $_[2]) {
242                    return $_[0]->base->list_objects('user');
243                }
244            },
245            code => sub {
246                my ($self, $user, @passwd) = @_;
247                my $uobj = $self->base->get_object('user', $user) or do {
248                    $self->print("Cannot get user $user\n");
249                    return;
250                };
251
252                if (! $uobj->CheckAccountValidity ) {
253                    $self->print("Account $user cannot currently log\n");
254                }
255
256                foreach (@passwd) {
257                    my $is = $uobj->ComparePassword( $_ );
258                    if ($is) {
259                        $self->print("Passord for $user is $_\n");
260                        last;
261                    }
262                }
263            },
264        });
265
266=head3 create
267
268Create object
269
270
271=over 4
272
273=item -i
274
275    interactive: will prompt for attribute
276
277=item -f FILE
278
279    Read file for attribute value
280
281=item -e
282
283    open an epty file instead instead attribute list
284
285=item --ro
286
287    Open an empty with attribute even read-only one
288
289=back
290
291=cut
292
293    $self->add_func('create', {
294            code => sub {
295                my $self = shift;
296                my ($otype, $objname) = $self->getoption(
297                    {
298                        'i'   => \my $interactive,
299                        'f=s' => \my $inputfile,
300                        'ro'  => \my $with_ro,
301                        'e'   => \my $empty_file,
302                    }, @_
303                );
304
305                if (!$otype) {
306                    $self->print("No object type given\n");
307                    return;
308                }
309
310                if ( $interactive ) {
311                    my $helper = $self->base->ochelper($otype);
312                    my $info = undef;
313                    while (1) {
314                        my $status;
315                        ($status, $info) = $helper->step($info);
316
317                        if ($status ne 'NEEDINFO') {
318                            if ($status eq 'CREATED') {
319                                $self->print("Object created\n");
320                                $self->commit;
321                            } else {
322                                $self->print("Nothing done\n");
323                                $self->rollback;
324                            }
325                            return;
326                        }
327
328                        if ($info->{name}{ask}) {
329                            my $line = $self->Context->Term->readline("Name of the object ?");
330                            $info->{name}{content} = $line;
331                        }
332                        foreach my $attr (@{$info->{ask} || []}) {
333                            $self->Context->Term->Attribs->{completion_function} = sub {
334                                $info->{contents}{$attr}
335                            };
336                            my $line = $self->Context->Term->readline(sprintf('  %s %s? ',
337                                    $attr,
338                                    $info->{contents}{$attr}
339                                    ? '(' . $info->{contents}{$attr} . ') '
340                                    : ''
341                                ));
342                            $info->{contents}{$attr} = $line if($line);
343                        }
344                    }
345                } elsif ($inputfile) {
346                    my $handle;
347                    open($handle, '<', $inputfile) or do {
348                        warn "Cannot open input file $@\n";
349                        return;
350                    };
351                    my $res = $self->_create_from_handle($handle, $otype, $objname);
352                    close($handle);
353                    $self->commit if($res);
354                    return($res);
355                } else {
356                    return LATMOS::Accounts::Utils::dump_read_temp_file(
357                        sub {
358                            my ($fh) = @_;
359                            $labase->text_empty_dump($fh, $otype,
360                                {
361                                    only_rw => !$with_ro,
362                                }
363                            ) unless($empty_file);
364                        },
365                        sub {
366                            my ($fh) = @_;
367                            if (my $res = $self->_create_from_handle($fh, $otype, $objname)) {
368                                 $self->commit;
369                                 return $res;
370                             } else {
371                                 return;
372                             }
373                        }
374                    );
375                }
376            },
377            completion => sub {
378                my ($self, $carg, @args) = @_;
379                my @options = ();
380                push( @options, qw(-i -f)  ) unless ( grep { $_ =~ /^-[fi]$/ } @args );
381                push( @options, qw(-e --ro)) unless ( grep { $_ eq '-f' } @args );
382
383                if (($args[-1] || '') eq '-f') {
384                    my $attribs = $self->Context->Term->Attribs;
385                    return $self->Context->Term->completion_matches($carg, $attribs->{'filename_completion_function'});
386                } else {
387                    return (@options, $self->base->list_supported_objects);
388                }
389            },
390        }
391    );
392    $self->add_func('exchangeip', 
393        {
394            help => 'Exchange two IP on host',
395            code => sub {
396                my ($self, @args) = @_;
397                my ($ip1, $ip2) =
398                    grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args;
399                if (!$ip2) {
400                    $self->print("Need two ip to exchange\n");
401                    return;
402                }
403                if ($self->base->nethost_exchange_ip($ip1, $ip2)) {
404                    $self->print("$ip1 and $ip2 get exchange\n");
405                    $self->commit;
406                } else {
407                    $self->rollback;
408                }   
409            },
410            completion => sub {
411                my ($self, $carg, @args) = @_;
412                if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) {
413                    if (my $obj = $self->base->get_object('nethost', $args[-1])) {
414                        return $obj->get_attributes('ip');
415                    }
416                } else {
417                    my @list = 
418                    ($self->base->attributes_summary('nethost', 'ip'),
419                        $self->base->list_objects('nethost'));
420                    return @list;
421                }
422            },
423        }
424    );
425
426    $self->add_func('loadcsv',
427        {
428            help => 'Load CSV file to create object',
429            code => sub {
430                my ($self, $otype, $file) = @_;
431
432                open(my $fh, '<', $file) or do {
433                   warn "Cannot open  $file $!\n";
434                   return;
435                };
436
437                my @ids;
438
439                loadCSV(
440                    $fh,
441                    cb => sub {
442                        my ($res, $linecount) = @_;
443
444                        my $ochelper = $labase->ochelper($otype);
445
446                        my $info = {
447                            contents => $res
448                        };
449                        if ($res->{name}) {
450                            $info->{name}{content} = $res->{name};
451                        }
452
453                        if (my $id = $ochelper->Automate($info)) {
454                            push(@ids, $id);
455                        } else {
456                            warn "Cannot create object line $linecount (not enough information ?)\n";
457                        }
458                    },
459                );
460
461                close($fh);
462
463                my @objs;
464                foreach (@ids) {
465                    my $obj = $self->base->get_object($otype, $_) or do {
466                        $self->print("Cannot get $otype $_\n");
467                        return;
468                    };
469                    push(@objs, $obj);
470                }
471
472                $self->print("Selecting $otype " . join(', ', @ids) . "\n");
473                LATMOS::Accounts::Cli::Object->new(
474                    Parent  => $self,
475                    Context => $self->Context,
476                    otype   => $otype,
477                    objs    => \@objs,
478                )->cli();
479            },
480            completion => sub {
481                if ($_[2]) {
482                    return Term::ReadLine::Gnu::filename_list(@_);
483                } else {
484                    return '@', $_[0]->base->list_supported_objects;
485                }
486            },
487        }
488    );
489
490    $self->add_func('user',  { alias => [qw'select user' ] });
491    $self->add_func('group', { alias => [qw'select group'] });
492    return $self
493}
494
4951;
496
497__END__
498
499=head1 SEE ALSO
500
501L<LATMOS::Accounts>
502
503=head1 AUTHOR
504
505Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
506
507=head1 COPYRIGHT AND LICENSE
508
509Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
510
511This library is free software; you can redistribute it and/or modify
512it under the same terms as Perl itself, either Perl version 5.10.0 or,
513at your option, any later version of Perl 5 you may have available.
514
515=cut
Note: See TracBrowser for help on using the repository browser.