Merge pull request #814 from ikedas/issue-813 by ikedas

Fixing #813

src/lib/Sympa/Scenario.pm

@@ -242,15 +242,13 @@ sub compile {
 
     my $parsed = _parse_scenario($data, $file_path);
     if ($parsed and not($function and $function eq 'include')) {
-        my $compiled = _compile_scenario($that, $function, $parsed);
-        if ($compiled) {
-            my $sub = eval $compiled;
+        $parsed->{compiled} = _compile_scenario($that, $function, $parsed);
+        if ($parsed->{compiled}) {
+            $parsed->{sub} = eval $parsed->{compiled};
             # Bad syntax in compiled Perl code.
-            die sprintf "%s: %s\n", ($file_path || '(data)'), $EVAL_ERROR
-                unless $sub;
-
-            $parsed->{compiled} = $compiled;
-            $parsed->{sub}      = $sub;
+            $log->syslog('err', '%s: %s\n', ($file_path || '(data)'),
+                $EVAL_ERROR)
+                unless ref $parsed->{sub} eq 'CODE';
         }
     }
 
@@ -422,30 +420,37 @@ sub authz {
     }
 
     my $sub = ($self->{_scenario} || {})->{sub};
-    my $result = $sub->($that, $context, $auth_method) if ref $sub eq 'CODE';
+    my $result = eval { $sub->($that, $context, $auth_method) }
+        if ref $sub eq 'CODE';
     # Cope with errors.
     unless ($result) {
-        if (ref $EVAL_ERROR eq 'HASH' and not %$EVAL_ERROR) {
+        unless ($sub) {
+            $result = {reason => 'not-compiled'};
+        } elsif (ref $EVAL_ERROR eq 'HASH') {
+            $result = $EVAL_ERROR;
+        } else {
+            # Fatal error will be logged but not be exposed.
+            $log->syslog('err', 'Error in scenario %s, context %s: (%s)',
+                $self, $that, $EVAL_ERROR || 'unknown');
+            $result = {};
+        }
+        $result->{action}      ||= 'reject';
+        $result->{reason}      ||= 'error-performing-condition';
+        $result->{auth_method} ||= $auth_method;
+        $result->{condition}   ||= 'default';
+
+        if ($result->{reason} eq 'not-compiled') {
+            $log->syslog('info', '%s: Not compiled, reject', $self);
+        } elsif ($result->{reason} eq 'no-rule-match') {
             $log->syslog('info', '%s: No rule match, reject', $self);
-            return {
-                action      => 'reject',
-                reason      => 'no-rule-match',
-                auth_method => 'default',
-                condition   => 'default'
-            };
+        } else {
+            $log->syslog('info', 'Error in scenario %s, context %s: (%s)',
+                $self, $that, $result->{reason});
+            Sympa::send_notify_to_listmaster($that,
+                'error_performing_condition', {error => $result->{reason}})
+                unless $options{debug};
         }
-
-        $log->syslog('info', 'Error in scenario %s, context %s: (%s)',
-            $self, $that, $EVAL_ERROR || 'unknown');
-        Sympa::send_notify_to_listmaster($that, 'error_performing_condition',
-            {error => ($EVAL_ERROR || 'unknown')})
-            unless $options{debug};
-        return {
-            action      => 'reject',
-            reason      => 'error-performing-condition',
-            auth_method => $auth_method,
-            condition   => 'default',
-        };
+        return $result;
     }
 
     my %action = %$result;
@@ -594,7 +599,7 @@ sub {
 %s
 
 %s
-    die {};
+    die {reason => 'no-rule-match'};
 }
 EOF
 
@@ -827,7 +832,11 @@ sub _compile_condition {
             $str =~ s{(\\.|.)}{($1 eq "'" or $1 eq "\\")? "\\\'" : $1}eg;
             $value = sprintf "'%s'", $str;
         } else {
-            # Parse error.
+            # Texts with unknown format may be treated as the string constants
+            # for compatibility to loose parsing with earlier ver (<=6.2.48).
+            my $str = $value;
+            $str =~ s/([\\\'])/\\$1/g;
+            $value = sprintf "'%s'", $str;
         }
         push(@args, $value);
     }