Commit 86e88da4 authored by Clément OUDOT's avatar Clément OUDOT

Merge branch 'v2.0' of gitlab.ow2.org:lemonldap-ng/lemonldap-ng into v2.0

parents a349c310 2b51cf0c
......@@ -46,8 +46,7 @@ has warnings => (
hdebug( 'warnings contains', $_[0]->{warnings} );
}
);
has changes =>
( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
has changes => ( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
has message => (
is => 'rw',
isa => 'Str',
......@@ -57,7 +56,7 @@ has message => (
}
);
has needConfirmation =>
( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
( is => 'rw', isa => 'ArrayRef', default => sub { return [] } );
# Booleans
has confChanged => (
......@@ -70,7 +69,7 @@ has confChanged => (
);
# Properties required during build
has refConf => ( is => 'ro', isa => 'HashRef', required => 1 );
has refConf => ( is => 'ro', isa => 'HashRef', required => 1 );
has req => ( is => 'ro', required => 1 );
has newConf => ( is => 'rw', isa => 'HashRef' );
has tree => ( is => 'rw', isa => 'ArrayRef' );
......@@ -125,15 +124,14 @@ sub scanTree {
# Set cfgNum to ref cfgNum (will be changed when saving), set other
# metadata and set a value to the key if empty
$self->newConf->{cfgNum} = $self->req->params('cfgNum');
$self->newConf->{cfgAuthor}
= $self->req->userData
->{ &Lemonldap::NG::Handler::Main::tsv->{whatToTrace}
|| '_whatToTrace' } // "anonymous";
$self->newConf->{cfgAuthor} =
$self->req->userData->{ Lemonldap::NG::Handler::Main->tsv->{whatToTrace}
|| '_whatToTrace' } // "anonymous";
$self->newConf->{cfgAuthorIP} = $self->req->address;
$self->newConf->{cfgDate} = time;
$self->newConf->{cfgVersion} = $VERSION;
$self->newConf->{key}
||= join( '', map { chr( int( rand(94) ) + 33 ) } ( 1 .. 16 ) );
$self->newConf->{key} ||=
join( '', map { chr( int( rand(94) ) + 33 ) } ( 1 .. 16 ) );
return 1;
}
......@@ -160,7 +158,7 @@ sub _scanNodes {
hdebug("Looking to $name");
# subnode
my $subNodes = $leaf->{nodes} // $leaf->{_nodes};
my $subNodes = $leaf->{nodes} // $leaf->{_nodes};
my $subNodesCond = $leaf->{nodes_cond} // $leaf->{_nodes_cond};
##################################
......@@ -193,7 +191,7 @@ sub _scanNodes {
$self->confChanged(1);
foreach my $deletedHost (@old) {
push @{ $self->changes },
{ key => $leaf->{id}, old => $deletedHost };
{ key => $leaf->{id}, old => $deletedHost };
}
}
next;
......@@ -210,7 +208,7 @@ sub _scanNodes {
hdebug(" $host becomes $newNames{$host}");
$self->confChanged(1);
push @{ $self->changes },
{ key => $base, old => $host, new => $newNames{$host} };
{ key => $base, old => $host, new => $newNames{$host} };
}
$self->_scanNodes($subNodes);
......@@ -218,15 +216,15 @@ sub _scanNodes {
}
# Other sub levels
elsif ( $leaf->{id}
=~ /^($specialNodeKeys)\/([^\/]+)\/([^\/]+)(?:\/(.*))?$/io )
elsif ( $leaf->{id} =~
/^($specialNodeKeys)\/([^\/]+)\/([^\/]+)(?:\/(.*))?$/io )
{
my ( $base, $key, $oldName, $target, $h )
= ( $1, $newNames{$2}, $2, $3, $4 );
my ( $base, $key, $oldName, $target, $h ) =
( $1, $newNames{$2}, $2, $3, $4 );
hdebug(
"Special node chield subnode detected $leaf->{id}",
" base $base, key $key, target $target, h "
. ( $h ? $h : 'undef' )
. ( $h ? $h : 'undef' )
);
# VirtualHosts
......@@ -235,18 +233,18 @@ sub _scanNodes {
if ( $target =~ /^(?:locationRules|exportedHeaders|post)$/ ) {
if ( $leaf->{cnodes} ) {
hdebug(' unopened subnode');
$self->newConf->{$target}->{$key}
= $self->refConf->{$target}->{$oldName} // {};
$self->newConf->{$target}->{$key} =
$self->refConf->{$target}->{$oldName} // {};
}
elsif ($h) {
hdebug(' 4 levels');
if ( $target eq 'locationRules' ) {
hdebug(' locationRules');
my $k
= $leaf->{comment}
? "(?#$leaf->{comment})$leaf->{re}"
: $leaf->{re};
my $k =
$leaf->{comment}
? "(?#$leaf->{comment})$leaf->{re}"
: $leaf->{re};
$self->set( $target, $key, $k, $leaf->{data} );
}
else {
......@@ -262,7 +260,7 @@ sub _scanNodes {
if ( ref $subNodes ) {
hdebug(' has subnodes');
$self->_scanNodes($subNodes)
or return 0;
or return 0;
}
if ( exists $self->refConf->{$target}->{$key}
and %{ $self->refConf->{$target}->{$key} } )
......@@ -276,10 +274,10 @@ sub _scanNodes {
hdebug(' missing value in old conf');
$self->confChanged(1);
push @{ $self->changes },
{
{
key => "$target, $key",
old => $k,
};
};
}
}
}
......@@ -289,7 +287,7 @@ sub _scanNodes {
hdebug(" '$key' has values");
$self->confChanged(1);
push @{ $self->changes },
{ key => "$target", new => $key };
{ key => "$target", new => $key };
}
}
}
......@@ -299,7 +297,7 @@ sub _scanNodes {
}
else {
push @{ $self->errors },
{ message => "Unknown vhost key $target" };
{ message => "Unknown vhost key $target" };
return 0;
}
next;
......@@ -314,12 +312,11 @@ sub _scanNodes {
hdebug(" SAML data is an array, serializing");
$leaf->{data} = join ';', @{ $leaf->{data} };
}
if ( $target =~ /^saml(?:S|ID)PMetaDataExportedAttributes$/ )
{
if ( $target =~ /^saml(?:S|ID)PMetaDataExportedAttributes$/ ) {
if ( $leaf->{cnodes} ) {
hdebug(" $target: unopened node");
$self->newConf->{$target}->{$key}
= $self->refConf->{$target}->{$oldName} // {};
$self->newConf->{$target}->{$key} =
$self->refConf->{$target}->{$oldName} // {};
}
elsif ($h) {
hdebug(" $target: opened node");
......@@ -334,17 +331,15 @@ sub _scanNodes {
}
elsif ( $target =~ /^saml(?:S|ID)PMetaDataXML$/ ) {
hdebug(" $target");
$self->set(
$target, [ $oldName, $key ],
$target, $leaf->{data}
);
$self->set( $target, [ $oldName, $key ],
$target, $leaf->{data} );
}
elsif ( $target =~ /^saml(?:ID|S)PMetaDataOptions/ ) {
my $optKey = $&;
hdebug(" $base sub key: $target");
if ( $target
=~ /^(?:$samlIDPMetaDataNodeKeys|$samlSPMetaDataNodeKeys)/o
)
if ( $target =~
/^(?:$samlIDPMetaDataNodeKeys|$samlSPMetaDataNodeKeys)/o
)
{
$self->set(
$optKey, [ $oldName, $key ],
......@@ -353,14 +348,13 @@ sub _scanNodes {
}
else {
push @{ $self->errors },
{ message =>
"Unknown SAML metadata option $target" };
{ message => "Unknown SAML metadata option $target" };
return 0;
}
}
else {
push @{ $self->errors },
{ message => "Unknown SAML key $target" };
{ message => "Unknown SAML key $target" };
return 0;
}
next;
......@@ -372,8 +366,7 @@ sub _scanNodes {
if ( $target =~ /^oidc(?:O|R)PMetaDataOptions$/ ) {
hdebug(" $target: looking for subnodes");
$self->_scanNodes($subNodes);
$self->set( $target, $key, $leaf->{title},
$leaf->{data} );
$self->set( $target, $key, $leaf->{title}, $leaf->{data} );
}
elsif ( $target =~ /^oidcOPMetaData(?:JSON|JWKS)$/ ) {
hdebug(" $target");
......@@ -383,8 +376,8 @@ sub _scanNodes {
hdebug(" $target");
if ( $leaf->{cnodes} ) {
hdebug(' unopened');
$self->newConf->{$target}->{$key}
= $self->refConf->{$target}->{$oldName} // {};
$self->newConf->{$target}->{$key} =
$self->refConf->{$target}->{$oldName} // {};
}
elsif ($h) {
hdebug(' opened');
......@@ -402,8 +395,8 @@ sub _scanNodes {
if ( $target eq 'oidcRPMetaDataOptionsExtraClaims' ) {
if ( $leaf->{cnodes} ) {
hdebug(' unopened');
$self->newConf->{$target}->{$key}
= $self->refConf->{$target}->{$oldName} // {};
$self->newConf->{$target}->{$key} =
$self->refConf->{$target}->{$oldName} // {};
}
elsif ($h) {
hdebug(' opened');
......@@ -415,9 +408,9 @@ sub _scanNodes {
$self->_scanNodes($subNodes);
}
}
elsif ( $target
=~ /^(?:$oidcOPMetaDataNodeKeys|$oidcRPMetaDataNodeKeys)/o
)
elsif ( $target =~
/^(?:$oidcOPMetaDataNodeKeys|$oidcRPMetaDataNodeKeys)/o
)
{
$self->set(
$optKey, [ $oldName, $key ],
......@@ -426,14 +419,13 @@ sub _scanNodes {
}
else {
push @{ $self->errors },
{ message =>
"Unknown OIDC metadata option $target" };
{ message => "Unknown OIDC metadata option $target" };
return 0;
}
}
else {
push @{ $self->errors },
{ message => "Unknown OIDC key $target" };
{ message => "Unknown OIDC key $target" };
return 0;
}
next;
......@@ -446,15 +438,14 @@ sub _scanNodes {
if ( $target =~ /^cas(?:App|Srv)MetaDataOptions$/ ) {
hdebug(" $target: looking for subnodes");
$self->_scanNodes($subNodes);
$self->set( $target, $key, $leaf->{title},
$leaf->{data} );
$self->set( $target, $key, $leaf->{title}, $leaf->{data} );
}
elsif ( $target =~ /^cas(?:App|Srv)MetaDataExportedVars$/ ) {
hdebug(" $target");
if ( $leaf->{cnodes} ) {
hdebug(' unopened');
$self->newConf->{$target}->{$key}
= $self->refConf->{$target}->{$oldName} // {};
$self->newConf->{$target}->{$key} =
$self->refConf->{$target}->{$oldName} // {};
}
elsif ($h) {
hdebug(' opened');
......@@ -472,8 +463,8 @@ sub _scanNodes {
if ( $target eq 'casSrvMetaDataOptionsProxiedServices' ) {
if ( $leaf->{cnodes} ) {
hdebug(' unopened');
$self->newConf->{$target}->{$key}
= $self->refConf->{$target}->{$oldName} // {};
$self->newConf->{$target}->{$key} =
$self->refConf->{$target}->{$oldName} // {};
}
elsif ($h) {
hdebug(' opened');
......@@ -485,9 +476,9 @@ sub _scanNodes {
$self->_scanNodes($subNodes);
}
}
elsif ( $target
=~ /^(?:$casSrvMetaDataNodeKeys|$casAppMetaDataNodeKeys)/o
)
elsif ( $target =~
/^(?:$casSrvMetaDataNodeKeys|$casAppMetaDataNodeKeys)/o
)
{
$self->set(
$optKey, [ $oldName, $key ],
......@@ -496,21 +487,20 @@ sub _scanNodes {
}
else {
push @{ $self->errors },
{ message =>
"Unknown CAS metadata option $target" };
{ message => "Unknown CAS metadata option $target" };
return 0;
}
}
else {
push @{ $self->errors },
{ message => "Unknown CAS option $target" };
{ message => "Unknown CAS option $target" };
return 0;
}
next;
}
else {
push @{ $self->errors },
{ message => "Fatal: unknown special sub node $base" };
{ message => "Fatal: unknown special sub node $base" };
return 0;
}
}
......@@ -524,39 +514,40 @@ sub _scanNodes {
hdebug( $leaf->{title} );
if ( $leaf->{cnodes} ) {
hdebug(' unopened');
$self->newConf->{applicationList}
= $self->refConf->{applicationList} // {};
$self->newConf->{applicationList} =
$self->refConf->{applicationList} // {};
}
else {
$self->_scanNodes($subNodes) or return 0;
# Check for deleted
my @listCatRef
= map { $self->refConf->{applicationList}->{$_}->{catname} }
keys %{ $self->refConf->{applicationList} };
my @listCatNew
= map { $self->newConf->{applicationList}->{$_}->{catname} }
keys(
%{ ref $self->newConf->{applicationList}
my @listCatRef =
map { $self->refConf->{applicationList}->{$_}->{catname} }
keys %{ $self->refConf->{applicationList} };
my @listCatNew =
map { $self->newConf->{applicationList}->{$_}->{catname} }
keys(
%{
ref $self->newConf->{applicationList}
? $self->newConf->{applicationList}
: {}
}
);
);
@listCatRef = sort @listCatRef;
@listCatNew = sort @listCatNew;
@listCatRef = sort @listCatRef;
@listCatNew = sort @listCatNew;
hdebug( '# @listCatRef : ' . \@listCatRef );
hdebug( '# @listCatNew : ' . \@listCatNew );
for ( my $i = 0; $i < @listCatNew; $i++ ) {
for ( my $i = 0 ; $i < @listCatNew ; $i++ ) {
if ( not( defined $listCatRef[$i] )
or $listCatRef[$i] ne $listCatNew[$i] )
{
push @{ $self->changes },
{
{
key => $leaf->{id},
new => $listCatNew[$i],
old => $listCatRef[$i]
};
};
}
}
}
......@@ -581,9 +572,8 @@ sub _scanNodes {
hdebug(" looking to cat $cat");
unless ( defined $knownCat->{$cat} ) {
push @{ $self->{errors} },
{ message =>
"Fatal: sub cat/app before parent ($leaf->{id})"
};
{ message =>
"Fatal: sub cat/app before parent ($leaf->{id})" };
return 0;
}
$cn = $cn->{ $knownCat->{$cat} };
......@@ -600,19 +590,20 @@ sub _scanNodes {
hdebug(' menu cat');
$knownCat->{__id}++;
my $s = $knownCat->{$app} = sprintf '%04d-cat',
$knownCat->{__id};
$knownCat->{__id};
$cn->{$s} = { catname => $leaf->{title}, type => 'category' };
unless ($cmp->{$app}
and $cmp->{$app}->{catname} eq $cn->{$s}->{catname} )
{
$self->confChanged(1);
push @{ $self->changes },
{
key => join( ', ',
'applicationList', @path, $leaf->{title} ),
{
key => join(
', ', 'applicationList', @path, $leaf->{title}
),
new => $cn->{$s}->{catname},
old => ( $cn->{$s} ? $cn->{$s}->{catname} : undef )
};
};
}
if ( ref $subNodes ) {
$self->_scanNodes($subNodes) or return 0;
......@@ -624,10 +615,10 @@ sub _scanNodes {
unless ( @listCatRef == @listCatNew ) {
$self->confChanged(1);
push @{ $self->changes },
{
{
key => join( ', ', 'applicationList', @path ),
new => 'Changes in cat(s)/app(s)',
};
};
}
}
......@@ -636,16 +627,16 @@ sub _scanNodes {
hdebug(' new app');
$knownCat->{__id}++;
my $name = sprintf( '%04d-app', $knownCat->{__id} );
$cn->{$name}
= { type => 'application', options => $leaf->{data} };
$cn->{$name} =
{ type => 'application', options => $leaf->{data} };
$cn->{$name}->{options}->{name} = $leaf->{title};
unless ( $cmp->{$app} ) {
$self->confChanged(1);
push @{ $self->changes },
{
{
key => join( ', ', 'applicationList', @path ),
new => $leaf->{title},
};
};
}
else {
foreach my $k ( keys %{ $cn->{$name}->{options} } ) {
......@@ -654,13 +645,13 @@ sub _scanNodes {
{
$self->confChanged(1);
push @{ $self->changes },
{
{
key => join( ', ',
'applicationList', @path,
$leaf->{title}, $k ),
new => $cn->{$name}->{options}->{$k},
old => $cmp->{$app}->{options}->{$k}
};
};
}
}
}
......@@ -683,31 +674,31 @@ sub _scanNodes {
$self->newConf->{grantSessionRules} = {};
foreach my $n (@$subNodes) {
hdebug(" looking at $n subnode");
my $k = $n->{re}
. ( $n->{comment} ? "##$n->{comment}" : '' );
my $k =
$n->{re} . ( $n->{comment} ? "##$n->{comment}" : '' );
$self->newConf->{grantSessionRules}->{$k} = $n->{data};
$count++;
unless ( defined $ref->{$k} ) {
$self->confChanged(1);
push @{ $self->changes },
{ keys => 'grantSessionRules', new => $k };
{ keys => 'grantSessionRules', new => $k };
}
elsif ( $ref->{$k} ne $n->{data} ) {
$self->confChanged(1);
push @{ $self->changes },
{
{
key => "grantSessionRules, $k",
old => $self->refConf->{grantSessionRules}->{$k},
new => $n->{data}
};
};
}
@old = grep { $_ ne $k } @old;
}
if (@old) {
$self->confChanged(1);
push @{ $self->changes },
{ key => 'grantSessionRules', old => $_, }
foreach (@old);
{ key => 'grantSessionRules', old => $_, }
foreach (@old);
}
}
next;
......@@ -720,8 +711,7 @@ sub _scanNodes {
if ( $leaf->{data} ) {
unless ( ref $leaf->{data} eq 'ARRAY' ) {
push @{ $self->{errors} },
{ message => 'Malformed openIdIDPList '
. $leaf->{data} };
{ message => 'Malformed openIdIDPList ' . $leaf->{data} };
return 0;
}
$self->set( $name, join( ';', @{ $leaf->{data} } ) );
......@@ -754,8 +744,7 @@ sub _scanNodes {
$self->newConf->{$name} = {};
foreach my $node ( @{ $leaf->{nodes} } ) {
my $tmp;
$tmp->{$_} = $node->{data}->{$_}
foreach (qw(type for));
$tmp->{$_} = $node->{data}->{$_} foreach (qw(type for));
$tmp->{over} = {};
foreach ( @{ $node->{data}->{over} } ) {
$tmp->{over}->{ $_->[0] } = $_->[1];
......@@ -791,30 +780,29 @@ sub _scanNodes {
}
$self->newConf->{$name}->{ $n->{title} } = $n->{data};
$count++;
unless (
defined $self->refConf->{$name}->{ $n->{title} } )
unless ( defined $self->refConf->{$name}->{ $n->{title} } )
{
$self->confChanged(1);
push @{ $self->changes },
{ key => $name, new => $n->{title}, };
{ key => $name, new => $n->{title}, };
}
elsif ( $self->refConf->{$name}->{ $n->{title} } ne
$n->{data} )
elsif (
$self->refConf->{$name}->{ $n->{title} } ne $n->{data} )
{
$self->confChanged(1);
push @{ $self->changes },
{
{
key => "$name, $n->{title}",
old => $self->refConf->{$name}->{ $n->{title} },
new => $n->{data}
};
};
}
@old = grep { $_ ne $n->{title} } @old;
}
if (@old) {
$self->confChanged(1);
push @{ $self->changes }, { key => $name, old => $_, }
foreach (@old);
foreach (@old);
}
}
next;
......@@ -851,23 +839,23 @@ sub _scanNodes {
@oldKeys = keys %{ $self->refConf->{$name}->{$host} };
}
foreach my $prm ( @{ $getHost->{h} } ) {
$self->newConf->{$name}->{$host}->{ $prm->{k} }
= $prm->{v};
if (!$change
$self->newConf->{$name}->{$host}->{ $prm->{k} } =
$prm->{v};
if (
!$change
and (
not defined(
$self->refConf->{$name}->{$host}
->{ $prm->{k} }
$self->refConf->{$name}->{$host}->{ $prm->{k} }
)
or $self->newConf->{$name}->{$host}->{ $prm->{k} }
ne $self->refConf->{$name}->{$host}->{ $prm->{k} }
)
)
)
{
$self->confChanged(1);
hdebug(" key $prm->{k} has been changed");
push @{ $self->changes },
{ key => "$name/$host", new => $prm->{k} };
{ key => "$name/$host", new => $prm->{k} };
}
elsif ( !$change ) {
@oldKeys = grep { $_ ne $prm->{k} } @oldKeys;
......@@ -877,15 +865,15 @@ sub _scanNodes {
$self->confChanged(1);
hdebug( " old keys: " . join( ' ', @oldKeys ) );
push @{ $self->changes },
{ key => "$name/$host", old => $_ }
foreach (@oldKeys);
{ key => "$name/$host", old => $_ }
foreach (@oldKeys);
}
}
if (@oldHosts) {
$self->confChanged(1);
hdebug( " old hosts " . join( ' ', @oldHosts ) );
push @{ $self->changes }, { key => "$name", old => $_ }
foreach (@oldHosts);
foreach (@oldHosts);
}
next;
}
......@@ -973,16 +961,15 @@ sub set {
or ( !defined $confs[0]->{$target}
and defined $self->defaultValue($target)
and $data eq $self->defaultValue($target) )
)
)
{
$self->confChanged(1);
push @{ $self->changes },
{
{
key => join( ', ', @path, $target ),
old => $confs[0]->{$target}
// $self->defaultValue($target),
old => $confs[0]->{$target} // $self->defaultValue($target),
new => $confs[1]->{$target}
};
};
}
};
}
......@@ -1006,7 +993,7 @@ sub defaultValue {
die unless ($target);
my $res = eval {
&Lemonldap::NG::Manager::Attributes::attributes()->{$target}
->{'default'};
->{'default'};
};
return $res;
}
......@@ -1055,8 +1042,7 @@ sub _unitTest {
# Check if key exists
unless ($attr) {
push @{ $self->errors },
{ message => "__unknownKey__: $key" };
push @{ $self->errors }, { message => "__unknownKey__: $key" };
$res = 0;
next;
}
......@@ -1066,7 +1052,7 @@ sub _unitTest {
$conf->{$key} //= {};
unless ( ref $conf->{$key} eq 'HASH' ) {
push @{ $self->errors },
{ message => "$key is not a hash ref" };
{ message => "$key is not a hash ref" };
$res = 0;
next;
}
......@@ -1079,20 +1065,21 @@ sub _unitTest {
or $attr->{type} =~ /Container$/ )
{
my $keyMsg = $attr->{keyMsgFail} // $type->{keyMsgFail};
my $msg = $attr->{msgFail} // $type->{msgFail};
my $msg = $attr->{msgFail} // $type->{msgFail};
$res = 0
unless (
unless (
$self->_execTest(
{ keyTest => $attr->{keyTest} // $type->{keyTest},
{
keyTest => $attr->{keyTest} // $type->{keyTest},
keyMsgFail => $attr->{keyMsgFail}
// $type->{keyMsgFail},
test => $attr->{test} // $type->{test},
// $type->{keyMsgFail},
test => $attr->{test} // $type->{test},
msgFail => $attr->{msgFail} // $type->{msgFail},
},
$conf->{$key},
$key, $attr, undef, $conf
)
);
);
}
elsif ( defined $attr->{keyTest} ) {
......@@ -1101,12 +1088,12 @@ sub _unitTest {
else {
my $msg = $attr->{msgFail} // $type->{msgFail};
$res = 0
unless (
unless (
$self->_execTest(
$attr->{test} // $type->{test},
$conf->{$key}, $key, $attr, $msg, $conf
)
);
);
}
}
}
......@@ -1121,13 +1108,13 @@ sub _execTest {
my ( $self, $test, $value, $key, $attr, $msg, $conf ) = @_;
my $ref;
die
"Malformed test for $key: only regexp ref or sub are accepted (type \"$ref\")"
unless ( $ref = ref($test) and $ref =~ /^(CODE|Regexp|HASH)$/ );
"Malformed test for $key: only regexp ref or sub are accepted (type \"$ref\")"
unless ( $ref = ref($test) and $ref =~ /^(CODE|Regexp|HASH)$/ );