Unverified Commit 357c1634 authored by IKEDA Soji's avatar IKEDA Soji Committed by GitHub
Browse files

Merge branch 'sympa-6.2' into pr/release-6.2.64

parents f68f1c18 136bc0bc
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
...@@ -4,8 +4,8 @@ ...@@ -4,8 +4,8 @@
# Sympa - SYsteme de Multi-Postage Automatique # Sympa - SYsteme de Multi-Postage Automatique
# #
# Copyright 2018 The Sympa Community. See the AUTHORS.md file at the # Copyright 2018, 2021 The Sympa Community. See the
# top-level directory of this distribution and at # AUTHORS.md file at the top-level directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>. # <https://github.com/sympa-community/sympa.git>.
# #
# This program is free software; you can redistribute it and/or modify # This program is free software; you can redistribute it and/or modify
...@@ -371,7 +371,7 @@ sub _sanitize_changes_set { ...@@ -371,7 +371,7 @@ sub _sanitize_changes_set {
return () unless ref $new eq 'ARRAY'; # Sanity check return () unless ref $new eq 'ARRAY'; # Sanity check
return () if $pitem->{obsolete}; return () if $pitem->{obsolete};
return () unless $pitem->{privilege} eq 'write'; return () unless 'write' eq ($pitem->{privilege} // '');
# Resolve synonym. # Resolve synonym.
if (ref $pitem->{synonym} eq 'HASH') { if (ref $pitem->{synonym} eq 'HASH') {
...@@ -425,7 +425,7 @@ sub _sanitize_changes_array { ...@@ -425,7 +425,7 @@ sub _sanitize_changes_array {
return () unless ref $new eq 'ARRAY'; # Sanity check return () unless ref $new eq 'ARRAY'; # Sanity check
return () if $pitem->{obsolete}; return () if $pitem->{obsolete};
return () unless $pitem->{privilege} eq 'write'; return () unless 'write' eq ($pitem->{privilege} // '');
my $i = -1; my $i = -1;
my %ret = map { my %ret = map {
...@@ -475,7 +475,7 @@ sub _sanitize_changes_paragraph { ...@@ -475,7 +475,7 @@ sub _sanitize_changes_paragraph {
return () unless ref $new eq 'HASH'; # Sanity check return () unless ref $new eq 'HASH'; # Sanity check
return () if $pitem->{obsolete}; return () if $pitem->{obsolete};
return () unless $pitem->{privilege} eq 'write'; return () unless 'write' eq ($pitem->{privilege} // '');
$self->_apply_defaults($cur, $pitem->{format}, $self->_apply_defaults($cur, $pitem->{format},
init => ($options{init} and not $options{loading})); init => ($options{init} and not $options{loading}));
...@@ -581,7 +581,7 @@ sub _sanitize_changes_leaf { ...@@ -581,7 +581,7 @@ sub _sanitize_changes_leaf {
return () if ref $new eq 'ARRAY'; # Sanity check: Hashref or scalar return () if ref $new eq 'ARRAY'; # Sanity check: Hashref or scalar
return () if $pitem->{obsolete}; return () if $pitem->{obsolete};
return () unless $pitem->{privilege} eq 'write'; return () unless 'write' eq ($pitem->{privilege} // '');
# If the parameter corresponds to a scenario or a task, mark it # If the parameter corresponds to a scenario or a task, mark it
# as changed if its name was changed. Example: 'subscribe'. # as changed if its name was changed. Example: 'subscribe'.
......
...@@ -2576,7 +2576,7 @@ our %pinfo = ( ...@@ -2576,7 +2576,7 @@ our %pinfo = (
### Data sources page ### ### Data sources page ###
inclusion_notification_feature => { inclusion_notification_feature => {
context => [qw(list)], context => [qw(list site)],
order => 60.01, order => 60.01,
group => 'data_source', group => 'data_source',
gettext_id => gettext_id =>
...@@ -3519,9 +3519,9 @@ our %pinfo = ( ...@@ -3519,9 +3519,9 @@ our %pinfo = (
}, },
distribution_ttl => { distribution_ttl => {
context => [qw(list)], #FIXME: No site-wide default context => [qw(list site)],
order => 60.13, order => 60.13,
group => 'data_source', group => 'data_source',
gettext_id => "Inclusions timeout for message distribution", gettext_id => "Inclusions timeout for message distribution",
gettext_comment => gettext_comment =>
"This parameter defines the delay since the last synchronization after which the user's list will be updated before performing either of following actions:\n* Reviewing list members\n* Message distribution", "This parameter defines the delay since the last synchronization after which the user's list will be updated before performing either of following actions:\n* Reviewing list members\n* Message distribution",
......
...@@ -1532,6 +1532,7 @@ sub send_probe_to_user { ...@@ -1532,6 +1532,7 @@ sub send_probe_to_user {
## $list->delete_list_member('users' => \@u, 'exclude' => 1) ## $list->delete_list_member('users' => \@u, 'exclude' => 1)
## $list->delete_list_member('users' => [$email], 'exclude' => 1) ## $list->delete_list_member('users' => [$email], 'exclude' => 1)
sub delete_list_member { sub delete_list_member {
$log->syslog('debug2', '(%s, ...)', @_);
my $self = shift; my $self = shift;
my %param = @_; my %param = @_;
my @u = @{$param{'users'}}; my @u = @{$param{'users'}};
...@@ -1543,12 +1544,12 @@ sub delete_list_member { ...@@ -1543,12 +1544,12 @@ sub delete_list_member {
$log->syslog('debug2', ''); $log->syslog('debug2', '');
my $name = $self->{'name'};
my $total = 0; my $total = 0;
my $sdm = Sympa::DatabaseManager->instance; my $sdm = Sympa::DatabaseManager->instance;
foreach my $who (@u) { foreach my $who (@u) {
next unless defined $who and length $who;
$who = Sympa::Tools::Text::canonic_email($who); $who = Sympa::Tools::Text::canonic_email($who);
## Include in exclusion_table only if option is set. ## Include in exclusion_table only if option is set.
...@@ -1564,13 +1565,16 @@ sub delete_list_member { ...@@ -1564,13 +1565,16 @@ sub delete_list_member {
q{DELETE FROM subscriber_table q{DELETE FROM subscriber_table
WHERE user_subscriber = ? AND WHERE user_subscriber = ? AND
list_subscriber = ? AND robot_subscriber = ?}, list_subscriber = ? AND robot_subscriber = ?},
$who, $name, $self->{'domain'} $who, $self->{'name'}, $self->{'domain'}
) )
) { ) {
$log->syslog('err', 'Unable to remove list member %s', $who); $log->syslog('err', 'Unable to remove list member %s', $who);
next; next;
} }
# Delete the pictures if any.
$self->delete_list_member_picture($who);
# Delete signoff requests if any. # Delete signoff requests if any.
my $spool_req = Sympa::Spool::Auth->new( my $spool_req = Sympa::Spool::Auth->new(
context => $self, context => $self,
...@@ -1589,7 +1593,7 @@ sub delete_list_member { ...@@ -1589,7 +1593,7 @@ sub delete_list_member {
if ($operation) { if ($operation) {
$log->add_stat( $log->add_stat(
'robot' => $self->{'domain'}, 'robot' => $self->{'domain'},
'list' => $name, 'list' => $self->{'name'},
'operation' => $operation, 'operation' => $operation,
'mail' => $who 'mail' => $who
); );
...@@ -1599,22 +1603,22 @@ sub delete_list_member { ...@@ -1599,22 +1603,22 @@ sub delete_list_member {
} }
$self->_cache_publish_expiry('member'); $self->_cache_publish_expiry('member');
delete_list_member_picture($self, shift(@u));
return (-1 * $total); return (-1 * $total);
} }
## Delete the indicated admin users from the list. ## Delete the indicated admin users from the list.
sub delete_list_admin { sub delete_list_admin {
my ($self, $role, @u) = @_; $log->syslog('debug2', '(%s, %s, ...)', @_);
$log->syslog('debug2', '', $role); my $self = shift;
my $role = shift;
my @u = @_;
my $name = $self->{'name'};
my $total = 0; my $total = 0;
foreach my $who (@u) { foreach my $who (@u) {
next unless defined $who and length $who;
$who = Sympa::Tools::Text::canonic_email($who); $who = Sympa::Tools::Text::canonic_email($who);
my $statement;
my $sdm = Sympa::DatabaseManager->instance; my $sdm = Sympa::DatabaseManager->instance;
...@@ -3295,7 +3299,7 @@ sub add_list_member { ...@@ -3295,7 +3299,7 @@ sub add_list_member {
} }
} }
#Log in stat_table to make staistics #Log in stat_table to make statistics
$log->add_stat( $log->add_stat(
'robot' => $self->{'domain'}, 'robot' => $self->{'domain'},
'list' => $self->{'name'}, 'list' => $self->{'name'},
......
...@@ -1527,19 +1527,8 @@ sub _merge_msg { ...@@ -1527,19 +1527,8 @@ sub _merge_msg {
return $entity; return $entity;
} }
## PARSAGE ## $utf8_body = personalize_text($utf8_body, $list, $rcpt, $data);
return $entity unless defined $utf8_body;
my $message_output;
unless (
defined(
$message_output =
personalize_text($utf8_body, $list, $rcpt, $data)
)
) {
$log->syslog('err', 'Error merging message');
return undef;
}
$utf8_body = $message_output;
## Data not encodable by original charset will fallback to UTF-8. ## Data not encodable by original charset will fallback to UTF-8.
my ($newcharset, $newenc); my ($newcharset, $newenc);
...@@ -1625,7 +1614,7 @@ sub personalize_text { ...@@ -1625,7 +1614,7 @@ sub personalize_text {
) )
) { ) {
$log->syslog( $log->syslog(
'err', 'info',
'Failed parsing template: %s', 'Failed parsing template: %s',
$template->{last_error} $template->{last_error}
); );
...@@ -1815,11 +1804,7 @@ sub _footer_text { ...@@ -1815,11 +1804,7 @@ sub _footer_text {
} }
if ($mode) { if ($mode) {
$footer_text = $footer_text =
personalize_text($footer_text, $list, $rcpt, $data); personalize_text($footer_text, $list, $rcpt, $data) // '';
unless (defined $footer_text) {
$log->syslog('info', 'Error personalizing %s', $type);
$footer_text = '';
}
} }
$footer_text = '' unless $footer_text =~ /\S/; $footer_text = '' unless $footer_text =~ /\S/;
} }
......
...@@ -8,8 +8,8 @@ ...@@ -8,8 +8,8 @@
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017, 2018 The Sympa Community. See the AUTHORS.md file at the # Copyright 2017, 2018, 2021 The Sympa Community. See the
# top-level directory of this distribution and at # AUTHORS.md file at the top-level directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>. # <https://github.com/sympa-community/sympa.git>.
# #
# This program is free software; you can redistribute it and/or modify # This program is free software; you can redistribute it and/or modify
...@@ -116,7 +116,7 @@ sub _twist { ...@@ -116,7 +116,7 @@ sub _twist {
if ($action =~ /\Areject\b/i) { if ($action =~ /\Areject\b/i) {
; ;
} elsif ( } elsif (
$sender ne $request->{email} $sender ne ($request->{email} // '')
and and
($request->{action} eq 'subscribe' or $request->{action} eq 'signoff') ($request->{action} eq 'subscribe' or $request->{action} eq 'signoff')
) { ) {
......
...@@ -8,6 +8,9 @@ ...@@ -8,6 +8,9 @@
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2021 The Sympa Community. See the
# AUTHORS.md file at the top-level directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>.
# #
# This program is free software; you can redistribute it and/or modify # 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 # it under the terms of the GNU General Public License as published by
...@@ -136,7 +139,10 @@ sub find_keys { ...@@ -136,7 +139,10 @@ sub find_keys {
return ($certs, $keys); return ($certs, $keys);
} }
BEGIN { eval 'use Crypt::OpenSSL::X509'; } BEGIN {
eval 'use Crypt::OpenSSL::X509';
eval 'use Convert::ASN1 qw()';
}
# IN: hashref: # IN: hashref:
# file => filename # file => filename
...@@ -153,6 +159,8 @@ sub parse_cert { ...@@ -153,6 +159,8 @@ sub parse_cert {
$log->syslog('debug3', '(%s => %s)', @_); $log->syslog('debug3', '(%s => %s)', @_);
my %arg = @_; my %arg = @_;
return undef unless $Crypt::OpenSSL::X509::VERSION;
## Load certificate ## Load certificate
my $x509; my $x509;
if ($arg{'text'}) { if ($arg{'text'}) {
...@@ -171,25 +179,17 @@ sub parse_cert { ...@@ -171,25 +179,17 @@ sub parse_cert {
my %res; my %res;
$res{subject} = join '', $res{subject} = join '',
map { '/' . $_->as_string } @{$x509->subject_name->entries}; map { '/' . $_->as_string } @{$x509->subject_name->entries};
my $extensions = $x509->extensions_by_name();
my %emails; # Get email(s).
foreach my $extension_name (keys %$extensions) { # The subjectAltName extension is used. The email() method that gives
if ($extension_name eq 'subjectAltName') { # single address may be used for workaround on malformed certificates.
my $extension_value = $extensions->{$extension_name}->value(); my @emails = _get_subjectAltName($x509, 1); # rfc822Name [1]
my @addresses = split '\.{2,}', $extension_value; unless (@emails) {
shift @addresses; @emails = ($x509->email) if $x509->email;
foreach my $address (@addresses) {
$emails{$address} = 1;
}
}
}
if (%emails) {
foreach my $email (keys %emails) {
$res{email}{lc($email)} = 1;
}
} elsif ($x509->email) {
$res{email}{lc($x509->email)} = 1;
} }
$res{email} =
{map { (Sympa::Tools::Text::canonic_email($_) => 1) } @emails};
# Check key usage roughy. # Check key usage roughy.
my %purposes = $x509->extensions_by_name->{keyUsage}->hash_bit_string; my %purposes = $x509->extensions_by_name->{keyUsage}->hash_bit_string;
$res{purpose}->{sign} = $purposes{'Digital Signature'} ? 1 : ''; $res{purpose}->{sign} = $purposes{'Digital Signature'} ? 1 : '';
...@@ -197,6 +197,53 @@ sub parse_cert { ...@@ -197,6 +197,53 @@ sub parse_cert {
return \%res; return \%res;
} }
sub _get_subjectAltName {
my $x509 = shift;
my $context_num = shift;
my $extensions = $x509->extensions_by_name;
return
unless $extensions
and $extensions->{subjectAltName}
and $extensions->{subjectAltName}->value =~ /\A#([0-9A-F]+)\z/;
my $bin = pack 'H*', $1;
my ($tag, $tnum, $len);
($tag, $tnum, $bin, $len) = _parse_asn1_single_value($bin);
return
unless defined $tag
and ($tag & ~Convert::ASN1::ASN_CONSTRUCTOR()) ==
Convert::ASN1::ASN_SEQUENCE();
my @ret;
while (length $bin) {
my $val;
($tag, $tnum, $val, $len) = _parse_asn1_single_value($bin);
last unless defined $tag;
$bin = substr $bin, $len;
next if $tag == 0 and length $val == 0;
push @ret, $val
if ($tag & 0xC0) == Convert::ASN1::ASN_CONTEXT()
and $tnum == $context_num;
}
return @ret;
}
sub _parse_asn1_single_value {
my $bin = shift;
my ($tb, $tag, $tnum) =
Convert::ASN1::asn_decode_tag2(substr $bin, 0, 10);
return unless defined $tb;
my ($lb, $len) = Convert::ASN1::asn_decode_length(substr $bin, $tb, 10);
return unless $tb + $lb + $len <= length $bin;
return ($tag, $tnum, substr($bin, $tb + $lb, $len), $tb + $lb + $len);
}
# NO LONGER USED # NO LONGER USED
# However, this function may be useful because it can extract messages openssl # However, this function may be useful because it can extract messages openssl
# can not (e.g. signature part not encoded by BASE64). # can not (e.g. signature part not encoded by BASE64).
......
...@@ -8,8 +8,8 @@ ...@@ -8,8 +8,8 @@
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, # Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites # 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER # Copyright (c) 2011, 2012, 2013, 2014, 2015, 2016, 2017 GIP RENATER
# Copyright 2017, 2018, 2019, 2020 The Sympa Community. See the AUTHORS.md # Copyright 2017, 2018, 2019, 2020, 2021 The Sympa Community. See the
# file at the top-level directory of this distribution and at # AUTHORS.md file at the top-level directory of this distribution and at
# <https://github.com/sympa-community/sympa.git>. # <https://github.com/sympa-community/sympa.git>.
# #
# This program is free software; you can redistribute it and/or modify # This program is free software; you can redistribute it and/or modify
...@@ -77,11 +77,10 @@ sub checkCookie { ...@@ -77,11 +77,10 @@ sub checkCookie {
} }
sub lists { sub lists {
my $self = shift; #$self is a service object my $self = shift; #$self is a service object
my $topic = shift; my $topic = shift;
my $subtopic = shift; my $subtopic = shift;
my $mode = shift; my $mode = shift // '';
$mode ||= '';
my $sender = $ENV{'USER_EMAIL'}; my $sender = $ENV{'USER_EMAIL'};
my $robot = $ENV{'SYMPA_ROBOT'}; my $robot = $ENV{'SYMPA_ROBOT'};
...@@ -1240,7 +1239,7 @@ sub complexLists { ...@@ -1240,7 +1239,7 @@ sub complexLists {
## Simplified return structure ## Simplified return structure
sub which { sub which {
my $self = shift; my $self = shift;
my $mode = shift; my $mode = shift // '';
my @result; my @result;
my $sender = $ENV{'USER_EMAIL'}; my $sender = $ENV{'USER_EMAIL'};
...@@ -1521,7 +1520,9 @@ sub setCustom { ...@@ -1521,7 +1520,9 @@ sub setCustom {
## Return a structure in SOAP data format ## Return a structure in SOAP data format
## either flat (string) or structured (complexType) ## either flat (string) or structured (complexType)
sub struct_to_soap { sub struct_to_soap {
my ($data, $format) = @_; my $data = shift;
my $format = shift // '';
my $soap_data; my $soap_data;
unless (ref($data) eq 'HASH') { unless (ref($data) eq 'HASH') {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment