add basic CREATE-ON-POST support.

5 files changed, 1114 insertions, 0 deletions

diff --git a/fml/lib/FML/Command/Admin/newcopml.pm b/fml/lib/FML/Command/Admin/newcopml.pm
new file mode 100644
index 00000000..b8c4bed4
--- /dev/null
+++ b/fml/lib/FML/Command/Admin/newcopml.pm
@@ -0,0 +1,169 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2006 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML$
+#
+
+package FML::Command::Admin::newcopml;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+use FML::Command::Admin::newml;
+push(@ISA, qw(FML::Command::Admin::newml));
+
+=head1 NAME
+
+FML::Command::Admin::newcopml - set up a new create-on-post mailing list.
+
+=head1 SYNOPSIS
+
+    use FML::Command::Admin::newcopml;
+    $obj = new FML::Command::Admin::newcopml;
+    $obj->newcopml($curproc, $command_args);
+
+See C<FML::Command> for more details.
+
+=head1 DESCRIPTION
+
+set up a new mailing list.
+create mailing list directory,
+install config.cf, include, include-ctl et. al.
+
+=head1 METHODS
+
+=head2 process($curproc, $command_args)
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+# Descriptions: not need lock in the first time.
+#    Arguments: none
+# Side Effects: none
+# Return Value: NUM( 1 or 0)
+sub need_lock { 0;}
+
+
+# Descriptions: install create-on-post mailing list configuration.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: create mailing list directory,
+#               install config.cf, include, include-ctl et. al.
+# Return Value: none
+sub process
+{
+    my ($self, $curproc, $command_args) = @_;
+
+    # 1. run newml.
+    $self->SUPER::process($curproc, $command_args);
+
+    # 2. set up create-on-post configuration.
+    use FML::ML::Control;
+    my $control = new FML::ML::Control;
+    $control->set_mode("create-on-post");
+    $control->install_createonpost($curproc, $command_args);
+}
+
+
+# Descriptions: show cgi menu for newcopml command.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: create home directories, update aliases, ...
+# Return Value: none
+sub cgi_menu
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $r = '';
+
+    # XXX-TODO: $command_args checked ?
+    eval q{
+        use FML::CGI::ML;
+        my $obj = new FML::CGI::ML;
+        $obj->cgi_menu($curproc, $command_args);
+    };
+    if ($r = $@) {
+        croak($r);
+    }
+}
+
+
+=head1 UTILITIES
+
+=head2 set_force_mode($curproc, $command_args)
+
+set force mode.
+
+=head2 get_force_mode($curproc, $command_args)
+
+return if force mode is enabled or not.
+
+=cut
+
+
+# Descriptions: set force mode.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update $self.
+# Return Value: none
+sub set_force_mode
+{
+    my ($self, $curproc, $command_args) = @_;
+    $self->{ _force_mode } = 1;
+}
+
+
+# Descriptions: return if force mode is enabled or not.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: none
+# Return Value: none
+sub get_force_mode
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $options = $curproc->command_line_options();
+
+    if (defined $self->{ _force_mode }) {
+	return( $self->{ _force_mode } ? 1 : 0 );
+    }
+    else {
+	return( (defined $options->{ force }) ? 1 : 0 );
+    }
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::Command::Admin::newcopml first appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Command/Admin/rmcopml.pm b/fml/lib/FML/Command/Admin/rmcopml.pm
new file mode 100644
index 00000000..a9ff1b60
--- /dev/null
+++ b/fml/lib/FML/Command/Admin/rmcopml.pm
@@ -0,0 +1,167 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2006 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML$
+#
+
+package FML::Command::Admin::rmcopml;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+use FML::Command::Admin::rmml;
+push(@ISA, qw(FML::Command::Admin::rmml));
+
+=head1 NAME
+
+FML::Command::Admin::rmcopml - disable a new create-on-post mailing list.
+
+=head1 SYNOPSIS
+
+    use FML::Command::Admin::rmcopml;
+    $obj = new FML::Command::Admin::rmcopml;
+    $obj->rmcopml($curproc, $command_args);
+
+See C<FML::Command> for more details.
+
+=head1 DESCRIPTION
+
+set up a new mailing list.
+create mailing list directory,
+install config.cf, include, include-ctl et. al.
+
+=head1 METHODS
+
+=head2 process($curproc, $command_args)
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = {};
+    return bless $me, $type;
+}
+
+
+# Descriptions: not need lock in the first time.
+#    Arguments: none
+# Side Effects: none
+# Return Value: NUM( 1 or 0)
+sub need_lock { 0;}
+
+
+# Descriptions: disable create-on-post mailing list configuration.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: create mailing list directory,
+#               install config.cf, include, include-ctl et. al.
+# Return Value: none
+sub process
+{
+    my ($self, $curproc, $command_args) = @_;
+
+    $self->SUPER::process($curproc, $command_args);
+
+    use FML::ML::Control;
+    my $control = new FML::ML::Control;
+    $control->set_mode("create-on-post");
+    $control->remove_createonpost($curproc, $command_args);
+}
+
+
+# Descriptions: show cgi menu for rmcopml command.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: create home directories, update aliases, ...
+# Return Value: none
+sub cgi_menu
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $r = '';
+
+    # XXX-TODO: $command_args checked ?
+    eval q{
+        use FML::CGI::ML;
+        my $obj = new FML::CGI::ML;
+        $obj->cgi_menu($curproc, $command_args);
+    };
+    if ($r = $@) {
+        croak($r);
+    }
+}
+
+
+=head1 UTILITIES
+
+=head2 set_force_mode($curproc, $command_args)
+
+set force mode.
+
+=head2 get_force_mode($curproc, $command_args)
+
+return if force mode is enabled or not.
+
+=cut
+
+
+# Descriptions: set force mode.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: update $self.
+# Return Value: none
+sub set_force_mode
+{
+    my ($self, $curproc, $command_args) = @_;
+    $self->{ _force_mode } = 1;
+}
+
+
+# Descriptions: return if force mode is enabled or not.
+#    Arguments: OBJ($self) OBJ($curproc) HASH_REF($command_args)
+# Side Effects: none
+# Return Value: none
+sub get_force_mode
+{
+    my ($self, $curproc, $command_args) = @_;
+    my $options = $curproc->command_line_options();
+
+    if (defined $self->{ _force_mode }) {
+	return( $self->{ _force_mode } ? 1 : 0 );
+    }
+    else {
+	return( (defined $options->{ force }) ? 1 : 0 );
+    }
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::Command::Admin::rmcopml first appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/CreateOnPost.pm b/fml/lib/FML/CreateOnPost.pm
new file mode 100644
index 00000000..b8b136b4
--- /dev/null
+++ b/fml/lib/FML/CreateOnPost.pm
@@ -0,0 +1,149 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2006 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML: @template.pm,v 1.10 2006/01/07 13:16:41 fukachan Exp $
+#
+
+package FML::CreateOnPost;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+=head1 NAME
+
+FML::CreateOnPost - CREATE-ON-POST
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 C<new()>
+
+constructor.
+
+=cut
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) OBJ($curproc)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self, $curproc) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = { _curproc => $curproc };
+    return bless $me, $type;
+}
+
+
+# Descriptions: create ml. 
+#    Arguments: OBJ($self) STR($ml_addr)
+# Side Effects: none
+# Return Value: none
+sub create_ml
+{
+    my ($self, $ml_addr) = @_;
+    my $curproc = $self->{ _curproc };
+    my $myname  = "fml";
+    my $hints   = {};
+
+    # prepare parameters;
+    my ($ml_name, $ml_domain) = split(/\@/, $ml_addr);
+    $hints->{ ARGV }    = [ $ml_addr, "newml" ];
+    $hints->{ argv }    = [ $ml_addr, "newml", '-O', 'update-alias=no' ];
+    $hints->{ options } = { 'O' => { 'update-alias' => 'no' } };
+
+    eval q{
+	$curproc->log("emulate $myname to create $ml_name\@$ml_domain");
+
+	use FML::Process::Switch;
+	&FML::Process::Switch::NewProcess($curproc,
+					  $myname,
+					  $ml_name,
+					  $ml_domain,
+					  $hints);
+    };
+    $curproc->logerror($@) if $@;
+}
+
+
+# Descriptions: run distribute process.
+#    Arguments: OBJ($self) STR($ml_addr)
+# Side Effects: none
+# Return Value: none
+sub distribute_ml
+{
+    my ($self, $ml_addr) = @_;
+    my $curproc    = $self->{ _curproc };
+    my $myname     = "distribute";
+    my $maintainer = 'fukachan@home.fml.org';
+
+    # prepare parameters;
+    my ($ml_name, $ml_domain) = split(/\@/, $ml_addr);
+    my $hints   = {};
+    $hints->{ ARGV } = [ $ml_addr ];
+    $hints->{ argv } = [ $ml_addr ];
+    $hints->{ config_overload } = {
+	'article_post_restrictions' => 'permit_anyone',
+	'maintainer'                => $maintainer,
+    };
+
+    # open STDIO
+    my $queue = $curproc->incoming_message_get_current_queue();
+    if (defined $queue) {
+	my $class = "incoming";
+
+	close(STDIN);
+	unless ($queue->open($class, { in_channel => *STDIN{IO} })) {
+	    my $qid = $queue->id();
+	    $curproc->logerror("cannot open qid=$qid");
+	}
+    }
+    else {
+	$curproc->logerror("queue not found");
+	return;
+    }
+
+    eval q{
+	$curproc->log("emulate $myname for $ml_name\@$ml_domain");
+
+	use FML::Process::Switch;
+	&FML::Process::Switch::NewProcess($curproc,
+					  $myname,
+					  $ml_name,
+					  $ml_domain,
+					  $hints);
+    };
+    $curproc->logerror($@) if $@;
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::CreateOnPost appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Process/CreateOnPost.pm b/fml/lib/FML/Process/CreateOnPost.pm
new file mode 100644
index 00000000..cb1d171b
--- /dev/null
+++ b/fml/lib/FML/Process/CreateOnPost.pm
@@ -0,0 +1,512 @@
+#-*- perl -*-
+#
+# Copyright (C) 2006 Ken'ichi Fukamachi
+#          All rights reserved.
+#
+# $FML: CreateOnPost.pm,v 1.7 2006/01/09 14:00:54 fukachan Exp $
+#
+
+package FML::Process::CreateOnPost;
+
+use strict;
+use Carp;
+use vars qw($debug @ISA @EXPORT @EXPORT_OK);
+
+use FML::Config;
+use FML::Process::Kernel;
+@ISA = qw(FML::Process::Kernel);
+
+
+=head1 NAME
+
+FML::Process::CreateOnPost -- create-on-post ML master process.
+
+=head1 SYNOPSIS
+
+    use FML::Process::CreateOnPost;
+    $curproc = new FML::Process::CreateOnPost;
+    $curproc->run();
+
+=head1 DESCRIPTION
+
+FML::Process::CreateOnPost provides the main function for
+C<libexec/createonpost>.
+
+See C<FML::Process::Flow> for the flow detail.
+
+=head1 METHODS
+
+=head2 new($args)
+
+constructor.
+It make a C<FML::Process::Kernel> object and return it.
+
+=head2 prepare($args)
+
+load default config files,
+set up domain we need to fake,
+and
+fix @INC if needed.
+
+lastly, parse incoming message input from \*STDIN channel.
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) HASH_REF($args)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self, $args) = @_;
+    my $type    = ref($self) || $self;
+    my $curproc = new FML::Process::Kernel $args;
+    return bless $curproc, $type;
+}
+
+
+# Descriptions: preparation.
+#    Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub prepare
+{
+    my ($curproc, $args) = @_;
+    my $config = $curproc->config();
+
+    my $eval = $config->get_hook( 'createonpost_prepare_start_hook' );
+    if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }
+
+    $curproc->ml_variables_resolve();
+    $curproc->config_cf_files_load();
+    $curproc->env_fix_perl_include_path();
+    $curproc->scheduler_init();
+    $curproc->log_message_init();
+
+    if ($config->yes('use_createonpost_function')) {
+	$curproc->incoming_message_parse();
+    }
+    else {
+	$curproc->logerror("use of createonpost_program prohibited");
+	exit(0);
+    }
+
+    $eval = $config->get_hook( 'createonpost_prepare_end_hook' );
+    if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }
+}
+
+
+=head2 verify_request($args)
+
+dummy.
+
+=cut
+
+
+# Descriptions: dummy.
+#    Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: exit ASAP.
+#               longjmp() to help() if appropriate
+# Return Value: none
+sub verify_request
+{
+    my ($curproc, $args) = @_;
+    my $config = $curproc->config();
+
+    my $eval = $config->get_hook( 'createonpost_verify_request_start_hook' );
+    if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }
+
+    unless ($curproc->is_refused()) {
+	$curproc->_createonpost_verify_request();
+    }
+    else {
+	$curproc->logwarn("ignore this request");
+	exit(0);
+    }
+
+    $eval = $config->get_hook( 'createonpost_verify_request_end_hook' );
+    if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }
+}
+
+
+=head2 run($args)
+
+the top level dispatcher for C<createonpost>.
+
+=cut
+
+
+# Descriptions: just a switch, call _createonpost_main().
+#    Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub run
+{
+    my ($curproc, $args) = @_;
+    my $config = $curproc->config();
+
+    my $eval = $config->get_hook( 'createonpost_run_start_hook' );
+    if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }
+
+    unless ($curproc->is_refused()) {
+	$curproc->log("create-on-post run ...");
+	$curproc->_run_createonpost();
+    }
+    else {
+	$curproc->logwarn("ignore this request");
+    }
+
+    $eval = $config->get_hook( 'createonpost_run_end_hook' );
+    if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }
+}
+
+
+=head2 finish($args)
+
+dummy.
+
+=cut
+
+
+# Descriptions: dummy.
+#    Arguments: OBJ($curproc) HASH_REF($args)
+# Side Effects: none
+# Return Value: none
+sub finish
+{
+    my ($curproc, $args) = @_;
+    my $config = $curproc->config();
+
+    my $eval = $config->get_hook( 'createonpost_finish_start_hook' );
+    if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }
+
+    $eval = $config->get_hook( 'createonpost_finish_end_hook' );
+    if ($eval) { eval qq{ $eval; }; $curproc->logwarn($@) if $@; }
+}
+
+
+=head2 help()
+
+show help.
+
+=cut
+
+
+# Descriptions: show help.
+#    Arguments: none
+# Side Effects: none
+# Return Value: none
+sub help
+{
+    my $name = $0;
+    eval {
+	use File::Basename;
+	$name = basename($0);
+    };
+
+print <<"_EOF_";
+
+Usage: $name [options]
+
+[BUGS]
+
+_EOF_
+}
+
+
+=head1 INTERNAL FUNCTIONS
+
+Internal function fakes mail retrieve and forward mechanism.
+
+It fetches a message via POP3 or IMAP4 protocol and forward it into
+fml8 process.
+
+=cut
+
+
+my $ADDR_CREATE_ON_POST = 1;
+my $ADDR_FML8_MANAGED   = 2;
+my $ADDR_NORMAL         = 3;
+
+
+# Descriptions: retrieve a message and forward it into fml8 to parse
+#               incoming message.
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
+sub _createonpost_verify_request
+{
+    my ($curproc) = @_;
+    my ($restriction, $addrlist);
+
+    # 1. parse To: and Cc:
+    my ($all, $address2class, $class2address) = $curproc->_classify_address();
+    my $r_args = {
+	address_to_class => $address2class, 
+	class_to_address => $class2address,
+    };
+
+    # 1.1 and some preparations.
+    my $header      = $curproc->incoming_message_header();
+    my $return_path = $header->address_cleanup( $header->get('Return-Path') );
+    my $cred        = $curproc->credential();
+    my $sender      = $cred->sender();
+
+    # 2. check sender. 
+    $r_args->{ address_list } = [ $return_path, $sender ];
+    $restriction = 'createonpost_sender_restrictions';
+    $addrlist    = $curproc->_apply_restrictions($restriction, $r_args);
+    if ($addrlist->{ "deny" }) {
+	$curproc->log("Return-Path: $return_path") if $return_path;
+	$curproc->log("sender: $sender") if $sender;
+	$curproc->log("$restriction: denied");
+	$curproc->stop_this_process();
+	return;
+    }
+
+    # 3. check recipients (To: and Cc:).
+    $r_args->{ address_list } = $all;
+    $restriction = 'createonpost_subscribe_restrictions',
+    $addrlist    = $curproc->_apply_restrictions($restriction, $r_args);
+
+    # 4. save for later use.
+    my $pcb = $curproc->pcb();
+    $pcb->set("createonpost", "address_list", $addrlist);
+    $pcb->set("createonpost", "address_to_class", $address2class);
+    $pcb->set("createonpost", "class_to_address", $class2address);
+}
+
+
+# Descriptions: classify recipient addresses (To: and Cc:) in header.
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: ARRAY(ARRAY_REF, HASH_REF, $HASH_REF)
+sub _classify_address
+{
+    my ($curproc)  = @_;
+    my $config     = $curproc->config();
+    my $ml_domain  = $curproc->ml_domain();
+    my $header     = $curproc->incoming_message_header();
+    my $to         = $header->get('To') || '';
+    my $cc         = $header->get('Cc') || '';
+    my $fields     = "$to, $cc";
+    my $result     = {};
+    my $addrlist   = [];
+    my $rev_result = {
+	$ADDR_CREATE_ON_POST => [],
+	$ADDR_FML8_MANAGED   => [],
+	$ADDR_NORMAL         => [],
+    };
+
+    use Mail::Address;
+    my (@addr) = Mail::Address->parse($fields);
+    for my $_addr (@addr) {
+	my $addr = $_addr->address();
+	push(@$addrlist, $addr);
+
+	# 1. create-on-post
+	if ($addr =~ /\@$ml_domain$/i) {
+	    $result->{ $addr } = $ADDR_CREATE_ON_POST;
+	    push(@{$rev_result->{ $ADDR_CREATE_ON_POST }}, $addr);
+	}
+	# 2. fml8 managed.
+	elsif ($curproc->is_fml8_managed_address($addr)) {
+	    $result->{ $addr } = $ADDR_FML8_MANAGED;
+	    push(@{$rev_result->{ $ADDR_FML8_MANAGED }}, $addr);
+	}
+	# 3. others
+	else {
+	    $result->{ $addr } = $ADDR_NORMAL;
+	    push(@{$rev_result->{ $ADDR_NORMAL }}, $addr);
+	}
+    }
+
+    return( $addrlist, $result, $rev_result );
+}
+
+
+# Descriptions: apply $createonpost_sender_restrictions rules.
+#    Arguments: OBJ($curproc) STR($restriction) HASH_REF($r_args)
+# Side Effects: none
+# Return Value: HASH_REF
+sub _apply_restrictions
+{
+    my ($curproc, $restriction, $r_args) = @_;
+    my $config      = $curproc->config();
+    my $rules       = $config->get_as_array_ref($restriction);
+    my $addrlist    = $r_args->{ address_list } || [];
+    my $result_data = {};
+    my $result_addr = {};
+
+    use FML::Restriction::CreateOnPost;
+    my $acl = new FML::Restriction::CreateOnPost $curproc;
+    my ($match, $result) = (0, 0);
+
+  RULE:
+    for my $rule (@$rules) {        # reject_XXX, permit_anyone
+      ADDR:
+	for my $addr (@$addrlist) { # e.g. COP, MANAGED, OTHER;
+	    next ADDR unless $addr;
+
+	    if ($acl->can($rule)) {
+		# match  = matched. return as soon as possible from here.
+		#          ASAP or RETRY the next rule, depends on the rule.
+		# result = action determined by matched rule.
+		($match, $result) = $acl->$rule($rule, $addr);
+	    }
+	    else {
+		($match, $result) = (0, undef);
+		$curproc->logwarn("unknown rule=$rule");
+	    }
+
+	    if ($match) {
+		$curproc->logdebug("match rule=$rule address=$addr");
+		$result_data->{ $result }++;
+		push(@{ $result_addr->{ $result } }, $addr );
+	    }
+	}
+    }
+
+    return $result_addr;
+}
+
+
+# Descriptions: create-on-post main dispatcher. 
+#    Arguments: OBJ($curproc)
+# Side Effects: none
+# Return Value: none
+sub _run_createonpost
+{
+    my ($curproc)        = @_;
+    my $pcb              = $curproc->pcb();
+    my $addr_list        = $pcb->get("createonpost", "address_list")     || {};
+    my $address_to_class = $pcb->get("createonpost", "address_to_class") || {};
+    my $class_to_address = $pcb->get("createonpost", "class_to_address") || {};
+    my (@process_list)   = ();
+
+    # address list
+    my (@deny_list)   = @{ $addr_list->{ "deny" }   || [] };
+    my (@permit_list) = @{ $addr_list->{ "permit" } || [] };
+
+    # 1. 
+    my $cop_list= $class_to_address->{ $ADDR_CREATE_ON_POST } || [];
+    for my $ml (@$cop_list) {
+	if ($curproc->is_fml8_managed_address($ml)) {
+	    $curproc->log("ml exist: $ml");
+	}
+	else {
+	    $curproc->log("ml fault: create $ml");
+	    $curproc->_create_ml($ml);
+	}
+    }
+
+    # 2. generate list to subscribe.
+  ADDR:
+    for my $addr (@permit_list) {
+	for my $ign (@deny_list) {
+	    if ($addr eq $ign) {
+		$curproc->log("ignore $addr");		
+		next ADDR;
+	    }
+ 	}
+	push(@process_list, $addr);
+    }
+
+    # 2.1 save user list on shared memory.
+    $curproc->_save_user_list(\@process_list);
+
+    # 3. run distribute processes.
+    for my $ml (@$cop_list) {
+        if ($curproc->is_fml8_managed_address($ml)) {
+	    $curproc->_distribute_ml($ml);
+        }
+        else {
+            $curproc->logerror("$ml not found");
+        }
+    }
+}
+
+
+# Descriptions: save user list for child process.
+#    Arguments: OBJ($curproc) ARRAY_REF($list)
+# Side Effects: none
+# Return Value: none
+sub _save_user_list
+{
+    my ($curproc, $list) = @_;
+
+    $curproc->set_address_fault();
+    $curproc->set_address_fault_list($list);
+    $curproc->log("subscribe? (@$list)");
+}
+
+
+# Descriptions: execute distribute process.
+#    Arguments: OBJ($curproc) STR($ml)
+# Side Effects: none
+# Return Value: none
+sub _distribute_ml
+{
+    my ($curproc, $ml) = @_;
+
+    use FML::CreateOnPost;
+    my $cop = new FML::CreateOnPost $curproc;
+    $cop->distribute_ml($ml);
+}
+
+
+=head1 FAULT HANDLING
+
+=head2 ML VALIDATION FAULT 
+
+This process checks the ML existence and call fault handler if not
+found. The fault handler creates a ML.
+
+=head2 ADDRESS VALIDATION FAULT 
+
+This process does not handle address fault that the specified address
+is not a member. Instead the executed process e.g. distirubition
+process handles it as address validation fault.
+
+=cut
+
+
+# Descriptions: create ml. 
+#    Arguments: OBJ($curproc) STR($ml_addr)
+# Side Effects: none
+# Return Value: none
+sub _create_ml
+{
+    my ($curproc, $ml_addr) = @_;
+
+    use FML::CreateOnPost;
+    my $cop = new FML::CreateOnPost $curproc;
+    $cop->create_ml($ml_addr);
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::Process::CreateOnPost first appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;
diff --git a/fml/lib/FML/Restriction/CreateOnPost.pm b/fml/lib/FML/Restriction/CreateOnPost.pm
new file mode 100644
index 00000000..7a18c9c8
--- /dev/null
+++ b/fml/lib/FML/Restriction/CreateOnPost.pm
@@ -0,0 +1,117 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2006 Ken'ichi Fukamachi
+#   All rights reserved. This program is free software; you can
+#   redistribute it and/or modify it under the same terms as Perl itself.
+#
+# $FML$
+#
+
+package FML::Restriction::CreateOnPost;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+push(@ISA, qw(FML::Restriction::Post));
+
+=head1 NAME
+
+FML::Restriction::CreateOnPost - restrictions on craete-on-post.
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=cut
+
+
+# Descriptions: constructor.
+#    Arguments: OBJ($self) OBJ($curproc)
+# Side Effects: none
+# Return Value: OBJ
+sub new
+{
+    my ($self, $curproc) = @_;
+    my ($type) = ref($self) || $self;
+    my $me     = { _curproc => $curproc };
+    return bless $me, $type;
+}
+
+
+# Descriptions: 
+#    Arguments: OBJ($self) STR($rule) STR($sender)
+# Side Effects: none
+# Return Value: ARRAY(STR, STR)
+sub reject_errormail
+{
+    my ($self, $rule, $sender) = @_;
+
+    if ($sender eq '<>') {
+	return("matched", "deny");
+    }
+
+    return(0, undef);
+}
+
+
+# Descriptions: 
+#    Arguments: OBJ($self) STR($rule) STR($sender)
+# Side Effects: none
+# Return Value: ARRAY(STR, STR)
+sub reject_fml8_managed_address
+{
+    my ($self, $rule, $sender) = @_;
+    my $curproc = $self->{ _curproc };
+
+    if ($curproc->is_fml8_managed_address($sender)) {
+	return("matched", "deny");
+    }
+
+    return(0, undef);
+}
+
+
+# Descriptions: 
+#    Arguments: OBJ($self) STR($rule) STR($sender)
+# Side Effects: none
+# Return Value: ARRAY(STR, STR)
+sub reject_createonpost_domain
+{
+    my ($self, $rule, $sender) = @_;
+    my $curproc   = $self->{ _curproc };
+    my $ml_domain = $curproc->ml_domain();
+
+    if ($sender =~ /\@$ml_domain$/i) {
+	return("matched", "deny");
+    }
+
+    return(0, undef);
+}
+
+
+=head1 CODING STYLE
+
+See C<http://www.fml.org/software/FNF/> on fml coding style guide.
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2006 Ken'ichi Fukamachi
+
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=head1 HISTORY
+
+FML::Restriction::CreateOnPost first appeared in fml8 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;