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

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:
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.

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

Xavier Guimard's avatar
Xavier Guimard committed
28
our $VERSION = '2.0.2';
29

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

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

35
# Messages storage
36 37 38
has errors => (
    is      => 'rw',
    isa     => 'ArrayRef',
Xavier Guimard's avatar
Xavier Guimard committed
39
    default => sub { return [] }
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} );
    }
);
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
49
has changes => ( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
50 51 52 53 54 55 56 57
has message => (
    is      => 'rw',
    isa     => 'Str',
    default => '',
    trigger => sub {
        hdebug( "Message becomes " . $_[0]->{message} );
    }
);
58
has needConfirmation =>
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
59
  ( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
60 61

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

# Properties required during build
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
72
has refConf => ( is => 'ro', isa      => 'HashRef', required => 1 );
73 74 75 76
has req     => ( is => 'ro', required => 1 );
has newConf => ( is => 'rw', isa      => 'HashRef' );
has tree    => ( is => 'rw', isa      => 'ArrayRef' );

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

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

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

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

    return 1;
}

use feature 'state';

141
##@method private boolean _scanNodes()
142
# Recursive JSON parser
143
#@result true if succeed
144
sub _scanNodes {
145
    my ( $self, $tree, ) = @_;
146
    hdebug("# _scanNodes()");
147 148 149 150 151 152
    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;
    }
Xavier Guimard's avatar
Xavier Guimard committed
153 154 155
    unless (@$tree) {
        hdebug('  empty tree !?');
    }
156 157
    foreach my $leaf (@$tree) {
        my $name = $leaf->{title};
158
        hdebug("Looking to $name");
159 160

        # subnode
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
161
        my $subNodes     = $leaf->{nodes} // $leaf->{_nodes};
162 163 164 165 166 167 168 169
        my $subNodesCond = $leaf->{nodes_cond} // $leaf->{_nodes_cond};

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

        # Root nodes
        if ( $leaf->{id} =~ /^($specialNodeKeys)$/io ) {
170
            hdebug("Root special node detected $leaf->{id}");
171 172 173

            # If node has not been opened
            if ( $leaf->{cnodes} ) {
174
                hdebug("  not opened");
175
                foreach my $k ( @{ $specialNodeHash->{ $leaf->{id} } } ) {
176
                    hdebug("  copying $k");
177 178 179 180 181 182 183 184 185 186 187 188 189
                    $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) {
190
                hdebug( "Keys detected as removed:", \@old );
191 192 193
                $self->confChanged(1);
                foreach my $deletedHost (@old) {
                    push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
194
                      { key => $leaf->{id}, old => $deletedHost };
195 196 197 198 199 200 201
                }
            }
            next;
        }

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

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

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

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

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

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

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

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

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

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

        ####################
        # Application list #
        ####################
511 512 513 514 515 516

        # Application list root node
        elsif ( $leaf->{title} eq 'applicationList' ) {
            hdebug( $leaf->{title} );
            if ( $leaf->{cnodes} ) {
                hdebug('  unopened');
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
517 518
                $self->newConf->{applicationList} =
                  $self->refConf->{applicationList} // {};
519 520 521 522 523
            }
            else {
                $self->_scanNodes($subNodes) or return 0;

                # Check for deleted
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
524 525 526 527 528 529 530 531
                my @listCatRef =
                  map { $self->refConf->{applicationList}->{$_}->{catname} }
                  keys %{ $self->refConf->{applicationList} };
                my @listCatNew =
                  map { $self->newConf->{applicationList}->{$_}->{catname} }
                  keys(
                    %{
                        ref $self->newConf->{applicationList}
532 533 534
                        ? $self->newConf->{applicationList}
                        : {}
                    }
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
535
                  );
536

Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
537 538
                @listCatRef = sort @listCatRef;
                @listCatNew = sort @listCatNew;
539 540
                hdebug( '# @listCatRef : ' . \@listCatRef );
                hdebug( '# @listCatNew : ' . \@listCatNew );
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
541
                for ( my $i = 0 ; $i < @listCatNew ; $i++ ) {
542 543 544
                    if ( not( defined $listCatRef[$i] )
                        or $listCatRef[$i] ne $listCatNew[$i] )
                    {
545
                        push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
546
                          {
547 548 549
                            key => $leaf->{id},
                            new => $listCatNew[$i],
                            old => $listCatRef[$i]
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
550
                          };
551 552 553 554 555 556 557
                    }
                }
            }
            next;
        }

        # Application list sub nodes
558
        elsif ( $leaf->{id} =~ /^applicationList\/(.+)$/ ) {
559
            hdebug('Application list subnode');
560 561 562 563 564 565 566 567 568 569 570 571
            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) {
572
                hdebug("  looking to cat $cat");
573 574
                unless ( defined $knownCat->{$cat} ) {
                    push @{ $self->{errors} },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
575 576
                      { message =>
                          "Fatal: sub cat/app before parent ($leaf->{id})" };
577 578 579 580 581 582 583 584 585 586 587 588 589
                    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' ) {
590
                hdebug('  menu cat');
591 592
                $knownCat->{__id}++;
                my $s = $knownCat->{$app} = sprintf '%04d-cat',
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
593
                  $knownCat->{__id};
594
                $cn->{$s} = { catname => $leaf->{title}, type => 'category' };
595 596 597 598 599
                unless ($cmp->{$app}
                    and $cmp->{$app}->{catname} eq $cn->{$s}->{catname} )
                {
                    $self->confChanged(1);
                    push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
600 601 602 603
                      {
                        key => join(
                            ', ', 'applicationList', @path, $leaf->{title}
                        ),
604 605
                        new => $cn->{$s}->{catname},
                        old => ( $cn->{$s} ? $cn->{$s}->{catname} : undef )
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
606
                      };
607 608 609 610
                }
                if ( ref $subNodes ) {
                    $self->_scanNodes($subNodes) or return 0;
                }
611 612
                my @listCatRef = keys %{ $cmp->{$app} };
                my @listCatNew = keys %{ $cn->{$s} };
613

614 615 616 617
                # Check for deleted
                unless ( @listCatRef == @listCatNew ) {
                    $self->confChanged(1);
                    push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
618
                      {
619
                        key => join( ', ', 'applicationList', @path ),
620
                        new => 'Changes in cat(s)/app(s)',
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
621
                      };
622
                }
623 624 625 626
            }

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

Xavier Guimard's avatar
Xavier Guimard committed
707 708 709 710 711 712 713
        # 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} },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
714
                      { message => 'Malformed openIdIDPList ' . $leaf->{data} };
Xavier Guimard's avatar
Xavier Guimard committed
715 716 717 718 719 720 721 722 723 724
                    return 0;
                }
                $self->set( $name, join( ';', @{ $leaf->{data} } ) );
            }
            else {
                $self->set( $name, undef );
            }
            next;
        }

725 726 727
        ####################
        # Other hash nodes #
        ####################
728
        elsif ( $leaf->{title} =~ /^$simpleHashKeys$/o
729 730
            and not $leaf->{title} eq 'applicationList' )
        {
731
            hdebug( $leaf->{title} );
732 733 734

            # If a `cnodes` key is found, keep old key unchanges
            if ( $leaf->{cnodes} ) {
735
                hdebug('  unopened');
736 737 738
                $self->newConf->{$name} = $self->refConf->{$name} // {};
            }
            else {
739
                hdebug('  opened');
740 741 742 743 744 745 746

                # combModules: just to replace "over" key
                if ( $name eq 'combModules' ) {
                    hdebug('     combModules');
                    $self->newConf->{$name} = {};
                    foreach my $node ( @{ $leaf->{nodes} } ) {
                        my $tmp;
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
747
                        $tmp->{$_} = $node->{data}->{$_} foreach (qw(type for));
748 749 750 751 752 753 754 755 756 757 758 759
                        $tmp->{over} = {};
                        foreach ( @{ $node->{data}->{over} } ) {
                            $tmp->{over}->{ $_->[0] } = $_->[1];
                        }
                        $self->newConf->{$name}->{ $node->{title} } = $tmp;
                    }

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

760 761 762 763 764 765 766 767 768
                $subNodes //= [];
                my $count = 0;
                my @old   = (
                    ref( $self->refConf->{$name} )
                    ? ( keys %{ $self->refConf->{$name} } )
                    : ()
                );
                $self->newConf->{$name} = {};
                foreach my $n (@$subNodes) {
769
                    hdebug("  looking at $n subnode");
Xavier Guimard's avatar
Xavier Guimard committed
770
                    if ( ref $n->{data} and ref $n->{data} eq 'ARRAY' ) {
Clément OUDOT's avatar
Clément OUDOT committed
771

772 773 774 775
                        # authChoiceModules
                        if ( $name eq 'authChoiceModules' ) {
                            hdebug('     combModules');
                            $n->{data}->[5] ||= {};
Clément OUDOT's avatar
Clément OUDOT committed
776
                            $n->{data}->[5] = to_json( $n->{data}->[5] );
777 778
                        }

Xavier Guimard's avatar
Xavier Guimard committed
779 780
                        $n->{data} = join ';', @{ $n->{data} };
                    }
781 782
                    $self->newConf->{$name}->{ $n->{title} } = $n->{data};
                    $count++;
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
783
                    unless ( defined $self->refConf->{$name}->{ $n->{title} } )
784 785 786
                    {
                        $self->confChanged(1);
                        push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
787
                          { key => $name, new => $n->{title}, };
788
                    }
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
789 790
                    elsif (
                        $self->refConf->{$name}->{ $n->{title} } ne $n->{data} )
791 792 793
                    {
                        $self->confChanged(1);
                        push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
794
                          {
795 796 797
                            key => "$name, $n->{title}",
                            old => $self->refConf->{$name}->{ $n->{title} },
                            new => $n->{data}
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
798
                          };
799 800 801 802 803 804
                    }
                    @old = grep { $_ ne $n->{title} } @old;
                }
                if (@old) {
                    $self->confChanged(1);
                    push @{ $self->changes }, { key => $name, old => $_, }
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
805
                      foreach (@old);
806 807 808 809 810
                }
            }
            next;
        }

811 812 813 814 815 816 817 818 819
        # Double hash nodes
        elsif ( $leaf->{title} =~ /^$doubleHashKeys$/ ) {
            hdebug( $leaf->{title} );
            my @oldHosts = (
                ref( $self->refConf->{$name} )
                ? ( keys %{ $self->refConf->{$name} } )
                : ()
            );
            $self->newConf->{$name} = {};
820 821
            unless ( defined $leaf->{data} ) {
                hdebug('  unopened');
822
                $self->newConf->{$name} = $self->refConf->{$name} || {};
823
                next;
824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841
            }
            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} } ) {
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
842 843 844 845
                    $self->newConf->{$name}->{$host}->{ $prm->{k} } =
                      $prm->{v};
                    if (
                        !$change
846 847
                        and (
                            not defined(
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
848
                                $self->refConf->{$name}->{$host}->{ $prm->{k} }
849 850 851 852
                            )
                            or $self->newConf->{$name}->{$host}->{ $prm->{k} }
                            ne $self->refConf->{$name}->{$host}->{ $prm->{k} }
                        )
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
853
                      )
854 855 856 857
                    {
                        $self->confChanged(1);
                        hdebug("    key $prm->{k} has been changed");
                        push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
858
                          { key => "$name/$host", new => $prm->{k} };
859 860 861 862 863 864 865 866 867
                    }
                    elsif ( !$change ) {
                        @oldKeys = grep { $_ ne $prm->{k} } @oldKeys;
                    }
                }
                if (@oldKeys) {
                    $self->confChanged(1);
                    hdebug( "  old keys: " . join( ' ', @oldKeys ) );
                    push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
868 869
                      { key => "$name/$host", old => $_ }
                      foreach (@oldKeys);
870 871 872 873 874 875
                }
            }
            if (@oldHosts) {
                $self->confChanged(1);
                hdebug( "  old hosts " . join( ' ', @oldHosts ) );
                push @{ $self->changes }, { key => "$name", old => $_ }
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
876
                  foreach (@oldHosts);
877 878 879 880
            }
            next;
        }

881 882 883 884 885 886 887
        ###############
        # Other nodes #
        ###############

        # Check if subnodes
        my $n = 0;
        if ( ref $subNodesCond ) {
Xavier Guimard's avatar
Xavier Guimard committed
888 889 890 891
            hdebug('  conditional subnodes detected');

            # Bad idea,subnode unopened are not read
            #$subNodesCond = [ grep { $_->{show} } @$subNodesCond ];
892 893 894 895
            $self->_scanNodes($subNodesCond) or return 0;
            $n++;
        }
        if ( ref $subNodes ) {
Xavier Guimard's avatar
Xavier Guimard committed
896
            hdebug('  subnodes detected');
897 898 899
            $self->_scanNodes($subNodes) or return 0;
            $n++;
        }
900 901 902
        if ($n) {
            next;
        }
903 904
        if ( defined $leaf->{data} and ref( $leaf->{data} ) eq 'ARRAY' ) {
            if ( ref( $leaf->{data}->[0] ) eq 'HASH' ) {
905
                hdebug("  array found");
906 907 908 909 910 911 912
                $self->_scanNodes( $leaf->{data} ) or return 0;
            }
            else {
                $self->set( $name, join( ';', @{ $leaf->{data} } ) );
            }
        }

913 914 915 916 917 918 919 920
        # 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 );
            }
        }

921 922 923 924 925 926 927 928
        # Normal leaf
        else {
            $self->set( $name, $leaf->{data} );
        }
    }
    return 1;
}

929 930
##@method private void set($target, @path, $data)
# Store a value in the $target key (following subkeys if @path is set)
931 932 933 934 935 936 937 938 939
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 ) {
940 941 942
            my $v = ref($tmp) ? $tmp->[$i] : $tmp;
            $confs[$i]->{$v} //= {};
            $confs[$i] = $confs[$i]->{$v};
943 944 945
        }
    }
    my $target = shift;
946 947
    hdebug( "# set() called:",
        { data => $data, path => \@path, target => $target } );
948 949 950 951
    die @path unless ($target);

    # Check new value
    if ( defined $data ) {
952
        hdebug("  data defined");
953 954 955 956 957 958 959 960

        # 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 )
Xavier Guimard's avatar
Xavier Guimard committed
961
                or (   !defined $confs[0]->{$target}
962 963
                    and defined $self->defaultValue($target)
                    and $data eq $self->defaultValue($target) )
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
964
              )
965 966 967
            {
                $self->confChanged(1);
                push @{ $self->changes },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
968
                  {
969
                    key => join( ', ', @path, $target ),
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
970
                    old => $confs[0]->{$target} // $self->defaultValue($target),
971
                    new => $confs[1]->{$target}
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
972
                  };
973 974 975 976 977 978
            }
        };
    }

    # Set old value if exists
    else {
979
        hdebug("  data undefined");
980
        if ( exists $confs[0]->{$target} ) {
981
            hdebug("    old value exists");
982 983
            $confs[1]->{$target} = $confs[0]->{$target};
        }
984 985 986
        else {
            hdebug("    no old value, skipping");
        }
987 988 989 990
    }
}

sub defaultValue {
991
    my ( $self, $target ) = @_;
Xavier Guimard's avatar
Typo  
Xavier Guimard committed
992
    hdebug("# defaultValue($target)");
993 994 995
    die unless ($target);
    my $res = eval {
        &Lemonldap::NG::Manager::Attributes::attributes()->{$target}
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
996
          ->{'default'};
997 998 999 1000
    };
    return $res;
}

1001 1002 1003 1004
##@method boolean testNewConf()
# Launch _unitTest() and _globaTest()
#
#@return true if tests succeed
1005 1006
sub testNewConf {
    my $self = shift;
1007
    hdebug('# testNewConf()');
Xavier Guimard's avatar
Xavier Guimard committed
1008
    return $self->_unitTest( $self->newConf(), '' ) && $self->_globalTest();
1009 1010
}

1011 1012 1013 1014
##@method private boolean _unitTest()
# Launch unit tests declared in Lemonldap::NG::Manager::Build::Attributes file
#
#@return true if tests succeed
1015
sub _unitTest {
1016
    my ( $self, $conf ) = @_;
1017
    hdebug('# _unitTest()');
1018 1019 1020 1021
    my $types = &Lemonldap::NG::Manager::Attributes::types();
    my $attrs = &Lemonldap::NG::Manager::Attributes::attributes();
    my $res   = 1;
    foreach my $key ( keys %$conf ) {
1022 1023 1024 1025 1026 1027
        if (    $self->{skippedUnitTests}
            and $self->{skippedUnitTests} =~ /\b$key\b/ )
        {
            $self->logger->debug("Ignore test for $key");
            next;
        }
1028
        hdebug("Testing $key");
1029 1030
        my $attr = $attrs->{$key};
        my $type = $types->{ $attr->{type} };
1031 1032 1033 1034 1035
        unless ( $type or $attr->{test} ) {
            print STDERR "Unknown attribute $key, deleting it\n";
            delete $conf->{$key};
            next;
        }
1036

1037
        if ( $attr->{type} and $attr->{type} eq 'subContainer' ) {
1038

Xavier Guimard's avatar
Typo  
Xavier Guimard committed
1039
            # TODO Recursive for SAML/OIDC nodes
1040 1041
        }
        else {
1042 1043

            # Check if key exists
1044
            unless ($attr) {
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
1045
                push @{ $self->errors }, { message => "__unknownKey__: $key" };
1046
                $res = 0;
1047 1048 1049
                next;
            }

1050
            # Hash parameters
1051
            if ( $key =~ /^$simpleHashKeys$/o ) {
1052 1053 1054
                $conf->{$key} //= {};
                unless ( ref $conf->{$key} eq 'HASH' ) {
                    push @{ $self->errors },
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
1055
                      { message => "$key is not a hash ref" };
1056 1057 1058
                    $res = 0;
                    next;
                }
1059
            }
1060
            elsif ( $attr->{type} =~ /Container$/ ) {
1061

1062 1063
                #TODO
            }
1064
            if (   $key =~ /^(?:$simpleHashKeys|$doubleHashKeys)$/o
1065 1066
                or $attr->{type} =~ /Container$/ )
            {
1067
                my $keyMsg = $attr->{keyMsgFail} // $type->{keyMsgFail};
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
1068
                my $msg    = $attr->{msgFail} // $type->{msgFail};
1069
                $res = 0
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
1070
                  unless (
1071
                    $self->_execTest(
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
1072 1073
                        {
                            keyTest    => $attr->{keyTest} // $type->{keyTest},
1074
                            keyMsgFail => $attr->{keyMsgFail}
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
1075 1076
                              // $type->{keyMsgFail},
                            test    => $attr->{test} // $type->{test},
1077 1078 1079 1080 1081
                            msgFail => $attr->{msgFail} // $type->{msgFail},
                        },
                        $conf->{$key},
                        $key, $attr, undef, $conf
                    )
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
1082
                  );