Parser.pm 45.3 KB
Newer Older
1
package Lemonldap::NG::Manager::Conf::Parser;
2

Yadd's avatar
Yadd committed
3
4
5
# This module is called either to parse a new configuration in JSON format (as
# posted by the web interface) and test a new configuration object.
#
Christophe Maudoux's avatar
Typo    
Christophe Maudoux committed
6
# The new object must be built with the following properties:
Yadd's avatar
Yadd committed
7
8
9
10
11
12
13
14
15
16
17
18
19
20
#  - refConf: the actual configuration
#  - req    : the Lemonldap::NG::Common::PSGI::Request
#  - tree   : the new configuration in JSON format
#   or
#  - newConf: the configuration to test
#
# The main method is check() which calls:
#  - scanTree() if configuration is not parsed (JSON string)
#  - testNewConf()
#
# It returns a boolean. Errors, warnings and changes are stored as array
# containing `{ message => 'Explanation' }. A main message is stored in
# `message` property.

Yadd's avatar
Yadd committed
21
22
use strict;
use utf8;
23
use Mouse;
Yadd's avatar
Yadd committed
24
use JSON 'to_json';
25
use Lemonldap::NG::Common::Conf::ReConstants;
26
27
use Lemonldap::NG::Manager::Attributes;

28
29
our $VERSION = '2.0.0';

Yadd's avatar
Yadd committed
30
31
extends 'Lemonldap::NG::Common::Conf::Compact';

Yadd's avatar
Yadd committed
32
# High debugging for developpers, set this to 1
Yadd's avatar
Yadd committed
33
34
use constant HIGHDEBUG => 0;

Yadd's avatar
Yadd committed
35
# Messages storage
Yadd's avatar
Yadd committed
36
37
38
has errors => (
    is      => 'rw',
    isa     => 'ArrayRef',
Yadd's avatar
Yadd committed
39
    default => sub { return [] }
Yadd's avatar
Yadd committed
40
41
42
43
44
45
46
47
48
);
has warnings => (
    is      => 'rw',
    isa     => 'ArrayRef',
    default => sub { return [] },
    trigger => sub {
        hdebug( 'warnings contains', $_[0]->{warnings} );
    }
);
49
50
has changes =>
    ( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
Yadd's avatar
Yadd committed
51
52
53
54
55
56
57
58
has message => (
    is      => 'rw',
    isa     => 'Str',
    default => '',
    trigger => sub {
        hdebug( "Message becomes " . $_[0]->{message} );
    }
);
59
60
has needConfirmation =>
    ( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
Yadd's avatar
Yadd committed
61
62

# Booleans
Yadd's avatar
Yadd committed
63
64
has confChanged => (
    is      => 'rw',
Yadd's avatar
Yadd committed
65
    isa     => 'Bool',
Yadd's avatar
Yadd committed
66
67
68
69
70
    default => 0,
    trigger => sub {
        hdebug( "condChanged: " . $_[0]->{confChanged} );
    }
);
Yadd's avatar
Yadd committed
71
72

# Properties required during build
73
has refConf => ( is => 'ro', isa => 'HashRef', required => 1 );
74
75
76
77
has req     => ( is => 'ro', required => 1 );
has newConf => ( is => 'rw', isa      => 'HashRef' );
has tree    => ( is => 'rw', isa      => 'ArrayRef' );

Yadd's avatar
Yadd committed
78
# High debug method
Yadd's avatar
Yadd committed
79
80
81
82
83
sub hdebug {
    if (HIGHDEBUG) {
        foreach my $d (@_) {
            if ( ref $d ) {
                require Data::Dumper;
Yadd's avatar
Yadd committed
84
                $Data::Dumper::Useperl = 1;
Yadd's avatar
Yadd committed
85
86
87
88
89
90
91
92
                print STDERR Data::Dumper::Dumper($d);
            }
            else { print STDERR "$d\n" }
        }
    }
    undef;
}

Yadd's avatar
Yadd committed
93
94
95
##@method boolean check()
# Main method
#@return result
96
97
sub check {
    my $self = shift;
Yadd's avatar
Yadd committed
98
    hdebug("# check()");
99
    unless ( $self->newConf ) {
Yadd's avatar
Yadd committed
100
        return 0 unless ( $self->scanTree );
101
102
    }
    unless ( $self->testNewConf ) {
Yadd's avatar
Yadd committed
103
        hdebug("  testNewConf() failed");
104
105
        return 0;
    }
Yadd's avatar
Yadd committed
106
    hdebug("  tests succeed");
Yadd's avatar
Yadd committed
107
    $self->compactConf( $self->newConf );
Yadd's avatar
Yadd committed
108
    unless ( $self->confChanged ) {
Christophe Maudoux's avatar
Typo    
Christophe Maudoux committed
109
        hdebug("  no change detected");
Yadd's avatar
Yadd committed
110
111
112
113
        $self->message('__confNotChanged__');
        return 0;
    }
    return 1;
114
115
}

Yadd's avatar
Yadd committed
116
117
118
##@method boolean scanTree()
# Methods to build new conf from JSON string
#@result true if succeed
119
120
sub scanTree {
    my $self = shift;
Yadd's avatar
Yadd committed
121
    hdebug("# scanTree()");
122
123
124
125
    $self->newConf( {} );
    $self->_scanNodes( $self->tree ) or return 0;

    # Set cfgNum to ref cfgNum (will be changed when saving), set other
Yadd's avatar
Yadd committed
126
    # metadata and set a value to the key if empty
Yadd's avatar
Yadd committed
127
    $self->newConf->{cfgNum} = $self->req->params('cfgNum');
128
129
130
131
    $self->newConf->{cfgAuthor}
        = $self->req->userData
        ->{ $Lemonldap::NG::Handler::Main::tsv->{whatToTrace}
            || '_whatToTrace' } // "anonymous";
Yadd's avatar
Yadd committed
132
    $self->newConf->{cfgAuthorIP} = $self->req->address;
133
    $self->newConf->{cfgDate}     = time;
134
    $self->newConf->{cfgVersion}  = $VERSION;
135
136
    $self->newConf->{key}
        ||= join( '', map { chr( int( rand(94) ) + 33 ) } ( 1 .. 16 ) );
137
138
139
140
141
142

    return 1;
}

use feature 'state';

Yadd's avatar
Yadd committed
143
##@method private boolean _scanNodes()
144
# Recursive JSON parser
Yadd's avatar
Yadd committed
145
#@result true if succeed
146
sub _scanNodes {
Yadd's avatar
Yadd committed
147
    my ( $self, $tree, ) = @_;
Yadd's avatar
Yadd committed
148
    hdebug("# _scanNodes()");
149
150
151
152
153
154
    state( $knownCat, %newNames );
    unless ( ref($tree) eq 'ARRAY' ) {
        print STDERR 'Fatal: node is not an array';
        push @{ $self->errors }, { message => 'Fatal: node is not an array' };
        return 0;
    }
Yadd's avatar
Yadd committed
155
156
157
    unless (@$tree) {
        hdebug('  empty tree !?');
    }
158
159
    foreach my $leaf (@$tree) {
        my $name = $leaf->{title};
Yadd's avatar
Yadd committed
160
        hdebug("Looking to $name");
161
162

        # subnode
163
        my $subNodes     = $leaf->{nodes}      // $leaf->{_nodes};
164
165
166
167
168
169
170
171
        my $subNodesCond = $leaf->{nodes_cond} // $leaf->{_nodes_cond};

        ##################################
        # VirtualHosts and SAML partners #
        ##################################

        # Root nodes
        if ( $leaf->{id} =~ /^($specialNodeKeys)$/io ) {
Yadd's avatar
Yadd committed
172
            hdebug("Root special node detected $leaf->{id}");
173
174
175

            # If node has not been opened
            if ( $leaf->{cnodes} ) {
Yadd's avatar
Yadd committed
176
                hdebug("  not opened");
177
                foreach my $k ( @{ $specialNodeHash->{ $leaf->{id} } } ) {
Yadd's avatar
Yadd committed
178
                    hdebug("  copying $k");
179
180
181
182
183
184
185
186
187
188
189
190
191
                    $self->newConf->{$k} = $self->refConf->{$k};
                }
                next;
            }
            $self->_scanNodes($subNodes);

            # Check deleted keys
            my $field = $specialNodeHash->{ $leaf->{id} }->[0];
            my @old   = keys %{ $self->refConf->{$field} };
            foreach my $k ( keys %{ $self->newConf->{$field} } ) {
                @old = grep { $_ ne $k } @old;
            }
            if (@old) {
Yadd's avatar
Yadd committed
192
                hdebug( "Keys detected as removed:", \@old );
193
194
195
                $self->confChanged(1);
                foreach my $deletedHost (@old) {
                    push @{ $self->changes },
196
                        { key => $leaf->{id}, old => $deletedHost };
197
198
199
200
201
202
203
                }
            }
            next;
        }

        # 1st sublevel
        elsif ( $leaf->{id} =~ /^($specialNodeKeys)\/([^\/]+)$/io ) {
Yadd's avatar
Yadd committed
204
            hdebug("Special node chield detected $leaf->{id}");
205
206
207
208
            my ( $base, $host ) = ( $1, $2 );

            # Check hostname/partner name changes (id points to the old name)
            $newNames{$host} = $leaf->{title};
209
210
211
212
            if ( $newNames{$host} ne $host and $host !~ /^new__/ ) {
                hdebug("  $host becomes $newNames{$host}");
                $self->confChanged(1);
                push @{ $self->changes },
213
                    { key => $base, old => $host, new => $newNames{$host} };
214
            }
215
216
217
218
219
220

            $self->_scanNodes($subNodes);
            next;
        }

        # Other sub levels
221
222
        elsif ( $leaf->{id}
            =~ /^($specialNodeKeys)\/([^\/]+)\/([^\/]+)(?:\/(.*))?$/io )
223
        {
224
225
            my ( $base, $key, $oldName, $target, $h )
                = ( $1, $newNames{$2}, $2, $3, $4 );
Yadd's avatar
Yadd committed
226
227
228
            hdebug(
                "Special node chield subnode detected $leaf->{id}",
                "  base $base, key $key, target $target, h "
229
                    . ( $h ? $h : 'undef' )
Yadd's avatar
Yadd committed
230
            );
231
232
233

            # VirtualHosts
            if ( $base eq 'virtualHosts' ) {
Yadd's avatar
Yadd committed
234
                hdebug("  virtualhost");
235
236
                if ( $target =~ /^(?:locationRules|exportedHeaders|post)$/ ) {
                    if ( $leaf->{cnodes} ) {
Yadd's avatar
Yadd committed
237
                        hdebug('    unopened subnode');
238
239
                        $self->newConf->{$target}->{$key}
                            = $self->refConf->{$target}->{$oldName} // {};
240
241
242
                    }

                    elsif ($h) {
Yadd's avatar
Yadd committed
243
                        hdebug('    4 levels');
244
                        if ( $target eq 'locationRules' ) {
Yadd's avatar
Yadd committed
245
                            hdebug('    locationRules');
246
247
248
249
                            my $k
                                = $leaf->{comment}
                                ? "(?#$leaf->{comment})$leaf->{re}"
                                : $leaf->{re};
250
251
252
                            $self->set( $target, $key, $k, $leaf->{data} );
                        }
                        else {
Yadd's avatar
Yadd committed
253
                            hdebug('    other than locationrules');
254
255
256
257
258
259
260
                            $self->set( $target, $key, $leaf->{title},
                                $leaf->{data} );
                        }
                    }

                    # Unless $h is set, scan subnodes and check changes
                    else {
Yadd's avatar
Yadd committed
261
                        hdebug('    3 levels only (missing $h)');
262
                        if ( ref $subNodes ) {
Yadd's avatar
Yadd committed
263
                            hdebug('    has subnodes');
264
                            $self->_scanNodes($subNodes)
265
                                or return 0;
266
267
268
269
                        }
                        if ( exists $self->refConf->{$target}->{$key}
                            and %{ $self->refConf->{$target}->{$key} } )
                        {
Yadd's avatar
Yadd committed
270
                            hdebug('    old conf subnode has values');
271
272
273
274
275
                            my $c = $self->newConf->{$target};
                            foreach my $k (
                                keys %{ $self->refConf->{$target}->{$key} } )
                            {
                                unless ( defined $c->{$key}->{$k} ) {
Yadd's avatar
Yadd committed
276
                                    hdebug('      missing value in old conf');
277
278
                                    $self->confChanged(1);
                                    push @{ $self->changes },
279
                                        {
280
281
                                        key => "$target, $key",
                                        old => $k,
282
                                        };
283
284
285
286
287
288
                                }
                            }
                        }
                        elsif ( exists $self->newConf->{$target}->{$key}
                            and %{ $self->newConf->{$target}->{$key} } )
                        {
Yadd's avatar
Yadd committed
289
                            hdebug("    '$key' has values");
290
291
                            $self->confChanged(1);
                            push @{ $self->changes },
292
                                { key => "$target", new => $key };
293
294
295
296
                        }
                    }
                }
                elsif ( $target =~ /^$virtualHostKeys$/o ) {
297
298
                    $self->set( 'vhostOptions', [ $oldName, $key ],
                        $target, $leaf->{data} );
299
300
301
                }
                else {
                    push @{ $self->errors },
302
                        { message => "Unknown vhost key $target" };
303
304
305
306
                    return 0;
                }
                next;
            }
Yadd's avatar
Yadd committed
307

308
            # SAML
Yadd's avatar
Yadd committed
309
            elsif ( $base =~ /^saml(?:S|ID)PMetaDataNodes$/ ) {
Yadd's avatar
Yadd committed
310
                hdebug('SAML');
311
312
                if ( defined $leaf->{data}
                    and ref( $leaf->{data} ) eq 'ARRAY' )
Yadd's avatar
Yadd committed
313
                {
Yadd's avatar
Yadd committed
314
315
316
                    hdebug("  SAML data is an array, serializing");
                    $leaf->{data} = join ';', @{ $leaf->{data} };
                }
317
318
                if ( $target =~ /^saml(?:S|ID)PMetaDataExportedAttributes$/ )
                {
319
                    if ( $leaf->{cnodes} ) {
Yadd's avatar
Yadd committed
320
                        hdebug("  $target: unopened node");
321
322
                        $self->newConf->{$target}->{$key}
                            = $self->refConf->{$target}->{$oldName} // {};
323
                    }
Yadd's avatar
Yadd committed
324
                    elsif ($h) {
Yadd's avatar
Yadd committed
325
                        hdebug("  $target: opened node");
326
                        $self->confChanged(1);
327
328
329
                        $self->set( $target, $key, $leaf->{title},
                            $leaf->{data} );
                    }
Yadd's avatar
Yadd committed
330
                    else {
Yadd's avatar
Yadd committed
331
332
                        hdebug("  $target: looking for subnodes");
                        $self->_scanNodes($subNodes);
Yadd's avatar
Yadd committed
333
                    }
334
                }
335
                elsif ( $target =~ /^saml(?:S|ID)PMetaDataXML$/ ) {
Yadd's avatar
Yadd committed
336
                    hdebug("  $target");
337
338
339
340
                    $self->set(
                        $target, [ $oldName, $key ],
                        $target, $leaf->{data}
                    );
341
                }
342
343
344
                elsif ( $target =~ /^saml(?:ID|S)PMetaDataOptions/ ) {
                    my $optKey = $&;
                    hdebug("  $base sub key: $target");
345
346
347
                    if ( $target
                        =~ /^(?:$samlIDPMetaDataNodeKeys|$samlSPMetaDataNodeKeys)/o
                        )
348
                    {
349
350
351
352
                        $self->set(
                            $optKey, [ $oldName, $key ],
                            $target, $leaf->{data}
                        );
353
354
355
                    }
                    else {
                        push @{ $self->errors },
356
357
                            { message =>
                                "Unknown SAML metadata option $target" };
358
359
                        return 0;
                    }
360
361
362
                }
                else {
                    push @{ $self->errors },
363
                        { message => "Unknown SAML key $target" };
364
365
366
367
                    return 0;
                }
                next;
            }
368

Yadd's avatar
Yadd committed
369
            # OIDC
Yadd's avatar
Yadd committed
370
            elsif ( $base =~ /^oidc(?:O|R)PMetaDataNodes$/ ) {
Yadd's avatar
Yadd committed
371
                hdebug('OIDC');
Yadd's avatar
Yadd committed
372
                if ( $target =~ /^oidc(?:O|R)PMetaDataOptions$/ ) {
Yadd's avatar
Yadd committed
373
374
                    hdebug("  $target: looking for subnodes");
                    $self->_scanNodes($subNodes);
375
376
                    $self->set( $target, $key, $leaf->{title},
                        $leaf->{data} );
Yadd's avatar
Yadd committed
377
378
                }
                elsif ( $target =~ /^oidcOPMetaData(?:JSON|JWKS)$/ ) {
Yadd's avatar
Yadd committed
379
                    hdebug("  $target");
Yadd's avatar
Yadd committed
380
381
382
                    $self->set( $target, $key, $leaf->{data} );
                }
                elsif ( $target =~ /^oidc(?:O|R)PMetaDataExportedVars$/ ) {
Yadd's avatar
Yadd committed
383
                    hdebug("  $target");
Yadd's avatar
Yadd committed
384
                    if ( $leaf->{cnodes} ) {
Yadd's avatar
Yadd committed
385
                        hdebug('    unopened');
386
387
                        $self->newConf->{$target}->{$key}
                            = $self->refConf->{$target}->{$oldName} // {};
Yadd's avatar
Yadd committed
388
389
                    }
                    elsif ($h) {
Yadd's avatar
Yadd committed
390
                        hdebug('    opened');
Yadd's avatar
Yadd committed
391
392
393
                        $self->set( $target, $key, $leaf->{title},
                            $leaf->{data} );
                    }
Yadd's avatar
Yadd committed
394
395
396
397
                    else {
                        hdebug("  $target: looking for subnodes");
                        $self->_scanNodes($subNodes);
                    }
Yadd's avatar
Yadd committed
398
                }
Yadd's avatar
Yadd committed
399
                elsif ( $target =~ /^oidc(?:O|R)PMetaDataOptions/ ) {
400
                    my $optKey = $&;
Yadd's avatar
Yadd committed
401
                    hdebug "  $base sub key: $target";
Yadd's avatar
Yadd committed
402
403
404
                    if ( $target eq 'oidcRPMetaDataOptionsExtraClaims' ) {
                        if ( $leaf->{cnodes} ) {
                            hdebug('    unopened');
405
406
                            $self->newConf->{$target}->{$key}
                                = $self->refConf->{$target}->{$oldName} // {};
Yadd's avatar
Yadd committed
407
408
409
410
411
412
413
414
415
416
417
                        }
                        elsif ($h) {
                            hdebug('    opened');
                            $self->set( $target, $key, $leaf->{title},
                                $leaf->{data} );
                        }
                        else {
                            hdebug("  $target: looking for subnodes");
                            $self->_scanNodes($subNodes);
                        }
                    }
418
419
420
                    elsif ( $target
                        =~ /^(?:$oidcOPMetaDataNodeKeys|$oidcRPMetaDataNodeKeys)/o
                        )
421
                    {
422
423
424
425
                        $self->set(
                            $optKey, [ $oldName, $key ],
                            $target, $leaf->{data}
                        );
426
427
428
                    }
                    else {
                        push @{ $self->errors },
429
430
                            { message =>
                                "Unknown OIDC metadata option $target" };
431
432
                        return 0;
                    }
Yadd's avatar
Yadd committed
433
                }
Yadd's avatar
Yadd committed
434
435
                else {
                    push @{ $self->errors },
436
                        { message => "Unknown OIDC key $target" };
Yadd's avatar
Yadd committed
437
438
439
440
                    return 0;
                }
                next;
            }
Yadd's avatar
Yadd committed
441
442
443
444
445

            # CAS
            elsif ( $base =~ /^cas(?:App|Srv)MetaDataNodes$/ ) {
                my $optKey = $&;
                hdebug('CAS');
Yadd's avatar
Yadd committed
446
447
448
                if ( $target =~ /^cas(?:App|Srv)MetaDataOptions$/ ) {
                    hdebug("  $target: looking for subnodes");
                    $self->_scanNodes($subNodes);
449
450
                    $self->set( $target, $key, $leaf->{title},
                        $leaf->{data} );
Yadd's avatar
Yadd committed
451
452
453
454
455
                }
                elsif ( $target =~ /^cas(?:App|Srv)MetaDataExportedVars$/ ) {
                    hdebug("  $target");
                    if ( $leaf->{cnodes} ) {
                        hdebug('    unopened');
456
457
                        $self->newConf->{$target}->{$key}
                            = $self->refConf->{$target}->{$oldName} // {};
Yadd's avatar
Yadd committed
458
459
460
461
462
463
464
465
466
467
468
                    }
                    elsif ($h) {
                        hdebug('    opened');
                        $self->set( $target, $key, $leaf->{title},
                            $leaf->{data} );
                    }
                    else {
                        hdebug("  $target: looking for subnodes");
                        $self->_scanNodes($subNodes);
                    }
                }
Yadd's avatar
Yadd committed
469
470
471
                elsif ( $target =~ /^cas(?:Srv|App)MetaDataOptions/ ) {
                    my $optKey = $&;
                    hdebug "  $base sub key: $target";
472
473
474
                    if ( $target eq 'casSrvMetaDataOptionsProxiedServices' ) {
                        if ( $leaf->{cnodes} ) {
                            hdebug('    unopened');
475
476
                            $self->newConf->{$target}->{$key}
                                = $self->refConf->{$target}->{$oldName} // {};
477
478
479
480
481
482
483
484
485
486
487
                        }
                        elsif ($h) {
                            hdebug('    opened');
                            $self->set( $target, $key, $leaf->{title},
                                $leaf->{data} );
                        }
                        else {
                            hdebug("  $target: looking for subnodes");
                            $self->_scanNodes($subNodes);
                        }
                    }
488
489
490
                    elsif ( $target
                        =~ /^(?:$casSrvMetaDataNodeKeys|$casAppMetaDataNodeKeys)/o
                        )
Yadd's avatar
Yadd committed
491
                    {
dcoutadeur dcoutadeur's avatar
dcoutadeur dcoutadeur committed
492
493
494
495
                        $self->set(
                            $optKey, [ $oldName, $key ],
                            $target, $leaf->{data}
                        );
Yadd's avatar
Yadd committed
496
497
498
                    }
                    else {
                        push @{ $self->errors },
499
500
                            { message =>
                                "Unknown CAS metadata option $target" };
Yadd's avatar
Yadd committed
501
502
                        return 0;
                    }
Yadd's avatar
Yadd committed
503
504
505
                }
                else {
                    push @{ $self->errors },
506
                        { message => "Unknown CAS option $target" };
Yadd's avatar
Yadd committed
507
508
                    return 0;
                }
Yadd's avatar
Yadd committed
509
                next;
Yadd's avatar
Yadd committed
510
            }
Yadd's avatar
Yadd committed
511
            else {
512
                push @{ $self->errors },
513
                    { message => "Fatal: unknown special sub node $base" };
Yadd's avatar
Yadd committed
514
515
                return 0;
            }
516
517
518
519
520
        }

        ####################
        # Application list #
        ####################
521
522
523
524
525
526

        # Application list root node
        elsif ( $leaf->{title} eq 'applicationList' ) {
            hdebug( $leaf->{title} );
            if ( $leaf->{cnodes} ) {
                hdebug('  unopened');
527
528
                $self->newConf->{applicationList}
                    = $self->refConf->{applicationList} // {};
529
530
531
532
533
            }
            else {
                $self->_scanNodes($subNodes) or return 0;

                # Check for deleted
534
535
536
537
538
539
540
                my @listCatRef
                    = map { $self->refConf->{applicationList}->{$_}->{catname} }
                    keys %{ $self->refConf->{applicationList} };
                my @listCatNew
                    = map { $self->newConf->{applicationList}->{$_}->{catname} }
                    keys(
                    %{  ref $self->newConf->{applicationList}
541
542
543
                        ? $self->newConf->{applicationList}
                        : {}
                    }
544
                    );
545
546
                @listCatRef =  sort @listCatRef;
                @listCatNew =  sort @listCatNew;
547
                for ( my $i = 0; $i < @listCatNew; $i++ ) {
548
549
550
                    if ( not( defined $listCatRef[$i] )
                        or $listCatRef[$i] ne $listCatNew[$i] )
                    {
551
                        push @{ $self->changes },
552
                            {
553
554
555
                            key => $leaf->{id},
                            new => $listCatNew[$i],
                            old => $listCatRef[$i]
556
                            };
557
558
559
560
561
562
563
                    }
                }
            }
            next;
        }

        # Application list sub nodes
564
        elsif ( $leaf->{id} =~ /^applicationList\/(.+)$/ ) {
565
            hdebug('Application list subnode');
566
567
568
569
570
571
572
573
574
575
576
577
            use feature 'state';
            my @cats = split /\//, $1;
            my $app = pop @cats;
            $self->newConf->{applicationList} //= {};

            # $cn is a pointer to the parent
            my $cn  = $self->newConf->{applicationList};
            my $cmp = $self->refConf->{applicationList};
            my @path;

            # Makes $cn point to the parent
            foreach my $cat (@cats) {
Yadd's avatar
Yadd committed
578
                hdebug("  looking to cat $cat");
579
580
                unless ( defined $knownCat->{$cat} ) {
                    push @{ $self->{errors} },
581
582
583
                        { message =>
                            "Fatal: sub cat/app before parent ($leaf->{id})"
                        };
584
585
586
587
588
589
590
591
592
593
594
595
596
                    return 0;
                }
                $cn = $cn->{ $knownCat->{$cat} };
                push @path, $cn->{catname};
                $cmp->{$cat} //= {};
                $cmp = $cmp->{$cat};
            }

            # Create new category
            #
            # Note that this works because nodes are ordered so "cat/cat2/app"
            # is looked after "cat" and "cat/cat2"
            if ( $leaf->{type} eq 'menuCat' ) {
Yadd's avatar
Yadd committed
597
                hdebug('  menu cat');
598
599
                $knownCat->{__id}++;
                my $s = $knownCat->{$app} = sprintf '%04d-cat',
600
601
                    $knownCat->{__id};
                $cn->{$s} = { catname => $leaf->{title}, type => 'category' };
602
603
604
605
606
                unless ($cmp->{$app}
                    and $cmp->{$app}->{catname} eq $cn->{$s}->{catname} )
                {
                    $self->confChanged(1);
                    push @{ $self->changes },
607
608
609
                        {
                        key => join( ', ',
                            'applicationList', @path, $leaf->{title} ),
610
611
                        new => $cn->{$s}->{catname},
                        old => ( $cn->{$s} ? $cn->{$s}->{catname} : undef )
612
                        };
613
614
615
616
                }
                if ( ref $subNodes ) {
                    $self->_scanNodes($subNodes) or return 0;
                }
Yadd's avatar
Yadd committed
617
618
                my @listCatRef = keys %{ $cmp->{$app} };
                my @listCatNew = keys %{ $cn->{$s} };
619

Yadd's avatar
Yadd committed
620
621
622
623
                # Check for deleted
                unless ( @listCatRef == @listCatNew ) {
                    $self->confChanged(1);
                    push @{ $self->changes },
624
                        {
Yadd's avatar
Yadd committed
625
                        key => join( ', ', 'applicationList', @path ),
626
                        new => 'Changes in cat(s)/app(s)',
627
                        };
Yadd's avatar
Yadd committed
628
                }
629
630
631
632
            }

            # Create new apps
            else {
Yadd's avatar
Yadd committed
633
                hdebug('  new app');
634
635
                $knownCat->{__id}++;
                my $name = sprintf( '%04d-app', $knownCat->{__id} );
636
637
                $cn->{$name}
                    = { type => 'application', options => $leaf->{data} };
638
639
640
641
                $cn->{$name}->{options}->{name} = $leaf->{title};
                unless ( $cmp->{$app} ) {
                    $self->confChanged(1);
                    push @{ $self->changes },
642
                        {
643
644
                        key => join( ', ', 'applicationList', @path ),
                        new => $leaf->{title},
645
                        };
646
647
648
649
650
651
652
653
                }
                else {
                    foreach my $k ( keys %{ $cn->{$name}->{options} } ) {
                        unless ( $cmp->{$app}->{options}->{$k} eq
                            $cn->{$name}->{options}->{$k} )
                        {
                            $self->confChanged(1);
                            push @{ $self->changes },
654
                                {
655
656
657
658
659
                                key => join( ', ',
                                    'applicationList', @path,
                                    $leaf->{title},    $k ),
                                new => $cn->{$name}->{options}->{$k},
                                old => $cmp->{$app}->{options}->{$k}
660
                                };
661
662
663
664
665
666
                        }
                    }
                }
            }
            next;
        }
Yadd's avatar
Yadd committed
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
        elsif ( $leaf->{id} eq 'grantSessionRules' ) {
            hdebug('grantSessionRules');
            if ( $leaf->{cnodes} ) {
                hdebug('  unopened');
                $self->newConf->{$name} = $self->refConf->{$name} // {};
            }
            else {
                hdebug('  opened');
                $subNodes //= [];
                my $count = 0;
                my $ref   = $self->refConf->{grantSessionRules};
                my $new   = $self->newConf->{grantSessionRules};
                my @old   = ref $ref ? keys %$ref : ();
                $self->newConf->{grantSessionRules} = {};
                foreach my $n (@$subNodes) {
                    hdebug("  looking at $n subnode");
683
684
                    my $k = $n->{re}
                        . ( $n->{comment} ? "##$n->{comment}" : '' );
Yadd's avatar
Yadd committed
685
686
687
688
689
                    $self->newConf->{grantSessionRules}->{$k} = $n->{data};
                    $count++;
                    unless ( defined $ref->{$k} ) {
                        $self->confChanged(1);
                        push @{ $self->changes },
690
                            { keys => 'grantSessionRules', new => $k };
Yadd's avatar
Yadd committed
691
692
693
694
                    }
                    elsif ( $ref->{$k} ne $n->{data} ) {
                        $self->confChanged(1);
                        push @{ $self->changes },
695
                            {
Yadd's avatar
Yadd committed
696
697
698
                            key => "grantSessionRules, $k",
                            old => $self->refConf->{grantSessionRules}->{$k},
                            new => $n->{data}
699
                            };
Yadd's avatar
Yadd committed
700
701
702
703
704
705
                    }
                    @old = grep { $_ ne $k } @old;
                }
                if (@old) {
                    $self->confChanged(1);
                    push @{ $self->changes },
706
707
                        { key => 'grantSessionRules', old => $_, }
                        foreach (@old);
Yadd's avatar
Yadd committed
708
709
710
711
                }
            }
            next;
        }
712

Yadd's avatar
Yadd committed
713
714
715
716
717
718
719
        # openIdIDPList: data is splitted by Conf.pm into a boolean and a
        # string
        elsif ( $name eq 'openIdIDPList' ) {
            hdebug('openIdIDPList');
            if ( $leaf->{data} ) {
                unless ( ref $leaf->{data} eq 'ARRAY' ) {
                    push @{ $self->{errors} },
720
721
                        { message => 'Malformed openIdIDPList '
                            . $leaf->{data} };
Yadd's avatar
Yadd committed
722
723
724
725
726
727
728
729
730
731
                    return 0;
                }
                $self->set( $name, join( ';', @{ $leaf->{data} } ) );
            }
            else {
                $self->set( $name, undef );
            }
            next;
        }

732
733
734
        ####################
        # Other hash nodes #
        ####################
735
        elsif ( $leaf->{title} =~ /^$simpleHashKeys$/o
736
737
            and not $leaf->{title} eq 'applicationList' )
        {
Yadd's avatar
Yadd committed
738
            hdebug( $leaf->{title} );
739
740
741

            # If a `cnodes` key is found, keep old key unchanges
            if ( $leaf->{cnodes} ) {
Yadd's avatar
Yadd committed
742
                hdebug('  unopened');
743
744
745
                $self->newConf->{$name} = $self->refConf->{$name} // {};
            }
            else {
Yadd's avatar
Yadd committed
746
                hdebug('  opened');
747
748
749
750
751
752
753

                # combModules: just to replace "over" key
                if ( $name eq 'combModules' ) {
                    hdebug('     combModules');
                    $self->newConf->{$name} = {};
                    foreach my $node ( @{ $leaf->{nodes} } ) {
                        my $tmp;
754
755
                        $tmp->{$_} = $node->{data}->{$_}
                            foreach (qw(type for));
756
757
758
759
760
761
762
763
764
765
766
767
                        $tmp->{over} = {};
                        foreach ( @{ $node->{data}->{over} } ) {
                            $tmp->{over}->{ $_->[0] } = $_->[1];
                        }
                        $self->newConf->{$name}->{ $node->{title} } = $tmp;
                    }

                    # TODO: check changes
                    $self->confChanged(1);
                    next;
                }

768
769
770
771
772
773
774
775
776
                $subNodes //= [];
                my $count = 0;
                my @old   = (
                    ref( $self->refConf->{$name} )
                    ? ( keys %{ $self->refConf->{$name} } )
                    : ()
                );
                $self->newConf->{$name} = {};
                foreach my $n (@$subNodes) {
Yadd's avatar
Yadd committed
777
                    hdebug("  looking at $n subnode");
Yadd's avatar
Yadd committed
778
                    if ( ref $n->{data} and ref $n->{data} eq 'ARRAY' ) {
Clément OUDOT's avatar
Clément OUDOT committed
779

Yadd's avatar
Yadd committed
780
781
782
783
                        # authChoiceModules
                        if ( $name eq 'authChoiceModules' ) {
                            hdebug('     combModules');
                            $n->{data}->[5] ||= {};
Clément OUDOT's avatar
Clément OUDOT committed
784
                            $n->{data}->[5] = to_json( $n->{data}->[5] );
Yadd's avatar
Yadd committed
785
786
                        }

Yadd's avatar
Yadd committed
787
788
                        $n->{data} = join ';', @{ $n->{data} };
                    }
789
790
                    $self->newConf->{$name}->{ $n->{title} } = $n->{data};
                    $count++;
791
792
                    unless (
                        defined $self->refConf->{$name}->{ $n->{title} } )
793
794
795
                    {
                        $self->confChanged(1);
                        push @{ $self->changes },
796
                            { key => $name, new => $n->{title}, };
797
                    }
798
799
                    elsif ( $self->refConf->{$name}->{ $n->{title} } ne
                        $n->{data} )
800
801
802
                    {
                        $self->confChanged(1);
                        push @{ $self->changes },
803
                            {
804
805
806
                            key => "$name, $n->{title}",
                            old => $self->refConf->{$name}->{ $n->{title} },
                            new => $n->{data}
807
                            };
808
809
810
811
812
813
                    }
                    @old = grep { $_ ne $n->{title} } @old;
                }
                if (@old) {
                    $self->confChanged(1);
                    push @{ $self->changes }, { key => $name, old => $_, }
814
                        foreach (@old);
815
816
817
818
819
                }
            }
            next;
        }

820
821
822
823
824
825
826
827
828
        # Double hash nodes
        elsif ( $leaf->{title} =~ /^$doubleHashKeys$/ ) {
            hdebug( $leaf->{title} );
            my @oldHosts = (
                ref( $self->refConf->{$name} )
                ? ( keys %{ $self->refConf->{$name} } )
                : ()
            );
            $self->newConf->{$name} = {};
Yadd's avatar
Yadd committed
829
830
            unless ( defined $leaf->{data} ) {
                hdebug('  unopened');
831
                $self->newConf->{$name} = $self->refConf->{$name} || {};
Yadd's avatar
Yadd committed
832
                next;
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
            }
            foreach my $getHost ( @{ $leaf->{data} } ) {
                my $change = 0;
                my @oldKeys;
                my $host = $getHost->{k};
                hdebug("  looking at host: $host");
                $self->newConf->{$name}->{$host} = {};
                unless ( defined $self->refConf->{$name}->{$host} ) {
                    $self->confChanged(1);
                    $change++;
                    push @{ $self->changes }, { key => $name, new => $host };
                    hdebug("    $host is new");
                }
                else {
                    @oldHosts = grep { $_ ne $host } @oldHosts;
                    @oldKeys = keys %{ $self->refConf->{$name}->{$host} };
                }
                foreach my $prm ( @{ $getHost->{h} } ) {
851
852
853
                    $self->newConf->{$name}->{$host}->{ $prm->{k} }
                        = $prm->{v};
                    if (!$change
854
855
                        and (
                            not defined(
856
857
                                $self->refConf->{$name}->{$host}
                                    ->{ $prm->{k} }
858
859
860
861
                            )
                            or $self->newConf->{$name}->{$host}->{ $prm->{k} }
                            ne $self->refConf->{$name}->{$host}->{ $prm->{k} }
                        )
862
                        )
863
864
865
866
                    {
                        $self->confChanged(1);
                        hdebug("    key $prm->{k} has been changed");
                        push @{ $self->changes },
867
                            { key => "$name/$host", new => $prm->{k} };
868
869
870
871
872
873
874
875
876
                    }
                    elsif ( !$change ) {
                        @oldKeys = grep { $_ ne $prm->{k} } @oldKeys;
                    }
                }
                if (@oldKeys) {
                    $self->confChanged(1);
                    hdebug( "  old keys: " . join( ' ', @oldKeys ) );
                    push @{ $self->changes },
877
878
                        { key => "$name/$host", old => $_ }
                        foreach (@oldKeys);
879
880
881
882
883
884
                }
            }
            if (@oldHosts) {
                $self->confChanged(1);
                hdebug( "  old hosts " . join( ' ', @oldHosts ) );
                push @{ $self->changes }, { key => "$name", old => $_ }
885
                    foreach (@oldHosts);
886
887
888
889
            }
            next;
        }

890
891
892
893
894
895
896
        ###############
        # Other nodes #
        ###############

        # Check if subnodes
        my $n = 0;
        if ( ref $subNodesCond ) {
Yadd's avatar
Yadd committed
897
898
899
900
            hdebug('  conditional subnodes detected');

            # Bad idea,subnode unopened are not read
            #$subNodesCond = [ grep { $_->{show} } @$subNodesCond ];
901
902
903
904
            $self->_scanNodes($subNodesCond) or return 0;
            $n++;
        }
        if ( ref $subNodes ) {
Yadd's avatar
Yadd committed
905
            hdebug('  subnodes detected');
906
907
908
            $self->_scanNodes($subNodes) or return 0;
            $n++;
        }
Yadd's avatar
Yadd committed
909
910
911
        if ($n) {
            next;
        }
912
913
        if ( defined $leaf->{data} and ref( $leaf->{data} ) eq 'ARRAY' ) {
            if ( ref( $leaf->{data}->[0] ) eq 'HASH' ) {
Yadd's avatar
Yadd committed
914
                hdebug("  array found");
915
916
917
918
919
920
921
                $self->_scanNodes( $leaf->{data} ) or return 0;
            }
            else {
                $self->set( $name, join( ';', @{ $leaf->{data} } ) );
            }
        }

922
923
924
925
926
927
928
929
        # Grouped nodes not opened
        elsif ( $leaf->{get} and ref $leaf->{get} eq 'ARRAY' ) {
            hdebug("  unopened grouped node");
            foreach my $subkey ( @{ $leaf->{get} } ) {
                $self->set( $subkey, undef );
            }
        }

930
931
932
933
934
935
936
937
        # Normal leaf
        else {
            $self->set( $name, $leaf->{data} );
        }
    }
    return 1;
}

Yadd's avatar
Yadd committed
938
939
##@method private void set($target, @path, $data)
# Store a value in the $target key (following subkeys if @path is set)
940
941
942
943
944
945
946
947
948
sub set {
    my $self  = shift;
    my $data  = pop;
    my @confs = ( $self->refConf, $self->newConf );
    my @path;
    while ( @_ > 1 ) {
        my $tmp = shift;
        push @path, $tmp;
        foreach my $i ( 0, 1 ) {
949
950
951
            my $v = ref($tmp) ? $tmp->[$i] : $tmp;
            $confs[$i]->{$v} //= {};
            $confs[$i] = $confs[$i]->{$v};
952
953
954
        }
    }
    my $target = shift;
Yadd's avatar
Yadd committed
955
956
    hdebug( "# set() called:",
        { data => $data, path => \@path, target => $target } );
957
958
959
960
    die @path unless ($target);

    # Check new value
    if ( defined $data ) {
Yadd's avatar
Yadd committed
961
        hdebug("  data defined");
962
963
964
965
966
967
968
969

        # TODO: remove if $data == default value
        $confs[1]->{$target} = $data;
        eval {
            unless (
                $target eq 'cfgLog'
                or ( defined $confs[0]->{$target}
                    and $confs[0]->{$target} eq $data )
Yadd's avatar
Yadd committed
970
                or (   !defined $confs[0]->{$target}
971
972
                    and defined $self->defaultValue($target)
                    and $data eq $self->defaultValue($target) )
973
                )
974
975
976
            {
                $self->confChanged(1);
                push @{ $self->changes },
977
                    {
978
                    key => join( ', ', @path, $target ),
979
980
                    old => $confs[0]->{$target}
                        // $self->defaultValue($target),
981
                    new => $confs[1]->{$target}
982
                    };
983
984
985
986
987
988
            }
        };
    }

    # Set old value if exists
    else {
Yadd's avatar
Yadd committed
989
        hdebug("  data undefined");
990
        if ( exists $confs[0]->{$target} ) {
Yadd's avatar
Yadd committed
991
            hdebug("    old value exists");
992
993
            $confs[1]->{$target} = $confs[0]->{$target};
        }
Yadd's avatar
Yadd committed
994
995
996
        else {
            hdebug("    no old value, skipping");
        }
997
998
999
1000
    }
}

sub defaultValue {
Yadd's avatar
Yadd committed
1001
    my ( $self, $target ) = @_;
Yadd's avatar
Typo    
Yadd committed
1002
    hdebug("# defaultValue($target)");
1003
1004
1005
    die unless ($target);
    my $res = eval {
        &Lemonldap::NG::Manager::Attributes::attributes()->{$target}
1006
            ->{'default'};
1007
1008
1009
1010
    };
    return $res;
}

Yadd's avatar
Yadd committed
1011
1012
1013
1014
##@method boolean testNewConf()
# Launch _unitTest() and _globaTest()
#
#@return true if tests succeed
1015
1016
sub testNewConf {
    my $self = shift;
Yadd's avatar
Yadd committed
1017
    hdebug('# testNewConf()');
Yadd's avatar
Yadd committed
1018
    return $self->_unitTest( $self->newConf(), '' ) && $self->_globalTest();
1019
1020
}

Yadd's avatar
Yadd committed
1021
1022
1023
1024
##@method private boolean _unitTest()
# Launch unit tests declared in Lemonldap::NG::Manager::Build::Attributes file
#
#@return true if tests succeed
1025
sub _unitTest {
Yadd's avatar
Yadd committed
1026
    my ( $self, $conf ) = @_;
Yadd's avatar
Yadd committed
1027
    hdebug('# _unitTest()');
1028
1029
1030
1031
    my $types = &Lemonldap::NG::Manager::Attributes::types();
    my $attrs = &Lemonldap::NG::Manager::Attributes::attributes();
    my $res   = 1;
    foreach my $key ( keys %$conf ) {
1032
1033
1034
1035
1036
1037
        if (    $self->{skippedUnitTests}
            and $self->{skippedUnitTests} =~ /\b$key\b/ )
        {
            $self->logger->debug("Ignore test for $key");
            next;
        }
Yadd's avatar
Yadd committed
1038
        hdebug("Testing $key");
1039
1040
        my $attr = $attrs->{$key};
        my $type = $types->{ $attr->{type} };
1041
1042
1043
1044
1045
        unless ( $type or $attr->{test} ) {
            print STDERR "Unknown attribute $key, deleting it\n";
            delete $conf->{$key};
            next;
        }
1046

Yadd's avatar
Yadd committed
1047
        if ( $attr->{type} and $attr->{type} eq 'subContainer' ) {
1048

Yadd's avatar
Typo    
Yadd committed
1049
            # TODO Recursive for SAML/OIDC nodes
1050
1051
        }
        else {
Yadd's avatar
Yadd committed
1052
1053

            # Check if key exists
1054
            unless ($attr) {
1055
1056
                push @{ $self->errors },
                    { message => "__unknownKey__: $key" };
Yadd's avatar
Yadd committed
1057
                $res = 0;
Yadd's avatar
Yadd committed
1058
1059
1060
                next;
            }

Yadd's avatar
Yadd committed
1061
            # Hash parameters
1062
            if ( $key =~ /^$simpleHashKeys$/o ) {
Yadd's avatar
Yadd committed
1063
1064
1065
                $conf->{$key} //= {};
                unless ( ref $conf->{$key} eq 'HASH' ) {
                    push @{ $self->errors },
1066
                        { message => "$key is not a hash ref" };
Yadd's avatar
Yadd committed
1067
1068
1069
                    $res = 0;
                    next;
                }
Yadd's avatar
Yadd committed
1070
            }
1071
            elsif ( $attr->{type} =~ /Container$/ ) {
1072

Yadd's avatar