Commit fa938985 authored by sikeda's avatar sikeda
Browse files

[dev] These functions were moved to new Sympa::Spool module:

- split_listname
- unmarshal_metadata
- marshal_metadata
- store_spool
This change may help merger work with trunk.

Additionally, tools::save_to_bad() was moved to archived.pl only in which it is used.


git-svn-id: https://subversion.renater.fr/sympa/branches/sympa-6.2-branch@12049 05aa8bb8-cd2b-0410-b1d7-8918dfa770ce
parent ba87af0f
......@@ -14,7 +14,7 @@ use Sympa::Constants;
use Sympa::DatabaseManager;
use Sympa::Log;
use Sympa::Message;
use tools;
use Sympa::Spool;
my $log = Sympa::Log->instance;
......@@ -50,7 +50,7 @@ unless ($modspool and opendir SPOOL, $modspool) {
foreach my $msg_file (sort grep(!/^\./, readdir SPOOL)) {
next if $msg_file =~ /^\./;
my $metadata = tools::unmarshal_metadata(
my $metadata = Sympa::Spool::unmarshal_metadata(
$modspool, $msg_file,
qr{\A([^\s\@]+)(?:\@([\w\.\-]+))?_([^_]+)\z},
[qw(localpart domainpart modkey)]
......
......@@ -36,6 +36,7 @@ use Conf;
use Sympa::Constants;
use Sympa::Log;
use SDM;
use Sympa::Spool;
my %options;
unless (GetOptions(\%options, 'help|h', 'dry_run', 'version|v')) {
......@@ -193,7 +194,7 @@ sub process {
$marshalled =
$bulk->store($message, $rcpt, tag => $message->{tag});
} else {
$marshalled = tools::marshal_metadata(
$marshalled = Sympa::Spool::marshal_metadata(
$message,
'%s.%s.%d.%f.%s@%s_%s,?????,????',
[ qw(priority packet_priority date time localpart domainpart tag)
......
......@@ -36,6 +36,7 @@ use Sympa::Constants;
use Conf;
use Sympa::LockedFile;
use Sympa::Log;
use Sympa::Spool;
my %options;
unless (GetOptions(\%options, 'help|h', 'dry_run', 'version|v')) {
......@@ -91,7 +92,7 @@ while ($filename = readdir $dh) {
Sympa::LockedFile->new($spool_dir . '/' . $filename, -1, '+<');
next unless $lock_fh;
my $metadata = tools::unmarshal_metadata(
my $metadata = Sympa::Spool::unmarshal_metadata(
$spool_dir, $filename,
qr{\A([^\s\@]+)(?:\@([\w\.\-]+))?\.(\d+)\.(\w+)(?:,.*)?\z},
[qw(localpart domainpart date pid)]
......@@ -133,7 +134,7 @@ sub process {
$message->{'md5_check'} = 1;
delete $message->{checksum};
tools::store_spool($spool_dir, $message, '%s@%s.%ld.%ld,%d',
Sympa::Spool::store_spool($spool_dir, $message, '%s@%s.%ld.%ld,%d',
[qw(localpart domainpart date pid RAND)])
unless $options{dry_run};
$log->syslog('info', '%s: Moved to msg spool', $message);
......
......@@ -85,6 +85,7 @@ use Sympa::Scenario;
use SDM;
use Sympa::Session;
use Sympa::SharedDocument;
use Sympa::Spool;
use Sympa::Template;
use tools;
use Sympa::Tools::Data;
......@@ -9115,7 +9116,7 @@ sub do_distribute {
$message->add_header('Content-Type', 'text/plain; Charset=utf-8');
 
unless (
tools::store_spool(
Sympa::Spool::store_spool(
$Conf::Conf{'queue'}, $message,
'%s@%s.%ld.%ld,%d', [qw(localpart domainpart TIME PID RAND)]
)
......@@ -20539,7 +20540,7 @@ sub do_remind {
$message->add_header('Content-Type', 'text/plain; Charset=utf-8');
 
unless (
tools::store_spool(
Sympa::Spool::store_spool(
$Conf::Conf{'queue'}, $message,
'%s@%s.%ld.%ld,%d', [qw(localpart domainpart TIME PID RAND)]
)
......@@ -21919,7 +21920,7 @@ sub do_send_mail {
$l_message->{md5_check} = 1;
 
unless (
tools::store_spool(
Sympa::Spool::store_spool(
$Conf::Conf{'queue'}, $l_message, '%s@%s.%ld.%ld,%d',
[qw(localpart domainpart TIME PID RAND)]
)
......@@ -22125,7 +22126,7 @@ sub do_tag_topic_by_sender {
$cmd_message->add_header('Content-Type', 'text/plain; Charset=utf-8');
 
unless (
tools::store_spool(
Sympa::Spool::store_spool(
$Conf::Conf{'queue'}, $cmd_message,
'%s@%s.%ld.%ld,%d', [qw(localpart domainpart TIME PID RAND)]
)
......
......@@ -72,6 +72,7 @@ nobase_modules_DATA = \
Sympa/Session.pm \
Sympa/SOAP.pm \
Sympa/SOAP/Transport.pm \
Sympa/Spool.pm \
Sympa/Task.pm \
Sympa/Template.pm \
tools.pm \
......@@ -121,6 +122,7 @@ MAN3PM = \
Sympa/Message/Plugin/FixEncoding.pm \
Sympa/ModDef.pm \
Sympa/Regexps.pm \
Sympa/Spool.pm \
Sympa/Template.pm \
Sympa/User.pm
......
......@@ -36,7 +36,7 @@ use Sympa::Constants;
use Sympa::LockedFile;
use Sympa::Log;
use Sympa::Message;
use tools;
use Sympa::Spool;
use Sympa::Tools::File;
my $log = Sympa::Log->instance;
......@@ -119,7 +119,7 @@ sub next {
# FIXME: The list or the robot that injected packet can no longer be
# available.
$metadata = tools::unmarshal_metadata(
$metadata = Sympa::Spool::unmarshal_metadata(
$self->{pct_directory},
$marshalled,
qr{\A(\w+)\.(\w+)\.(\d+)\.(\d+\.\d+)\.([^\s\@]*)\@([\w\.\-*]*)_(\w+),(\d+),(\d+)/(\w+)\z},
......@@ -131,7 +131,7 @@ sub next {
# Skip messages not yet to be delivered.
next unless $metadata->{date} <= time;
my $msg_file = tools::marshal_metadata(
my $msg_file = Sympa::Spool::marshal_metadata(
$metadata,
'%s.%s.%d.%f.%s@%s_%s,%ld,%d',
[ qw(priority packet_priority date time localpart domainpart tag pid rand)
......@@ -244,7 +244,7 @@ sub store {
# First, store the message in bulk/msg spool, because as soon as packets
# are created bulk.pl may distribute them.
my $marshalled = tools::store_spool(
my $marshalled = Sympa::Spool::store_spool(
$self->{msg_directory},
$message,
'%s.%s.%d.%f.%s@%s_%s,%ld,%d',
......
......@@ -37,7 +37,7 @@ use Sympa::Message;
use Sympa::Regexps;
use Sympa::Report;
use Sympa::Scenario;
use tools;
use Sympa::Spool;
use Sympa::Tools::Data;
use Sympa::Tools::File;
use Sympa::Tools::Password;
......@@ -2942,7 +2942,7 @@ sub confirm {
$filename = $queueauth . '/' . $file;
next unless -f $filename and -r $filename;
$metadata = tools::unmarshal_metadata(
$metadata = Sympa::Spool::unmarshal_metadata(
$queueauth, $file,
qr{\A([^\s\@]+)(?:\@([\w\.\-]+))?_(\w+)\z},
[qw(localpart domainpart authkey)]
......
......@@ -62,6 +62,7 @@ use Sympa::Regexps;
use Sympa::Robot;
use Sympa::Scenario;
use SDM;
use Sympa::Spool;
use Sympa::Task;
use Sympa::Template;
use tools;
......@@ -2141,7 +2142,7 @@ sub distribute_digest {
next unless $lock_fh;
my $metadata =
tools::unmarshal_metadata($spool, $filename,
Sympa::Spool::unmarshal_metadata($spool, $filename,
qr{\A(\d+)\.(\d+\.\d+)(?:,.*)?\z},
[qw(date time)]);
next unless $metadata;
......@@ -2571,7 +2572,7 @@ sub send_confirm_to_editor {
## move message to spool mod
# If crypted, store the crypted form of the message (keep decrypted
# form for HTML view).
my $marshalled = tools::store_spool(
my $marshalled = Sympa::Spool::store_spool(
$modqueue, $message, '%s@%s_%s',
[qw(localpart domainpart AUTHKEY)],
original => 1
......@@ -2584,7 +2585,7 @@ sub send_confirm_to_editor {
$log->syslog('info', '%s is stored in mod spool as <%s>',
$message, $marshalled);
$modkey = ${
tools::unmarshal_metadata(
Sympa::Spool::unmarshal_metadata(
$modqueue, $marshalled,
qr{\A([^\s\@]+)(?:\@([\w\.\-]+))?_([^_]+)\z},
[qw(localpart domainpart authkey)]
......@@ -2753,7 +2754,7 @@ sub send_confirm_to_sender {
# If crypted, store the crypted form of the message.
my $authkey;
my $marshalled = tools::store_spool(
my $marshalled = Sympa::Spool::store_spool(
$authqueue, $message, '%s@%s_%s',
[qw(localpart domainpart AUTHKEY)],
original => 1
......@@ -2764,7 +2765,7 @@ sub send_confirm_to_sender {
return undef;
}
$authkey = ${
tools::unmarshal_metadata(
Sympa::Spool::unmarshal_metadata(
$authqueue, $marshalled,
qr{\A([^\s\@]+)(?:\@([\w\.\-]+))?_([^_]+)\z},
[qw(localpart domainpart authkey)]
......@@ -8950,7 +8951,7 @@ sub store_digest {
}
my $oldtime = Sympa::Tools::File::get_mtime($spool);
my $marshalled =
tools::store_spool($spool, $message, '%ld.%f,%ld,%d',
Sympa::Spool::store_spool($spool, $message, '%ld.%f,%ld,%d',
[qw(date TIME PID RAND)]);
utime $oldtime, $oldtime, $spool;
......@@ -11474,7 +11475,7 @@ sub has_include_data_sources {
}
# move a message to a queue or distribute spool
#DEPRECATED: No longer used. Use tools::store_spool() (and unlink()).
#DEPRECATED: No longer used. Use Sympa::Spool::store_spool() (and unlink()).
sub move_message {
my ($self, $file, $queue) = @_;
$log->syslog('debug2', '(%s, %s, %s)', $file, $self->{'name'}, $queue);
......
......@@ -75,6 +75,7 @@ use Sympa::HTMLSanitizer;
use Sympa::Language;
use Sympa::Log;
use Sympa::Scenario;
use Sympa::Spool;
use Sympa::Template;
use tools;
use Sympa::Tools::Data;
......@@ -600,7 +601,7 @@ sub new_from_template {
# Assign unique ID and log it.
my $marshalled =
tools::marshal_metadata($self, '%s@%s.%ld.%ld,%d',
Sympa::Spool::marshal_metadata($self, '%s@%s.%ld.%ld,%d',
[qw(localpart domainpart date PID RAND)]);
$self->{messagekey} = $marshalled;
$log->syslog(
......
# -*- indent-tabs-mode: nil; -*-
# vim:ft=perl:et:sw=4
# $Id$
# Sympa - SYsteme de Multi-Postage Automatique
#
# Copyright (c) 1997, 1998, 1999 Institut Pasteur & Christophe Wolfhugel
# Copyright (c) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
# 2006, 2007, 2008, 2009, 2010, 2011 Comite Reseau des Universites
# Copyright (c) 2011, 2012, 2013, 2014, 2015 GIP RENATER
#
# 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 <http://www.gnu.org/licenses/>.
package Sympa::Spool;
use strict;
use warnings;
use Digest::MD5;
use English qw(-no_match_vars);
use POSIX qw();
use Sys::Hostname qw();
use Time::HiRes qw();
use Conf;
use Sympa::List;
use Sympa::LockedFile;
use Sympa::Log;
my $log = Sympa::Log->instance;
sub split_listname {
my $robot_id = shift || '*';
my $mailbox = shift;
return unless defined $mailbox and length $mailbox;
my $return_path_suffix =
Conf::get_robot_conf($robot_id, 'return_path_suffix');
my $regexp = join(
'|',
map { quotemeta $_ }
grep { $_ and length $_ }
split(
/[\s,]+/, Conf::get_robot_conf($robot_id, 'list_check_suffixes')
)
);
if ( $mailbox eq 'sympa'
and $robot_id eq $Conf::Conf{'domain'}) { # compat.
return (undef, 'sympa');
} elsif ($mailbox eq Conf::get_robot_conf($robot_id, 'email')
or $robot_id eq $Conf::Conf{'domain'}
and $mailbox eq $Conf::Conf{'email'}) {
return (undef, 'sympa');
} elsif ($mailbox eq Conf::get_robot_conf($robot_id, 'listmaster_email')
or $robot_id eq $Conf::Conf{'domain'}
and $mailbox eq $Conf::Conf{'listmaster_email'}) {
return (undef, 'listmaster');
} elsif ($mailbox =~ /^(\S+)$return_path_suffix$/) { # -owner
return ($1, 'return_path');
} elsif (!$regexp) {
return ($mailbox);
} elsif ($mailbox =~ /^(\S+)-($regexp)$/) {
my ($name, $suffix) = ($1, $2);
my $type;
if ($suffix eq 'request') { # -request
$type = 'owner';
} elsif ($suffix eq 'editor') {
$type = 'editor';
} elsif ($suffix eq 'subscribe') {
$type = 'subscribe';
} elsif ($suffix eq 'unsubscribe') {
$type = 'unsubscribe';
} else {
$name = $mailbox;
$type = 'UNKNOWN';
}
return ($name, $type);
} else {
return ($mailbox);
}
}
# Old name: SympaspoolClassic::analyze_file_name().
sub unmarshal_metadata {
$log->syslog('debug3', '(%s, %s, %s)', @_);
my $spool_dir = shift;
my $marshalled = shift;
my $metadata_regexp = shift;
my $metadata_keys = shift;
my $data;
my @matches;
unless (@matches = ($marshalled =~ /$metadata_regexp/)) {
$log->syslog('debug',
'File name %s does not have the proper format: %s',
$marshalled, $metadata_regexp);
return undef;
}
$data = {
messagekey => $marshalled,
map {
my $value = shift @matches;
(defined $value and length $value) ? ($_ => $value) : ();
} @{$metadata_keys}
};
my ($robot_id, $listname, $type, $list, $priority);
$robot_id = lc($data->{'domainpart'})
if defined $data->{'domainpart'}
and length $data->{'domainpart'}
and Conf::valid_robot($data->{'domainpart'}, {just_try => 1});
($listname, $type) =
Sympa::Spool::split_listname($robot_id || '*', $data->{'localpart'});
$list = Sympa::List->new($listname, $robot_id || '*', {'just_try' => 1})
if defined $listname;
## Get priority
#FIXME: is this always needed?
if (exists $data->{'priority'}) {
# Priority was given by metadata.
;
} elsif ($type and $type eq 'listmaster') {
## highest priority
$priority = 0;
} elsif ($type and $type eq 'owner') { # -request
$priority = Conf::get_robot_conf($robot_id, 'request_priority');
} elsif ($type and $type eq 'return_path') { # -owner
$priority = Conf::get_robot_conf($robot_id, 'owner_priority');
} elsif ($type and $type eq 'sympa') {
$priority = Conf::get_robot_conf($robot_id, 'sympa_priority');
} elsif (ref $list eq 'Sympa::List') {
$priority = $list->{'admin'}{'priority'};
} else {
$priority = Conf::get_robot_conf($robot_id, 'default_list_priority');
}
$data->{context} = $list || $robot_id || '*';
$data->{'listname'} = $listname if $listname;
$data->{'listtype'} = $type if defined $type;
$data->{'priority'} = $priority if defined $priority;
$log->syslog('debug3', 'messagekey=%s, context=%s, priority=%s',
$marshalled, $data->{context}, $data->{'priority'});
return $data;
}
sub marshal_metadata {
my $message = shift;
my $metadata_format = shift;
my $metadata_keys = shift;
#FIXME: Currently only "sympa@DOMAIN" and "LISTNAME(-TYPE)@DOMAIN" are
# supported.
my ($localpart, $domainpart);
if (ref $message->{context} eq 'Sympa::List') {
($localpart) = split /\@/,
$message->{context}->get_list_address($message->{listtype});
$domainpart = $message->{context}->{'domain'};
} else {
my $robot_id = $message->{context} || '*';
$localpart = Conf::get_robot_conf($robot_id, 'email');
$domainpart = Conf::get_robot_conf($robot_id, 'domain');
}
my @args = map {
if ($_ eq 'localpart') {
$localpart;
} elsif ($_ eq 'domainpart') {
$domainpart;
} elsif ($_ eq 'PID') {
$PID;
} elsif ($_ eq 'AUTHKEY') {
Digest::MD5::md5_hex(time . (int rand 46656) . $domainpart);
} elsif ($_ eq 'RAND') {
int rand 10000;
} elsif ($_ eq 'TIME') {
Time::HiRes::time();
} elsif (exists $message->{$_}
and defined $message->{$_}
and !ref($message->{$_})) {
$message->{$_};
} else {
'';
}
} @{$metadata_keys};
# Set "C" locale so that decimal point for "%f" will be ".".
my $locale_numeric = POSIX::setlocale(POSIX::LC_NUMERIC());
POSIX::setlocale(POSIX::LC_NUMERIC(), 'C');
my $marshalled = sprintf $metadata_format, @args;
POSIX::setlocale(POSIX::LC_NUMERIC(), $locale_numeric);
return $marshalled;
}
sub store_spool {
my $spool_dir = shift;
my $message = shift;
my $metadata_format = shift;
my $metadata_keys = shift;
my %options = @_;
# At first content is stored into temporary file that has unique name and
# is referred only by this function.
my $tmppath = sprintf '%s/T.sympa@_tempfile.%s.%ld.%ld',
$spool_dir, Sys::Hostname::hostname(), time, $PID;
my $fh;
unless (open $fh, '>', $tmppath) {
die sprintf 'Cannot create %s: %s', $tmppath, $ERRNO;
}
print $fh $message->to_string(original => $options{original});
close $fh;
# Rename temporary path to the file name including metadata.
# Will retry up to five times.
my $tries;
for ($tries = 0; $tries < 5; $tries++) {
my $marshalled = Sympa::Spool::marshal_metadata($message, $metadata_format,
$metadata_keys);
my $path = $spool_dir . '/' . $marshalled;
my $lock;
unless ($lock = Sympa::LockedFile->new($path, -1, '+')) {
next;
}
if (-e $path) {
$lock->close;
next;
}
unless (rename $tmppath, $path) {
die sprintf 'Cannot create %s: %s', $path, $ERRNO;
}
$lock->close;
# Set mtime to be {date} in metadata of the message.
my $mtime =
defined $message->{date} ? $message->{date}
: defined $message->{time} ? $message->{time}
: time;
utime $mtime, $mtime, $path;
return $marshalled;
}
unlink $tmppath;
return undef;
}
1;
__END__
=encoding utf-8
=head1 NAME
Sympa::Spool - Future base class of Sympa spool subclasses
=head1 SYNOPSIS
TBD.
=head1 DESCRIPTION
This module aims to be the base class for spool subclasses of Sympa.
=head2 Methods
Not implemented yet.
=head2 Low level functions
=over
=item split_listname ( $robot, $mailbox )
I<Function>.
TBD.
Note:
For C<-request> and C<-owner> suffix, this function returns
C<owner> and C<return_path> type, respectively.
=item unmarshal_metadata ( $spool_dir, $marshalled,
$metadata_regexp, $metadata_keys )
I<Function>.
TBD.
=item marshal_metadata ( $message, $metadata_format, $metadata_keys )
I<Function>.
TBD.
=item store_spool ( $spool_dir, $message, $metadata_format, $metadata_keys,
[ key => value, ... ] )
I<Function>.
TBD.
=back
=head1 SEE ALSO
L<Sympa::Message>, especially L<Serialization|Sympa::Message/"Serialization">.
=cut
......@@ -33,7 +33,7 @@ use Sympa::Constants;
use Sympa::LockedFile;
use Sympa::Log;
use Sympa::Message;
use tools;
use Sympa::Spool;
use Sympa::Tools::File;
my $log = Sympa::Log->instance;
......@@ -106,7 +106,7 @@ sub next {
-1, '+<');
next unless $lock_fh;
$metadata = tools::unmarshal_metadata(
$metadata = Sympa::Spool::unmarshal_metadata(
$self->{directory},
$marshalled,
qr{\A(\d+)\.(\d+\.\d+)\.([^\s\@]*)\@([\w\.\-*]*),(\d+),(\d+)},
......@@ -154,7 +154,7 @@ sub store {
$message->{date} = time unless defined $message->{date};
my $marshalled =
tools::store_spool($self->{directory}, $message, '%d.%f.%s@%s,%ld,%d',
Sympa::Spool::store_spool($self->{directory}, $message, '%d.%f.%s@%s,%ld,%d',
[qw(date TIME localpart domainpart PID RAND)], %options);
return unless $marshalled;
......
......@@ -44,6 +44,7 @@ use Sympa::List;
use Sympa::LockedFile;
use Sympa::Log;
use Sympa::Message;
use Sympa::Spool;
use tools;
use Sympa::Tools::File;
use Sympa::Tools::Text;
......@@ -1364,7 +1365,7 @@ sub upgrade {
Sympa::LockedFile->new($spooldir . '/' . $filename, -1, '+<');
next unless $lock_fh;
my $metadata = tools::unmarshal_metadata(
my $metadata = Sympa::Spool::unmarshal_metadata(
$spooldir, $filename,