Cli.pm 10 KB
Newer Older
Yadd's avatar
Yadd committed
1
2
3
4
5
package Lemonldap::NG::Manager::Cli;

use strict;
use Mouse;
use Data::Dumper;
6
use Lemonldap::NG::Manager::Constants;
Yadd's avatar
Yadd committed
7
8
9
10
11
12
13
14
15
16
17
18
19

extends('Lemonldap::NG::Manager::Cli::Lib');

has cfgNum => (
    is      => 'rw',
    isa     => 'Int',
    trigger => sub {
        $_[0]->{req} =
          Lemonldap::NG::Manager::Cli::Request->new(
            cfgNum => $_[0]->{cfgNum} );
    }
);

Yadd's avatar
Yadd committed
20
21
has sep => ( is => 'rw', isa => 'Str', default => '/' );

Yadd's avatar
Yadd committed
22
23
has req => ( is => 'ro' );

Yadd's avatar
Yadd committed
24
25
26
27
28
29
has format => ( is => 'rw', isa => 'Str', default => "%-25s | %-25s | %-25s" );

has yes => ( is => 'rw', isa => 'Bool', default => 0 );

has force => ( is => 'rw', isa => 'Bool', default => 0 );

Yadd's avatar
Yadd committed
30
sub get {
Yadd's avatar
Yadd committed
31
32
33
34
35
    my ( $self, @keys ) = @_;
    die 'get requires at least one key' unless (@keys);
  L: foreach my $key (@keys) {
        my $value = $self->_getKey($key);
        if ( ref $value eq 'HASH' ) {
Yadd's avatar
Yadd committed
36
            print "$key has the following keys:\n";
Yadd's avatar
Yadd committed
37
            print "   $_\n" foreach ( sort keys %$value );
Yadd's avatar
Yadd committed
38
39
        }
        else {
Yadd's avatar
Yadd committed
40
            $value //= '';
Yadd's avatar
Yadd committed
41
42
43
44
45
            print "$key = $value\n";
        }
    }
}

Yadd's avatar
Yadd committed
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
sub set {
    my ( $self, %pairs ) = @_;
    my $format = $self->format . "\n";
    die 'set requires at least one key and one value' unless (%pairs);
    my @list;
    foreach my $key ( keys %pairs ) {
        my $oldValue = $self->_getKey($key);
        if ( ref $oldValue ) {
            die "$key seems to be a hash, modification refused";
        }
        push @list, [ $key, $oldValue, $pairs{$key} ];
    }
    unless ( $self->yes ) {
        print "Proposed changes:\n";
        printf $format, 'Key', 'Old value', 'New value';
        foreach (@list) {
            printf $format, @$_;
        }
        print "Confirm (N/y)? ";
        my $c = <STDIN>;
        unless ( $c =~ /^y(?:es)?$/ ) {
            die "Aborting";
        }
    }
    require Clone;
    my $new = Clone::clone( $self->mgr->currentConf );
    foreach my $key ( keys %pairs ) {
        $self->_setKey( $new, $key, $pairs{$key} );
    }
75
76
77
78
79
80
81
82
    return $self->_save($new);
}

sub addKey {
    my $self = shift;
    unless ( @_ % 3 == 0 ) {
        die 'usage: "addKey (?:rootKey newKey newValue)+';
    }
83
    my $sep = $self->sep;
84
85
86
87
88
    my @list;
    while (@_) {
        my $root   = shift;
        my $newKey = shift;
        my $value  = shift;
89
        unless ( $root =~ /$simpleHashKeys$/o or $root =~ /$sep/o ) {
90
            die "$root is not a simple hash. Aborting";
Yadd's avatar
Yadd committed
91
        }
92
        push @list, [ $root, $newKey, $value ];
Yadd's avatar
Yadd committed
93
    }
94
95
96
    require Clone;
    my $new = Clone::clone( $self->mgr->currentConf );
    foreach my $el (@list) {
97
98
99
100
101
102
103
104
105
106
        my @path = split $sep, $el->[0];
        if ( $#path == 0 ) {
            $new->{ $path[0] }->{ $el->[1] } = $el->[2];
        }
        elsif ( $#path == 1 ) {
            $new->{ $path[0] }->{ $path[1] }->{ $el->[1] } = $el->[2];
        }
        else {
            die $el->[0] . " has too many levels. Aborting";
        }
Yadd's avatar
Yadd committed
107
    }
108
109
110
111
112
113
114
    return $self->_save($new);
}

sub delKey {
    my $self = shift;
    unless ( @_ % 2 == 0 ) {
        die 'usage: "delKey (?:rootKey key)+';
Yadd's avatar
Yadd committed
115
    }
116
    my $sep = $self->sep;
117
118
119
120
    my @list;
    while (@_) {
        my $root = shift;
        my $key  = shift;
121
        unless ( $root =~ /$simpleHashKeys$/o or $root =~ /$sep/o ) {
122
123
124
125
126
127
128
            die "$root is not a simple hash. Aborting";
        }
        push @list, [ $root, $key ];
    }
    require Clone;
    my $new = Clone::clone( $self->mgr->currentConf );
    foreach my $el (@list) {
129
130
131
132
133
134
135
136
137
138
        my @path = split $sep, $el->[0];
        if ( $#path == 0 ) {
            delete $new->{ $path[0] }->{ $el->[1] };
        }
        elsif ( $#path == 1 ) {
            delete $new->{ $path[0] }->{ $path[1] }->{ $el->[1] };
        }
        else {
            die $el->[0] . " has too many levels. Aborting";
        }
Yadd's avatar
Yadd committed
139
    }
140
    return $self->_save($new);
Yadd's avatar
Yadd committed
141
142
}

Yadd's avatar
Yadd committed
143
144
145
146
147
sub lastCfg {
    my ($self) = @_;
    return $self->jsonResponse('/confs/latest')->{cfgNum};
}

Yadd's avatar
Yadd committed
148
149
150
151
152
153
154
155
sub _getKey {
    my ( $self, $key ) = @_;
    my $sep = $self->sep;
    my ( $base, @path ) = split $sep, $key;
    unless ( $base =~ /^\w+$/ ) {
        warn "Malformed key $base";
        return ();
    }
156
    my $value = $self->mgr->getConfKey( $self->req, $base, noCache => 1 );
Yadd's avatar
Yadd committed
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
    if ( $self->req->error ) {
        die $self->req->error;
    }
    if ( ref $value eq 'HASH' ) {
        while ( my $next = shift @path ) {
            unless ( exists $value->{$next} ) {
                warn "Unknown subkey $next for $key";
                next L;
            }
            $value = $value->{$next};
        }
    }
    elsif (@path) {
        warn "No subkeys for $base";
        return ();
    }
    return $value;
}

sub _setKey {
    my ( $self, $conf, $key, $value ) = @_;
    my $sep = $self->sep;
    my (@path) = split $sep, $key;
    my $last = pop @path;
    while ( my $next = shift @path ) {
        $conf = $conf->{$next};
    }
    $conf->{$last} = $value;
}

187
188
sub _save {
    my ( $self, $new ) = @_;
189
190
    require Lemonldap::NG::Manager::Conf::Parser;
    my $parser = Lemonldap::NG::Manager::Conf::Parser->new(
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
        {
            newConf => $new,
            refConf => $self->mgr->currentConf,
            req     => $self->req
        }
    );
    unless ( $parser->testNewConf() ) {
        printf STDERR "Modifications rejected: %s:\n", $parser->{message};
    }
    my $s = $self->mgr->confAcc->saveConf( $new, { force => $self->force } );
    if ( $s > 0 ) {
        print STDERR "Saved under number $s\n";
        $parser->{status} = [ $self->mgr->applyConf($new) ];
    }
    else {
        printf STDERR "Modifications rejected: %s:\n", $parser->{message};
        print STDERR Dumper($parser);
    }
    foreach (qw(errors warnings status)) {
        if ( $parser->{$_} and @{ $parser->{$_} } ) {
            my $s = Dumper( $parser->{$_} );
            $s =~ s/\$VAR1\s*=\s*//;
            printf STDERR "%-8s: %s", ucfirst($_), $s;
        }
    }
}

Yadd's avatar
Yadd committed
218
219
sub run {
    my $self = shift;
Yadd's avatar
Yadd committed
220

Yadd's avatar
Yadd committed
221
222
    print STDERR "VERY EXPERIMENTAL FEATURE, prefer web interface\n";

Yadd's avatar
Yadd committed
223
    # Options simply call corresponding accessor
Yadd's avatar
Yadd committed
224
    my $args = {};
Yadd's avatar
Yadd committed
225
    while ( $_[0] =~ s/^--?// ) {
Yadd's avatar
Yadd committed
226
227
        my $k = shift;
        my $v = shift;
228
229
230
231
232
        if ( ref $self ) {
            eval { $self->$k($v) };
            if ($@) {
                die "Unknown option -$k or bad value ($@)";
            }
Yadd's avatar
Yadd committed
233
        }
234
235
236
237
238
239
        else {
            $args->{$k} = $v;
        }
    }
    unless ( ref $self ) {
        $self = $self->new($args);
Yadd's avatar
Yadd committed
240
    }
Yadd's avatar
Yadd committed
241
242
243
    unless (@_) {
        die 'nothing to do, aborting';
    }
244
    $self->cfgNum( $self->lastCfg ) unless ( $self->cfgNum );
Yadd's avatar
Yadd committed
245
    my $action = shift;
Yadd's avatar
Yadd committed
246
    unless ( $action =~ /^(?:get|set|addKey|delKey)$/ ) {
Yadd's avatar
Yadd committed
247
248
        die
"unknown action $action. Only get, set, addKey or delKey are accepted";
Yadd's avatar
Yadd committed
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
    }
    $self->$action(@_);
}

package Lemonldap::NG::Manager::Cli::Request;

use Mouse;

has cfgNum => ( is => 'rw' );

has error => ( is => 'rw' );

sub params {
    my ( $self, $key ) = @_;
    return $self->{$key};
}

1;
Yadd's avatar
Yadd committed
267
268
269
270
271
272
__END__

=head1 NAME

=encoding utf8

Yadd's avatar
Yadd committed
273
274
Lemonldap::NG::Manager::Cli - EXPERIMENTAL command line manager for
Lemonldap::NG web SSO system.
Yadd's avatar
Yadd committed
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297

=head1 SYNOPSIS

  #!/usr/bin/env perl
  
  use warnings;
  use strict;
  use Lemonldap::NG::Manager::Cli;
  
  # Optional: you can specify here some parameters
  my $cli = Lemonldap::NG::Manager::Cli->new(iniFile=>'t/lemonldap-ng.ini');
  
  $cli->run(@ARGV);

or use llng-manager-cli provides with this package.

  llng-manager-cli <options> <command> <keys>

=head1 DESCRIPTION

Lemonldap::NG::Manager provides a web interface to manage Lemonldap::NG Web-SSO
system.

Yadd's avatar
Yadd committed
298
299
Lemonldap::NG Manager::Cli provides an EXPERIMENTAL command line client to read
or modify configuration.
Yadd's avatar
Yadd committed
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324

=head1 METHODS

=head2 ACCESSORS

All accessors can be set using the command line: just set a '-' before their
names. Example

  llng-manager-cli -sep ',' get macros,_whatToTrace

=head3 iniFile()

The lemonldap-ng.ini file to use is not default value.

=head3 sep()

The key separator, default to '/'. For example to read the value of macro
_whatToTrace using ',', use:

  llng-manager-cli -sep ',' get macros,_whatToTrace

=head3 cfgNum()

The configuration number. If not set, it will use the latest configuration.

Yadd's avatar
Yadd committed
325
326
327
328
329
330
331
332
333
334
335
336
337
338
=head3 yes()

If set to 1, no confirmation is asked to save new values:

  llng-manager -yes 1 set portal http://somewhere/

=head3 force()

Set it to 1 to save a configuration earlier than latest

=head3 format()

Confirmation array line format. Default to "%-25s | %-25s | %-25s"

Yadd's avatar
Yadd committed
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
=head2 run()

The main method: it reads option, command and launch the corresponding
subroutine.

=head3 Commands

=head4 get

Using get, you can read several keys. Example:

  llng-manager-cli get portal cookieName domain

=head1 SEE ALSO

Yadd's avatar
Yadd committed
354
355
356
For other features of llng-cli, see L<Lemonldap::NG::Common::Cli>

Other links: L<Lemonldap::NG::Manager>, L<http://lemonldap-ng.org/>
Yadd's avatar
Yadd committed
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389

=head1 AUTHORS

Original idea from David Delassus in 2012.

=over

=item Clement Oudot, E<lt>clem.oudot@gmail.comE<gt>

=item David Delassus, E<lt>linkdd@cpan.orgE<gt>

=item François-Xavier Deltombe, E<lt>fxdeltombe@gmail.com.E<gt>

=item Xavier Guimard, E<lt>x.guimard@free.frE<gt>

=item Thomas Chemineau, E<lt>thomas.chemineau@gmail.comE<gt>

=back

=head1 BUG REPORT

Use OW2 system to report bug or ask for features:
L<http://jira.ow2.org>

=head1 DOWNLOAD

Lemonldap::NG is available at
L<http://forge.objectweb.org/project/showfiles.php?group_id=274>

=head1 COPYRIGHT AND LICENSE

=over

Yadd's avatar
Yadd committed
390
=item Copyright (C) 2015-2016 by Xavier Guimard, E<lt>x.guimard@free.frE<gt>
Yadd's avatar
Yadd committed
391

Yadd's avatar
Yadd committed
392
=item Copyright (C) 2015-2016 by Clément Oudot, E<lt>clem.oudot@gmail.comE<gt>
Yadd's avatar
Yadd committed
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409

=back

This library 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, 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 L<http://www.gnu.org/licenses/>.

=cut