Parser.pm 48.3 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 Crypt::URandom;
24
use Mouse;
25
use JSON 'to_json';
26
use Lemonldap::NG::Common::Conf::ReConstants;
27 28
use Lemonldap::NG::Manager::Attributes;

Xavier Guimard's avatar
Xavier Guimard committed
29
our $VERSION = '2.1.0';
30

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

Xavier Guimard's avatar
Xavier Guimard committed
33
# High debugging for developers, set this to 1
34 35
use constant HIGHDEBUG => 0;

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

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

# Properties required during build
Xavier Guimard's avatar
Tidy  
Xavier Guimard committed
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' );

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

93 94 95
##@method boolean check()
# Main method
#@return result
96
sub check {
97
    my $self      = shift;
98 99
    my $localConf = shift;

100
    hdebug("# check()");
101
    unless ( $self->newConf ) {
Xavier Guimard's avatar
Xavier Guimard committed
102
        return 0 unless ( $self->scanTree );
103
    }
104
    unless ( $self->testNewConf($localConf) ) {
Xavier Guimard's avatar
Xavier Guimard committed
105
        hdebug("  testNewConf() failed");
106 107
        return 0;
    }
108
    my $separator = $self->newConf->{multiValuesSeparator} || '; ';
Xavier Guimard's avatar
Xavier Guimard committed
109
    hdebug("  tests succeed");
110 111 112
    my %conf          = %{ $self->newConf() };
    my %compactedConf = %{ $self->compactConf( $self->newConf ) };
    my @removedKeys   = ();
Xavier Guimard's avatar
Xavier Guimard committed
113
    unless ( $self->confChanged ) {
Christophe Maudoux's avatar
Typo  
Christophe Maudoux committed
114
        hdebug("  no change detected");
Xavier Guimard's avatar
Xavier Guimard committed
115 116 117
        $self->message('__confNotChanged__');
        return 0;
    }
118 119 120 121 122 123 124 125 126 127 128 129 130 131
    unless ( $self->newConf->{dontCompactConf} ) {
        foreach ( sort keys %conf ) {
            push @removedKeys, $_ unless exists $compactedConf{$_};
        }
    }
    push @{ $self->changes },
      (
        $self->{newConf}->{dontCompactConf}
        ? { confCompacted => '0' }
        : {
            confCompacted => '1',
            removedKeys   => join( $separator, @removedKeys )
        }
      );
Xavier Guimard's avatar
Xavier Guimard committed
132
    return 1;
133 134
}

135 136 137
##@method boolean scanTree()
# Methods to build new conf from JSON string
#@result true if succeed
138 139
sub scanTree {
    my $self = shift;
140
    hdebug("# scanTree()");
141 142 143 144
    $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
145
    # metadata and set a value to the key if empty
Xavier Guimard's avatar
Xavier Guimard committed
146
    $self->newConf->{cfgNum} = $self->req->params('cfgNum');
Xavier Guimard's avatar
Xavier Guimard committed
147 148 149
    $self->newConf->{cfgAuthor} =
      $self->req->userData->{ Lemonldap::NG::Handler::Main->tsv->{whatToTrace}
          || '_whatToTrace' } // "anonymous";
Xavier Guimard's avatar
Xavier Guimard committed
150
    $self->newConf->{cfgAuthorIP} = $self->req->address;
151
    $self->newConf->{cfgDate}     = time;
152
    $self->newConf->{cfgVersion}  = $Lemonldap::NG::Manager::VERSION;
153 154 155
    $self->newConf->{key} ||= join( '',
        map { chr( int( ord( Crypt::URandom::urandom(1) ) * 94 / 256 ) + 33 ) }
          ( 1 .. 16 ) );
156 157 158 159 160 161

    return 1;
}

use feature 'state';

162
##@method private boolean _scanNodes()
163
# Recursive JSON parser
164
#@result true if succeed
165
sub _scanNodes {
166
    my ( $self, $tree, ) = @_;
167
    hdebug("# _scanNodes()");
168 169 170 171 172 173
    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
174 175 176
    unless (@$tree) {
        hdebug('  empty tree !?');
    }
177 178
    foreach my $leaf (@$tree) {
        my $name = $leaf->{title};
179
        hdebug("Looking to $name");
180 181

        # subnode
182
        my $subNodes     = $leaf->{nodes}      // $leaf->{_nodes};
183 184 185 186 187 188 189 190
        my $subNodesCond = $leaf->{nodes_cond} // $leaf->{_nodes_cond};

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

        # Root nodes
        if ( $leaf->{id} =~ /^($specialNodeKeys)$/io ) {
191
            hdebug("Root special node detected $leaf->{id}");
192 193 194

            # If node has not been opened
            if ( $leaf->{cnodes} ) {
195
                hdebug("  not opened");
196
                foreach my $k ( @{ $specialNodeHash->{ $leaf->{id} } } ) {
197
                    hdebug("  copying $k");
198 199 200 201 202 203 204 205 206 207 208 209 210
                    $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) {
211
                hdebug( "Keys detected as removed:", \@old );
212 213 214
                $self->confChanged(1);
                foreach my $deletedHost (@old) {
                    push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
215
                      { key => $leaf->{id}, old => $deletedHost };
216 217 218 219 220 221 222
                }
            }
            next;
        }

        # 1st sublevel
        elsif ( $leaf->{id} =~ /^($specialNodeKeys)\/([^\/]+)$/io ) {
223
            hdebug("Special node chield detected $leaf->{id}");
224 225 226 227
            my ( $base, $host ) = ( $1, $2 );

            # Check hostname/partner name changes (id points to the old name)
            $newNames{$host} = $leaf->{title};
228 229 230 231
            if ( $newNames{$host} ne $host and $host !~ /^new__/ ) {
                hdebug("  $host becomes $newNames{$host}");
                $self->confChanged(1);
                push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
232
                  { key => $base, old => $host, new => $newNames{$host} };
233
            }
234 235 236 237 238 239

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

        # Other sub levels
Xavier Guimard's avatar
Xavier Guimard committed
240 241
        elsif ( $leaf->{id} =~
            /^($specialNodeKeys)\/([^\/]+)\/([^\/]+)(?:\/(.*))?$/io )
242
        {
Xavier Guimard's avatar
Xavier Guimard committed
243 244
            my ( $base, $key, $oldName, $target, $h ) =
              ( $1, $newNames{$2}, $2, $3, $4 );
245 246 247
            hdebug(
                "Special node chield subnode detected $leaf->{id}",
                "  base $base, key $key, target $target, h "
Xavier Guimard's avatar
Xavier Guimard committed
248
                  . ( $h ? $h : 'undef' )
249
            );
250 251 252

            # VirtualHosts
            if ( $base eq 'virtualHosts' ) {
253
                hdebug("  virtualhost");
254 255
                if ( $target =~ /^(?:locationRules|exportedHeaders|post)$/ ) {
                    if ( $leaf->{cnodes} ) {
256
                        hdebug('    unopened subnode');
Xavier Guimard's avatar
Xavier Guimard committed
257 258
                        $self->newConf->{$target}->{$key} =
                          $self->refConf->{$target}->{$oldName} // {};
259 260 261
                    }

                    elsif ($h) {
262
                        hdebug('    4 levels');
263
                        if ( $target eq 'locationRules' ) {
264
                            hdebug('    locationRules');
Xavier Guimard's avatar
Xavier Guimard committed
265 266 267 268
                            my $k =
                              $leaf->{comment}
                              ? "(?#$leaf->{comment})$leaf->{re}"
                              : $leaf->{re};
Christophe Maudoux's avatar
Christophe Maudoux committed
269
                            $k .= "(?#AuthnLevel=$leaf->{level})" if $leaf->{level};
270 271 272
                            $self->set( $target, $key, $k, $leaf->{data} );
                        }
                        else {
273
                            hdebug('    other than locationrules');
274 275 276 277 278 279 280
                            $self->set( $target, $key, $leaf->{title},
                                $leaf->{data} );
                        }
                    }

                    # Unless $h is set, scan subnodes and check changes
                    else {
281
                        hdebug('    3 levels only (missing $h)');
282
                        if ( ref $subNodes ) {
283
                            hdebug('    has subnodes');
284
                            $self->_scanNodes($subNodes)
Xavier Guimard's avatar
Xavier Guimard committed
285
                              or return 0;
286 287 288 289
                        }
                        if ( exists $self->refConf->{$target}->{$key}
                            and %{ $self->refConf->{$target}->{$key} } )
                        {
290
                            hdebug('    old conf subnode has values');
291 292 293 294 295
                            my $c = $self->newConf->{$target};
                            foreach my $k (
                                keys %{ $self->refConf->{$target}->{$key} } )
                            {
                                unless ( defined $c->{$key}->{$k} ) {
296
                                    hdebug('      missing value in old conf');
297 298
                                    $self->confChanged(1);
                                    push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
299
                                      {
300 301
                                        key => "$target, $key",
                                        old => $k,
Xavier Guimard's avatar
Xavier Guimard committed
302
                                      };
303 304 305 306 307 308
                                }
                            }
                        }
                        elsif ( exists $self->newConf->{$target}->{$key}
                            and %{ $self->newConf->{$target}->{$key} } )
                        {
309
                            hdebug("    '$key' has values");
310 311
                            $self->confChanged(1);
                            push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
312
                              { key => "$target", new => $key };
313 314 315 316
                        }
                    }
                }
                elsif ( $target =~ /^$virtualHostKeys$/o ) {
317 318
                    $self->set( 'vhostOptions', [ $oldName, $key ],
                        $target, $leaf->{data} );
319 320 321
                }
                else {
                    push @{ $self->errors },
Xavier Guimard's avatar
Xavier Guimard committed
322
                      { message => "Unknown vhost key $target" };
323 324 325 326
                    return 0;
                }
                next;
            }
327

328
            # SAML
329
            elsif ( $base =~ /^saml(?:S|ID)PMetaDataNodes$/ ) {
330
                hdebug('SAML');
331 332
                if ( defined $leaf->{data}
                    and ref( $leaf->{data} ) eq 'ARRAY' )
Xavier Guimard's avatar
Xavier Guimard committed
333
                {
334 335 336
                    hdebug("  SAML data is an array, serializing");
                    $leaf->{data} = join ';', @{ $leaf->{data} };
                }
Xavier Guimard's avatar
Xavier Guimard committed
337
                if ( $target =~ /^saml(?:S|ID)PMetaDataExportedAttributes$/ ) {
338
                    if ( $leaf->{cnodes} ) {
339
                        hdebug("  $target: unopened node");
Xavier Guimard's avatar
Xavier Guimard committed
340 341
                        $self->newConf->{$target}->{$key} =
                          $self->refConf->{$target}->{$oldName} // {};
342
                    }
Xavier Guimard's avatar
Xavier Guimard committed
343
                    elsif ($h) {
344
                        hdebug("  $target: opened node");
345
                        $self->confChanged(1);
346 347 348
                        $self->set( $target, $key, $leaf->{title},
                            $leaf->{data} );
                    }
349
                    else {
350 351
                        hdebug("  $target: looking for subnodes");
                        $self->_scanNodes($subNodes);
352
                    }
353
                }
354
                elsif ( $target =~ /^saml(?:S|ID)PMetaDataXML$/ ) {
355
                    hdebug("  $target");
Xavier Guimard's avatar
Xavier Guimard committed
356 357
                    $self->set( $target, [ $oldName, $key ],
                        $target, $leaf->{data} );
358
                }
359 360 361
                elsif ( $target =~ /^saml(?:ID|S)PMetaDataOptions/ ) {
                    my $optKey = $&;
                    hdebug("  $base sub key: $target");
Xavier Guimard's avatar
Xavier Guimard committed
362 363 364
                    if ( $target =~
                        /^(?:$samlIDPMetaDataNodeKeys|$samlSPMetaDataNodeKeys)/o
                      )
365
                    {
366 367 368 369
                        $self->set(
                            $optKey, [ $oldName, $key ],
                            $target, $leaf->{data}
                        );
370 371 372
                    }
                    else {
                        push @{ $self->errors },
Xavier Guimard's avatar
Xavier Guimard committed
373
                          { message => "Unknown SAML metadata option $target" };
374 375
                        return 0;
                    }
376 377 378
                }
                else {
                    push @{ $self->errors },
Xavier Guimard's avatar
Xavier Guimard committed
379
                      { message => "Unknown SAML key $target" };
380 381 382 383
                    return 0;
                }
                next;
            }
384

Xavier Guimard's avatar
Xavier Guimard committed
385
            # OIDC
386
            elsif ( $base =~ /^oidc(?:O|R)PMetaDataNodes$/ ) {
387
                hdebug('OIDC');
Xavier Guimard's avatar
Xavier Guimard committed
388
                if ( $target =~ /^oidc(?:O|R)PMetaDataOptions$/ ) {
389 390
                    hdebug("  $target: looking for subnodes");
                    $self->_scanNodes($subNodes);
Xavier Guimard's avatar
Xavier Guimard committed
391
                    $self->set( $target, $key, $leaf->{title}, $leaf->{data} );
Xavier Guimard's avatar
Xavier Guimard committed
392 393
                }
                elsif ( $target =~ /^oidcOPMetaData(?:JSON|JWKS)$/ ) {
394
                    hdebug("  $target");
Xavier Guimard's avatar
Xavier Guimard committed
395 396 397
                    $self->set( $target, $key, $leaf->{data} );
                }
                elsif ( $target =~ /^oidc(?:O|R)PMetaDataExportedVars$/ ) {
398
                    hdebug("  $target");
Xavier Guimard's avatar
Xavier Guimard committed
399
                    if ( $leaf->{cnodes} ) {
400
                        hdebug('    unopened');
Xavier Guimard's avatar
Xavier Guimard committed
401 402
                        $self->newConf->{$target}->{$key} =
                          $self->refConf->{$target}->{$oldName} // {};
Xavier Guimard's avatar
Xavier Guimard committed
403 404
                    }
                    elsif ($h) {
405
                        hdebug('    opened');
406
                        $self->confChanged(1);
Xavier Guimard's avatar
Xavier Guimard committed
407 408 409
                        $self->set( $target, $key, $leaf->{title},
                            $leaf->{data} );
                    }
410 411 412 413
                    else {
                        hdebug("  $target: looking for subnodes");
                        $self->_scanNodes($subNodes);
                    }
Xavier Guimard's avatar
Xavier Guimard committed
414
                }
415
                elsif ( $target =~ /^oidc(?:O|R)PMetaDataOptions/ ) {
416
                    my $optKey = $&;
417
                    hdebug "  $base sub key: $target";
Xavier Guimard's avatar
Xavier Guimard committed
418 419 420
                    if ( $target eq 'oidcRPMetaDataOptionsExtraClaims' ) {
                        if ( $leaf->{cnodes} ) {
                            hdebug('    unopened');
Xavier Guimard's avatar
Xavier Guimard committed
421 422
                            $self->newConf->{$target}->{$key} =
                              $self->refConf->{$target}->{$oldName} // {};
Xavier Guimard's avatar
Xavier Guimard committed
423 424 425 426 427 428 429 430 431 432 433
                        }
                        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
Xavier Guimard committed
434 435 436
                    elsif ( $target =~
                        /^(?:$oidcOPMetaDataNodeKeys|$oidcRPMetaDataNodeKeys)/o
                      )
437
                    {
438 439 440 441
                        $self->set(
                            $optKey, [ $oldName, $key ],
                            $target, $leaf->{data}
                        );
442 443 444
                    }
                    else {
                        push @{ $self->errors },
Xavier Guimard's avatar
Xavier Guimard committed
445
                          { message => "Unknown OIDC metadata option $target" };
446 447
                        return 0;
                    }
448
                }
Xavier Guimard's avatar
Xavier Guimard committed
449 450
                else {
                    push @{ $self->errors },
Xavier Guimard's avatar
Xavier Guimard committed
451
                      { message => "Unknown OIDC key $target" };
Xavier Guimard's avatar
Xavier Guimard committed
452 453 454 455
                    return 0;
                }
                next;
            }
456 457 458 459 460

            # CAS
            elsif ( $base =~ /^cas(?:App|Srv)MetaDataNodes$/ ) {
                my $optKey = $&;
                hdebug('CAS');
461 462 463
                if ( $target =~ /^cas(?:App|Srv)MetaDataOptions$/ ) {
                    hdebug("  $target: looking for subnodes");
                    $self->_scanNodes($subNodes);
Xavier Guimard's avatar
Xavier Guimard committed
464
                    $self->set( $target, $key, $leaf->{title}, $leaf->{data} );
465 466 467 468 469
                }
                elsif ( $target =~ /^cas(?:App|Srv)MetaDataExportedVars$/ ) {
                    hdebug("  $target");
                    if ( $leaf->{cnodes} ) {
                        hdebug('    unopened');
Xavier Guimard's avatar
Xavier Guimard committed
470 471
                        $self->newConf->{$target}->{$key} =
                          $self->refConf->{$target}->{$oldName} // {};
472 473 474
                    }
                    elsif ($h) {
                        hdebug('    opened');
475
                        $self->confChanged(1);
476 477 478 479 480 481 482 483
                        $self->set( $target, $key, $leaf->{title},
                            $leaf->{data} );
                    }
                    else {
                        hdebug("  $target: looking for subnodes");
                        $self->_scanNodes($subNodes);
                    }
                }
484 485 486
                elsif ( $target =~ /^cas(?:Srv|App)MetaDataOptions/ ) {
                    my $optKey = $&;
                    hdebug "  $base sub key: $target";
487 488 489
                    if ( $target eq 'casSrvMetaDataOptionsProxiedServices' ) {
                        if ( $leaf->{cnodes} ) {
                            hdebug('    unopened');
Xavier Guimard's avatar
Xavier Guimard committed
490 491
                            $self->newConf->{$target}->{$key} =
                              $self->refConf->{$target}->{$oldName} // {};
492 493 494 495 496 497 498 499 500 501 502
                        }
                        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
Xavier Guimard committed
503 504 505
                    elsif ( $target =~
                        /^(?:$casSrvMetaDataNodeKeys|$casAppMetaDataNodeKeys)/o
                      )
506
                    {
dcoutadeur dcoutadeur's avatar
dcoutadeur dcoutadeur committed
507 508 509 510
                        $self->set(
                            $optKey, [ $oldName, $key ],
                            $target, $leaf->{data}
                        );
511 512 513
                    }
                    else {
                        push @{ $self->errors },
Xavier Guimard's avatar
Xavier Guimard committed
514
                          { message => "Unknown CAS metadata option $target" };
515 516
                        return 0;
                    }
517 518 519
                }
                else {
                    push @{ $self->errors },
Xavier Guimard's avatar
Xavier Guimard committed
520
                      { message => "Unknown CAS option $target" };
521 522
                    return 0;
                }
523
                next;
524
            }
525
            else {
526
                push @{ $self->errors },
Xavier Guimard's avatar
Xavier Guimard committed
527
                  { message => "Fatal: unknown special sub node $base" };
528 529
                return 0;
            }
530 531 532 533 534
        }

        ####################
        # Application list #
        ####################
535 536 537 538 539 540

        # Application list root node
        elsif ( $leaf->{title} eq 'applicationList' ) {
            hdebug( $leaf->{title} );
            if ( $leaf->{cnodes} ) {
                hdebug('  unopened');
Xavier Guimard's avatar
Xavier Guimard committed
541 542
                $self->newConf->{applicationList} =
                  $self->refConf->{applicationList} // {};
543 544 545 546 547
            }
            else {
                $self->_scanNodes($subNodes) or return 0;

                # Check for deleted
Xavier Guimard's avatar
Xavier Guimard committed
548 549 550 551 552 553 554 555
                my @listCatRef =
                  map { $self->refConf->{applicationList}->{$_}->{catname} }
                  keys %{ $self->refConf->{applicationList} };
                my @listCatNew =
                  map { $self->newConf->{applicationList}->{$_}->{catname} }
                  keys(
                    %{
                        ref $self->newConf->{applicationList}
556 557 558
                        ? $self->newConf->{applicationList}
                        : {}
                    }
Xavier Guimard's avatar
Xavier Guimard committed
559
                  );
560

561 562
                @listCatRef = map { $_ ? $_ : () } @listCatRef;
                @listCatNew = map { $_ ? $_ : () } @listCatNew;
Xavier Guimard's avatar
Xavier Guimard committed
563 564
                @listCatRef = sort @listCatRef;
                @listCatNew = sort @listCatNew;
565 566 567 568 569 570 571 572 573 574 575
                hdebug( '# @listCatRef : ', \@listCatRef );
                hdebug( '# @listCatNew : ', \@listCatNew );

                # Check for deleted
                my @diff =
                  grep !${ { map { $_, 1 } @listCatNew } }{$_}, @listCatRef;
                if ( scalar @diff ) {
                    $self->confChanged(1);
                    push @{ $self->changes },
                      {
                        new => join( ', ', 'categoryList',      @listCatNew ),
Christophe Maudoux's avatar
Christophe Maudoux committed
576
                        key => join( ', ', 'Deletes in cat(s)', @diff ),
577 578
                        old => join( ', ', 'categoryList',      @listCatRef ),
                      };
579 580 581 582 583 584
                }
            }
            next;
        }

        # Application list sub nodes
585
        elsif ( $leaf->{id} =~ /^applicationList\/(.+)$/ ) {
586
            hdebug('Application list subnode');
587 588
            use feature 'state';
            my @cats = split /\//, $1;
589
            my $app  = pop @cats;
590 591 592 593 594 595 596 597 598
            $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) {
599
                hdebug("  looking to cat $cat");
600 601
                unless ( defined $knownCat->{$cat} ) {
                    push @{ $self->{errors} },
Xavier Guimard's avatar
Xavier Guimard committed
602 603
                      { message =>
                          "Fatal: sub cat/app before parent ($leaf->{id})" };
604 605 606 607 608 609 610 611
                    return 0;
                }
                $cn = $cn->{ $knownCat->{$cat} };
                push @path, $cn->{catname};
                $cmp->{$cat} //= {};
                $cmp = $cmp->{$cat};
            }

612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627
            my $newapp = $app;

         # Compute a nice name for new nodes, taking care of potential conflicts
         # For some reason, the manager sends /nNaN sometimes
            if ( $newapp =~ /^n(\d+|NaN)$/ ) {

                # Remove all special characters
                my $baseName = $leaf->{title} =~ s/\W//gr;
                $baseName = lc $baseName;
                $newapp   = $baseName;
                my $cnt = 1;
                while ( exists $cn->{$newapp} ) {
                    $newapp = "${baseName}_" . $cnt++;
                }
            }

628 629 630 631 632
            # 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' ) {
633
                hdebug('  menu cat');
634
                $knownCat->{__id}++;
635 636 637 638 639 640
                $knownCat->{$app} = $newapp;
                $cn->{$newapp}    = {
                    catname => $leaf->{title},
                    type    => 'category',
                    order   => $knownCat->{__id}
                };
641
                unless ($cmp->{$app}
642
                    and $cmp->{$app}->{catname} eq $cn->{$newapp}->{catname} )
643 644 645
                {
                    $self->confChanged(1);
                    push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
646 647 648 649
                      {
                        key => join(
                            ', ', 'applicationList', @path, $leaf->{title}
                        ),
650 651 652 653
                        new => $cn->{$newapp}->{catname},
                        old => (
                            $cn->{$newapp} ? $cn->{$newapp}->{catname} : undef
                        )
Xavier Guimard's avatar
Xavier Guimard committed
654
                      };
655 656 657 658
                }
                if ( ref $subNodes ) {
                    $self->_scanNodes($subNodes) or return 0;
                }
Xavier Guimard's avatar
Xavier Guimard committed
659
                my @listCatRef = keys %{ $cmp->{$app} };
660
                my @listCatNew = keys %{ $cn->{$newapp} };
661

Xavier Guimard's avatar
Xavier Guimard committed
662 663 664 665
                # Check for deleted
                unless ( @listCatRef == @listCatNew ) {
                    $self->confChanged(1);
                    push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
666
                      {
Xavier Guimard's avatar
Xavier Guimard committed
667
                        key => join( ', ', 'applicationList', @path ),
668
                        new => 'Changes in cat(s)/app(s)',
Xavier Guimard's avatar
Xavier Guimard committed
669
                      };
Xavier Guimard's avatar
Xavier Guimard committed
670
                }
671 672 673 674
            }

            # Create new apps
            else {
675
                hdebug('  new app');
676
                $knownCat->{__id}++;
677 678 679 680 681 682
                $cn->{$newapp} = {
                    type    => 'application',
                    options => $leaf->{data},
                    order   => $knownCat->{__id}
                };
                $cn->{$newapp}->{options}->{name} = $leaf->{title};
683 684 685
                unless ( $cmp->{$app} ) {
                    $self->confChanged(1);
                    push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
686
                      {
687 688
                        key => join( ', ', 'applicationList', @path ),
                        new => $leaf->{title},
Xavier Guimard's avatar
Xavier Guimard committed
689
                      };
690 691
                }
                else {
692 693 694 695 696 697 698 699 700
                    # Check for change in ordering
                    if ( ( $cn->{$newapp}->{order} || 0 ) !=
                        ( $cmp->{$newapp}->{order} || 0 ) )
                    {
                        $self->confChanged(1);
                    }

                    # Check for change in options
                    foreach my $k ( keys %{ $cn->{$newapp}->{options} } ) {
701
                        unless ( $cmp->{$app}->{options}->{$k} eq
702
                            $cn->{$newapp}->{options}->{$k} )
703 704 705
                        {
                            $self->confChanged(1);
                            push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
706
                              {
707 708 709
                                key => join( ', ',
                                    'applicationList', @path,
                                    $leaf->{title},    $k ),
710
                                new => $cn->{$newapp}->{options}->{$k},
711
                                old => $cmp->{$app}->{options}->{$k}
Xavier Guimard's avatar
Xavier Guimard committed
712
                              };
713 714 715 716 717 718
                        }
                    }
                }
            }
            next;
        }
719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734
        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
Xavier Guimard committed
735 736
                    my $k =
                      $n->{re} . ( $n->{comment} ? "##$n->{comment}" : '' );
737 738 739 740 741
                    $self->newConf->{grantSessionRules}->{$k} = $n->{data};
                    $count++;
                    unless ( defined $ref->{$k} ) {
                        $self->confChanged(1);
                        push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
742
                          { keys => 'grantSessionRules', new => $k };
743 744 745 746
                    }
                    elsif ( $ref->{$k} ne $n->{data} ) {
                        $self->confChanged(1);
                        push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
747
                          {
748 749 750
                            key => "grantSessionRules, $k",
                            old => $self->refConf->{grantSessionRules}->{$k},
                            new => $n->{data}
Xavier Guimard's avatar
Xavier Guimard committed
751
                          };
752 753 754 755 756 757
                    }
                    @old = grep { $_ ne $k } @old;
                }
                if (@old) {
                    $self->confChanged(1);
                    push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
758 759
                      { key => 'grantSessionRules', old => $_, }
                      foreach (@old);
760 761 762 763
                }
            }
            next;
        }
764

Xavier Guimard's avatar
Xavier Guimard committed
765 766 767 768 769 770 771
        # 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
Xavier Guimard committed
772
                      { message => 'Malformed openIdIDPList ' . $leaf->{data} };
Xavier Guimard's avatar
Xavier Guimard committed
773 774 775 776 777 778 779 780 781 782
                    return 0;
                }
                $self->set( $name, join( ';', @{ $leaf->{data} } ) );
            }
            else {
                $self->set( $name, undef );
            }
            next;
        }

783 784 785
        ####################
        # Other hash nodes #
        ####################
786
        elsif ( $leaf->{title} =~ /^$simpleHashKeys$/o
787 788
            and not $leaf->{title} eq 'applicationList' )
        {
789
            hdebug( $leaf->{title} );
790 791 792

            # If a `cnodes` key is found, keep old key unchanges
            if ( $leaf->{cnodes} ) {
793
                hdebug('  unopened');
794 795 796
                $self->newConf->{$name} = $self->refConf->{$name} // {};
            }
            else {
797
                hdebug('  opened');
798 799 800 801 802 803 804

                # 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
Xavier Guimard committed
805
                        $tmp->{$_} = $node->{data}->{$_} foreach (qw(type for));
806 807 808 809 810 811 812 813 814 815 816 817
                        $tmp->{over} = {};
                        foreach ( @{ $node->{data}->{over} } ) {
                            $tmp->{over}->{ $_->[0] } = $_->[1];
                        }
                        $self->newConf->{$name}->{ $node->{title} } = $tmp;
                    }

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

818 819 820 821 822 823
                # sfExtra: just to replace "over" key
                if ( $name eq 'sfExtra' ) {
                    hdebug('     sfExtra');
                    $self->newConf->{$name} = {};
                    foreach my $node ( @{ $leaf->{nodes} } ) {
                        my $tmp;
824 825
                        $tmp->{$_} = $node->{data}->{$_}
                          foreach (qw(type rule logo label));
826 827 828 829 830 831 832 833 834 835 836 837
                        $tmp->{over} = {};
                        foreach ( @{ $node->{data}->{over} } ) {
                            $tmp->{over}->{ $_->[0] } = $_->[1];
                        }
                        $self->newConf->{$name}->{ $node->{title} } = $tmp;
                    }

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

838 839 840 841 842 843 844 845 846
                $subNodes //= [];
                my $count = 0;
                my @old   = (
                    ref( $self->refConf->{$name} )
                    ? ( keys %{ $self->refConf->{$name} } )
                    : ()
                );
                $self->newConf->{$name} = {};
                foreach my $n (@$subNodes) {
847
                    hdebug("  looking at $n subnode");
Xavier Guimard's avatar
Xavier Guimard committed
848
                    if ( ref $n->{data} and ref $n->{data} eq 'ARRAY' ) {
Clément OUDOT's avatar
Clément OUDOT committed
849

850 851
                        # authChoiceModules
                        if ( $name eq 'authChoiceModules' ) {
852
                            hdebug('     authChoiceModules');
853 854 855 856 857 858 859
                            if ( ref( $n->{data}->[5] ) eq 'ARRAY' ) {
                                $n->{data}->[5] = to_json(
                                    { map { @$_ } @{ $n->{data}->[5] } } );
                            }
                            else {
                                $n->{data}->[5] = '{}';
                            }
860 861
                        }

Xavier Guimard's avatar
Xavier Guimard committed
862 863
                        $n->{data} = join ';', @{ $n->{data} };
                    }
864 865
                    $self->newConf->{$name}->{ $n->{title} } = $n->{data};
                    $count++;
Xavier Guimard's avatar
Xavier Guimard committed
866
                    unless ( defined $self->refConf->{$name}->{ $n->{title} } )
867 868 869
                    {
                        $self->confChanged(1);
                        push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
870
                          { key => $name, new => $n->{title}, };
871
                    }
Xavier Guimard's avatar
Xavier Guimard committed
872 873
                    elsif (
                        $self->refConf->{$name}->{ $n->{title} } ne $n->{data} )
874 875 876
                    {
                        $self->confChanged(1);
                        push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
877
                          {
878 879 880
                            key => "$name, $n->{title}",
                            old => $self->refConf->{$name}->{ $n->{title} },
                            new => $n->{data}
Xavier Guimard's avatar
Xavier Guimard committed
881
                          };
882 883 884 885 886 887
                    }
                    @old = grep { $_ ne $n->{title} } @old;
                }
                if (@old) {
                    $self->confChanged(1);
                    push @{ $self->changes }, { key => $name, old => $_, }
Xavier Guimard's avatar
Xavier Guimard committed
888
                      foreach (@old);
889 890 891 892 893
                }
            }
            next;
        }

894 895 896 897 898 899 900 901 902
        # Double hash nodes
        elsif ( $leaf->{title} =~ /^$doubleHashKeys$/ ) {
            hdebug( $leaf->{title} );
            my @oldHosts = (
                ref( $self->refConf->{$name} )
                ? ( keys %{ $self->refConf->{$name} } )
                : ()
            );
            $self->newConf->{$name} = {};
903 904
            unless ( defined $leaf->{data} ) {
                hdebug('  unopened');
905
                $self->newConf->{$name} = $self->refConf->{$name} || {};
906
                next;
907 908 909 910 911 912 913 914 915 916 917 918 919 920 921
            }
            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;
922
                    @oldKeys  = keys %{ $self->refConf->{$name}->{$host} };
923 924
                }
                foreach my $prm ( @{ $getHost->{h} } ) {
Xavier Guimard's avatar
Xavier Guimard committed
925 926 927 928
                    $self->newConf->{$name}->{$host}->{ $prm->{k} } =
                      $prm->{v};
                    if (
                        !$change
929 930
                        and (
                            not defined(
Xavier Guimard's avatar
Xavier Guimard committed
931
                                $self->refConf->{$name}->{$host}->{ $prm->{k} }
932 933 934 935
                            )
                            or $self->newConf->{$name}->{$host}->{ $prm->{k} }
                            ne $self->refConf->{$name}->{$host}->{ $prm->{k} }
                        )
Xavier Guimard's avatar
Xavier Guimard committed
936
                      )
937 938 939 940
                    {
                        $self->confChanged(1);
                        hdebug("    key $prm->{k} has been changed");
                        push @{ $self->changes },
Xavier Guimard's avatar
Xavier Guimard committed
941
                          { key => "$name/$host", new => $prm->{k} };
942 943 944 945 946 947 948 949 950
                    }
                    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
Xavier Guimard committed
951 952
                      { key => "$name/$host", old => $_ }
                      foreach (@oldKeys);
953 954 955 956 957 958
                }
            }
            if (@oldHosts) {
                $self->confChanged(1);
                hdebug( "  old hosts " . join( ' ', @oldHosts ) );
                push @{ $self->changes }, { key => "$name", old => $_ }
Xavier Guimard's avatar
Xavier Guimard committed
959
                  foreach (@oldHosts);
960 961 962 963
            }
            next;
        }

964 965 966 967 968 969 970
        ###############
        # Other nodes #
        ###############

        # Check if subnodes
        my $n = 0;
        if ( ref $subNodesCond ) {
Xavier Guimard's avatar
Xavier Guimard committed
971 972 973 974
            hdebug('  conditional subnodes detected');

            # Bad idea,subnode unopened are not read
            #$subNodesCond = [ grep { $_->{show} } @$subNodesCond ];
975 976 977 978
            $self->_scanNodes($subNodesCond) or return 0;
            $n++;
        }
        if ( ref $subNodes ) {
Xavier Guimard's avatar
Xavier Guimard committed
979
            hdebug('  subnodes detected');
Xavier Guimard's avatar