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

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

Fix the doc
  • 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
235=head2 testpass
236
237Test password for given user
238
239=cut
240
241    $self->add_func('testpass', {
242            completion => sub {
243                if (! $_[2]) {
244                    return $_[0]->base->list_objects('user');
245                }
246            },
247            code => sub {
248                my ($self, $user, @passwd) = @_;
249                my $uobj = $self->base->get_object('user', $user) or do {
250                    $self->print("Cannot get user $user\n");
251                    return;
252                };
253
254                if (! $uobj->CheckAccountValidity ) {
255                    $self->print("Account $user cannot currently log\n");
256                }
257
258                foreach (@passwd) {
259                    my $is = $uobj->ComparePassword( $_ );
260                    if ($is) {
261                        $self->print("Passord for $user is $_\n");
262                        last;
263                    }
264                }
265            },
266        });
267
268=head3 create
269
270Create object
271
272
273=over 4
274
275=item -i
276
277    interactive: will prompt for attribute
278
279=item -f FILE
280
281    Read file for attribute value
282
283=item -e
284
285    open an epty file instead instead attribute list
286
287=item --ro
288
289    Open an empty with attribute even read-only one
290
291=back
292
293=cut
294
295    $self->add_func('create', {
296            code => sub {
297                my $self = shift;
298                my ($otype, $objname) = $self->getoption(
299                    {
300                        'i'   => \my $interactive,
301                        'f=s' => \my $inputfile,
302                        'ro'  => \my $with_ro,
303                        'e'   => \my $empty_file,
304                    }, @_
305                );
306
307                if (!$otype) {
308                    $self->print("No object type given\n");
309                    return;
310                }
311
312                if ( $interactive ) {
313                    my $helper = $self->base->ochelper($otype);
314                    my $info = undef;
315                    while (1) {
316                        my $status;
317                        ($status, $info) = $helper->step($info);
318
319                        if ($status ne 'NEEDINFO') {
320                            if ($status eq 'CREATED') {
321                                $self->print("Object created\n");
322                                $self->commit;
323                            } else {
324                                $self->print("Nothing done\n");
325                                $self->rollback;
326                            }
327                            return;
328                        }
329
330                        if ($info->{name}{ask}) {
331                            my $line = $self->Context->Term->readline("Name of the object ?");
332                            $info->{name}{content} = $line;
333                        }
334                        foreach my $attr (@{$info->{ask} || []}) {
335                            $self->Context->Term->Attribs->{completion_function} = sub {
336                                $info->{contents}{$attr}
337                            };
338                            my $line = $self->Context->Term->readline(sprintf('  %s %s? ',
339                                    $attr,
340                                    $info->{contents}{$attr}
341                                    ? '(' . $info->{contents}{$attr} . ') '
342                                    : ''
343                                ));
344                            $info->{contents}{$attr} = $line if($line);
345                        }
346                    }
347                } elsif ($inputfile) {
348                    my $handle;
349                    open($handle, '<', $inputfile) or do {
350                        warn "Cannot open input file $@\n";
351                        return;
352                    };
353                    my $res = $self->_create_from_handle($handle, $otype, $objname);
354                    close($handle);
355                    $self->commit if($res);
356                    return($res);
357                } else {
358                    return LATMOS::Accounts::Utils::dump_read_temp_file(
359                        sub {
360                            my ($fh) = @_;
361                            $labase->text_empty_dump($fh, $otype,
362                                {
363                                    only_rw => !$with_ro,
364                                }
365                            ) unless($empty_file);
366                        },
367                        sub {
368                            my ($fh) = @_;
369                            if (my $res = $self->_create_from_handle($fh, $otype, $objname)) {
370                                 $self->commit;
371                                 return $res;
372                             } else {
373                                 return;
374                             }
375                        }
376                    );
377                }
378            },
379            completion => sub {
380                my ($self, $carg, @args) = @_;
381                my @options = ();
382                push( @options, qw(-i -f)  ) unless ( grep { $_ =~ /^-[fi]$/ } @args );
383                push( @options, qw(-e --ro)) unless ( grep { $_ eq '-f' } @args );
384
385                if (($args[-1] || '') eq '-f') {
386                    my $attribs = $self->Context->Term->Attribs;
387                    return $self->Context->Term->completion_matches($carg, $attribs->{'filename_completion_function'});
388                } else {
389                    return (@options, $self->base->list_supported_objects);
390                }
391            },
392        }
393    );
394    $self->add_func('exchangeip', 
395        {
396            help => 'Exchange two IP on host',
397            code => sub {
398                my ($self, @args) = @_;
399                my ($ip1, $ip2) =
400                    grep { $_ && $_ =~ /\d+\.\d+\.\d+\.\d+/ } @args;
401                if (!$ip2) {
402                    $self->print("Need two ip to exchange\n");
403                    return;
404                }
405                if ($self->base->nethost_exchange_ip($ip1, $ip2)) {
406                    $self->print("$ip1 and $ip2 get exchange\n");
407                    $self->commit;
408                } else {
409                    $self->rollback;
410                }   
411            },
412            completion => sub {
413                my ($self, $carg, @args) = @_;
414                if ($args[-1] && $args[-1] !~ m/\d+\.\d+\.\d+\.\d+/) {
415                    if (my $obj = $self->base->get_object('nethost', $args[-1])) {
416                        return $obj->get_attributes('ip');
417                    }
418                } else {
419                    my @list = 
420                    ($self->base->attributes_summary('nethost', 'ip'),
421                        $self->base->list_objects('nethost'));
422                    return @list;
423                }
424            },
425        }
426    );
427
428    $self->add_func('loadcsv',
429        {
430            help => 'Load CSV file to create object',
431            code => sub {
432                my ($self, $otype, $file) = @_;
433
434                open(my $fh, '<', $file) or do {
435                   warn "Cannot open  $file $!\n";
436                   return;
437                };
438
439                my @ids;
440
441                loadCSV(
442                    $fh,
443                    cb => sub {
444                        my ($res, $linecount) = @_;
445
446                        my $ochelper = $labase->ochelper($otype);
447
448                        my $info = {
449                            contents => $res
450                        };
451                        if ($res->{name}) {
452                            $info->{name}{content} = $res->{name};
453                        }
454
455                        if (my $id = $ochelper->Automate($info)) {
456                            push(@ids, $id);
457                        } else {
458                            warn "Cannot create object line $linecount (not enough information ?)\n";
459                        }
460                    },
461                );
462
463                close($fh);
464
465                my @objs;
466                foreach (@ids) {
467                    my $obj = $self->base->get_object($otype, $_) or do {
468                        $self->print("Cannot get $otype $_\n");
469                        return;
470                    };
471                    push(@objs, $obj);
472                }
473
474                $self->print("Selecting $otype " . join(', ', @ids) . "\n");
475                LATMOS::Accounts::Cli::Object->new(
476                    Parent  => $self,
477                    Context => $self->Context,
478                    otype   => $otype,
479                    objs    => \@objs,
480                )->cli();
481            },
482            completion => sub {
483                if ($_[2]) {
484                    return Term::ReadLine::Gnu::filename_list(@_);
485                } else {
486                    return '@', $_[0]->base->list_supported_objects;
487                }
488            },
489        }
490    );
491
492    $self->add_func('user',  { alias => [qw'select user' ] });
493    $self->add_func('group', { alias => [qw'select group'] });
494    return $self
495}
496
4971;
498
499__END__
500
501=head1 SEE ALSO
502
503L<LATMOS::Accounts>
504
505=head1 AUTHOR
506
507Olivier Thauvin, E<lt>olivier.thauvin@latmos.ipsl.frE<gt>
508
509=head1 COPYRIGHT AND LICENSE
510
511Copyright (C) 2008, 2009, 2010, 2011, 2012 CNRS SA/CETP/LATMOS
512
513This library is free software; you can redistribute it and/or modify
514it under the same terms as Perl itself, either Perl version 5.10.0 or,
515at your option, any later version of Perl 5 you may have available.
516
517=cut
Note: See TracBrowser for help on using the repository browser.