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 {
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);
}
......
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