Update parameters tests + add test (#583, Closes #LEMONLDAP-924)

lemonldap-ng-manager/MANIFEST

@@ -165,6 +165,7 @@ t/06-rest-api.t
 t/07-utf8.t
 t/10-save-unchanged-conf.t
 t/12-save-changed-conf.t
+t/14-bad-changes-in-conf.t
 t/20-test-coverage.t
 t/40-sessions.t
 t/50-notifications.t
@@ -175,6 +176,7 @@ t/conf/lmConf-1.js
 t/jsonfiles/01-base-tree.json
 t/jsonfiles/02-base-tree-all-nodes-opened.json
 t/jsonfiles/12-modified.json
+t/jsonfiles/14-bad.json
 t/lemonldap-ng.ini
 t/test-lib.pm
 TODO.md

lemonldap-ng-manager/Makefile.PL

@@ -37,5 +37,8 @@ WriteMakefile(
           )
         : ()
     ),
+    clean => {
+        FILES => 't/conf/lmConf-2.js',
+    },
 );
 

lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Attributes.pm

@@ -22,11 +22,7 @@ sub types {
         'boolOrExpr' => {
             'msgFail' => '__notAValidPerlExpression__',
             'test'    => sub {
-                my $s = eval {
+                my $s = eval $_[0];
-                    do {
-                        $_[0];
-                      }
-                };
                 return $@ ? ( 0, "__badExpression__: $@" ) : 1;
               }
         },
@@ -804,11 +800,7 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
         },
         'grantSessionRules' => {
             'keyTest' => sub {
-                my $s = eval {
+                my $s = eval $_[0];
-                    do {
-                        $_[0];
-                      }
-                };
                 return $@ ? ( 0, "__badExpression__: $@" ) : 1;
             },
             'test' => sub {
@@ -819,11 +811,7 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
         'groups' => {
             'default' => {},
             'test'    => sub {
-                my $s = eval {
+                my $s = eval $_[0];
-                    do {
-                        $_[0];
-                      }
-                };
                 return $@ ? ( 0, "__badExpression__: $@" ) : 1;
             },
             'type' => 'keyTextContainer'
@@ -1065,8 +1053,23 @@ m[^(?:ldapi://[^/]*/?|\w[\w\-\.]*(?::\d{1,5})?|ldap(?:s|\+tls)?://\w[\w\-\.]*(?:
             },
             'keyTest' =>
 qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-9]*[a-zA-Z0-9]|[a-zA-Z])[.]?)$/,
-            'test' => sub {
+            'test' => {
-                1;
+                'keyMsgFail' => '__badRegexp__',
+                'keyTest'    => sub {
+                    eval {
+                        do {
+                            qr/$_[0]/;
+                          }
+                    };
+                    return $@ ? 0 : 1;
+                },
+                'msgFail' => '__badExpression__',
+                'test'    => sub {
+                    my $s = $_[0];
+                    $s =~ s/\b(accept|deny)\b/1/g;
+                    eval $s;
+                    return $@ ? ( 0, "__badExpression__: $@" ) : 1;
+                  }
             },
             'type' => 'ruleContainer'
         },
@@ -1082,11 +1085,7 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
             'default' => {},
             'keyTest' => qr/^[_a-zA-Z][a-zA-Z0-9_]*$/,
             'test'    => sub {
-                my $s = eval {
+                my $s = eval $_[0];
-                    do {
-                        $_[0];
-                      }
-                };
                 return $@ ? ( 0, "__badExpression__: $@" ) : 1;
             },
             'type' => 'keyTextContainer'
@@ -1683,11 +1682,7 @@ qr/^(?:(?:(?:(?:[a-zA-Z0-9][-a-zA-Z0-9]*)?[a-zA-Z0-9])[.])*(?:[a-zA-Z][-a-zA-Z0-
         },
         'portalSkinRules' => {
             'keyTest' => sub {
-                my $s = eval {
+                my $s = eval $_[0];
-                    do {
-                        $_[0];
-                      }
-                };
                 return $@ ? ( 0, "__badExpression__: $@" ) : 1;
             },
             'msgFail' => '__badValue__',

lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Build/Attributes.pm

@@ -11,7 +11,7 @@ use strict;
 use Regexp::Common qw/URI/;
 
 my $perlExpr = sub {
-    my $s = eval { $_[0] };
+    my $s = eval $_[0];
     return $@ ? ( 0, "__badExpression__: $@" ) : (1);
 };
 
@@ -855,9 +855,22 @@ sub attributes {
         },
 
         locationRules => {
-            type       => 'ruleContainer',
+            type => 'ruleContainer',
-            help       => 'writingrulesand_headers.html#rules',
+            help => 'writingrulesand_headers.html#rules',
-            test       => sub { 1 },
+            test => {
+                keyTest => sub {
+                    eval { qr/$_[0]/ };
+                    return $@ ? 0 : 1;
+                },
+                keyMsgFail => '__badRegexp__',
+                test       => sub {
+                    my $s = $_[0];
+                    $s =~ s/\b(accept|deny)\b/1/g;
+                    eval $s;
+                    return $@ ? ( 0, "__badExpression__: $@" ) : (1);
+                },
+                msgFail    => '__badExpression__',
+            },
             keyTest    => qr/^$Regexp::Common::URI::RFC2396::hostname$/,
             keyMsgFail => '__badHostname__',
             default    => {

lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Conf/Parser.pm

@@ -832,7 +832,7 @@ sub _unitTest {
             }
 
             # Hash parameters
-            if ( $key =~ $simpleHashKeys or $attr->{type} =~ /Container$/ ) {
+            if ( $key =~ $simpleHashKeys ) {
                 $conf->{$key} //= {};
                 unless ( ref $conf->{$key} eq 'HASH' ) {
                     push @{ $self->errors },
@@ -841,24 +841,11 @@ sub _unitTest {
                     next;
                 }
             }
-            if ( $key =~ $simpleHashKeys ) {
+            elsif ( $attr->{type} =~ /Container$/ ) {
 
-                #foreach my $k ( keys %{ $conf->{$key} } ) {
+                #TODO
-                #    my $keyMsg = $attr->{keyMsgFail} // $type->{keyMsgFail}
+            }
-                #      // 'Bad hash key';
+            if ( $key =~ $simpleHashKeys or $attr->{type} =~ /Container$/ ) {
-                #    my $msg = $attr->{msgFail} // $type->{msgFail};
-                #    $res = 0
-                #      unless (
-                #        $self->_execTest( $attr->{keyTest} // $type->{keyTest}
-                #              // qr/^\w+$/,
-                #            $k, "$key/$k", $attr, $keyMsg, $conf )
-                #        and $self->_execTest(
-                #            $attr->{test} // $type->{test},
-                #            $conf->{$key}->{$k},
-                #            "$key/$k", $attr, $msg, $conf
-                #        )
-                #      );
-                #}
                 my $keyMsg = $attr->{keyMsgFail} // $type->{keyMsgFail};
                 my $msg    = $attr->{msgFail}    // $type->{msgFail};
                 $res = 0
@@ -876,10 +863,6 @@ sub _unitTest {
                     )
                   );
             }
-            elsif ( $attr->{type} =~ /Container$/ ) {
-
-                #TODO
-            }
             elsif ( defined $attr->{keyTest} ) {
 
                 #TODO
@@ -911,9 +894,13 @@ sub _execTest {
       unless ( $ref = ref($test) and $ref =~ /^(CODE|Regexp|HASH)$/ );
     if ( $ref eq 'CODE' ) {
         my ( $r, $m ) = ( $test->( $value, $conf, $attr ) );
-        push @{ $self->{ ( $r ? 'warnings' : 'error' ) } },
+        if ($m) {
-          { message => "$key: $m" }
+            push @{ $self->{ ( $r ? 'warnings' : 'errors' ) } },
-          if ($m);
+              { message => "$key: $m" };
+        }
+        elsif ( !$r ) {
+            push @{ $self->{errors} }, { message => "$key: $msg" };
+        }
         return $r;
     }
     elsif ( $ref eq 'Regexp' ) {

lemonldap-ng-manager/t/14-bad-changes-in-conf.t

@@ -0,0 +1,33 @@
+#!/usr/bin/env perl -I pl/lib
+#
+# Verify that bas changes are detected
+
+use Test::More;
+use strict;
+use JSON;
+use Data::Dumper;
+require 't/test-lib.pm';
+
+my $struct = 't/jsonfiles/14-bad.json';
+
+sub body {
+    return IO::File->new( $struct, 'r' );
+}
+
+unlink 't/conf/lmConf-2.js';
+
+my ( $res, $resBody );
+ok( $res = &client->_post( '/confs/', 'cfgNum=1', &body, 'application/json' ),
+    "Request succeed" );
+ok( $res->[0] == 200, "Result code is 200" );
+ok( $resBody = from_json( $res->[2]->[0] ), "Result body contains JSON text" );
+ok( $resBody->{result} == 0, "JSON response contains \"result:0\"" )
+  or print STDERR Dumper($res);
+ok( @{ $resBody->{details}->{__errors__} } == 1, '1 error detected' );
+
+count(5);
+print STDERR Dumper($resBody);
+
+done_testing( count() );
+
+unlink 't/conf/lmConf-2.js';