Unverified Commit 90c35054 authored by IKEDA Soji's avatar IKEDA Soji Committed by GitHub
Browse files

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

Fixing #813
parents 78b837db 61641d42
...@@ -242,15 +242,13 @@ sub compile { ...@@ -242,15 +242,13 @@ sub compile {
my $parsed = _parse_scenario($data, $file_path); my $parsed = _parse_scenario($data, $file_path);
if ($parsed and not($function and $function eq 'include')) { if ($parsed and not($function and $function eq 'include')) {
my $compiled = _compile_scenario($that, $function, $parsed); $parsed->{compiled} = _compile_scenario($that, $function, $parsed);
if ($compiled) { if ($parsed->{compiled}) {
my $sub = eval $compiled; $parsed->{sub} = eval $parsed->{compiled};
# Bad syntax in compiled Perl code. # Bad syntax in compiled Perl code.
die sprintf "%s: %s\n", ($file_path || '(data)'), $EVAL_ERROR $log->syslog('err', '%s: %s\n', ($file_path || '(data)'),
unless $sub; $EVAL_ERROR)
unless ref $parsed->{sub} eq 'CODE';
$parsed->{compiled} = $compiled;
$parsed->{sub} = $sub;
} }
} }
...@@ -422,30 +420,37 @@ sub authz { ...@@ -422,30 +420,37 @@ sub authz {
} }
my $sub = ($self->{_scenario} || {})->{sub}; 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. # Cope with errors.
unless ($result) { 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); $log->syslog('info', '%s: No rule match, reject', $self);
return { } else {
action => 'reject', $log->syslog('info', 'Error in scenario %s, context %s: (%s)',
reason => 'no-rule-match', $self, $that, $result->{reason});
auth_method => 'default', Sympa::send_notify_to_listmaster($that,
condition => 'default' 'error_performing_condition', {error => $result->{reason}})
}; unless $options{debug};
} }
return $result;
$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',
};
} }
my %action = %$result; my %action = %$result;
...@@ -594,7 +599,7 @@ sub { ...@@ -594,7 +599,7 @@ sub {
%s %s
%s %s
die {}; die {reason => 'no-rule-match'};
} }
EOF EOF
...@@ -827,7 +832,11 @@ sub _compile_condition { ...@@ -827,7 +832,11 @@ sub _compile_condition {
$str =~ s{(\\.|.)}{($1 eq "'" or $1 eq "\\")? "\\\'" : $1}eg; $str =~ s{(\\.|.)}{($1 eq "'" or $1 eq "\\")? "\\\'" : $1}eg;
$value = sprintf "'%s'", $str; $value = sprintf "'%s'", $str;
} else { } 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); push(@args, $value);
} }
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment