Developers of Sympa

[David Verdin <address@concealed>]

Hi all,

Here is a transcript of a discussion Soji and I had yesterday about code design. A little explanation first.

Basically when rolling back to filesystem spools, I created a new module, called SympspoolClassic.pm which has the same primitive as Sympaspool.pm, except that it manipulates files instead of database.
This modules is inherited by specialized modules called TaskSpool.pm, MessageSpool.pm KeySpool.pm and soon SubscribeSpool.pm which add specislized subs and use different regexp to define the name of the files stored in spool - this mainly to maintain compatibility with previous versions of Sympa.
These specialized modules also have specialized subs due to the fact that they handle diffrent functions; for example, SubscribeSpool.pm has the "sub_request_exists" method which checks whether a subscription for a list is already in spool.

Soji did a great work on the SympspoolClassic.pm module to port previous functions that existed in Sympaspool. Briefly, SympaSpool.pm had a method called "get_content" that allowed to query the database. Soji rewrote it to be able, with exactly the same call to a "get_content" method in SympaspoolClassic, to get a list of files in spool that correspond to the query.

Finally, this is the point we discussed: I created a method in SympaspoolClassic.pm called "parse" that analyzes a file in spool. It analyses the filename, checks whether this a valid spool file and get the content a the file a string. This allows to get basic informations regarding the file waiting in spool: list, robot, date of submission, etc.
Modules extending SympaspoolClassic.pm sometimes overrode this sub to do more work. subscribSpool.pm add, for example, the full parsing of the content, because it is necessary to handle the spools dan it has a very small computation cost.
Soji split this method in two: one method that analyzes the filename, another one that pasres the content. I disagreed and the follwong discussion ensued:

David,

Thanks for response.  I'd like to make detailed discussion on
sympa-developer, so below is brief comments.

On Wed, 10 Jul 2013 11:18:19 +0200
David Verdin <address@concealed> wrote:

Hi Soji!

i noticed with great pleasure how well you rewrote all the selctor part 
of the SympaspoolClassic.pm module. this is great! I had no time to deal 
with it yet, and it will be very usefull. I had in mind that we could 
not maintain the web view of the spols; With your code, it is finally 
possible!

I have another topic to discuss: the parse1 and parse2 subs that you 
used in replacement of the parse function. I see in your comments that 
you intend to replace them with Message::load and Message::new. I don't 
think that's suche a good move, for the following reasons:

  * the parse function was originally designed to give basic
    informations regarding the spool - any spool, actually - even the
    task spool, which does not contain message. I just want to gather
    the file, list and robot name, along with the file content, that can
    be parsed after, but it is not necessary.

As I clarified by refactoring for these weeks, almost all calls
of <spool>->next(), <spool>->get_content() etc. are followed by
Message->new() calls.

Splitting parse() to parse_1() and parse_2() has another intension:
single parse() function always reads all files in spool even when
some (or most) of them won't be used.

  * if we use the Message::new method in the spool, that means we will
    check S/MIME signatures, encryption, and generally speaking perform
    all the operations we do when processing a single message each time
    we want to know the spool content. I think this is overkill and,
    which is worse, could drastically impair performances.

These processes should be able to be delayed even in Message::new(),
I think.  Currently MIME parsing and consequent jobs are performed
in Message::load(), while several process on message objects
essntially need not MIME parsing.

  * In some SympaspoolClassic submethods, I override the parse method,
    but I start with calling the SUPER::parse method; that means I
    expect to find this method in SympaspoolClassic and I expect its
    normal outcome (filename checking, content gathering) to be
    performed. In addition, these subclasses (SubscribeSpool.pm, for
    example) don't deal with SMTP messages. If we try to parse an STMP
    message when dealing with a subscription request or a task, we take
    the risk to meet bugs.

My aim is also keeping spool classes minimized.  On next step,
I wanted to move get_storage_name() and analyze_file_name() to
message classes.  Please see attached (tentative, so buggy!) diff.

Anyway, let's continue on developpers list!


Thank you.

--- Soji

I think the code I wrote is troubling because sometimes I use 
SympaspoolClassic, and other times I use inheriting classes, such as 
TaslSpool or KeySpool.
We could probably keep SympaspoolClassic at the lowest possible level. 
Is should be a class specialized in spool mnipulation: adding and 
removing file, list files, count files, analyse file name, etc.
Any operation explicitely linked to a particualr spool (check whether a 
subscription request was requested before, select item by priority, 
etc.) should be addressed by specialized classes, such as KeySpool or 
TaskSpool.
Simply put: SympaspoolClassic class would never be used directly, only 
inheriting classes would be used.

What do you think of all this?

Best regards,

David

P.S.: For today, I'll revert to using parse function alone - it will be 
versionned - just to be able to swork with my current framework.

--
A bug in Sympa? Quick! To the bug tracker!

David Verdin Infrastructure pour les Services Informatiques
Tél : +33 2 23 23 69 71 Fax : +33 2 23 23 71 21   www.renater.fr	RENATER 263 Avenue du Gal Leclerc 35042 Rennes Cedex

Index: wwsympa/bounced.pl.in
===================================================================
--- wwsympa/bounced.pl.in       (リビジョン 9459)
+++ wwsympa/bounced.pl.in       (作業コピー)
@@ -261,7 +261,9 @@
 $SIG{'TERM'} = 'sigterm';
 my $end = 0;
 
-my $spool = new SympaspoolClassic('bounce');
+my $spool = SympaspoolClassic->new(
+    'bounce', undef, 'generator' => 'BounceMessage'
+);
 
 
 Log::do_log('debug','starting infinite loop');
@@ -273,19 +275,8 @@
     # Process grouped notifications
     Site->send_notify_to_listmaster(undef, undef, 1, undef);
 
-    my $spooled_bounce;
-    while ($spooled_bounce = $spool->next){
-       my $bounce = undef;
-       $bounce = BounceMessage->new($spooled_bounce)
-           if $spooled_bounce;
-       unless ($bounce) {
-           Log::do_log('err',
-               'Message %s: badly formatted bounce message. Ignoring.',
-               $spooled_bounce->{'messagekey'}
-           );
-           $spool->move_to_bad($spooled_bounce->{'messagekey'});
-           next;
-       }
+    my $bounce;
+    while ($bounce = $spool->next) {
        if ($bounce->process) {
            unless ($spool->remove_message($bounce->{'messagekey'})) {
                Log::do_log ('err',
Index: src/lib/Task.pm
===================================================================
--- src/lib/Task.pm     (リビジョン 9459)
+++ src/lib/Task.pm     (作業コピー)
@@ -81,6 +81,31 @@
     return $task;
 }
 
+sub serialize {
+    my $self = shift;
+
+    $data = {
+       'messagekey' => $self->implode_metadata,
+       'messageasstring' => $self->as_string(),
+       'date' => $self->{'date'},
+       'task_date' => $self->{'date'},
+       'task_label' => $self->{'label'},
+       'task_model' => $self->{'model'},
+       'task_flavour' => $self->{'flavour'},
+    };
+    if ($self->list) {
+        $data->{'list'} = $self->list->name;
+        $data->{'robot'} = $self->robot->domain;
+       $data->{'task_object'} = $self->{'id'};
+    } elsif ($self->robot) {
+        $data->{'robot'} = $self->robot->domain;
+        $data->{'task_object'}= '_global';
+    }
+
+    return $data;
+}
+
+
 ## task creation in spool
 sub create {
     my $param = shift;
Index: src/lib/Site.pm
===================================================================
--- src/lib/Site.pm     (リビジョン 9459)
+++ src/lib/Site.pm     (作業コピー)
@@ -1014,19 +1014,17 @@
 
     my $message;
     if ($list) {
-       $message = Message->new({
-           'messageasstring' => $messageasstring, 'noxsympato' => 1,
-           'list_object' => $list,
-       });
+       $message = bless {
+           'msg_as_string' => $messageasstring, 'list' => $list,
+       } => 'Message';
     } elsif (ref $robot) {
-       $message = Message->new({
-           'messageasstring' => $messageasstring, 'noxsympato' => 1,
-           'robot_object' => $robot,
-       });
+       $message = bless {
+           'msg_as_string' => $messageasstring, 'robot' => $robot,
+       } => 'Message';
     } else {
-       $message = Message->new({
-           'messageasstring' => $messageasstring, 'noxsympato' => 1,
-       });
+       $message = bless {
+           'msg_as_string' => $messageasstring,
+       } => 'Message';
     }
 
     ## SENDING
Index: src/lib/KeySpool.pm
===================================================================
--- src/lib/KeySpool.pm (リビジョン 9459)
+++ src/lib/KeySpool.pm (作業コピー)
@@ -1,114 +0,0 @@
-# KeySpool: this module contains methods to handle filesystem spools 
containing moderated messages.
-# RCS Identication ; $Revision: 6646 $ ; $Date: 2010-08-19 10:32:08 +0200 
(jeu 19 aoû 2010) $ 
-#
-# Sympa - SYsteme de Multi-Postage Automatique
-# Copyrigh (c) 1997, 1998, 1999, 2000, 2001 Comite Reseau des Universites
-# Copyright (c) 1997,1998, 1999 Institut Pasteur & Christophe Wolfhugel
-#
-# 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 KeySpool;
-
-use strict;
-use warnings;
-
-use SympaspoolClassic;
-use Log;
-
-our @ISA = qw(SympaspoolClassic);
-
-our $filename_regexp = '^(\S+)_(\w+)(\.distribute)?$';
-
-sub new {
-    Log::do_log('debug2', '(%s, %s)', @_);
-    return shift->SUPER::new('mod', shift);
-}
-
-sub get_storage_name {
-    my $self = shift;
-    my $filename;
-    my $param = shift;
-    if ($param->{'list'} && $param->{'robot'}) {
-       $filename = 
$param->{'list'}.'@'.$param->{'robot'}.'_'.$param->{'authkey'};
-    }
-    return $filename;
-}
-
-sub analyze_file_name {
-    Log::do_log('debug3', '(%s, %s, %s)', @_);
-    my $self = shift;
-    my $key  = shift;
-    my $data = shift;
-
-    unless($key =~ /$filename_regexp/){
-       Log::do_log('err',
-           'File %s name does not have the proper format', $key);
-       return undef;
-    }
-    my $list_id;
-    ($list_id, $data->{'authkey'}, $data->{'validated'}) = ($1, $2, $3);
-    ($data->{'list'}, $data->{'robot'}) = split /\@/, $list_id;
-
-    $data->{'list'} = lc($data->{'list'});
-    $data->{'robot'} = lc($data->{'robot'});
-    return undef
-       unless $data->{'robot_object'} = Robot->new($data->{'robot'});
-
-    my $listname;
-    #FIXME: is this needed?
-    ($listname, $data->{'type'}) =
-       $data->{'robot_object'}->split_listname($data->{'list'}); #FIXME
-    return undef
-       unless defined $listname and
-       $data->{'list_object'} =
-       List->new($listname, $data->{'robot_object'});
-
-    ## Get priority
-
-    $data->{'priority'} = $data->{'list_object'}->priority;
-
-    ## Get file date
-
-    $data->{'date'} = (stat $data->{'file'})[9];
-
-    return $data;
-}
-
-## Return messages not validated yet.
-sub get_awaiting_messages {
-    my $self = shift;
-    my $param = shift;
-    $param->{'selector'}{'validated'} = ['.distribute','ne'];
-    return $self->get_content($param);
-}
-
-sub validate_message {
-    my $self = shift;
-    my $key  = shift;
-
-    unless(File::Copy::copy($self->{'dir'} . '/' . $key,
-       $self->{'dir'} . '/' . $key . '.distribute'
-    )) {
-       Log::do_log('err', 'Could not rename file %s/%s: %s',
-           $self->{'dir'}, $key, $!);
-       return undef;
-    }
-    unless (unlink($self->{'dir'} . '/' . $key)) {
-       Log::do_log('err', 'Could not unlink message %s/%s: %s',
-           $self->{'dir'}, $key, $!);
-    }
-    return 1;
-}
-
-1;
Index: src/lib/Sympaspool.pm
===================================================================
--- src/lib/Sympaspool.pm       (リビジョン 9459)
+++ src/lib/Sympaspool.pm       (作業コピー)
@@ -431,6 +431,11 @@
     my $sender = $metadata->{'sender'};
     $sender |= '';
 
+    # new style
+    if (ref $message_asstring) {
+       return $self->_store_new($message_asstring, $metadata, $locked)
+    }
+
     Log::do_log('debug2',
        '(%s, <message_asstring>, list=%s, robot=%s, date=%s, %s)',
        $self, $metadata->{'list'}, $metadata->{'robot'}, $metadata->{'date'},
@@ -512,6 +517,98 @@
     return $messagekey;
 }
 
+sub _store_new {  
+    my $self = shift;
+    my $message = shift;  
+    my $metadata = shift; # a set of attributes related to the spool
+    my $locked = shift;   # if define message must stay locked after store
+
+    Log::do_log('debug2',
+       '(%s, %s, list=%s, robot=%s, date=%s, %s)',
+       $self, $message, $message->list, $message->robot, $message->{'date'},
+       $locked);
+
+    if ($self->{'spoolname'} ne 'task' and
+       $message->as_string() ne 'rebuild' and
+       $self->{'spoolname'} ne 'digest' and
+       $self->{'spoolname'} ne 'subscribe' and
+       $self->{'spoolname'} ne 'signoff'
+    ) {
+       $metadata = $message->serialize;
+    } else {
+       $metadata->{'messageasstring'} = $message->as_string();
+    }
+
+    my $b64msg = MIME::Base64::encode($metadata->{'messageasstring'});
+
+    if (defined $metadata->{'subject'}) {
+       $metadata->{'subject'} = substr $$metadata->{'subject'}, 0, 109;
+    } else {
+       $metadata->{'subject'} = '';
+    }
+    if (defined $metadata->{'messageid'}) {
+       $metadata->{'messageid'} = substr $metadata->{'messageid'}, 0, 295;
+    } else {
+       $metadata->{'messageid'} = '';
+    }
+    $metadata->{'headerdate'} = substr $message->get_header('Date'), 0, 78
+       if defined $metadata->{'headerdate'};
+    if (defined $metadata->{'sender'}) {
+       $metadata->{'sender'} = substr $metadata->{'sender'}, 0, 109;
+    } else {
+       $metadata->{'sender'} = '';
+    }
+    $metadata->{'date'}= int(time)
+       unless $metadata->{'date'};
+    $metadata->{'size'} = length $message->as_string
+       unless $metadata->{'size'};
+    $metadata->{'message_status'} = 'ok';
+
+    my ($insertpart1, $insertpart2, @insertparts) = ('', '');
+    foreach my $meta (
+       qw(list authkey robot message_status priority date type subject sender
+       messageid size headerdate spam_status dkim_privatekey dkim_d dkim_i
+       dkim_selector task_label task_date task_model
+       task_flavour task_object)
+    ) {
+       $insertpart1 .= ', ' . $meta . '_spool';
+       $insertpart2 .= ', ?';
+       push @insertparts, $metadata->{$meta};
+    }
+    my $lock = $$.'@'.hostname() ;
+
+    push @sth_stack, $sth;
+
+    $sth = SDM::do_prepared_query(
+       sprintf(
+           q{INSERT INTO spool_table
+             (spoolname_spool, messagelock_spool, message_spool%s)
+             VALUES (?, ?, ?%s)},
+           $insertpart1, $insertpart2
+       ),
+       $self->{'spoolname'}, $lock, $b64msg, @insertparts
+    );
+    # this query returns the autoinc primary key as result of this insert
+    $sth = SDM::do_prepared_query(
+       q{SELECT messagekey_spool as messagekey
+         FROM spool_table
+         WHERE messagelock_spool = ? AND date_spool = ?},
+       $lock, $metadata->{'date'}
+    );
+    ##FIXME: should check error
+
+    my $inserted_message = $sth->fetchrow_hashref('NAME_lc');
+    my $messagekey = $inserted_message->{'messagekey'};
+    
+    $sth->finish;
+    $sth = pop @sth_stack;
+
+    unless ($locked) {
+       $self->unlock_message($messagekey);     
+    }
+    return $messagekey;
+}
+
 ################"
 # remove a message in database spool using (messagekey,list,robot) which are 
a unique id in the spool
 #
Index: src/lib/SympaspoolClassic.pm
===================================================================
--- src/lib/SympaspoolClassic.pm        (リビジョン 9472)
+++ src/lib/SympaspoolClassic.pm        (作業コピー)
@@ -88,6 +88,7 @@
        'dir' => $dir,
        'sortby' => ($opts{'sortby'} || undef),
        'way' => ($opts{'way'} || undef),
+       'generator' => ($opts{'generator'} || undef),
     } => $pkg;
 
     Log::do_log('debug3', 'Spool to scan "%s"', $dir);
@@ -234,6 +235,11 @@
     my $self = shift;
     my $key  = shift;
 
+    # new syle
+    if ($self->{'generator'}) {
+       return $self->{'generator'}->new({'messagekey' => $key});
+    }
+
     unless ($key) {
        Log::do_log('err',
            'Unable to find out which file to process');
@@ -260,6 +266,13 @@
     my $key  = shift;
     my $data = shift;
 
+    # new style
+    if ($self->{'generator'}) {
+       my $messageasstring = $self->get_file_content($key);
+       return undef unless defined $messageasstring;
+       return $data->load($messageasstring);
+    }
+
     unless ($key) {
        Log::do_log('err',
            'Unable to find out which file to process');
@@ -585,6 +598,12 @@
     my $self = shift;
     my $messageasstring = shift;
     my $param = shift;
+
+    # new style
+    if (ref $messageasstring) {
+       return $self->_store_new($messageasstring, $param);
+    }
+
     my $target_file = $param->{'filename'};
     $target_file ||= $self->get_storage_name($param);
 ##    Log::do_log('trace', 'Storing in file %s/%s',
@@ -599,6 +618,32 @@
     return 1;
 }
 
+sub _store_new {  
+    my $self = shift;
+    my $message = shift;
+    my $param = shift;
+
+    my $data = $message->serialize;
+
+    my $target_file = $data->{'messagekey'};
+    if (index($target_file, '*') >= 0) {
+       my $random = int rand 10000;
+       $target_file =~ s/\*/$random/eg;
+    }
+
+    #FIXME: This might overwrite existing file.
+    my $fh;
+    unless(open $fh, '>', $self->{'dir'} . '/' . $target_file) {
+       Log::do_log('err', 'Unable to write file %s to spool %s',
+           $target_file, $self->{'dir'});
+       return undef;
+    }
+    print $fh $data->{'messageasstring'};
+    close $fh;
+
+    return $target_file;
+}
+
 # NOTE: This should be moved to Message class.
 sub get_storage_name {
     my $self = shift;
Index: src/lib/HeldMessage.pm
===================================================================
--- src/lib/HeldMessage.pm      (リビジョン 9459)
+++ src/lib/HeldMessage.pm      (作業コピー)
@@ -1,4 +1,4 @@
-# KeySpool: this module contains methods to handle filesystem spools 
containing moderated messages.
+# HeldMessage: this module contains methods to handle moderated messages.
 # RCS Identication ; $Revision: 6646 $ ; $Date: 2010-08-19 10:32:08 +0200 
(jeu 19 aoû 2010) $ 
 #
 # Sympa - SYsteme de Multi-Postage Automatique
@@ -18,95 +18,104 @@
 # 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 KeySpool;
+package HeldMessage;
 
 use strict;
 use warnings;
 
-use SympaspoolClassic;
+use Message;
 use Log;
 
-our @ISA = qw(SympaspoolClassic);
+our @ISA = qw(Message);
 
 our $filename_regexp = '^(\S+)_(\w+)(\.distribute)?$';
 
-sub new {
-    Log::do_log('debug2', '(%s, %s)', @_);
-    return shift->SUPER::new('mod', shift);
-}
+sub implode_metadata {
+    my $self = shift;
+    my $key;
 
-sub get_storage_name {
-    my $self = shift;
-    my $filename;
-    my $param = shift;
-    if ($param->{'list'} && $param->{'robot'}) {
-       $filename = 
$param->{'list'}.'@'.$param->{'robot'}.'_'.$param->{'authkey'};
+    if ($self->list) {
+        $key = sprintf '%s.%d_%s%s',
+            $self->list->get_id, ($self->{'authkey'} || '*'),
+           ($self->{'validated'} ? '.distribute' : '');
+    } else {
+        Log::do_log('err',
+            'Insufficient parameters provided to create file name');
+        return undef;
     }
-    return $filename;
+    return $key;
 }
 
-sub analyze_file_name {
+sub explode_metadata {
     Log::do_log('debug3', '(%s, %s, %s)', @_);
     my $self = shift;
-    my $key  = shift;
-    my $data = shift;
+    my $datas = shift;
 
-    unless($key =~ /$filename_regexp/){
-       Log::do_log('err',
-           'File %s name does not have the proper format', $key);
-       return undef;
+    my ($list_id, $robot, $name, $type, $list);
+
+    if ($datas->{'list'} or $datas->{'robot'}) {
+       $self->{'listname'} = $datas->{'list'};
+       $self->{'robot_id'} = $datas->{'robot'};
+       $self->{'authkey'} = $datas->{'authkey'};
+       $self->{'validated'} = $datas->{'validated'};
+    } elsif ($datas->{'messagekey'}) {
+        $self->{'messagekey'} = $datas->{'messagekey'};
+        return undef
+            unless $datas->{'messagekey'} =~ /$filename_regexp/;
+        $list_id = $1;
+       $self->{'authkey'} = $2;
+       $self->{'validated'} = ($3 ? 1 : 0);
+        ($self->{'listname'}, $self->{'robot_id'}) = split /\@/, $list_id;
+    } else {
+        Log::do_log('err', 'No metadata for message');
+        return undef;
     }
-    my $list_id;
-    ($list_id, $data->{'authkey'}, $data->{'validated'}) = ($1, $2, $3);
-    ($data->{'list'}, $data->{'robot'}) = split /\@/, $list_id;
 
-    $data->{'list'} = lc($data->{'list'});
-    $data->{'robot'} = lc($data->{'robot'});
     return undef
-       unless $data->{'robot_object'} = Robot->new($data->{'robot'});
+       unless $robot = Robot->new($self->{'robot_id'}, 'just_try' => 1);
 
-    my $listname;
-    #FIXME: is this needed?
-    ($listname, $data->{'type'}) =
-       $data->{'robot_object'}->split_listname($data->{'list'}); #FIXME
+    ($name, $type) = $robot->split_listname($self->{'listname'});
     return undef
-       unless defined $listname and
-       $data->{'list_object'} =
-       List->new($listname, $data->{'robot_object'});
+       unless defined $name and
+       $list = List->new($listname, $robot, {'just_try' => 1});
 
+    $self->{'list'} = $list;
+
     ## Get priority
 
-    $data->{'priority'} = $data->{'list_object'}->priority;
+    $self->{'priority'} = $list->priority;
 
     ## Get file date
 
-    $data->{'date'} = (stat $data->{'file'})[9];
+    $self->{'date'} = (stat $datas->{'file'})[9];
 
-    return $data;
+    return $self;
 }
 
 ## Return messages not validated yet.
 sub get_awaiting_messages {
     my $self = shift;
     my $param = shift;
-    $param->{'selector'}{'validated'} = ['.distribute','ne'];
+    $param->{'selector'}{'validated'} = ['1', 'ne'];
     return $self->get_content($param);
 }
 
-sub validate_message {
+sub validate {
     my $self = shift;
-    my $key  = shift;
 
-    unless(File::Copy::copy($self->{'dir'} . '/' . $key,
-       $self->{'dir'} . '/' . $key . '.distribute'
+    my $key = $self->{'messagekey'};
+    my $modspool = SympaspoolClassic->new('mod');
+
+    unless(File::Copy::copy($modspool->{'dir'} . '/' . $key,
+       $modspool->{'dir'} . '/' . $key . '.distribute'
     )) {
        Log::do_log('err', 'Could not rename file %s/%s: %s',
-           $self->{'dir'}, $key, $!);
+           $modspool->{'dir'}, $key, $!);
        return undef;
     }
-    unless (unlink($self->{'dir'} . '/' . $key)) {
+    unless (unlink($modspool->{'dir'} . '/' . $key)) {
        Log::do_log('err', 'Could not unlink message %s/%s: %s',
-           $self->{'dir'}, $key, $!);
+           $modspool->{'dir'}, $key, $!);
     }
     return 1;
 }
Index: src/lib/Message.pm
===================================================================
--- src/lib/Message.pm  (リビジョン 9459)
+++ src/lib/Message.pm  (作業コピー)
@@ -66,6 +66,8 @@
 #use Conf; # loaded in Site
 #use Log; # loaded in Conf
 
+our $filename_regexp = '^(\S+)\.(\d+)\.\w+$';
+
 my %openssl_errors = (
     1 => 'an error occurred parsing the command options',
     2 => 'one of the input files could not be read',
@@ -269,10 +271,7 @@
     $self->{'msg_as_string'} = $messageasstring;
     $self->{'size'} = length $messageasstring;
 
-    my $parser = MIME::Parser->new();
-    $parser->output_to_core(1);
-    my $msg = $parser->parse_data(\$messageasstring);
-    $self->{'msg'} = $msg;
+    $self->as_entity(); # set MIME entity.
 
     # Get envelope sender, actual sender according to sender_headers site
     # parameter and spam status according to spam_status scenario.
@@ -308,19 +307,71 @@
 =cut
 
 sub explode_metadata {
-    my $self = shift;
+    Log::do_log('debug3', '(%s, %s)', @_);
+    my $self  = shift;
     my $datas = shift;
 
-    my $file = $datas->{'file'};
-    return $self unless $file;
-    return $self if $self->{'date'};
+    my ($list_id, $extra, $robot, $name, $type, $list);
 
-    $file =~ s/^.*\/([^\/]+)$/$1/;
-    if ($file =~ /^(\S+)\.(\d+)\.\w+$/) {
-#      $self->{'rcpt'} = $1;
-       $self->{'date'} = $2;
+    # {'listname'} item is not the list name but mailbox of list address.
+    if ($datas->{'list'} or $datas->{'robot'}) {
+       ($self->{'listname'}, $self->{'robot_id'}) =
+           ($datas->{'list'}, $datas->{'robot'});
+    } elsif ($datas->{'messagekey'}) {
+       $self->{'messagekey'} = $datas->{'messagekey'};
+       return undef
+           unless $datas->{'messagekey'} =~ /$filename_regexp/;
+       ($list_id, $extra) = ($1, $2);
+       ($self->{'listname'}, $self->{'robot_id'}) = split /\@/, $list_id;
+    } else {
+       Log::do_log('err', 'No metadata for message');
+       return undef;
     }
-    
+
+    return $self
+       unless $robot = Robot->new($self->{'robot_id'}, 'just_try' => 1);
+    ($name, $type) = $robot->split_listname($self->{'listname'});
+    if (defined $name) {
+       $list = List->new($name, $robot, {'just_try' => 1});
+    }
+
+    if ($robot) {
+       $self->{'robot'} = $robot;
+    } elsif ($list) {
+       $self->{'list'} = $list;
+    }
+    $self->{'listtype'} = $type;
+
+    ## Get priority
+    if ($type and $type eq 'listmaster') {
+       ## highest priority
+       $self->{'priority'} = 0;
+    } elsif ($type and $type eq 'owner') { # -request
+       $self->{'priority'} = $robot->request_priority;
+    } elsif ($type and $type eq 'return_path') { # -owner
+       $self->{'priority'} = $robot->owner_priority;
+    } elsif ($type and $type eq 'sympa') {     
+       $self->{'priority'} = $robot->sympa_priority;
+    } elsif (ref $list and $list->isa('List')) {
+       $self->{'priority'} = $list->priority;
+    } else {
+       $self->{'priority'} = $robot->default_list_priority;
+    }
+
+    Log::do_log('debug3',
+       'messagekey=%s, list=%s, robot=%s, priority=%s',
+       $self->{'messagekey'}, $self->{'list'}, $self->{'robot'},
+       $self->{'priority'}
+    );
+
+    ## Get file date
+
+    if ($extra and $extra =~ /^\d+$/) {
+       $self->{'date'} = $extra;
+    } elsif ($datas->{'file'}) {
+       $self->{'date'} = (stat $datas->{'file'})[9];
+    }
+
     return $self;
 }
 
@@ -347,6 +398,33 @@
 
 =cut
 
+sub serialize {
+    my $self = shift;
+
+    my $data = {
+       'messagekey' => $self->implode_metadata,
+       'messageasstring' => $self->to_string,
+       'size' => $self->{'size'},
+       'date' => $self->{'date'},
+       'spam_status' => $self->{'spam_status'},
+       'messageid' => $self->get_msg_id,
+       'sender' => $self->get_sender_email,
+    };
+    $data->{'subject'} = $self->get_header('Subject');
+    $data->{'headerdate'} = $self->get_header('Date');
+    if ($self->list) {
+       $data->{'list'} = $self->list->name;
+       $data->{'robot'} = $self->robot->domain;
+    } elsif ($self->robot) {
+       $data->{'robot'} = $self->robot->domain;
+    }
+    # for KeySpool
+    $data->{'authkey'} = $self->{'authkey'}
+       if  $self->{'authkey'};
+
+    return $data;
+}
+
 sub to_string {
     my $self = shift;
 
@@ -385,6 +463,24 @@
     return $str;
 }
 
+sub implode_metadata {
+    my $self = shift;
+    my $key;
+
+    if ($self->robot) {
+       my $id =
+           ($self->list || $self->robot)->get_address($self->{'listtype'});
+       $id =~ s/\@.+//;
+       $key = sprintf '%s@%s.%d.*',
+           $id, $self->robot->domain, ($self->{'date'} || time);
+    } else {
+       Log::do_log('err',
+           'Insufficient parameters provided to create file name');
+       return undef;
+    }
+    return $key;
+}
+
 =over 4
 
 =item get_header ( FIELD, [ SEP ] )
@@ -1475,6 +1571,14 @@
 
 sub as_entity {
     my $self = shift;
+
+    unless (defined $self->{'msg'}) {
+       my $parser = MIME::Parser->new();
+       $parser->output_to_core(1);
+       my $msg_as_string = $self->{'msg_as_string'};
+       $self->{'msg'} = $parser->parse_data(\$msg_as_string);
+    }
+
     return $self->{'msg'};
 }
 
Index: src/lib/BounceMessage.pm
===================================================================
--- src/lib/BounceMessage.pm    (リビジョン 9459)
+++ src/lib/BounceMessage.pm    (作業コピー)
@@ -35,14 +35,12 @@
              "User's Disk Quota Exceeded:" => '4.2.2');
 
 ## Creates a new object
-sub new {
+sub load {
     Log::do_log('debug2', '(%s, %s)', @_);
-    my $pkg   = shift;
-    my $datas = shift;
-    my $self;
-
+    my $self = shift;
     return undef
-       unless $self = $pkg->SUPER::new($datas);
+       unless $self->SUPER::load(@_);
+
     unless ($self->as_string()) {
        Log::do_log('notice',
            'Ignoring bounce %s, because it is empty', $self);
Index: src/lib/mail.pm
===================================================================
--- src/lib/mail.pm     (リビジョン 9459)
+++ src/lib/mail.pm     (作業コピー)
@@ -722,8 +722,10 @@
        my $string_to_send;
        if ($message->is_signed) {
            $string_to_send = $message->as_string();
+       } elsif ($message->{'smime_crypted'}) {
+           $string_to_send = $message->get_mime_message->as_string(); #FIXME
        } else {
-           $string_to_send = $message->get_mime_message->as_string(); #FIXME
+           $string_to_send = $message->as_string();
        }
 
        *SMTP = &smtpto($from, $rcpt, $robot);

Attachment: smime.p7s
Description: Signature cryptographique S/MIME