From 963185d13e3490f93b97f926b604a521d29389ea Mon Sep 17 00:00:00 2001 From: IKEDA Soji Date: Sun, 17 Jun 2018 10:48:00 +0900 Subject: [PATCH 1/5] Refactoring. Introducing Sympa::Config and Sympa::List::Users to check schema of users. --- src/lib/Makefile.am | 2 + src/lib/Sympa/Config.pm | 1384 +++++++++++++++++++++++++++++++ src/lib/Sympa/List/Config.pm | 1485 +--------------------------------- src/lib/Sympa/List/Users.pm | 293 +++++++ 4 files changed, 1723 insertions(+), 1441 deletions(-) create mode 100644 src/lib/Sympa/Config.pm create mode 100644 src/lib/Sympa/List/Users.pm diff --git a/src/lib/Makefile.am b/src/lib/Makefile.am index 6ec4d2bd6..63fdcb8da 100644 --- a/src/lib/Makefile.am +++ b/src/lib/Makefile.am @@ -40,6 +40,7 @@ nobase_modules_DATA = \ Sympa/CommandDef.pm \ Conf.pm \ Sympa/ConfDef.pm \ + Sympa/Config.pm \ Sympa/Config_XML.pm \ Sympa/Crash.pm \ Sympa/Database.pm \ @@ -63,6 +64,7 @@ nobase_modules_DATA = \ Sympa/Language.pm \ Sympa/List.pm \ Sympa/List/Config.pm \ + Sympa/List/Users.pm \ Sympa/ListDef.pm \ Sympa/ListOpt.pm \ Sympa/LockedFile.pm \ diff --git a/src/lib/Sympa/Config.pm b/src/lib/Sympa/Config.pm new file mode 100644 index 000000000..8614f3968 --- /dev/null +++ b/src/lib/Sympa/Config.pm @@ -0,0 +1,1384 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 +# $Id$ + +# Sympa - SYsteme de Multi-Postage Automatique +# +# Copyright 2018 The Sympa Community. See the AUTHORS.md file at the +# top-level directory of this distribution and at +# . +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +package Sympa::Config; + +use strict; +use warnings; + +use Sympa::Log; +use Sympa::Tools::Data; +use Sympa::Tools::Text; + +my $log = Sympa::Log->instance; + +sub new { + my $class = shift; + my $context = shift; + my %options = @_; + + # The undef means list creation. + # Empty hashref (default) means loading existing config. + my $config; + if (exists $options{config}) { + $config = $options{config}; + } else { + $config = {}; + } + $config = Sympa::Tools::Data::clone_var($config) + if $options{copy}; + + #FIXME:Should $config be sanitized? + my $self = + bless {context => $context, _config => $config, _changes => {}} => + $class; + + my $pinfo = $self->_schema; + foreach my $pname (_keys($pinfo)) { + $self->__init_schema($pinfo->{$pname}, [$pname], %options); + } + $self->{_pinfo} = $pinfo; + + return $self; +} + +#sub _schema; + +# Initialize default values. +sub __init_schema { + my $self = shift; + my $phash = shift; + my $pnames = shift; + my %options = @_; + + my $subres; + if (ref $phash->{format} eq 'HASH') { + foreach my $pname (_keys($phash->{format})) { + my $pii = $phash->{format}->{$pname}; + + $subres->{$pname} = + $self->__init_schema($pii, [@$pnames, $pname], %options); + } + } + return $self->_init_schema_item($phash, $pnames, $subres, %options); +} + +sub _init_schema_item { + my $self = shift; + my $pitem = shift; + my $pnames = shift; + my $subres = shift; + my %options = @_; + + return undef + unless ref $pitem->{format} ne 'HASH' and exists $pitem->{default}; + + my $default = $pitem->{default}; + + if ($pitem->{occurrence} =~ /n$/) { # The set or the array of scalars + if (defined $default) { + my $re = quotemeta($pitem->{split_char} || ','); + $pitem->{default} = [split /\s*$re\s*/, $default]; + } else { + $pitem->{default} = []; + } + } elsif ($pitem->{scenario} or $pitem->{task}) { + if (defined $default) { + $pitem->{default} = {name => $default}; + } + } + + return undef; +} + +sub get { + my $self = shift; + my $ppath = shift; + + my @ppaths = split /[.]/, $ppath; + return unless @ppaths; + + my @value = _get($self->{_config}, @ppaths); + return unless @value; + return $value[0] unless ref $value[0]; + return Sympa::Tools::Data::clone_var($value[0]); +} + +sub _get { + my $cur = shift; + my @ppaths = @_; + + while (1) { + my $key = shift @ppaths; + + if ($key =~ /\A\d+\z/) { + unless (ref $cur eq 'ARRAY' and exists $cur->[$key]) { + return; + } elsif (not @ppaths) { + return ($cur->[$key]); + } else { + $cur = $cur->[$key]; + } + } else { + unless (ref $cur eq 'HASH' and exists $cur->{$key}) { + return; + } elsif (not @ppaths) { + return $cur->{$key}; + } else { + $cur = $cur->{$key}; + } + } + } +} + +sub get_change { + my $self = shift; + my $ppath = shift; + + my @ppaths = split /[.]/, $ppath; + return unless @ppaths; + + my @value = _get_change($self->{_changes}, @ppaths); + return unless @value; + return $value[0] unless ref $value[0]; + return Sympa::Tools::Data::clone_var($value[0]); +} + +sub _get_change { + my $new = shift; + my @ppaths = @_; + + while (1) { + my $key = shift @ppaths; + + unless (ref $new eq 'HASH' and exists $new->{$key}) { + return; + } elsif (not @ppaths) { + return $new->{$key}; + } else { + $new = $new->{$key}; + } + } +} + +sub get_changeset { + my $self = shift; + + return $self->{_changes}; +} + +# Apply default values, if elements are mandatory and are scalar. +# The init option means list/node creation. +sub _apply_defaults { + my $self = shift; + my $cur = shift; + my $phash = shift; + my %options = @_; + + foreach my $key (_keys($phash)) { + my $pii = $phash->{$key}; + + if (exists $cur->{$key}) { + next; + } elsif (ref $pii->{format} eq 'HASH') { # Not a scalar + next; + } elsif (exists $pii->{default}) { + if ($options{init} or $pii->{occurrence} =~ /^1/) { + if (ref $pii->{default}) { + $cur->{$key} = + Sympa::Tools::Data::clone_var($pii->{default}); + } else { + $cur->{$key} = $pii->{default}; + } + } + } + } +} + +sub get_schema { + my $self = shift; + + return Sympa::Tools::Data::clone_var($self->{_pinfo}); +} + +sub keys { + my $self = shift; + my $pname = shift; + + return _keys($self->{_pinfo}) unless $pname; + my @pnames = split /[.]/, $pname; + + my $phash = $self->{_pinfo}; + while (1) { + my $key = shift @pnames; + + unless (ref $phash eq 'HASH' + and exists $phash->{$key} + and exists $phash->{$key}->{format}) { + return; + } elsif (not @pnames) { + return _keys($phash->{$key}->{format}); + } else { + $phash = $phash->{$key}->{format}; + } + } +} + +sub _keys { + my $hash = shift; + my $phash = shift || $hash; + + return sort { + ($phash->{$a}->{order} || 999) <=> ($phash->{$b}->{order} || 999) + } CORE::keys %$hash; +} + +# Gets parameter name of node from list of parameter paths. +sub _pname { + my $ppaths = shift; + return undef unless $ppaths and @$ppaths; + [grep { !/\A\d+\z/ } @$ppaths]->[-1]; +} + +# Gets full parameter name of node from list of parameter paths. +sub _pfullname { + my $ppaths = shift; + return undef unless $ppaths and @$ppaths; + return join '.', grep { !/\A\d+\z/ } @$ppaths; +} + +sub submit { + my $self = shift; + my $new = shift; + my $user = shift; + my $errors = shift; + + my $changes = $self->_sanitize_changes($new, $user); + + # Error if no parameter was edited. + unless ($changes and %$changes) { + $self->{_changes} = {}; + push @$errors, ['notice', 'no_parameter_edited']; + return ''; + } + + $self->{_changes} = $changes; + return $self->_validate_changes($changes, $errors); +} + +# Sanitizes parsed input including changes. +# Parameters: +# $new: Change information. +# $user: Operating user. $param->{'user'}{'email'}. +# Returns: +# Sanitized input, where "owner.0.gecos" will be stores in +# $hashref->{'owner'}{'0'}{'gecos'}. +sub _sanitize_changes { + my $self = shift; + my $new = shift; + my $user = shift; + + return undef unless ref $new eq 'HASH'; # Sanity check + + # Apply privileges: {privilege} will keep 'hidden', 'read' or 'write'. + my $pinfo = $self->get_schema($user); + + # Undefined {_config} means list creation. + # Empty hashref means loading existing config. + my $init = (not defined $self->{_config}); + my $loading = ($self->{_config} and not %{$self->{_config}}); + my $cur = $init ? {} : Sympa::Tools::Data::clone_var($self->{_config}); + $self->_apply_defaults($cur, $pinfo, init => ($init and not $loading)); + + my %ret = map { + unless (exists $pinfo->{$_} and $pinfo->{$_}) { + (); # Sanity check: unknown parameter + } else { + # Resolve alias. + my ($k, $o) = ($_, $_); + do { + ($k, $o) = ($o, $pinfo->{$o}->{obsolete}); + } while ($o and $pinfo->{$o}); + unless ($k eq $_) { + $new->{$k} = $new->{$_}; + delete $new->{$_}; + } + + my $pii = $pinfo->{$k}; + my $ppi = [$k]; + my $newi = $new->{$k}; + my $curi = $cur->{$k}; + + my @r; + if ($pii->{occurrence} =~ /n$/) { + if (ref $pii->{format} eq 'ARRAY') { + @r = + $self->_sanitize_changes_set($curi, $newi, $pii, + $ppi); + } else { + @r = + $self->_sanitize_changes_array($curi, $newi, $pii, + $ppi, loading => $loading); + } + } elsif (ref $pii->{format} eq 'HASH') { + @r = $self->_sanitize_changes_paragraph( + $curi, $newi, $pii, $ppi, + init => (not defined $curi), + loading => $loading + ); + } else { + @r = $self->_sanitize_changes_leaf($curi, $newi, $pii, $ppi); + } + + # Omit removal if current configuration is already empty. + (@r and not defined $r[1] and not defined $curi) ? () : @r; + } + } _keys($new, $pinfo); + + return {%ret}; +} + +# Sanitizes set. +sub _sanitize_changes_set { + my $self = shift; + my $cur = shift || []; + my $new = shift; + my $pitem = shift; + my $ppaths = shift; + + return () unless ref $new eq 'ARRAY'; # Sanity check + return () if $pitem->{obsolete}; + return () unless $pitem->{privilege} eq 'write'; + + # Resolve synonym. + if (ref $pitem->{synonym} eq 'HASH') { + @$new = map { + if (defined $_) { + my $synonym = $pitem->{synonym}->{$_}; + (defined $synonym) ? $synonym : $_; + } else { + undef; + } + } @$new; + } + + my $i = -1; + my %updated = map { + $i++; + my $curi = $_; + (grep { Sympa::Tools::Data::smart_eq($curi, $_) } @$new) + ? () + : ($i => undef); + } @$cur; + my %added = map { + my $newi = $_; + (grep { Sympa::Tools::Data::smart_eq($newi, $_) } @$cur) + ? () + : (++$i => $_); + } @$new; + my %ret = (%updated, %added); + + # If all children are removed, remove parent. + while (my ($k, $v) = each %ret) { + $cur->[$k] = $v; + } + return (_pname($ppaths) => undef) unless grep { defined $_ } @$cur; + + unless (%ret) { + return (); # No valid changes + } else { + return (_pname($ppaths) => {%ret}); + } +} + +# Sanitizes array. +sub _sanitize_changes_array { + my $self = shift; + my $cur = shift || []; + my $new = shift; + my $pitem = shift; + my $ppaths = shift; + my %options = @_; + + return () unless ref $new eq 'ARRAY'; # Sanity check + return () if $pitem->{obsolete}; + return () unless $pitem->{privilege} eq 'write'; + + my $i = -1; + my %ret = map { + $i++; + my $curi = $cur->[$i]; + my $ppi = [@$ppaths, $i]; + + my @r; + if (ref $pitem->{format} eq 'HASH') { + @r = $self->_sanitize_changes_paragraph( + $curi, $_, $pitem, $ppi, + init => (not defined $curi), + loading => $options{loading} + ); + } else { + @r = $self->_sanitize_changes_leaf($curi, $_, $pitem, $ppi); + } + + # Omit removal if current configuration is already empty. + (@r and not defined $r[1] and not defined $curi) + ? () + : (@r ? ($i => $r[1]) : ()); + } @$new; + + # If all children are removed, remove parent. + while (my ($k, $v) = each %ret) { + $cur->[$k] = $v; + } + return (_pname($ppaths) => undef) unless grep { defined $_ } @$cur; + + unless (%ret) { + return (); # No valid changes + } else { + return (_pname($ppaths) => {%ret}); + } +} + +# Sanitizes paragraph. +# The init option means node creation. +sub _sanitize_changes_paragraph { + my $self = shift; + my $cur = shift || {}; + my $new = shift; + my $pitem = shift; + my $ppaths = shift; + my %options = @_; + + return () unless ref $new eq 'HASH'; # Sanity check + return () if $pitem->{obsolete}; + return () unless $pitem->{privilege} eq 'write'; + + $self->_apply_defaults($cur, $pitem->{format}, + init => ($options{init} and not $options{loading})); + + my %ret = map { + unless (exists $pitem->{format}->{$_} and $pitem->{format}->{$_}) { + (); # Sanity check: unknown parameter + } else { + # Resolve alias. + my ($k, $o) = ($_, $_); + do { + ($k, $o) = ($o, $pitem->{format}->{$o}->{obsolete}); + } while ($o and $pitem->{format}->{$o}); + unless ($k eq $_) { + $new->{$k} = $new->{$_}; + delete $new->{$_}; + } + + my $pii = $pitem->{format}->{$k}; + my $ppi = [@$ppaths, $k]; + my $newi = $new->{$k}; + my $curi = $cur->{$k}; + + my @r; + if ($pii->{occurrence} =~ /n$/) { + if (ref $pii->{format} eq 'ARRAY') { + @r = + $self->_sanitize_changes_set($curi, $newi, $pii, + $ppi); + } else { + @r = + $self->_sanitize_changes_array($curi, $newi, $pii, + $ppi, loading => $options{loading}); + } + } elsif (ref $pii->{format} eq 'HASH') { + @r = $self->_sanitize_changes_paragraph( + $curi, $newi, $pii, $ppi, + init => (not defined $curi), + loading => $options{loading} + ); + } else { + @r = $self->_sanitize_changes_leaf($curi, $newi, $pii, $ppi); + } + + # Omit removal if current configuration is already empty. + (@r and not defined $r[1] and not defined $curi) ? () : @r; + } + } _keys($new, $pitem->{format}); + + while (my ($k, $v) = each %ret) { + $cur->{$k} = $v; + } + # As soon as a required component is found to be removed, + # the whole parameter instance is removed. + return (_pname($ppaths) => undef) + if grep { + $pitem->{format}->{$_}->{occurrence} =~ /^1/ + and not defined $cur->{$_} + } _keys($pitem->{format}); + # If all children are removed, remove parent. + return (_pname($ppaths) => undef) + unless grep { defined $_ } values %$cur; + + unless (%ret) { + return (); # No valid changes + } else { + return (_pname($ppaths) => {%ret}); + } +} + +my %filters = ( + canonic_domain => sub { + my $self = shift; + my $new = shift; + return lc $new; #FIXME:how about i18n'ed domains? + }, + canonic_email => sub { + my $self = shift; + my $new = shift; + return Sympa::Tools::Text::canonic_email($new); + }, + canonic_lang => sub { + my $self = shift; + my $new = shift; + $new = Sympa::Language::canonic_lang($new); # be scalar + return $new; + }, + lc => sub { + my $self = shift; + my $new = shift; + return lc $new; + }, +); + +# Sanitizes leaf. +sub _sanitize_changes_leaf { + my $self = shift; + my $cur = shift; + my $new = shift; + my $pitem = shift; + my $ppaths = shift; + + return () if ref $new eq 'ARRAY'; # Sanity check: Hashref or scalar + return () if $pitem->{obsolete}; + return () unless $pitem->{privilege} eq 'write'; + + # If the parameter corresponds to a scenario or a task, mark it + # as changed if its name was changed. Example: 'subscribe'. + if ($pitem->{scenario} or $pitem->{task}) { + return () unless ref($new || {}) eq 'HASH'; # Sanity check + $cur = ($cur || {})->{name}; + $new = ($new || {})->{name}; + } + + # Resolve synonym. + if (defined $new and ref $pitem->{synonym} eq 'HASH') { + my $synonym = $pitem->{synonym}->{$new}; + $new = $synonym if defined $synonym; + } + # Apply filters. + # Note: Erroneous values are overlooked and _not_ eliminated in this step. + # We should eliminate them in the step of validation. + if (defined $new) { + my $f_new = $new; + foreach my $filter (@{$pitem->{filters} || []}) { + next unless ref $filters{$filter} eq 'CODE'; + $f_new = $filters{$filter}->($self, $f_new); + last unless defined $f_new; + } + $new = $f_new if defined $f_new; + } + + if (Sympa::Tools::Data::smart_eq($cur, $new)) { + return (); # Not changed + } + + if ($pitem->{scenario} or $pitem->{task}) { + return (_pname($ppaths) => {name => $new}); + } else { + return (_pname($ppaths) => $new); + } +} + +# Global validations examine the entire configuration for semantic errors or +# requirements that can't be detected within a single paragraph. +# +# Error data is returned in a hashref with the usual keys. +# +sub _global_validations { {} } + +# Validates changes on list configuration. +# +# Parameters: +# - $new: Hashref including changes. +# - $errors: Error information, initially may be empty arrayref. +# Returns: +# - 'valid' if changes are valid; 'invalid' otherwise; +# '' if no changes necessary; undef if internal error occurred. +# - $new may be modified, if there are any omittable changes. +# - Error information will be added to $errors. +sub _validate_changes { + my $self = shift; + my $new = shift; + my $errors = shift; + + my $pinfo = $self->{_pinfo}; + + my $ret = 'valid'; + foreach my $pname (_keys($new, $pinfo)) { + my $newi = $new->{$pname}; + my $pii = $pinfo->{$pname}; + my $ppi = [$pname]; + + my $r; + if ($pii->{occurrence} =~ /n$/) { + $r = + $self->_validate_changes_multiple($newi, $pii, $ppi, $errors); + } elsif (ref $pii->{format} eq 'HASH') { + $r = + $self->_validate_changes_paragraph($newi, $pii, $ppi, + $errors); + } else { + $r = $self->_validate_changes_leaf($newi, $pii, $ppi, $errors); + } + + return undef unless defined $r; + delete $new->{$pname} if $r eq 'omit'; + $ret = 'invalid' if $r eq 'invalid'; + } + + my %global_validations = %{$self->_global_validations || {}}; + # review the entire new configuration as a whole + foreach my $validation (CORE::keys %global_validations) { + next unless ref $global_validations{$validation} eq 'CODE'; + my ($error, $err_info) = $global_validations{$validation}->($self, $new); + next unless $error; + + push @$errors, + [ + 'user', $error, $err_info + ]; + $ret = 'invalid'; + } + return '' unless %$new; + return $ret; +} + +# Validates array or set. +sub _validate_changes_multiple { + my $self = shift; + my $new = shift; + my $pitem = shift; + my $ppaths = shift; + my $errors = shift; + + if (not defined $new and $pitem->{occurrence} =~ /^1/) { + push @$errors, + [ + 'user', 'mandatory_parameter', + {p_info => $pitem, p_paths => $ppaths} + ]; + return 'omit'; + } + + my $ret = 'valid'; + if (defined $new) { + foreach my $i (sort { $a <=> $b } CORE::keys %$new) { + my $newi = $new->{$i}; + my $ppi = [@$ppaths, $i]; + + if (defined $newi) { + my $r; + if (ref $pitem->{format} eq 'HASH') { + $r = + $self->_validate_changes_paragraph($newi, $pitem, + $ppi, $errors); + } else { + $r = + $self->_validate_changes_leaf($newi, $pitem, $ppi, + $errors); + } + + return undef unless defined $r; + delete $new->{$i} if $r eq 'omit'; + $ret = 'invalid' if $r eq 'invalid'; + } + } + + return 'omit' unless %$new; + } + + return $ret; +} + +# Validates paragraph. +sub _validate_changes_paragraph { + my $self = shift; + my $new = shift; + my $pitem = shift; + my $ppaths = shift; + my $errors = shift; + + if (not defined $new and $pitem->{occurrence} =~ /^1/) { + push @$errors, + [ + 'user', 'mandatory_parameter', + {p_info => $pitem, p_paths => $ppaths} + ]; + return 'omit'; + } + + my $ret = 'valid'; + if (defined $new) { + foreach my $key (_keys($new, $pitem->{format})) { + my $pii = $pitem->{format}->{$key}; + my $ppi = [@$ppaths, $key]; + my $newi = $new->{$key}; + + my $r; + if ($pii->{occurrence} =~ /n$/) { + $r = + $self->_validate_changes_multiple($newi, $pii, $ppi, + $errors); + } elsif (ref $pii->{format} eq 'HASH') { + $r = + $self->_validate_changes_paragraph($newi, $pii, $ppi, + $errors); + } else { + $r = + $self->_validate_changes_leaf($newi, $pii, $ppi, $errors); + } + + return undef unless defined $r; + delete $new->{$key} if $r eq 'omit'; + $ret = 'invalid' if $r eq 'invalid'; + } + + return 'omit' unless %$new; + } + + return $ret; +} + +sub _local_validations { {} } + +# Validates leaf. +sub _validate_changes_leaf { + my $self = shift; + my $new = shift; + my $pitem = shift; + my $ppaths = shift; + my $errors = shift; + + # If the parameter corresponds to a scenario or a task, mark it + # as changed if its name was changed. Example: 'subscribe'. + if ($pitem->{scenario} or $pitem->{task}) { + $new = $new->{name} if defined $new; + } + + if (not defined $new and $pitem->{occurrence} =~ /^1/) { + push @$errors, + [ + 'user', 'mandatory_parameter', + {p_info => $pitem, p_paths => $ppaths} + ]; + return 'omit'; + } + + # Check that the new values have the right syntax. + if (defined $new) { + my $format = $pitem->{format}; + if (ref $format eq 'ARRAY' and not grep { $new eq $_ } @$format) { + push @$errors, + [ + 'user', 'syntax_errors', + {p_info => $pitem, p_paths => $ppaths, value => $new} + ]; + return 'invalid'; + } elsif (ref $format ne 'ARRAY' and not $new =~ /^$format$/) { + push @$errors, + [ + 'user', 'syntax_errors', + {p_info => $pitem, p_paths => $ppaths, value => $new} + ]; + return 'invalid'; + } + + my %validations = %{$self->_local_validations || {}}; + foreach my $validation (@{$pitem->{validations} || []}) { + next unless ref $validations{$validation} eq 'CODE'; + my ($error, $validity) = + $validations{$validation}->($self, $new, $pitem, $ppaths); + next unless $error; + + push @$errors, + [ + 'user', $error, + {p_info => $pitem, p_paths => $ppaths, value => $new} + ]; + return $validity || 'invalid'; + } + } + + return 'valid'; +} + +sub commit { + my $self = shift; + my $errors = shift || []; + + my $pinfo = $self->{_pinfo}; + + # Undefined {_config} means list creation. + # Empty hashref means loading existing config. + my $init = (not defined $self->{_config}); + my $loading = ($self->{_config} and not %{$self->{_config}}); + my $cur = $init ? {} : $self->{_config}; + $self->_apply_defaults($cur, $pinfo, init => ($init and not $loading)); + + foreach my $pname (_keys($self->{_changes}, $pinfo)) { + my $curi = $cur->{$pname}; + my $newi = $self->{_changes}->{$pname}; + my $pii = $pinfo->{$pname}; + + unless (defined $newi) { + delete $cur->{$pname}; + } elsif ($pii->{occurrence} =~ /n$/) { + $curi = $cur->{$pname} = [] unless defined $curi; + $self->_merge_changes_multiple($curi, $newi, $pii, + loading => $loading); + } elsif (ref $pii->{format} eq 'HASH') { + my $init = (not defined $curi); + $curi = $cur->{$pname} = {} if $init; + $self->_merge_changes_paragraph( + $curi, $newi, $pii, + init => $init, + loading => $loading + ); + } else { + $cur->{$pname} = $newi; + } + } + + $self->{_config} = $cur if $init; + + # Update 'defaults' item to indicate default settings, for compatibility. + #FIXME:Multiple levels of keys should be possible. + foreach my $pname (_keys($self->{_changes}, $pinfo)) { + if (defined $self->{_changes}->{$pname} + or $pinfo->{$pname}->{internal}) { + delete $self->{_config}->{defaults}->{$pname}; + } else { + $self->{_config}->{defaults}->{$pname} = 1; + } + } +} + +sub _merge_changes_multiple { + my $self = shift; + my $cur = shift; + my $new = shift; + my $pitem = shift; + my %options = @_; + + foreach my $i (reverse sort { $a <=> $b } CORE::keys %$new) { + my $curi = $cur->[$i]; + my $newi = $new->{$i}; + + unless (defined $new->{$i}) { + splice @$cur, $i, 1; + } elsif (ref $pitem->{format} eq 'HASH') { + my $init = (not defined $curi); + $curi = $cur->[$i] = {} if $init; + $self->_merge_changes_paragraph( + $curi, $newi, $pitem, + init => $init, + loading => $options{loading} + ); + } else { + $cur->[$i] = $newi; + } + } + + # The set: Dedupe and sort. + if (ref $pitem->{format} eq 'ARRAY') { + my %elements = map { ($_ => 1) } grep { defined $_ } @$cur; + @$cur = sort(CORE::keys %elements); + } +} + +# Merges changes on paragraph node. +# The init option means node creation. +sub _merge_changes_paragraph { + my $self = shift; + my $cur = shift; + my $new = shift; + my $pitem = shift; + my %options = @_; + + $self->_apply_defaults($cur, $pitem->{format}, + init => ($options{init} and not $options{loading})); + + foreach my $key (_keys($new, $pitem->{format})) { + my $curi = $cur->{$key}; + my $newi = $new->{$key}; + my $pii = $pitem->{format}->{$key}; + + unless (defined $newi) { + delete $cur->{$key}; + } elsif ($pii->{occurrence} =~ /n$/) { + $curi = $cur->{$key} = [] unless defined $curi; + $self->_merge_changes_multiple($curi, $newi, $pii, + loading => $options{loading}); + } elsif (ref $pii->{format} eq 'HASH') { + my $init = (not defined $curi); + $curi = $cur->{$key} = {} if $init; + $self->_merge_changes_paragraph( + $curi, $newi, $pii, + init => $init, + loading => $options{loading} + ); + } else { + $cur->{$key} = $newi; + } + } +} + +sub get_id { + my $that = shift->{context}; + (ref $that eq 'Sympa::List') ? $that->get_id : (defined $that) ? $that : ''; +} + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::Config - List configuration + +=head1 SYNOPSIS + + use base qw(Sympa::Config); + + sub _schema { {...} } + +=head1 DESCRIPTION + +=head2 Methods + +=over + +=item new ( $that, [ config =E $initial_config ], [ copy =E 1 ], +[ I =E I, ... ] ) + +I. +Creates new instance of L object. + +Parameters: + +=over + +=item $that + +Context. An instance of L class, Robot or Site. + +=item config =E $initial_config + +Initial configuration. + +=over + +=item * + +When the context object will be initially created, +C must be specified explicitly +so that default parameter values will be completed. + +=item * + +When existing list will be instantiated and config will be loaded, +C<{}> (default) would be specified +so that default parameter values except optional ones +(with occurrence C<'0-1'> or C<'0-n'>) will be completed. + +=item * + +Otherwise, default parameter values are completed +only when the new paragraph node will be added by submit(). + +=back + +Note that initial configuration will never be sanitized. + +=item copy =E 1 + +Uses deep copy of initial configuration (see L) +instead of real reference. + +=back + +=item get ( $ppath ) + +I. +Gets copy of current value of parameter. + +Parameter: + +=over + +=item $ppath + +Parameter path, +e.g.: C<'owner.0.email'> specifies "email" parameter of +the first "owner" paragraph; +C<'owner.0'> specifies the first "owner" paragraph; +C<'owner'> specifies the array of all "owner" paragraph. + +=back + +Returns: + +Value of parameter. +If parameter or value does not exist, returns C in scalar context +and an empty list in array context. + +=item get_change ( $ppath ) + +I. +Gets copy of submitted change on parameter. + +Parameter: + +=over + +=item $ppath + +Parameter path. +See also get(). + +=back + +Returns: + +If value won't be changed, returns empty list in array context +and C in scalar context. +If value would be deleted, returns C. + +Changes on the array are given by hashref +with keys as affected indexes of the array. + +=item get_changeset ( ) + +I. +Gets all submitted changes. + +Note that returned value is the real reference to internal information. +Any modifications might break it. + +=item get_schema ( [ I, ... ] ) + +I. +Get configuration schema as hashref. + +=item keys ( [ $pname ] ) + +I. +Gets parameter keys in order defined by schema. + +Parameter: + +=over + +=item $pname + +Full parameter name, e.g. C<'owner'>. +If omitted or false value, +returns keys of top-level parameters. + +=back + +Returns: + +List of keys. +If parameter does not exist or it does not have sub-parameters, +i.e. it is not the paragraph, empty list. + +=item submit ( $new, $user, \@errors ) + +I. +Submits change and verifies it. +Submission is done by: + +=over + +=item * + +Sanitizing changes: + +Omits unknown parameters, +resolves parameter aliases, +omits malformed change information, +omits obsoleted parameters, +omits changes on unwritable parameters, +removes nodes under which required children nodes will be removed, +resolves synonym of input values, +canonicalizes inputs (see L), +and omits identical changes. + +=item * + +Verifying changes: + +Omits removal of mandatory parameters, +checks format of inputs, +and performs additional validations (see L). + +=back + +Parameters: + +=over + +=item $new + +Changes to be submitted, hashref. + +=item $user + +Email of the user requesting submission. + +=item \@errors + +If errors occur, they will be pushed in this arrayref. +Each element is arrayref C<[ I, I, I ]>: + +=over + +=item I + +One of C<'user'> (failure), C<'intern'> (internal failure) +and C<'notice'> (successful notice). + +=item I + +A keyword to determine error. + +=item I + +Optional hashref with keys: +C for schema item of parameter; +C for elements of parameter path; +C for erroneous value (optional). + +=back + +=back + +Returns: + +If no changes found (or all changes were omitted), an empty string C<''>. +If any errors found in input, C<'invalid'>. +Otherwise, C<'valid'>. + +In case any changes are submitted, +changeset may be accessible by get_change() or get_changeset(). + +=item commit ( [ \@errors ] ) + +I. +Merges changes set by sbumit() into actual configuration. + +Parameter: + +=over + +=item \@errors + +Arrayref. +See \@errors in submit(). + +=back + +Returns: + +None. +Errors will be stored in arrayref. + +=back + +=head3 Methods child classes should implement + +=over + +=item _schema ( ) + +I, I. +TBD. + +=item _init_schema_item ( $pitem, $pnames, $subres, +[ I =E I, ... ] ) + +I. +TBD. + +=item _global_validations ( ) + +I. +TBD. + +=item _local_validations ( ) + +I. +TBD. + +=back + +=head2 Attribute + +Instance of L has following attribute. + +=over + +=item {context} + +Context, L instance. + +=back + +=head2 Structure of configuration + +Configuration on the memory is represented by a hashref, +with its keys as node names and values as node values. + +=head3 Node types + +Each node of configuration has one of following four types. +Some of them can include other type of nodes recursively. + +=over + +=item Set (multiple enumerated values) + +Arrayref. +In the schema, defined with: + +=over + +=item * + +{occurrence}: C<'0-n'> or C<'1-n'>. + +=item * + +{format}: Arrayref. + +=back + +List of unique items not considering order. +Items are scalars, and cannot be special values (scenario or task). +The set cannot contain paragraphs, sets or arrays. + +=item Array (multiple values) + +Arrayref. +In the schema, defined with: + +=over + +=item * + +{occurrence}: C<'0-n'> or C<'1-n'>. + +=item * + +{format}: Regexp or hashref. + +=back + +List of the same type of nodes in order. +Type of all nodes can be one of paragraph, +scalar or special value (scenario or task). +The array cannot contain sets or arrays. + +=item Paragraph (structured value) + +Hashref. +In the schema, defined with: + +=over + +=item * + +{occurrence}: If the node is an item of array, C<'0-n'> or C<'1-n'>. +Otherwise, C<'0-1'> or C<'1'>. + +=item * + +{format}: Hashref. + +=back + +Compound node of one or more named nodes. +Paragraph can contain any type of nodes, and each of their names and types +are defined as member of {format} item in schema. + +=item Leaf (simple value) + +Scalar, or hashref for special value (scenario or task). +In the schema, defined with: + +=over + +=item * + +{occurrence}: If the node is an item of array, C<'0-n'> or C<'1-n'>. +Otherwise, C<'0-1'> or C<'1'>. + +=item * + +{format}: If the node is an item of array, regexp. +Otherwise, regexp or arrayref. + +=back + +Scalar or special value (scenario or task). +Leaf cannot contain any other nodes. + +=back + +=head2 Filters + +TBD. + +=head2 Validations + +TBD. + +=head1 SEE ALSO + +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.33b.X. + +=cut + diff --git a/src/lib/Sympa/List/Config.pm b/src/lib/Sympa/List/Config.pm index 66586cc7e..0f7137ad1 100644 --- a/src/lib/Sympa/List/Config.pm +++ b/src/lib/Sympa/List/Config.pm @@ -4,8 +4,8 @@ # Sympa - SYsteme de Multi-Postage Automatique # -# Copyright 2017 The Sympa Community. See the AUTHORS.md file at the top-level -# directory of this distribution and at +# Copyright 2017, 2018 The Sympa Community. See the AUTHORS.md file at the +# top-level directory of this distribution and at # . # # This program is free software; you can redistribute it and/or modify @@ -27,9 +27,10 @@ use strict; use warnings; use Conf; +use Sympa::Log; use Sympa::Robot; -use Sympa::Tools::Data; -use Sympa::Tools::Text; + +use base qw(Sympa::Config); my $log = Sympa::Log->instance; @@ -39,138 +40,54 @@ sub new { my %options = @_; die 'bug in logic. Ask developer' unless ref $context eq 'Sympa::List'; - - # The undef means list creation. - # Empty hashref (default) means loading existing config. - my $config; - if (exists $options{config}) { - $config = $options{config}; - } else { - $config = {}; - } - $config = Sympa::Tools::Data::clone_var($config) - if $options{copy}; - - #FIXME:Should $config be sanitized? - my $self = - bless {context => $context, _config => $config, _changes => {}} => - $class; - - $self->{_pinfo} = $self->_list_params(%options); - - return $self; + $class->SUPER::new($context, %options); } -sub _list_params { - my $self = shift; - my %options = @_; +sub _schema { + my $self = shift; my $list = $self->{context}; - - my $pinfo = Sympa::Robot::list_params($list->{'domain'}); - $self->_list_params_init_defaults($pinfo); - - $self->_list_params_apply_family($pinfo) - unless $options{no_family}; - - return $pinfo; -} - -# Initialize default values. -sub _list_params_init_defaults { - my $self = shift; - my $phash = shift; - - foreach my $key (_keys($phash)) { - my $pii = $phash->{$key}; - - if (ref $pii->{format} eq 'HASH') { - $self->_list_params_init_defaults($pii->{format}); - } elsif (exists $pii->{default}) { - $pii->{default} = $self->_get_default($pii); - } - } + return Sympa::Robot::list_params($list->{'domain'}); } -sub _get_default { - my $self = shift; - my $pitem = shift; - - my $val; - my $list = $self->{context}; +sub _init_schema_item { + my $self = shift; + my $pitem = shift; + my $pnames = shift; + my $subres = shift; + my %options = @_; - my $default = $pitem->{default}; - if (ref $default eq 'HASH' and exists $default->{conf}) { - $val = Conf::get_robot_conf($list->{'domain'}, $default->{conf}); - } else { - $val = $default; - } + if (ref $pitem->{format} ne 'HASH' and exists $pitem->{default}) { + my $list = $self->{context}; + my $default = $pitem->{default}; - if ($pitem->{occurrence} =~ /n$/) { # The set or the array of scalars - unless (defined $val) { - $val = []; - } else { - my $re = quotemeta($pitem->{split_char} || ','); - $val = [split /\s*$re\s*/, $val]; - } - return $val; - } elsif ($pitem->{scenario} or $pitem->{task}) { - unless (defined $val) { - return undef; - } else { - return {name => $val}; + if (ref $default eq 'HASH' and exists $default->{conf}) { + $pitem->{default} = + Conf::get_robot_conf($list->{'domain'}, $default->{conf}); } - } else { - return $val; } -} -sub _list_params_apply_family { - my $self = shift; - my $pinfo = shift; + $self->SUPER::_init_schema_item($pitem, $pnames, $subres, %options); + return undef if $options{no_family}; my $family = $self->{context}->get_family; - return unless ref $family eq 'Sympa::Family'; + return undef unless ref $family eq 'Sympa::Family'; - foreach my $pname (_keys($pinfo)) { - $self->__list_params_apply_family($pinfo->{$pname}, [$pname], - $family); - } -} - -sub __list_params_apply_family { - my $self = shift; - my $pitem = shift; - my $pnames = shift; - my $family = shift; - - my $ret = 0; if (ref $pitem->{format} eq 'HASH') { - foreach my $key (_keys($pitem->{format})) { - if ($self->__list_params_apply_family( - $pitem->{format}->{$key}, - [@$pnames, $key], $family - ) - ) { - if ($pitem->{format}->{$key}->{occurrence} eq '0-1') { - $pitem->{format}->{$key}->{occurrence} = '1'; - } elsif ($pitem->{format}->{$key}->{occurrence} eq '0-n') { - $pitem->{format}->{$key}->{occurrence} = '1-n'; - } - $ret = 1; - } + if ($subres and grep {$_} values %$subres) { + return 'constrained'; } } else { my $constraint = $family->get_param_constraint(join '.', @$pnames); my @constr; unless (defined $constraint) { # Error - next; + return undef; } elsif (ref $constraint eq 'ARRAY') { # Multiple choices @constr = @$constraint; } elsif ($constraint ne '0') { # Fixed value @constr = ($constraint); } else { # No control - next; + return undef; } if (ref $pitem->{format} eq 'ARRAY') { @@ -213,124 +130,20 @@ sub __list_params_apply_family { delete $pitem->{default} unless grep { $pitem->{default} eq $_ } @constr; } - $ret = 1; - } - } - - return $ret; -} - -sub get { - my $self = shift; - my $ppath = shift; - - my @ppaths = split /[.]/, $ppath; - return unless @ppaths; - - my @value = _get($self->{_config}, @ppaths); - return unless @value; - return $value[0] unless ref $value[0]; - return Sympa::Tools::Data::clone_var($value[0]); -} - -sub _get { - my $cur = shift; - my @ppaths = @_; - - while (1) { - my $key = shift @ppaths; - - if ($key =~ /\A\d+\z/) { - unless (ref $cur eq 'ARRAY' and exists $cur->[$key]) { - return; - } elsif (not @ppaths) { - return ($cur->[$key]); - } else { - $cur = $cur->[$key]; - } - } else { - unless (ref $cur eq 'HASH' and exists $cur->{$key}) { - return; - } elsif (not @ppaths) { - return $cur->{$key}; - } else { - $cur = $cur->{$key}; - } + return 'constrained'; } } -} -sub get_change { - my $self = shift; - my $ppath = shift; - - my @ppaths = split /[.]/, $ppath; - return unless @ppaths; - - my @value = _get_change($self->{_changes}, @ppaths); - return unless @value; - return $value[0] unless ref $value[0]; - return Sympa::Tools::Data::clone_var($value[0]); -} - -sub _get_change { - my $new = shift; - my @ppaths = @_; - - while (1) { - my $key = shift @ppaths; - - unless (ref $new eq 'HASH' and exists $new->{$key}) { - return; - } elsif (not @ppaths) { - return $new->{$key}; - } else { - $new = $new->{$key}; - } - } -} - -sub get_changeset { - my $self = shift; - - return $self->{_changes}; -} - -# Apply default values, if elements are mandatory and are scalar. -# The init option means list/node creation. -sub _apply_defaults { - my $self = shift; - my $cur = shift; - my $phash = shift; - my %options = @_; - - foreach my $key (_keys($phash)) { - my $pii = $phash->{$key}; - - if (exists $cur->{$key}) { - next; - } elsif (ref $pii->{format} eq 'HASH') { # Not a scalar - next; - } elsif (exists $pii->{default}) { - if ($options{init} or $pii->{occurrence} =~ /^1/) { - if (ref $pii->{default}) { - $cur->{$key} = - Sympa::Tools::Data::clone_var($pii->{default}); - } else { - $cur->{$key} = $pii->{default}; - } - } - } - } + return undef; } sub get_schema { my $self = shift; my $user = shift; - my $pinfo = Sympa::Tools::Data::clone_var($self->{_pinfo}); + my $pinfo = $self->SUPER::get_schema; if ($user) { - foreach my $pname (_keys($pinfo)) { + foreach my $pname (CORE::keys %{$pinfo || {}}) { $self->_get_schema_apply_privilege($pinfo->{$pname}, [$pname], $user, undef); } @@ -352,7 +165,7 @@ sub _get_schema_apply_privilege { # - Trick: "hidden", "read" and "write" precede others in reverse # dictionary order. # - Internal parameters are not editable anyway. - my $priv = $list->may_edit(_pfullname($pnames), $user); + my $priv = $list->may_edit(join('.', @{$pnames || []}), $user); $priv = 'read' if $pitem->{internal} and (not $priv or 'read' lt $priv); @@ -365,7 +178,7 @@ sub _get_schema_apply_privilege { $pitem->{privilege} ||= 'hidden'; # Implicit default if (ref $pitem->{format} eq 'HASH') { - foreach my $key (_keys($pitem->{format})) { + foreach my $key (CORE::keys %{$pitem->{format} || {}}) { $self->_get_schema_apply_privilege( $pitem->{format}->{$key}, [@$pnames, $key], @@ -375,682 +188,7 @@ sub _get_schema_apply_privilege { } } -sub keys { - my $self = shift; - my $pname = shift; - - return _keys($self->{_pinfo}) unless $pname; - my @pnames = split /[.]/, $pname; - - my $phash = $self->{_pinfo}; - while (1) { - my $key = shift @pnames; - - unless (ref $phash eq 'HASH' - and exists $phash->{$key} - and exists $phash->{$key}->{format}) { - return; - } elsif (not @pnames) { - return _keys($phash->{$key}->{format}); - } else { - $phash = $phash->{$key}->{format}; - } - } -} - -sub _keys { - my $hash = shift; - my $phash = shift || $hash; - - return sort { - ($phash->{$a}->{order} || 999) <=> ($phash->{$b}->{order} || 999) - } CORE::keys %$hash; -} - -# Gets parameter name of node from list of parameter paths. -sub _pname { - my $ppaths = shift; - return undef unless $ppaths and @$ppaths; - [grep { !/\A\d+\z/ } @$ppaths]->[-1]; -} - -# Gets full parameter name of node from list of parameter paths. -sub _pfullname { - my $ppaths = shift; - return undef unless $ppaths and @$ppaths; - return join '.', grep { !/\A\d+\z/ } @$ppaths; -} - -sub submit { - my $self = shift; - my $new = shift; - my $user = shift; - my $errors = shift; - - my $changes = $self->_sanitize_changes($new, $user); - - # Error if no parameter was edited. - unless ($changes and %$changes) { - $self->{_changes} = {}; - push @$errors, ['notice', 'no_parameter_edited']; - return ''; - } - - $self->{_changes} = $changes; - return $self->_validate_changes($changes, $errors); -} - -# Sanitizes parsed input including changes. -# Parameters: -# $new: Change information. -# $user: Operating user. $param->{'user'}{'email'}. -# Returns: -# Sanitized input, where "owner.0.gecos" will be stores in -# $hashref->{'owner'}{'0'}{'gecos'}. -sub _sanitize_changes { - my $self = shift; - my $new = shift; - my $user = shift; - - return undef unless ref $new eq 'HASH'; # Sanity check - - my $list = $self->{context}; - - # Apply privileges: {privilege} will keep 'hidden', 'read' or 'write'. - my $pinfo = $self->get_schema($user); - - # Undefined {_config} means list creation. - # Empty hashref means loading existing config. - my $init = (not defined $self->{_config}); - my $loading = ($self->{_config} and not %{$self->{_config}}); - my $cur = $init ? {} : Sympa::Tools::Data::clone_var($self->{_config}); - $self->_apply_defaults($cur, $pinfo, init => ($init and not $loading)); - - my %ret = map { - unless (exists $pinfo->{$_} and $pinfo->{$_}) { - (); # Sanity check: unknown parameter - } else { - # Resolve alias. - my ($k, $o) = ($_, $_); - do { - ($k, $o) = ($o, $pinfo->{$o}->{obsolete}); - } while ($o and $pinfo->{$o}); - unless ($k eq $_) { - $new->{$k} = $new->{$_}; - delete $new->{$_}; - } - - my $pii = $pinfo->{$k}; - my $ppi = [$k]; - my $newi = $new->{$k}; - my $curi = $cur->{$k}; - - my @r; - if ($pii->{occurrence} =~ /n$/) { - if (ref $pii->{format} eq 'ARRAY') { - @r = - $self->_sanitize_changes_set($curi, $newi, $pii, - $ppi); - } else { - @r = - $self->_sanitize_changes_array($curi, $newi, $pii, - $ppi, loading => $loading); - } - } elsif (ref $pii->{format} eq 'HASH') { - @r = $self->_sanitize_changes_paragraph( - $curi, $newi, $pii, $ppi, - init => (not defined $curi), - loading => $loading - ); - } else { - @r = $self->_sanitize_changes_leaf($curi, $newi, $pii, $ppi); - } - - # Omit removal if current configuration is already empty. - (@r and not defined $r[1] and not defined $curi) ? () : @r; - } - } _keys($new, $pinfo); - - return {%ret}; -} - -# Sanitizes set. -sub _sanitize_changes_set { - my $self = shift; - my $cur = shift || []; - my $new = shift; - my $pitem = shift; - my $ppaths = shift; - - return () unless ref $new eq 'ARRAY'; # Sanity check - return () if $pitem->{obsolete}; - return () unless $pitem->{privilege} eq 'write'; - - my $list = $self->{context}; - - # Resolve synonym. - if (ref $pitem->{synonym} eq 'HASH') { - @$new = map { - if (defined $_) { - my $synonym = $pitem->{synonym}->{$_}; - (defined $synonym) ? $synonym : $_; - } else { - undef; - } - } @$new; - } - - my $i = -1; - my %updated = map { - $i++; - my $curi = $_; - (grep { Sympa::Tools::Data::smart_eq($curi, $_) } @$new) - ? () - : ($i => undef); - } @$cur; - my %added = map { - my $newi = $_; - (grep { Sympa::Tools::Data::smart_eq($newi, $_) } @$cur) - ? () - : (++$i => $_); - } @$new; - my %ret = (%updated, %added); - - # If all children are removed, remove parent. - while (my ($k, $v) = each %ret) { - $cur->[$k] = $v; - } - return (_pname($ppaths) => undef) unless grep { defined $_ } @$cur; - - unless (%ret) { - return (); # No valid changes - } else { - return (_pname($ppaths) => {%ret}); - } -} - -# Sanitizes array. -sub _sanitize_changes_array { - my $self = shift; - my $cur = shift || []; - my $new = shift; - my $pitem = shift; - my $ppaths = shift; - my %options = @_; - - return () unless ref $new eq 'ARRAY'; # Sanity check - return () if $pitem->{obsolete}; - return () unless $pitem->{privilege} eq 'write'; - - my $i = -1; - my %ret = map { - $i++; - my $curi = $cur->[$i]; - my $ppi = [@$ppaths, $i]; - - my @r; - if (ref $pitem->{format} eq 'HASH') { - @r = $self->_sanitize_changes_paragraph( - $curi, $_, $pitem, $ppi, - init => (not defined $curi), - loading => $options{loading} - ); - } else { - @r = $self->_sanitize_changes_leaf($curi, $_, $pitem, $ppi); - } - - # Omit removal if current configuration is already empty. - (@r and not defined $r[1] and not defined $curi) - ? () - : (@r ? ($i => $r[1]) : ()); - } @$new; - - # If all children are removed, remove parent. - while (my ($k, $v) = each %ret) { - $cur->[$k] = $v; - } - return (_pname($ppaths) => undef) unless grep { defined $_ } @$cur; - - unless (%ret) { - return (); # No valid changes - } else { - return (_pname($ppaths) => {%ret}); - } -} - -# Sanitizes paragraph. -# The init option means node creation. -sub _sanitize_changes_paragraph { - my $self = shift; - my $cur = shift || {}; - my $new = shift; - my $pitem = shift; - my $ppaths = shift; - my %options = @_; - - return () unless ref $new eq 'HASH'; # Sanity check - return () if $pitem->{obsolete}; - return () unless $pitem->{privilege} eq 'write'; - - $self->_apply_defaults($cur, $pitem->{format}, - init => ($options{init} and not $options{loading})); - - my %ret = map { - unless (exists $pitem->{format}->{$_} and $pitem->{format}->{$_}) { - (); # Sanity check: unknown parameter - } else { - # Resolve alias. - my ($k, $o) = ($_, $_); - do { - ($k, $o) = ($o, $pitem->{format}->{$o}->{obsolete}); - } while ($o and $pitem->{format}->{$o}); - unless ($k eq $_) { - $new->{$k} = $new->{$_}; - delete $new->{$_}; - } - - my $pii = $pitem->{format}->{$k}; - my $ppi = [@$ppaths, $k]; - my $newi = $new->{$k}; - my $curi = $cur->{$k}; - - my @r; - if ($pii->{occurrence} =~ /n$/) { - if (ref $pii->{format} eq 'ARRAY') { - @r = - $self->_sanitize_changes_set($curi, $newi, $pii, - $ppi); - } else { - @r = - $self->_sanitize_changes_array($curi, $newi, $pii, - $ppi, loading => $options{loading}); - } - } elsif (ref $pii->{format} eq 'HASH') { - @r = $self->_sanitize_changes_paragraph( - $curi, $newi, $pii, $ppi, - init => (not defined $curi), - loading => $options{loading} - ); - } else { - @r = $self->_sanitize_changes_leaf($curi, $newi, $pii, $ppi); - } - - # Omit removal if current configuration is already empty. - (@r and not defined $r[1] and not defined $curi) ? () : @r; - } - } _keys($new, $pitem->{format}); - - while (my ($k, $v) = each %ret) { - $cur->{$k} = $v; - } - # As soon as a required component is found to be removed, - # the whole parameter instance is removed. - return (_pname($ppaths) => undef) - if grep { - $pitem->{format}->{$_}->{occurrence} =~ /^1/ - and not defined $cur->{$_} - } _keys($pitem->{format}); - # If all children are removed, remove parent. - return (_pname($ppaths) => undef) - unless grep { defined $_ } values %$cur; - - unless (%ret) { - return (); # No valid changes - } else { - return (_pname($ppaths) => {%ret}); - } -} - -my %filters = ( - canonic_domain => sub { - my $self = shift; - my $new = shift; - return lc $new; #FIXME:how about i18n'ed domains? - }, - canonic_email => sub { - my $self = shift; - my $new = shift; - return Sympa::Tools::Text::canonic_email($new); - }, - canonic_lang => sub { - my $self = shift; - my $new = shift; - $new = Sympa::Language::canonic_lang($new); # be scalar - return $new; - }, - lc => sub { - my $self = shift; - my $new = shift; - return lc $new; - }, -); - -# Sanitizes leaf. -sub _sanitize_changes_leaf { - my $self = shift; - my $cur = shift; - my $new = shift; - my $pitem = shift; - my $ppaths = shift; - - return () if ref $new eq 'ARRAY'; # Sanity check: Hashref or scalar - return () if $pitem->{obsolete}; - return () unless $pitem->{privilege} eq 'write'; - - my $list = $self->{context}; - - # If the parameter corresponds to a scenario or a task, mark it - # as changed if its name was changed. Example: 'subscribe'. - if ($pitem->{scenario} or $pitem->{task}) { - return () unless ref($new || {}) eq 'HASH'; # Sanity check - $cur = ($cur || {})->{name}; - $new = ($new || {})->{name}; - } - - # Resolve synonym. - if (defined $new and ref $pitem->{synonym} eq 'HASH') { - my $synonym = $pitem->{synonym}->{$new}; - $new = $synonym if defined $synonym; - } - # Apply filters. - # Note: Erroneous values are overlooked and _not_ eliminated in this step. - # We should eliminate them in the step of validation. - if (defined $new) { - my $f_new = $new; - foreach my $filter (@{$pitem->{filters} || []}) { - next unless ref $filters{$filter} eq 'CODE'; - $f_new = $filters{$filter}->($self, $f_new); - last unless defined $f_new; - } - $new = $f_new if defined $f_new; - } - - if (Sympa::Tools::Data::smart_eq($cur, $new)) { - return (); # Not changed - } - - if ($pitem->{scenario} or $pitem->{task}) { - return (_pname($ppaths) => {name => $new}); - } else { - return (_pname($ppaths) => $new); - } -} - -# -# Global validations examine the entire configuration for semantic errors or -# requirements that can't be detected within a single paragraph. -# -# The 'owner_domain' option is an example of this need. The restriction applies -# to the entire set of owner addresses, not just a single owner. -# -# Error data is returned in a hashref with the usual keys. -# -my %global_validations = ( - owner_domain => sub { - my $self = shift; - my $new = shift; - - my $pinfo = $self->{_pinfo}; - my $loglevel = 'debug'; # was set to 'info' during development - - # gather parameters - my $owner_domain = $self->get('owner_domain'); - if (defined($self->get_change('owner_domain'))) { - $owner_domain = $self->get_change('owner_domain'); - } - (my $domainrex = "[.\@]($owner_domain)\$") =~ s/ /|/g; - - my $owner_domain_min = $self->get('owner_domain_min'); - if (defined($self->get_change('owner_domain_min'))) { - $owner_domain_min = $self->get_change('owner_domain_min'); - } - $owner_domain_min ||= 0; - - # if no owner_domain setting, do nothing - return if ($owner_domain =~ /^\s*$/); - - # calculate updated owner list, including deletions - my @owner = map { $_->{'email'} } @{$self->get('owner')}; - my $changes = $self->get_change('owner'); - map { $owner[$_] = $changes->{$_}->{'email'} } CORE::keys %$changes; - @owner = grep defined, @owner; - - # count matches and non-matches - my @non_matching_owners = grep {!/$domainrex/} @owner; - my @matching_owners = grep {/$domainrex/} @owner; - - my $non_matching_count = 1 + $#non_matching_owners; - my $matching_owner_count = 1 + $#matching_owners; - - # logging - $log->syslog($loglevel, "owner_domain: $owner_domain"); - $log->syslog($loglevel, "owner_domain_min: $owner_domain_min"); - $log->syslog($loglevel, "owners: " . join(",", @owner)); - $log->syslog($loglevel, "total owners: " . ($#owner + 1)); - $log->syslog($loglevel, "domainrex: $domainrex"); - $log->syslog($loglevel, "matching_owners: " . join(",", @matching_owners)); - $log->syslog($loglevel, "matching_owner_count: $matching_owner_count"); - $log->syslog($loglevel, "non_matching_owners: " . join(",", @non_matching_owners)); - $log->syslog($loglevel, "non_matching_count: $non_matching_count"); - - # apply different rules based on min domain requirement - if ($owner_domain_min == 0) { - return ('owner_domain', - {p_info => $pinfo->{'owner'}, - p_paths => ['owner'], - owner_domain => $owner_domain, - value => join(' ', @non_matching_owners)}) - unless ($non_matching_count == 0); - } else { - return ('owner_domain_min', - {p_info => $pinfo->{'owner'}, - p_paths => ['owner'], - owner_domain => $owner_domain, - owner_domain_min => $owner_domain_min, - value => $matching_owner_count}) - unless ($matching_owner_count >= $owner_domain_min); - } - return ''; - }, - ); - -# Validates changes on list configuration. -# Context: -# - $list: An instance of Sympa::List. -# Parameters: -# - $new: Hashref including changes. -# - $errors: Error information, initially may be empty arrayref. -# Returns: -# - 'valid' if changes are valid; 'invalid' otherwise; -# '' if no changes necessary; undef if internal error occurred. -# - $new may be modified, if there are any omittable changes. -# - Error information will be added to $errors. -sub _validate_changes { - my $self = shift; - my $new = shift; - my $errors = shift; - - my $pinfo = $self->{_pinfo}; - - my $ret = 'valid'; - foreach my $pname (_keys($new, $pinfo)) { - my $newi = $new->{$pname}; - my $pii = $pinfo->{$pname}; - my $ppi = [$pname]; - - my $r; - if ($pii->{occurrence} =~ /n$/) { - $r = - $self->_validate_changes_multiple($newi, $pii, $ppi, $errors); - } elsif (ref $pii->{format} eq 'HASH') { - $r = - $self->_validate_changes_paragraph($newi, $pii, $ppi, - $errors); - } else { - $r = $self->_validate_changes_leaf($newi, $pii, $ppi, $errors); - } - - return undef unless defined $r; - delete $new->{$pname} if $r eq 'omit'; - $ret = 'invalid' if $r eq 'invalid'; - } - - # review the entire new configuration as a whole - foreach my $validation (CORE::keys %global_validations) { - next unless ref $global_validations{$validation} eq 'CODE'; - my ($error, $err_info) = $global_validations{$validation}->($self, $new); - next unless $error; - - push @$errors, - [ - 'user', $error, $err_info - ]; - $ret = 'invalid'; - } - return '' unless %$new; - return $ret; -} - -# Validates array or set. -sub _validate_changes_multiple { - my $self = shift; - my $new = shift; - my $pitem = shift; - my $ppaths = shift; - my $errors = shift; - - if (not defined $new and $pitem->{occurrence} =~ /^1/) { - push @$errors, - [ - 'user', 'mandatory_parameter', - {p_info => $pitem, p_paths => $ppaths} - ]; - return 'omit'; - } - - my $ret = 'valid'; - if (defined $new) { - foreach my $i (sort { $a <=> $b } CORE::keys %$new) { - my $newi = $new->{$i}; - my $ppi = [@$ppaths, $i]; - - if (defined $newi) { - my $r; - if (ref $pitem->{format} eq 'HASH') { - $r = - $self->_validate_changes_paragraph($newi, $pitem, - $ppi, $errors); - } else { - $r = - $self->_validate_changes_leaf($newi, $pitem, $ppi, - $errors); - } - - return undef unless defined $r; - delete $new->{$i} if $r eq 'omit'; - $ret = 'invalid' if $r eq 'invalid'; - } - } - - return 'omit' unless %$new; - } - - return $ret; -} - -# Validates paragraph. -sub _validate_changes_paragraph { - my $self = shift; - my $new = shift; - my $pitem = shift; - my $ppaths = shift; - my $errors = shift; - - if (not defined $new and $pitem->{occurrence} =~ /^1/) { - push @$errors, - [ - 'user', 'mandatory_parameter', - {p_info => $pitem, p_paths => $ppaths} - ]; - return 'omit'; - } - - my $ret = 'valid'; - if (defined $new) { - foreach my $key (_keys($new, $pitem->{format})) { - my $pii = $pitem->{format}->{$key}; - my $ppi = [@$ppaths, $key]; - my $newi = $new->{$key}; - - my $r; - if ($pii->{occurrence} =~ /n$/) { - $r = - $self->_validate_changes_multiple($newi, $pii, $ppi, - $errors); - } elsif (ref $pii->{format} eq 'HASH') { - $r = - $self->_validate_changes_paragraph($newi, $pii, $ppi, - $errors); - } else { - $r = - $self->_validate_changes_leaf($newi, $pii, $ppi, $errors); - } - - return undef unless defined $r; - delete $new->{$key} if $r eq 'omit'; - $ret = 'invalid' if $r eq 'invalid'; - } - - return 'omit' unless %$new; - } - - return $ret; -} - -my %validations = ( - # Checking that list editor address is not set to editor special address. - list_editor_address => sub { - my $self = shift; - my $new = shift; - - my $list = $self->{context}; - - my $email = Sympa::Tools::Text::canonic_email($new); - return 'syntax_errors' - unless defined $email; - - return 'incorrect_email' - if Sympa::get_address($list, 'editor') eq $new; - }, - # Checking that list owner address is not set to one of the special - # addresses. - list_special_addresses => sub { - my $self = shift; - my $new = shift; - - my $list = $self->{context}; - - my $email = Sympa::Tools::Text::canonic_email($new); - return 'syntax_errors' - unless defined $email; - - my @special = (); - push @special, - map { Sympa::get_address($list, $_) } - qw(owner editor return_path subscribe unsubscribe); - push @special, map { - sprintf '%s-%s@%s', - $list->{'name'}, lc $_, $list->{'domain'} - } - split /[,\s]+/, - Conf::get_robot_conf($list->{'domain'}, 'list_check_suffixes'); - my $bounce_email_re = quotemeta($list->get_bounce_address('ANY')); - $bounce_email_re =~ s/(?<=\\\+).*(?=\\\@)/.*/; - - return 'incorrect_email' - if grep { $email eq $_ } @special - or $email =~ /^$bounce_email_re$/; - }, +use constant _local_validations => { # Checking no topic named "other". reserved_msg_topic_name => sub { my $self = shift; @@ -1059,102 +197,7 @@ my %validations = ( return 'topic_other' if lc $new eq 'other'; }, - # Avoid duplicate parameter values in the array. - unique_paragraph_key => sub { - my $self = shift; - my $new = shift; - my $pitem = shift; - my $ppaths = shift; - - my @p_ppaths = (@$ppaths); - my $keyname = pop @p_ppaths; - my $i = pop @p_ppaths; - return unless defined $i and $i =~ /\A\d+\z/; - return if $i == 0; - - my ($p_cur) = $self->get(join '.', @p_ppaths); - $p_cur ||= []; - my @p_curkeys = map { $_->{$keyname} } @$p_cur; - - my ($p_new) = $self->get_change(join '.', @p_ppaths); - my %p_newkeys = - map { - (exists $p_new->{$_}->{$keyname}) - ? ($_ => $p_new->{$_}->{$keyname}) - : () - } (CORE::keys %$p_new); - - foreach my $j (0 .. $i - 1) { - next unless exists $p_newkeys{$j}; - $p_curkeys[$j] = $p_newkeys{$j}; - } - foreach my $j (0 .. $i - 1) { - next unless defined $p_curkeys[$j]; - if ($p_curkeys[$j] eq $new) { - return qw(unique_paragraph_key omit); - } - } - }, -); - -# Validates leaf. -sub _validate_changes_leaf { - my $self = shift; - my $new = shift; - my $pitem = shift; - my $ppaths = shift; - my $errors = shift; - - # If the parameter corresponds to a scenario or a task, mark it - # as changed if its name was changed. Example: 'subscribe'. - if ($pitem->{scenario} or $pitem->{task}) { - $new = $new->{name} if defined $new; - } - - if (not defined $new and $pitem->{occurrence} =~ /^1/) { - push @$errors, - [ - 'user', 'mandatory_parameter', - {p_info => $pitem, p_paths => $ppaths} - ]; - return 'omit'; - } - - # Check that the new values have the right syntax. - if (defined $new) { - my $format = $pitem->{format}; - if (ref $format eq 'ARRAY' and not grep { $new eq $_ } @$format) { - push @$errors, - [ - 'user', 'syntax_errors', - {p_info => $pitem, p_paths => $ppaths, value => $new} - ]; - return 'invalid'; - } elsif (ref $format ne 'ARRAY' and not $new =~ /^$format$/) { - push @$errors, - [ - 'user', 'syntax_errors', - {p_info => $pitem, p_paths => $ppaths, value => $new} - ]; - return 'invalid'; - } - foreach my $validation (@{$pitem->{validations} || []}) { - next unless ref $validations{$validation} eq 'CODE'; - my ($error, $validity) = - $validations{$validation}->($self, $new, $pitem, $ppaths); - next unless $error; - - push @$errors, - [ - 'user', $error, - {p_info => $pitem, p_paths => $ppaths, value => $new} - ]; - return $validity || 'invalid'; - } - } - - return 'valid'; -} +}; sub commit { my $self = shift; @@ -1167,132 +210,15 @@ sub commit { # Updating config_changes for changed parameters. # FIXME:Check subitems also. if (ref($list->get_family) eq 'Sympa::Family') { - unless ( - $list->update_config_changes('param', [_keys($changes, $pinfo)])) - { + unless ($list->update_config_changes( + 'param', [CORE::keys %{$changes || {}}] + )) { push @$errors, ['intern', 'update_config_changes']; return undef; } } - # Undefined {_config} means list creation. - # Empty hashref means loading existing config. - my $init = (not defined $self->{_config}); - my $loading = ($self->{_config} and not %{$self->{_config}}); - my $cur = $init ? {} : $self->{_config}; - $self->_apply_defaults($cur, $pinfo, init => ($init and not $loading)); - - foreach my $pname (_keys($self->{_changes}, $pinfo)) { - my $curi = $cur->{$pname}; - my $newi = $self->{_changes}->{$pname}; - my $pii = $pinfo->{$pname}; - - unless (defined $newi) { - delete $cur->{$pname}; - } elsif ($pii->{occurrence} =~ /n$/) { - $curi = $cur->{$pname} = [] unless defined $curi; - $self->_merge_changes_multiple($curi, $newi, $pii, - loading => $loading); - } elsif (ref $pii->{format} eq 'HASH') { - my $init = (not defined $curi); - $curi = $cur->{$pname} = {} if $init; - $self->_merge_changes_paragraph( - $curi, $newi, $pii, - init => $init, - loading => $loading - ); - } else { - $cur->{$pname} = $newi; - } - } - - $self->{_config} = $cur if $init; - - # Update 'defaults' item to indicate default settings, for compatibility. - #FIXME:Multiple levels of keys should be possible. - foreach my $pname (_keys($self->{_changes}, $pinfo)) { - if (defined $self->{_changes}->{$pname} - or $pinfo->{$pname}->{internal}) { - delete $self->{_config}->{defaults}->{$pname}; - } else { - $self->{_config}->{defaults}->{$pname} = 1; - } - } -} - -sub _merge_changes_multiple { - my $self = shift; - my $cur = shift; - my $new = shift; - my $pitem = shift; - my %options = @_; - - foreach my $i (reverse sort { $a <=> $b } CORE::keys %$new) { - my $curi = $cur->[$i]; - my $newi = $new->{$i}; - - unless (defined $new->{$i}) { - splice @$cur, $i, 1; - } elsif (ref $pitem->{format} eq 'HASH') { - my $init = (not defined $curi); - $curi = $cur->[$i] = {} if $init; - $self->_merge_changes_paragraph( - $curi, $newi, $pitem, - init => $init, - loading => $options{loading} - ); - } else { - $cur->[$i] = $newi; - } - } - - # The set: Dedupe and sort. - if (ref $pitem->{format} eq 'ARRAY') { - my %elements = map { ($_ => 1) } grep { defined $_ } @$cur; - @$cur = sort(CORE::keys %elements); - } -} - -# Merges changes on paragraph node. -# The init option means node creation. -sub _merge_changes_paragraph { - my $self = shift; - my $cur = shift; - my $new = shift; - my $pitem = shift; - my %options = @_; - - $self->_apply_defaults($cur, $pitem->{format}, - init => ($options{init} and not $options{loading})); - - foreach my $key (_keys($new, $pitem->{format})) { - my $curi = $cur->{$key}; - my $newi = $new->{$key}; - my $pii = $pitem->{format}->{$key}; - - unless (defined $newi) { - delete $cur->{$key}; - } elsif ($pii->{occurrence} =~ /n$/) { - $curi = $cur->{$key} = [] unless defined $curi; - $self->_merge_changes_multiple($curi, $newi, $pii, - loading => $options{loading}); - } elsif (ref $pii->{format} eq 'HASH') { - my $init = (not defined $curi); - $curi = $cur->{$key} = {} if $init; - $self->_merge_changes_paragraph( - $curi, $newi, $pii, - init => $init, - loading => $options{loading} - ); - } else { - $cur->{$key} = $newi; - } - } -} - -sub get_id { - my $list = shift->{context}; - $list ? $list->get_id : ''; + $self->SUPER::commit($errors); } 1; @@ -1330,45 +256,14 @@ Creates new instance of L object. Parameters: +See also L. + =over =item $list Context. An instance of L class. -=item config =E $initial_config - -Initial configuration. - -=over - -=item * - -When the list will be initially created, -C must be specified explicitly -so that default parameter values will be completed. - -=item * - -When existing list will be instantiated and config will be loaded, -C<{}> (default) would be specified -so that default parameter values except optional ones -(with occurrence C<'0-1'> or C<'0-n'>) will be completed. - -=item * - -Otherwise, default parameter values are completed -only when the new paragraph node will be added by submit(). - -=back - -Note that initial configuration will never be sanitized. - -=item copy =E 1 - -Uses deep copy of initial configuration (see L) -instead of real reference. - =item no_family =E 1 Won't apply family constraint. @@ -1378,64 +273,6 @@ See also L. =back -=item get ( $ppath ) - -I. -Gets copy of current value of parameter. - -Parameter: - -=over - -=item $ppath - -Parameter path, -e.g.: C<'owner.0.email'> specifies "email" parameter of -the first "owner" paragraph; -C<'owner.0'> specifies the first "owner" paragraph; -C<'owner'> specifies the array of all "owner" paragraph. - -=back - -Returns: - -Value of parameter. -If parameter or value does not exist, returns C in scalar context -and an empty list in array context. - -=item get_change ( $ppath ) - -I. -Gets copy of submitted change on parameter. - -Parameter: - -=over - -=item $ppath - -Parameter path. -See also get(). - -=back - -Returns: - -If value won't be changed, returns empty list in array context -and C in scalar context. -If value would be deleted, returns C. - -Changes on the array are given by hashref -with keys as affected indexes of the array. - -=item get_changeset ( ) - -I. -Gets all submitted changes. - -Note that returned value is the real reference to internal information. -Any modifications might break it. - =item get_schema ( [ $user ] ) I. @@ -1454,249 +291,15 @@ for the user. =back -=item keys ( [ $pname ] ) - -I. -Gets parameter keys in order defined by schema. - -Parameter: - -=over - -=item $pname - -Full parameter name, e.g. C<'owner'>. -If omitted or false value, -returns keys of top-level parameters. - -=back - -Returns: - -List of keys. -If parameter does not exist or it does not have sub-parameters, -i.e. it is not the paragraph, empty list. - -=item submit ( $new, $user, \@errors ) - -I. -Submits change and verifies it. -Submission is done by: - -=over - -=item * - -Sanitizing changes: - -Omits unknown parameters, -resolves parameter aliases, -omits malformed change information, -omits obsoleted parameters, -omits changes on unwritable parameters, -removes nodes under which required children nodes will be removed, -resolves synonym of input values, -canonicalizes inputs (see L), -and omits identical changes. - -=item * - -Verifying changes: - -Omits removal of mandatory parameters, -checks format of inputs, -and performs additional validations (see L). - -=back - -Parameters: - -=over - -=item $new - -Changes to be submitted, hashref. - -=item $user - -Email of the user requesting submission. - -=item \@errors - -If errors occur, they will be pushed in this arrayref. -Each element is arrayref C<[ I, I, I ]>: - -=over - -=item I - -One of C<'user'> (failure), C<'intern'> (internal failure) -and C<'notice'> (successful notice). - -=item I - -A keyword to determine error. - -=item I - -Optional hashref with keys: -C for schema item of parameter; -C for elements of parameter path; -C for erroneous value (optional). - -=back - -=back - -Returns: - -If no changes found (or all changes were omitted), an empty string C<''>. -If any errors found in input, C<'invalid'>. -Otherwise, C<'valid'>. - -In case any changes are submitted, -changeset may be accessible by get_change() or get_changeset(). - -=item commit ( [ \@errors ] ) - -I. -Merges changes set by sbumit() into actual configuration. - -Parameter: - -=over - -=item \@errors - -Arrayref. -See \@errors in submit(). - -=back - -Returns: - -None. -Errors will be stored in arrayref. - =back =head2 Attribute -Instance of L has following attribute. - -=over - -=item {context} - -Context, L instance. - -=back - -=head2 Structure of configuration - -Configuration on the memory is represented by a hashref, -with its keys as node names and values as node values. - -=head3 Node types - -Each node of configuration has one of following four types. -Some of them can include other type of nodes recursively. - -=over - -=item Set (multiple enumerated values) - -Arrayref. -In the schema, defined with: - -=over - -=item * - -{occurrence}: C<'0-n'> or C<'1-n'>. - -=item * - -{format}: Arrayref. - -=back - -List of unique items not considering order. -Items are scalars, and cannot be special values (scenario or task). -The set cannot contain paragraphs, sets or arrays. - -=item Array (multiple values) - -Arrayref. -In the schema, defined with: - -=over - -=item * - -{occurrence}: C<'0-n'> or C<'1-n'>. - -=item * - -{format}: Regexp or hashref. - -=back - -List of the same type of nodes in order. -Type of all nodes can be one of paragraph, -scalar or special value (scenario or task). -The array cannot contain sets or arrays. - -=item Paragraph (structured value) - -Hashref. -In the schema, defined with: - -=over - -=item * - -{occurrence}: If the node is an item of array, C<'0-n'> or C<'1-n'>. -Otherwise, C<'0-1'> or C<'1'>. - -=item * - -{format}: Hashref. - -=back - -Compound node of one or more named nodes. -Paragraph can contain any type of nodes, and each of their names and types -are defined as member of {format} item in schema. - -=item Leaf (simple value) - -Scalar, or hashref for special value (scenario or task). -In the schema, defined with: - -=over - -=item * - -{occurrence}: If the node is an item of array, C<'0-n'> or C<'1-n'>. -Otherwise, C<'0-1'> or C<'1'>. - -=item * - -{format}: If the node is an item of array, regexp. -Otherwise, regexp or arrayref. - -=back - -Scalar or special value (scenario or task). -Leaf cannot contain any other nodes. - -=back +See L. =head2 Family constraint The family (see L) adds additional constraint to schema. -The family constraint =over @@ -1726,6 +329,7 @@ TBD. =head1 SEE ALSO +L, L, L. @@ -1735,4 +339,3 @@ L appeared on Sympa 6.2.17. =cut -# -*- indent-tabs-mode: nil; -*- diff --git a/src/lib/Sympa/List/Users.pm b/src/lib/Sympa/List/Users.pm new file mode 100644 index 000000000..d6b2a2b9f --- /dev/null +++ b/src/lib/Sympa/List/Users.pm @@ -0,0 +1,293 @@ +# -*- indent-tabs-mode: nil; -*- +# vim:ft=perl:et:sw=4 +# $Id$ + +# Sympa - SYsteme de Multi-Postage Automatique +# +# Copyright 2018 The Sympa Community. See the AUTHORS.md file at the +# top-level directory of this distribution and at +# . +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +package Sympa::List::Users; + +use strict; +use warnings; + +use Conf; +use Sympa::ListDef; +use Sympa::Log; +use Sympa::Tools::Text; + +use base qw(Sympa::List::Config); + +my $log = Sympa::Log->instance; + +sub _schema { + my $self = shift; + + return {%Sympa::ListDef::user_info}; +} + +# The 'owner_domain' option is an example of this need. The restriction applies +# to the entire set of owner addresses, not just a single owner. +use constant _global_validations => { + owner_domain => sub { + my $self = shift; + my $new = shift; + + my $pinfo = $self->{_pinfo}; + my $loglevel = 'debug'; # was set to 'info' during development + + # gather parameters + my $owner_domain = $self->get('owner_domain'); + if (defined($self->get_change('owner_domain'))) { + $owner_domain = $self->get_change('owner_domain'); + } + (my $domainrex = "[.\@]($owner_domain)\$") =~ s/ /|/g; + + my $owner_domain_min = $self->get('owner_domain_min'); + if (defined($self->get_change('owner_domain_min'))) { + $owner_domain_min = $self->get_change('owner_domain_min'); + } + $owner_domain_min ||= 0; + + # if no owner_domain setting, do nothing + return if ($owner_domain =~ /^\s*$/); + + # calculate updated owner list, including deletions + my @owner = map { $_->{'email'} } @{$self->get('owner')}; + my $changes = $self->get_change('owner'); + map { $owner[$_] = $changes->{$_}->{'email'} } + CORE::keys %{$changes || {}}; + @owner = grep defined, @owner; + + # count matches and non-matches + my @non_matching_owners = grep {!/$domainrex/} @owner; + my @matching_owners = grep {/$domainrex/} @owner; + + my $non_matching_count = 1 + $#non_matching_owners; + my $matching_owner_count = 1 + $#matching_owners; + + # logging + $log->syslog($loglevel, "owner_domain: $owner_domain"); + $log->syslog($loglevel, "owner_domain_min: $owner_domain_min"); + $log->syslog($loglevel, "owners: " . join(",", @owner)); + $log->syslog($loglevel, "total owners: " . ($#owner + 1)); + $log->syslog($loglevel, "domainrex: $domainrex"); + $log->syslog($loglevel, "matching_owners: " . join(",", @matching_owners)); + $log->syslog($loglevel, "matching_owner_count: $matching_owner_count"); + $log->syslog($loglevel, "non_matching_owners: " . join(",", @non_matching_owners)); + $log->syslog($loglevel, "non_matching_count: $non_matching_count"); + + # apply different rules based on min domain requirement + if ($owner_domain_min == 0) { + return ('owner_domain', + {p_info => $pinfo->{'owner'}, + p_paths => ['owner'], + owner_domain => $owner_domain, + value => join(' ', @non_matching_owners)}) + unless ($non_matching_count == 0); + } else { + return ('owner_domain_min', + {p_info => $pinfo->{'owner'}, + p_paths => ['owner'], + owner_domain => $owner_domain, + owner_domain_min => $owner_domain_min, + value => $matching_owner_count}) + unless ($matching_owner_count >= $owner_domain_min); + } + return ''; + }, +}; + +use constant _local_validations => { + # Checking that list editor address is not set to editor special address. + list_editor_address => sub { + my $self = shift; + my $new = shift; + + my $list = $self->{context}; + + my $email = Sympa::Tools::Text::canonic_email($new); + return 'syntax_errors' + unless defined $email; + + return 'incorrect_email' + if Sympa::get_address($list, 'editor') eq $new; + }, + # Checking that list owner address is not set to one of the special + # addresses. + list_special_addresses => sub { + my $self = shift; + my $new = shift; + + my $list = $self->{context}; + + my $email = Sympa::Tools::Text::canonic_email($new); + return 'syntax_errors' + unless defined $email; + + my @special = (); + push @special, + map { Sympa::get_address($list, $_) } + qw(owner editor return_path subscribe unsubscribe); + push @special, map { + sprintf '%s-%s@%s', + $list->{'name'}, lc $_, $list->{'domain'} + } + split /[,\s]+/, + Conf::get_robot_conf($list->{'domain'}, 'list_check_suffixes'); + my $bounce_email_re = quotemeta($list->get_bounce_address('ANY')); + $bounce_email_re =~ s/(?<=\\\+).*(?=\\\@)/.*/; + + return 'incorrect_email' + if grep { $email eq $_ } @special + or $email =~ /^$bounce_email_re$/; + }, + # Avoid duplicate parameter values in the array. + unique_paragraph_key => sub { + my $self = shift; + my $new = shift; + my $pitem = shift; + my $ppaths = shift; + + my @p_ppaths = (@$ppaths); + my $keyname = pop @p_ppaths; + my $i = pop @p_ppaths; + return unless defined $i and $i =~ /\A\d+\z/; + return if $i == 0; + + my ($p_cur) = $self->get(join '.', @p_ppaths); + $p_cur ||= []; + my @p_curkeys = map { $_->{$keyname} } @$p_cur; + + my ($p_new) = $self->get_change(join '.', @p_ppaths); + my %p_newkeys = + map { + (exists $p_new->{$_}->{$keyname}) + ? ($_ => $p_new->{$_}->{$keyname}) + : () + } (CORE::keys %$p_new); + + foreach my $j (0 .. $i - 1) { + next unless exists $p_newkeys{$j}; + $p_curkeys[$j] = $p_newkeys{$j}; + } + foreach my $j (0 .. $i - 1) { + next unless defined $p_curkeys[$j]; + if ($p_curkeys[$j] eq $new) { + return qw(unique_paragraph_key omit); + } + } + }, +}; + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Sympa::List::Users - List users + +=head1 SYNOPSIS + + use Sympa::List::Users; + my $config = Sympa::List::Users->new($list, {...}); + + my $errors = []; + my $validity = $config->submit({...}, $user, $errors); + $config->commit($errors); + + my ($value) = $config->get('owner.0.gecos'); + my @keys = $config->keys('owner'); + +=head1 DESCRIPTION + +=head2 Methods + +=over + +=item new ( $list, [ config =E $initial_config ], [ copy =E 1 ], +[ no_family =E 1 ] ) + +I. +Creates new instance of L object. + +Parameters: + +See also L. + +=over + +=item $list + +Context. An instance of L class. + +=item no_family =E 1 + +Won't apply family constraint. +By default, the constraint will be applied if the list is belonging to +family. +See also L. + +=back + +=item get_schema ( [ $user ] ) + +I. +Get configuration schema as hashref. +See L about structure of schema. + +Parameter: + +=over + +=item $user + +Email address of a user. +If specified, adds C<'privilege'> attribute taken from L +for the user. + +=back + +=back + +=head2 Attribute + +See L. + +=head2 Filters + +TBD. + +=head2 Validations + +TBD. + +=head1 SEE ALSO + +L, +L, +L. + +=head1 HISTORY + +L appeared on Sympa 6.2.33b.2. + +=cut + From 448d6af9807dc29f971414aa031740568adee8e3 Mon Sep 17 00:00:00 2001 From: IKEDA Soji Date: Tue, 19 Jun 2018 18:13:27 +0900 Subject: [PATCH 2/5] Update review.tt2 --- default/web_tt2/review.tt2 | 227 ++++++++++++++++++++----------------- src/cgi/wwsympa.fcgi.in | 174 ++++++++++++++++++++++------ src/lib/Sympa/ListDef.pm | 12 +- 3 files changed, 265 insertions(+), 148 deletions(-) diff --git a/default/web_tt2/review.tt2 b/default/web_tt2/review.tt2 index d9a2a2e3e..032f524c2 100644 --- a/default/web_tt2/review.tt2 +++ b/default/web_tt2/review.tt2 @@ -1,6 +1,6 @@ -[% IF page.match('^\d*$') ~%] +[% IF !page || page.match('^\d*$') ~%] [% PROCESS ReviewMembers ~%] [%~ ELSIF page == 'owner' ~%] [% PROCESS ReviewUsers @@ -226,11 +226,21 @@ [%~ BLOCK ReviewUsers # (role,users) ~%] + [% SET pS = config_schema.0 ~%] + [% SET pV = config_values.${pS.name} ~%] + [% SET pF = { + email => 'small-6 medium-4 columns', + gecos => 'small-6 medium-4 columns', + reception => 'medium-2 columns show-for-medium', + visibility => 'medium-2 columns show-for-medium', + info => 'columns', + } ~%] +

- [% IF role == 'owner' ~%] - [%|loc%]Owners[%END%] - [%~ ELSIF role == 'editor' ~%] - [%|loc%]Moderators[%END%] + [% IF pS.title ~%] + [% pS.title %] + [%~ ELSE ~%] + [% pS.name %] [%~ END %]

@@ -238,38 +248,31 @@
- + [%~# FIXME ~%]
-
- -
- -
- -
- -
- -
- -
- + [% FOREACH kS = pS.format ~%] + [% NEXT UNLESS pF.${kS.name} ~%] + [% NEXT UNLESS kS.privilege == 'read' || kS.privilege == 'write' ~%] + +
+
+ [%~ END %] - [% IF is_privileged_owner ~%] -
- -
- [%~ END %] - - +
- [% IF is_privileged_owner ~%] + [% IF pS.privilege == 'write' && is_privileged_owner ~%]
- [% IF users.size() ~%] - [% SET idx = 0 ~%] - [% FOREACH u = users ~%] + [% SET oI = 0 ~%] + [% IF pV.size() ~%] + [% FOREACH oV = pV ~%]
-
-
+
+ [% FOREACH kS = pS.format ~%] + [% NEXT UNLESS pF.${kS.name} ~%] + [% NEXT UNLESS kS.privilege == 'read' || kS.privilege == 'write' ~%] + +
+ [% IF kS.name == 'email' ~%] - [%~ IF role == 'owner' && u.profile == 'privileged' ~%] + [%~ IF pS.name == 'owner' && oV.profile == 'privileged' ~%] - [%~ ELSIF role == 'owner' ~%] + [%~ ELSIF pS.name == 'owner' ~%] - [%~ ELSIF role == 'editor' ~%] + [%~ ELSIF pS.name == 'editor' ~%] [%~ END %] - [% IF is_privileged_owner ~%] - [% u.email %] + class="MainMenuLinks">[% oV.email %] [%~ ELSE ~%] - [% u.email %] + [% oV.email %] [%~ END %] -
- -
- [% u.gecos || ' ' %] -
- -
- [% u.reception | optdesc %] -
- -
- [% u.visibility | optdesc %] -
- - [% IF is_privileged_owner ~%] -
- [% u.info %] -
+ [%~ ELSIF kS.name == 'reception' || kS.name == 'visibility' ~%] + [% oV.${kS.name} | optdesc %] + [%~ ELSE ~%] + [% oV.${kS.name} || ' ' %] [%~ END %] +
+ [%~ END %]
- [% IF is_privileged_owner ~%]
- [% IF u.subscribed ~%] - - [%~ ELSIF u.included ~%] + value="[% oV.email %]" /> + [%~ ELSE ~%]   [%~ END %]
- [%~ END %]
- [%~ SET idx = idx + 1 %] + [%~ SET oI = oI + 1 %] [%~ END %] [%~ ELSE ~%]

- [% IF role == 'owner' ~%] + [% IF pS.name == 'owner' ~%] [%|loc%]List has no owners[%END%] - [%~ ELSIF role == 'editor' ~%] + [%~ ELSIF pS.name == 'editor' ~%] [%|loc%]List has no moderators[%END%] [%~ END %]

[%~ END %] - [% IF is_privileged_owner ~%] + [% FOREACH kS = pS.format; + IF kS.name == 'email' && kS.privilege == 'write'; + SET is_writable = 1; + LAST; + END; + END ~%] + [% IF is_writable && is_privileged_owner ~%]

- [% IF role == 'owner' ~%] + [% IF pS.name == 'owner' ~%] [%|loc%]Add owners[%END%] - [%~ ELSIF role == 'editor' ~%] + [%~ ELSIF pS.name == 'editor' ~%] [%|loc%]Add moderators[%END%] [%~ END %]

-
+
- [% IF role == 'owner' ~%] -
- - -
- [%~ END %] - -
-
[%~ END %] - + [% IF pS.privilege == 'write' && is_privileged_owner ~%] + + + [% END ~%]
diff --git a/src/cgi/wwsympa.fcgi.in b/src/cgi/wwsympa.fcgi.in index 542ba5387..ee1b8f325 100644 --- a/src/cgi/wwsympa.fcgi.in +++ b/src/cgi/wwsympa.fcgi.in @@ -67,6 +67,8 @@ use Sympa::Family; use Sympa::HTMLSanitizer; use Sympa::Language; use Sympa::List; +use Sympa::List::Config; +use Sympa::List::Users; use Sympa::Log; use Sympa::Message; use Sympa::Regexps; @@ -821,6 +823,7 @@ our %in_regexp = ( ## List config parameters 'single_param' => '.+', 'multiple_param' => '.+', + 'deleted_param' => '.+', ## Textarea content 'template_content' => '.+', @@ -4790,49 +4793,150 @@ sub _review_user { unless Sympa::is_listmaster($list, $param->{'user'}{'email'}) or $list->is_admin('owner', $param->{'user'}{'email'}); - # Delete/add users. - my @del_users = grep {$_} map { Sympa::Tools::Text::canonic_email($_) } - split /\0/, $in{'del_emails'}; - my $new_users = [ - grep { $_ and $_->{email} } - @{(_deserialize_changes() || {})->{user} || []} - ]; - foreach my $email (@del_users) { - next if grep {$email eq $_->{email}} @$new_users; - $list->delete_list_admin($role, $email); - } - foreach my $user (@{(ref $new_users eq 'ARRAY') ? $new_users : []}) { - my $email = $user->{email}; - if (grep {$email eq $_} @del_users) { - ; #FIXME: Update user? - } else { - unless ($list->add_list_admin($role, $user)) { - #FIXME: Report error + my $new_admin = _deserialize_changes(); + if ($in{'submit'} and $new_admin and %$new_admin) { + delete $in{'submit'}; + + my $users = + [grep { $_->{role} eq $role } @{$list->get_current_admins || []}]; + + my @deleted_emails = + map {$in{$_}} + grep {/\Adeleted_param[.]$role[.]\d+\z/} keys %in; + my $update_admin = {$role => [ + map { + my $email = $_->{email}; + (grep {$email eq $_} @deleted_emails) ? {email => undef} : $_; + } ( + @$users, + grep { $_ and $_->{email} } @{$new_admin->{$role} || []} + ) + ]}; + + my $config = + Sympa::List::Users->new($list, config => {$role => $users}); + my $errors = []; + + my $validity = + $config->submit($update_admin, $param->{'user'}{'email'}, $errors); + unless (defined $validity) { + if (my @intern = grep { $_->[0] eq 'intern' } @$errors) { + foreach my $err (@intern) { + Sympa::WWW::Report::reject_report_web($err->[0], $err->[1], + {}, $param->{'action'}, $list); + wwslog('err', 'Internal error %s', $err->[1]); + } } else { - # Notify the new list owner/editor - Sympa::send_notify_to_user( - $list, - 'added_as_listadmin', - $email, - { admin_type => $role, - delegator => $param->{'user'}{'email'} + Sympa::WWW::Report::reject_report_web('intern', 'unknown', {}, + $param->{'action'}, $list); + wwslog('err', 'Unknown error'); + } + web_db_log( + { 'status' => 'error', + 'error_type' => 'internal' + } + ); + return undef; + } + + my $error_return = 0; + foreach my $err (grep { $_->[0] eq 'user' } @$errors) { + $error_return = 1 unless $err->[1] eq 'mandatory_parameter'; + + Sympa::WWW::Report::reject_report_web( + $err->[0], + $err->[1], + { 'p_name' => + $language->gettext($err->[2]->{p_info}->{gettext_id}), + %{$err->[2]} + }, + $param->{'action'}, + $list + ); + wwslog( + 'err', + 'Error on parameter %s: %s', + join('.', @{$err->[2]->{p_paths}}), + $err->[1] + ); + web_db_log( + { 'status' => 'error', + 'error_type' => 'syntax_errors' + } + ); + } + if ($error_return) { + ; + } elsif ($validity eq '') { + Sympa::WWW::Report::notice_report_web('no_parameter_edited', + {}, $param->{'action'}); + wwslog('info', 'No parameter was edited by user'); + } else { + # Validation of the form finished. Start of valid data treatments. + + # Delete/add users. + my @del_users = map { + my $email; + if ($_ =~ /\Adeleted_param[.]$role[.]\d+\z/) { + $email = Sympa::Tools::Text::canonic_email($in{$_}); + $email ? ($email) : (); + } else { + (); + } + } keys %in; + my $new_users = [ + grep { $_ and $_->{email} } @{($new_admin || {})->{$role} || []} + ]; + + foreach my $email (@del_users) { + next if grep {$email eq $_->{email}} @$new_users; + $list->delete_list_admin($role, $email); + } + foreach my $user + (@{(ref $new_users eq 'ARRAY') ? $new_users : []}) { + my $email = $user->{email}; + if (grep {$email eq $_} @del_users) { + ; #FIXME: Update user? + } else { + unless ($list->add_list_admin($role, $user)) { + #FIXME: Report error + } else { + # Notify the new list owner/editor + Sympa::send_notify_to_user( + $list, + 'added_as_listadmin', + $email, + { admin_type => $role, + delegator => $param->{'user'}{'email'} + } + ); + Sympa::WWW::Report::notice_report_web('user_notified', + {'notified_user' => $email}, + $param->{'action'}); } - ); - Sympa::WWW::Report::notice_report_web('user_notified', - {'notified_user' => $email}, - $param->{'action'}); + } } } } - # Users list my $users = [grep { $_->{role} eq $role } @{$list->get_current_admins || []}]; - foreach my $user (@$users) { - $user->{sources} = $list->get_datasource_name($user->{id}) - if $user->{id}; - } - $param->{($role eq 'owner') ? 'owners' : 'editors'} = $users; + my $config = + Sympa::List::Users->new($list, config => {$role => $users}); + my $schema = $config->get_schema($param->{'user'}{'email'}); + my @schema = _do_edit_list_request($config, $schema->{$role}, [$role]); + + # If at least one param was editable, make the update button appear in + # the form. + $param->{'is_form_editable'} = + grep { $_->{privilege} eq 'write' } @schema; + $param->{'config_schema'} = [@schema]; + $param->{'config_values'} = { + map { + my @value = $config->get($_->{name}); + @value ? ($_->{name} => $value[0]) : (); + } @schema + }; return 1; } diff --git a/src/lib/Sympa/ListDef.pm b/src/lib/Sympa/ListDef.pm index 5959db8ca..d0a119eb0 100644 --- a/src/lib/Sympa/ListDef.pm +++ b/src/lib/Sympa/ListDef.pm @@ -2490,7 +2490,7 @@ our %user_info = ( 'Owners are managing subscribers of the list. They may review subscribers and add or delete email addresses from the mailing list. If you are a privileged owner of the list, you can choose other owners for the mailing list. Privileged owners may edit a few more options than other owners. ', format => { email => { - order => 1, + order => 2, gettext_id => "email address", format_s => '$email', occurrence => '1', @@ -2500,33 +2500,33 @@ our %user_info = ( [qw(list_special_addresses unique_paragraph_key)], }, gecos => { - order => 2, + order => 3, gettext_id => "name", format => '.+', length => 30 }, info => { - order => 3, + order => 6, gettext_id => "private information", format => '.+', length => 30 }, profile => { - order => 4, + order => 1, gettext_id => "profile", format => ['privileged', 'normal'], occurrence => '1', default => 'normal' }, reception => { - order => 5, + order => 4, gettext_id => "reception mode", format => ['mail', 'nomail'], occurrence => '1', default => 'mail' }, visibility => { - order => 6, + order => 5, gettext_id => "visibility", format => ['conceal', 'noconceal'], occurrence => '1', From e67ebf9f4d63eefe91c4cfd3e4db3694523a7b45 Mon Sep 17 00:00:00 2001 From: IKEDA Soji Date: Tue, 19 Jun 2018 18:14:42 +0900 Subject: [PATCH 3/5] Update edit.tt2 --- default/Makefile.am | 1 + default/web_tt2/config_common.tt2 | 219 +++++++++++++++++++++++++ default/web_tt2/edit.tt2 | 106 ++++-------- default/web_tt2/edit_list_request.tt2 | 222 +------------------------- default/web_tt2/nav.tt2 | 2 +- src/cgi/wwsympa.fcgi.in | 144 ++++++++++------- src/lib/Sympa/ListDef.pm | 6 +- 7 files changed, 345 insertions(+), 355 deletions(-) create mode 100644 default/web_tt2/config_common.tt2 diff --git a/default/Makefile.am b/default/Makefile.am index 4e85f08d6..c2303d7c0 100644 --- a/default/Makefile.am +++ b/default/Makefile.am @@ -211,6 +211,7 @@ nobase_default_DATA = \ web_tt2/change_email_request.tt2 \ web_tt2/choosepasswd.tt2 \ web_tt2/compose_mail.tt2 \ + web_tt2/config_common.tt2 \ web_tt2/confirm_action.tt2 \ web_tt2/copy_template.tt2 \ web_tt2/crash.tt2 \ diff --git a/default/web_tt2/config_common.tt2 b/default/web_tt2/config_common.tt2 new file mode 100644 index 000000000..d751f2178 --- /dev/null +++ b/default/web_tt2/config_common.tt2 @@ -0,0 +1,219 @@ +[%# Block definitions ~%] + +[%~ BLOCK EditListSet # (ppaths,pitem,val) ~%] + + [% IF pitem.privilege == 'write' ~%] + + [%~ ELSE ~%] + [% FOREACH enum = pitem.format ~%] + [% FOREACH v = val ~%] + [% IF enum == v ~%] + [%~ IF pitem.field_type == 'lang' ~%] + + [%~ END ~%] + [% enum | optdesc(pitem.field_type,is_listmaster) %] + [%~ IF pitem.field_type == 'lang' ~%] + + [%~ END %] + + [%~ LAST %] + [%~ END %] + [% END %] + [%~ END %] + [%~ END %] + +[%~ END ~%] + +[%~ BLOCK EditListArrayDel # (ppaths,pitem) ~%] + + [% IF pitem.privilege == 'write' ~%] + + + [%~ END %] + +[%~ END ~%] + +[%~ BLOCK EditListLeaf # (ppaths,pitem,val) ~%] + [% IF pitem.enum ~%] + [% PROCESS EditListEnum %] + [%~ ELSIF pitem.scenario ~%] + [% PROCESS EditListScenario %] + [%~ ELSIF pitem.task ~%] + [% PROCESS EditListTask %] + [%~ ELSIF pitem.datasource ~%] + [% PROCESS EditListDatasource %] + [%~ ELSE ~%] + [% PROCESS EditListScalar %] + [%~ END %] +[%~ END ~%] + +[%~ BLOCK EditListEnum # (ppaths,pitem,val) ~%] + + [% IF pitem.privilege == 'write' ~%] + + [%~ ELSE ~%] + [% FOREACH enum = pitem.format ~%] + [% IF enum == val ~%] + [% IF pitem.field_type == 'lang' ~%] + + [%~ END ~%] + [% enum | optdesc(pitem.field_type,is_listmaster) %] + [%~ IF pitem.field_type == 'lang' ~%] + + [%~ END %] + + [%~ LAST %] + [%~ END %] + [%~ END %] + [%~ END %] + +[%~ END ~%] + +[%~ BLOCK EditListScenario # (ppaths,pitem,val) ~%] + + [% IF pitem.privilege == 'write' ~%] + + [%~ ELSE ~%] + [% FOREACH scenario = pitem.format ~%] + [% IF scenario.value.name == val.name ~%] + [% scenario.value.title %] + [%~ IF is_listmaster %] ([% scenario.value.name %])[% END %] + [%~ END %] + [%~ END %] + [%~ END %] + +[%~ END ~%] + +[%~ BLOCK EditListTask # (ppaths,pitem,val) ~%] + + [% IF pitem.privilege == 'write' ~%] + + [%~ ELSE ~%] + [% FOREACH task = pitem.format ~%] + [% IF task.value.name == val.name ~%] + [% task.value.title %] + [%~ IF is_listmaster %] ([% task.value.name %])[% END %] + [%~ END %] + [%~ END %] + [%~ END %] + +[%~ END ~%] + +[%~ BLOCK EditListDatasource # (ppaths,pitem,val) ~%] + + [% IF pitem.privilege == 'write' ~%] + + [%~ ELSE ~%] + [% FOREACH source = pitem.format ~%] + [% IF source.value.name == val ~%] + [% source.value.title %] + [%~ IF is_listmaster %] ([% source.value.name %])[% END %] + [%~ END %] + [%~ END %] + [%~ END %] + +[%~ END ~%] + +[%~ BLOCK EditListScalar # (ppaths,pitem,val) ~%] + + [% IF pitem.privilege == 'write' ~%] + [% IF pitem.unit ~%] + [%# FIXME %] + [%~ END %] + + [% IF pitem.unit ~%] + + [%~ END %] + + [% pitem.unit %] + [%~ ELSE ~%] + [% IF pitem.field_type == 'lang' ~%] + + [%~ END ~%] + [% IF pitem.field_type ~%] + [% val | optdesc(pitem.field_type,is_listmaster) %] + [%~ ELSE ~%] + [% val %] + [%~ END %] + [%~ IF pitem.field_type == 'lang' ~%] + + [%~ END %] + + [% IF val.length() ~%] + [% pitem.unit %] + [%~ END %] + [%~ END %] + +[%~ END ~%] diff --git a/default/web_tt2/edit.tt2 b/default/web_tt2/edit.tt2 index 84d19dc82..b91f14c9e 100644 --- a/default/web_tt2/edit.tt2 +++ b/default/web_tt2/edit.tt2 @@ -1,8 +1,13 @@ +[% PROCESS config_common.tt2 ~%] + +[% SET pS = config_schema.0 ~%] +[% SET oV = config_values.${pS.name}.0 ~%] +

-[% IF role == 'owner' ~%] +[% IF pS.name == 'owner' ~%] [%|loc%]Owner[%END%] -[%~ ELSIF role == 'editor' ~%] +[%~ ELSIF pS.name == 'editor' ~%] [%|loc%]Moderator[%END%] [%~ ELSE ~%] [% RETURN %] @@ -11,90 +16,41 @@
-[% SET pV = config_values.${role}.0 ~%] - - + +
+[% FOREACH kS = pS.format ~%] + [% NEXT UNLESS kS.privilege == 'read' || kS.privilege == 'write' ~%] + [% IF kS.name == 'subscribed' || kS.name == 'included' || kS.name == 'id' ~%] + [% NEXT %] [%~# FIXME %] + [%~ END %] -
- - [% pV.email %] -
- -
- - -
- -[% IF is_privileged_owner ~%]
- - -
-[%~ END %] + -[% IF role == 'owner' ~%] -
- - [% IF is_listmaster ~%] - - [%~ ELSE ~%] - [% pV.profile | optdesc %] - [%~ END %] + [% IF kS.name == 'email' ~%] + [% oV.${kS.name} %] + [%~ ELSE ~%] + [% PROCESS EditListLeaf + ppaths = [pS.name,0,kS.name] + pitem = kS + val = oV.${kS.name} + %] + [%~ END %]
[%~ END %] -
- - -
- -
- - -
- -
- - [% pV.date | optdesc('unixtime') %] -
- -
- - [% pV.update_date | optdesc('unixtime') %] -
- -[% IF is_privileged_owner ~%] +[% IF pS.privilege == 'write' && is_privileged_owner ~%]
+[% PROCESS config_common.tt2 ~%] +

[%|loc%]Edit List Configuration[%END%] @@ -334,224 +336,4 @@

-[%# Block definitions ~%] - -[%~ BLOCK EditListSet # (ppaths,pitem,val) ~%] - - [% IF pitem.privilege == 'write' ~%] - - [%~ ELSE ~%] - [% FOREACH enum = pitem.format ~%] - [% FOREACH v = val ~%] - [% IF enum == v ~%] - [%~ IF pitem.field_type == 'lang' ~%] - - [%~ END ~%] - [% enum | optdesc(pitem.field_type,is_listmaster) %] - [%~ IF pitem.field_type == 'lang' ~%] - - [%~ END %] - - [%~ LAST %] - [%~ END %] - [% END %] - [%~ END %] - [%~ END %] - -[%~ END ~%] - -[%~ BLOCK EditListArrayDel # (ppaths,pitem) ~%] - - [% IF pitem.privilege == 'write' ~%] - - - [%~ END %] - -[%~ END ~%] - -[%~ BLOCK EditListLeaf # (ppaths,pitem,val) ~%] - [% IF pitem.enum ~%] - [% PROCESS EditListEnum %] - [%~ ELSIF pitem.scenario ~%] - [% PROCESS EditListScenario %] - [%~ ELSIF pitem.task ~%] - [% PROCESS EditListTask %] - [%~ ELSIF pitem.datasource ~%] - [% PROCESS EditListDatasource %] - [%~ ELSE ~%] - [% PROCESS EditListScalar %] - [%~ END %] -[%~ END ~%] - -[%~ BLOCK EditListEnum # (ppaths,pitem,val) ~%] - - [% IF pitem.privilege == 'write' ~%] - - [%~ ELSE ~%] - [% FOREACH enum = pitem.format ~%] - [% IF enum == val ~%] - [% IF pitem.field_type == 'lang' ~%] - - [%~ END ~%] - [% enum | optdesc(pitem.field_type,is_listmaster) %] - [%~ IF pitem.field_type == 'lang' ~%] - - [%~ END %] - - [%~ LAST %] - [%~ END %] - [%~ END %] - [%~ END %] - -[%~ END ~%] - -[%~ BLOCK EditListScenario # (ppaths,pitem,val) ~%] - - [% IF pitem.privilege == 'write' ~%] - - [%~ ELSE ~%] - [% FOREACH scenario = pitem.format ~%] - [% IF scenario.value.name == val.name ~%] - [% scenario.value.title %] - [%~ IF is_listmaster %] ([% scenario.value.name %])[% END %] - [%~ END %] - [%~ END %] - [%~ END %] - -[%~ END ~%] - -[%~ BLOCK EditListTask # (ppaths,pitem,val) ~%] - - [% IF pitem.privilege == 'write' ~%] - - [%~ ELSE ~%] - [% FOREACH task = pitem.format ~%] - [% IF task.value.name == val.name ~%] - [% task.value.title %] - [%~ IF is_listmaster %] ([% task.value.name %])[% END %] - [%~ END %] - [%~ END %] - [%~ END %] - -[%~ END ~%] - -[%~ BLOCK EditListDatasource # (ppaths,pitem,val) ~%] - - [% IF pitem.privilege == 'write' ~%] - - [%~ ELSE ~%] - [% FOREACH source = pitem.format ~%] - [% IF source.value.name == val ~%] - [% source.value.title %] - [%~ IF is_listmaster %] ([% source.value.name %])[% END %] - [%~ END %] - [%~ END %] - [%~ END %] - -[%~ END ~%] - -[%~ BLOCK EditListScalar # (ppaths,pitem,val) ~%] - - [% IF pitem.privilege == 'write' ~%] - [% IF pitem.unit ~%] - [%# FIXME %] - [%~ END %] - - [% IF pitem.unit ~%] - - [%~ END %] - - [% pitem.unit %] - [%~ ELSE ~%] - [% IF pitem.field_type == 'lang' ~%] - - [%~ END ~%] - [% IF pitem.field_type ~%] - [% val | optdesc(pitem.field_type,is_listmaster) %] - [%~ ELSE ~%] - [% val %] - [%~ END %] - [%~ IF pitem.field_type == 'lang' ~%] - - [%~ END %] - - [% IF val.length() ~%] - [% pitem.unit %] - [%~ END %] - [%~ END %] - -[%~ END ~%] - diff --git a/default/web_tt2/nav.tt2 b/default/web_tt2/nav.tt2 index 5592e8341..0421f20f0 100644 --- a/default/web_tt2/nav.tt2 +++ b/default/web_tt2/nav.tt2 @@ -200,7 +200,7 @@
  • - [%|loc%]Editors[%END%] + [%|loc%]Moderators[%END%]
    • diff --git a/src/cgi/wwsympa.fcgi.in b/src/cgi/wwsympa.fcgi.in index ee1b8f325..ade70e479 100644 --- a/src/cgi/wwsympa.fcgi.in +++ b/src/cgi/wwsympa.fcgi.in @@ -5093,72 +5093,104 @@ sub do_edit { $param->{'role'} = $role; $param->{'page'} = $role; # For review action - my @keys = qw(gecos profile info reception visibility); - - #FIXME: Provide config schema including privileges by Family. - my $schema = {}; - my ($role_p, $priv_p) = $list->may_edit($role, $param->{'user'}{'email'}); - foreach my $key (@keys) { - my ($role, $priv) = - $list->may_edit("$role.$key", $param->{'user'}{'email'}); - my $pitem = $schema->{$key} = {}; - $priv = $priv_p - if not $priv - or ($priv_p and $priv_p lt $priv); - $pitem->{privilege} = $priv - if not $pitem->{privilege} - or ($priv and $priv lt $pitem->{privilege}); - $pitem->{privilege} ||= 'hidden'; # Implicit default - } + my $users = [ + grep { $_ and $_->{email} eq $email and $_->{role} eq $role } + @{$list->get_current_admins || []} + ]; + #FIXME + return 1 unless @$users; + + my $config = + Sympa::List::Users->new($list, config => {$role => $users}); + my $schema = $config->get_schema($param->{'user'}{'email'}); + my @schema = _do_edit_list_request($config, $schema->{$role}, [$role]); # Initial access. show current value. - unless ($in{'submit'}) { - $param->{'config_schema'} = $schema; - my ($user) = - grep { $_ and $_->{email} eq $email and $_->{role} eq $role } - @{$list->get_current_admins || []}; - $param->{'config_values'} = {$role => [$user]} if $user; - - $param->{'previous_action'} = $in{'previous_action'} || 'review'; - return 1; - } else { - # Start parsing the data sent by the edition form. - my $new_config = _deserialize_changes(); - my $new = $new_config->{$role}->[0] || {} if $new_config; + my $new_admin = _deserialize_changes(); + if ($in{'submit'} and $new_admin and %$new_admin) { + delete $in{'submit'}; - my $values = {}; - foreach my $key (@keys) { - next unless $schema->{$key}{privilege} - and $schema->{$key}{privilege} eq 'write'; - - if ($key eq 'gecos') { - $values->{gecos} = (defined $new->{gecos}) ? $new->{gecos} : '' - if exists $new->{gecos}; - } elsif ($key eq 'reception') { - $values->{reception} = $new->{reception} - if $new->{reception} - and grep {$new->{reception} eq $_} qw(mail nomail); - } elsif ($key eq 'visibility') { - $values->{visibility} = $new->{visibility} - if $new->{visibility} - and grep {$new->{visibility} eq $_} - qw(conceal noconceal); - } elsif ($key eq 'profile') { - $values->{profile} = $new->{profile} - if $new->{profile} - and grep {$new->{profile} eq $_} qw(normal privileged); - } elsif ($key eq 'info') { - $values->{info} = (defined $new->{info}) ? $new->{info} : '' - if exists $new->{info}; + #FIXME + return 1 unless $new_admin->{$role} and $new_admin->{$role}->[0]; + # Prevent changing email. + $new_admin->{$role}->[0]->{email} = $email; + + # Start parsing the data sent by the edition form. + my $errors = []; + my $validity = + $config->submit($new_admin, $param->{'user'}{'email'}, $errors); + unless (defined $validity) { + if (my @intern = grep { $_->[0] eq 'intern' } @$errors) { + foreach my $err (@intern) { + Sympa::WWW::Report::reject_report_web($err->[0], $err->[1], + {}, $param->{'action'}, $list); + wwslog('err', 'Internal error %s', $err->[1]); + } + } else { + Sympa::WWW::Report::reject_report_web('intern', 'unknown', {}, + $param->{'action'}, $list); + wwslog('err', 'Unknown error'); } + web_db_log( + { 'status' => 'error', + 'error_type' => 'internal' + } + ); + return undef; + } + + my $error_return = 0; + foreach my $err (grep { $_->[0] eq 'user' } @$errors) { + $error_return = 1 unless $err->[1] eq 'mandatory_parameter'; + + Sympa::WWW::Report::reject_report_web( + $err->[0], + $err->[1], + { 'p_name' => + $language->gettext($err->[2]->{p_info}->{gettext_id}), + %{$err->[2]} + }, + $param->{'action'}, + $list + ); + wwslog( + 'err', + 'Error on parameter %s: %s', + join('.', @{$err->[2]->{p_paths}}), + $err->[1] + ); + web_db_log( + { 'status' => 'error', + 'error_type' => 'syntax_errors' + } + ); + } + if ($error_return) { + ; + } elsif ($validity eq '') { + Sympa::WWW::Report::notice_report_web('no_parameter_edited', + {}, $param->{'action'}); + wwslog('info', 'No parameter was edited by user'); + } else { + # Validation of the form finished. Start of valid data + # treatments. + $list->update_list_admin($email, $role, + $new_admin->{$role}->[0]); } - $list->update_list_admin($email, $role, $values) - if $values and %$values; $in{'page'} = $role; # For review. return $in{'previous_action'} || 'review'; } + # If at least one param was editable, make the update button appear in + # the form. + $param->{'is_form_editable'} = + grep { $_->{privilege} eq 'write' } @schema; + $param->{'config_schema'} = [@schema]; + $param->{'config_values'} = {$role => $users} if $users and @$users; + + $param->{'previous_action'} = $in{'previous_action'} || 'review'; + return 1; } ## Show the table of exclude diff --git a/src/lib/Sympa/ListDef.pm b/src/lib/Sympa/ListDef.pm index d0a119eb0..daefd145a 100644 --- a/src/lib/Sympa/ListDef.pm +++ b/src/lib/Sympa/ListDef.pm @@ -2485,7 +2485,7 @@ our %user_info = ( owner => { order => 10.03, group => 'description', - gettext_id => "Owner", + gettext_id => "Owners", gettext_comment => 'Owners are managing subscribers of the list. They may review subscribers and add or delete email addresses from the mailing list. If you are a privileged owner of the list, you can choose other owners for the mailing list. Privileged owners may edit a few more options than other owners. ', format => { @@ -2555,7 +2555,7 @@ our %user_info = ( }, date => { order => 14, - gettext_id => 'date this user become a list admin', + gettext_id => 'delegated since', format => '\d+', field_type => 'unixtime', internal => 1, @@ -2636,7 +2636,7 @@ our %user_info = ( }, date => { order => 14, - gettext_id => 'date this user become a list admin', + gettext_id => 'delegated since', format => '\d+', field_type => 'unixtime', internal => 1, From 8cadf5ba35177019d2a72ea0a1c1f159162d6b62 Mon Sep 17 00:00:00 2001 From: IKEDA Soji Date: Wed, 20 Jun 2018 16:58:43 +0900 Subject: [PATCH 4/5] Small fixes. --- src/cgi/wwsympa.fcgi.in | 77 ++++++++++------------------------------- src/lib/Sympa/Config.pm | 32 +++++++++++------ 2 files changed, 39 insertions(+), 70 deletions(-) diff --git a/src/cgi/wwsympa.fcgi.in b/src/cgi/wwsympa.fcgi.in index ade70e479..ce8b914e4 100644 --- a/src/cgi/wwsympa.fcgi.in +++ b/src/cgi/wwsympa.fcgi.in @@ -4897,23 +4897,21 @@ sub _review_user { my $email = $user->{email}; if (grep {$email eq $_} @del_users) { ; #FIXME: Update user? + } elsif ($list->add_list_admin($role, $user)) { + # Notify the new list owner/editor + Sympa::send_notify_to_user( + $list, + 'added_as_listadmin', + $email, + { admin_type => $role, + delegator => $param->{'user'}{'email'} + } + ); + Sympa::WWW::Report::notice_report_web('user_notified', + {'notified_user' => $email}, + $param->{'action'}); } else { - unless ($list->add_list_admin($role, $user)) { - #FIXME: Report error - } else { - # Notify the new list owner/editor - Sympa::send_notify_to_user( - $list, - 'added_as_listadmin', - $email, - { admin_type => $role, - delegator => $param->{'user'}{'email'} - } - ); - Sympa::WWW::Report::notice_report_web('user_notified', - {'notified_user' => $email}, - $param->{'action'}); - } + #FIXME: Report error } } } @@ -5116,9 +5114,10 @@ sub do_edit { $new_admin->{$role}->[0]->{email} = $email; # Start parsing the data sent by the edition form. - my $errors = []; + my $errors = []; my $validity = - $config->submit($new_admin, $param->{'user'}{'email'}, $errors); + $config->submit($new_admin, $param->{'user'}{'email'}, $errors, + no_global_validations => 1); unless (defined $validity) { if (my @intern = grep { $_->[0] eq 'intern' } @$errors) { foreach my $err (@intern) { @@ -10779,14 +10778,7 @@ sub do_edit_list { Sympa::WWW::Report::notice_report_web('subscribers_noticed_deleted_topics', {}, $param->{'action'}); } - # For changed owner/editor - _notify_added_admin($config); - #my $owner_update = 1 - # if $config->get_change('owner') - # or $config->get_change('owner_include'); - #my $editor_update = 1 - # if $config->get_change('editor') - # or $config->get_change('editor_include'); + my $data_source_updated = 1 if grep { $config->get_change($_) } grep { $_ =~ /\Ainclude_/ or $_ eq 'ttl' } @@ -10994,39 +10986,6 @@ sub _notify_deleted_topic { return $deleted; } -sub _notify_added_admin { - my $config = shift; - - # If new owners/editors have been added, then notify them. - foreach my $admin_type ('owner', 'editor') { - my %previous_emails = map { - ($_->{email} => 1) - } @{$config->get($admin_type) || []}; - my @new_emails = - grep {$_} - map { $_->{email} } - grep {$_} values %{$config->get_change($admin_type) || {}}; - - # Compare with new entries. - foreach my $email (@new_emails) { - unless ($previous_emails{$email}) { - # Notify the new list owner/editor - Sympa::send_notify_to_user( - $list, - 'added_as_listadmin', - $email, - { admin_type => $admin_type, - delegator => $param->{'user'}{'email'} - } - ); - Sympa::WWW::Report::notice_report_web('user_notified', - {'notified_user' => $email}, - $param->{'action'}); - } - } - } -} - # Sends back the list config edition form. sub do_edit_list_request { wwslog('info', '(%s)', $in{'group'}); diff --git a/src/lib/Sympa/Config.pm b/src/lib/Sympa/Config.pm index 8614f3968..e04477228 100644 --- a/src/lib/Sympa/Config.pm +++ b/src/lib/Sympa/Config.pm @@ -268,10 +268,11 @@ sub _pfullname { } sub submit { - my $self = shift; - my $new = shift; - my $user = shift; - my $errors = shift; + my $self = shift; + my $new = shift; + my $user = shift; + my $errors = shift; + my %options = @_; my $changes = $self->_sanitize_changes($new, $user); @@ -283,7 +284,7 @@ sub submit { } $self->{_changes} = $changes; - return $self->_validate_changes($changes, $errors); + return $self->_validate_changes($changes, $errors, %options); } # Sanitizes parsed input including changes. @@ -634,9 +635,10 @@ sub _global_validations { {} } # - $new may be modified, if there are any omittable changes. # - Error information will be added to $errors. sub _validate_changes { - my $self = shift; - my $new = shift; - my $errors = shift; + my $self = shift; + my $new = shift; + my $errors = shift; + my %options = @_; my $pinfo = $self->{_pinfo}; @@ -663,7 +665,8 @@ sub _validate_changes { $ret = 'invalid' if $r eq 'invalid'; } - my %global_validations = %{$self->_global_validations || {}}; + my %global_validations = %{$self->_global_validations || {}} + unless $options{no_global_validations}; # review the entire new configuration as a whole foreach my $validation (CORE::keys %global_validations) { next unless ref $global_validations{$validation} eq 'CODE'; @@ -1121,7 +1124,7 @@ List of keys. If parameter does not exist or it does not have sub-parameters, i.e. it is not the paragraph, empty list. -=item submit ( $new, $user, \@errors ) +=item submit ( $new, $user, \@errors, [ no_global_validations =E 1 ] ) I. Submits change and verifies it. @@ -1170,6 +1173,13 @@ Email of the user requesting submission. If errors occur, they will be pushed in this arrayref. Each element is arrayref C<[ I, I, I ]>: +=item no_global_validations =E 1 + +If set, global validations are disabled. +Global validations examine the entire configuration for semantic errors or +requirements that can't be detected within a single paragraph. +See also L. + =over =item I @@ -1378,7 +1388,7 @@ L. =head1 HISTORY -L appeared on Sympa 6.2.33b.X. +L appeared on Sympa 6.2.33b.2. =cut From f96432e33a9a81287face0ec852bef0400f08c49 Mon Sep 17 00:00:00 2001 From: IKEDA Soji Date: Wed, 20 Jun 2018 21:04:42 +0900 Subject: [PATCH 5/5] Small fix. --- src/lib/Sympa/ListDef.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/lib/Sympa/ListDef.pm b/src/lib/Sympa/ListDef.pm index daefd145a..40f513270 100644 --- a/src/lib/Sympa/ListDef.pm +++ b/src/lib/Sympa/ListDef.pm @@ -2594,20 +2594,20 @@ our %user_info = ( length => 30 }, info => { - order => 3, + order => 5, gettext_id => "private information", format => '.+', length => 30 }, reception => { - order => 4, + order => 3, gettext_id => "reception mode", format => ['mail', 'nomail'], occurrence => '1', default => 'mail' }, visibility => { - order => 5, + order => 4, gettext_id => "visibility", format => ['conceal', 'noconceal'], occurrence => '1',