enable newml/rmml updates procmailrc templates

4 files changed, 344 insertions, 15 deletions

diff --git a/fml/lib/FML/Command/Admin/newml.pm b/fml/lib/FML/Command/Admin/newml.pm
index d4febe5c..71af4fe8 100644
--- a/fml/lib/FML/Command/Admin/newml.pm
+++ b/fml/lib/FML/Command/Admin/newml.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: newml.pm,v 1.45 2002/06/25 12:35:31 fukachan Exp $
+# $FML: newml.pm,v 1.46 2002/06/27 08:24:08 fukachan Exp $
 #
 
 package FML::Command::Admin::newml;
@@ -191,6 +191,10 @@ sub _install_template_files
     # 2.2 setup ~fml/.qmail-* (qmail style)
     my $qmail = new FML::MTAControl { mta_type => 'qmail' };
     $qmail->setup($curproc, $params);
+
+    # 2.3
+    my $procmail = new FML::MTAControl { mta_type => 'procmail' };
+    $procmail->setup($curproc, $params);
 }
 
 
@@ -216,7 +220,7 @@ sub _update_aliases
     }
     else {
 	eval q{
-	    for my $mta (qw(postfix qmail)) {
+	    for my $mta (qw(postfix qmail procmail)) {
 		my $optargs = { mta_type => $mta };
 
 		use FML::MTAControl;
diff --git a/fml/lib/FML/Command/Admin/rmml.pm b/fml/lib/FML/Command/Admin/rmml.pm
index 16171ebe..8fe84b35 100644
--- a/fml/lib/FML/Command/Admin/rmml.pm
+++ b/fml/lib/FML/Command/Admin/rmml.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: rmml.pm,v 1.5 2002/06/25 12:36:51 fukachan Exp $
+# $FML: rmml.pm,v 1.6 2002/06/27 08:24:08 fukachan Exp $
 #
 
 package FML::Command::Admin::rmml;
@@ -146,7 +146,7 @@ sub _remove_aliases
     eval q{
 	use FML::MTAControl;
 
-	for my $mta (qw(postfix qmail)) {
+	for my $mta (qw(postfix qmail procmail)) {
 	    my $optargs = { mta_type => $mta };
 	    my $obj = new FML::MTAControl;
 	    $obj->remove_alias($curproc, $params, $optargs);
diff --git a/fml/lib/FML/MTAControl.pm b/fml/lib/FML/MTAControl.pm
index ed643697..41b3f606 100644
--- a/fml/lib/FML/MTAControl.pm
+++ b/fml/lib/FML/MTAControl.pm
@@ -4,7 +4,7 @@
 #   All rights reserved. This program is free software; you can
 #   redistribute it and/or modify it under the same terms as Perl itself.
 #
-# $FML: MTAControl.pm,v 1.8 2002/06/01 05:09:23 fukachan Exp $
+# $FML: MTAControl.pm,v 1.9 2002/06/27 08:24:08 fukachan Exp $
 #
 
 package FML::MTAControl;
@@ -14,8 +14,11 @@ use Carp;
 
 use FML::MTAControl::Postfix;
 use FML::MTAControl::Qmail;
+use FML::MTAControl::Procmail;
 @ISA = qw(FML::MTAControl::Postfix
-	  FML::MTAControl::Qmail);
+	  FML::MTAControl::Qmail
+	  FML::MTAControl::Procmail
+	  );
 
 my $debug = 0;
 
@@ -73,7 +76,9 @@ sub setup
 	defined $optargs->{ mta_type } ? $optargs->{ mta_type } :
 	    $self->{ mta_type };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' || 
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_setup";
 	$self->$method($curproc, $params, $optargs);
     }
@@ -94,7 +99,9 @@ sub update_alias
 	defined $optargs->{ mta_type } ? $optargs->{ mta_type } :
 	    $self->{ mta_type };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' ||
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_update_alias";
 	$self->$method($curproc, $params, $optargs);
     }
@@ -116,7 +123,9 @@ sub find_key_in_alias_maps
 	    $self->{ mta_type };
     my $key      = $optargs->{ key };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' || 
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_find_key_in_alias_maps";
 	$self->$method($curproc, $params, $optargs);
     }
@@ -137,7 +146,9 @@ sub get_aliases_as_hash_ref
 	defined $optargs->{ mta_type } ? $optargs->{ mta_type } :
 	    $self->{ mta_type };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' || 
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_get_aliases_as_hash_ref";
 	$self->$method($curproc, $params, $optargs);
     }
@@ -159,7 +170,9 @@ sub install_alias
 	defined $optargs->{ mta_type } ? $optargs->{ mta_type } :
 	    $self->{ mta_type };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' || 
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_install_alias";
 	$self->$method($curproc, $params, $optargs);
     }
@@ -181,7 +194,9 @@ sub remove_alias
 	defined $optargs->{ mta_type } ? $optargs->{ mta_type } :
 	    $self->{ mta_type };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' || 
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_remove_alias";
 	$self->$method($curproc, $params, $optargs);
     }
@@ -203,7 +218,9 @@ sub install_virtual_map
 	defined $optargs->{ mta_type } ? $optargs->{ mta_type } :
 	    $self->{ mta_type };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' || 
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_install_virtual_map";
 	$self->$method($curproc, $params, $optargs);
     }
@@ -225,7 +242,9 @@ sub remove_virtual_map
 	defined $optargs->{ mta_type } ? $optargs->{ mta_type } :
 	    $self->{ mta_type };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' || 
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_remove_virtual_map";
 	$self->$method($curproc, $params, $optargs);
     }
@@ -246,7 +265,9 @@ sub update_virtual_map
 	defined $optargs->{ mta_type } ? $optargs->{ mta_type } :
 	    $self->{ mta_type };
 
-    if ($mta_type eq 'postfix' || $mta_type eq 'qmail') {
+    if ($mta_type eq 'postfix' || 
+	$mta_type eq 'qmail'   ||
+	$mta_type eq 'procmail') {
 	my $method = "${mta_type}_update_virtual_map";
 	$self->$method($curproc, $params, $optargs);
     }
diff --git a/fml/lib/FML/MTAControl/Procmail.pm b/fml/lib/FML/MTAControl/Procmail.pm
new file mode 100644
index 00000000..c1390f7f
--- /dev/null
+++ b/fml/lib/FML/MTAControl/Procmail.pm
@@ -0,0 +1,304 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2002 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: procmail.pm,v 1.6 2002/06/30 14:30:15 fukachan Exp $
+#
+
+package FML::MTAControl::Procmail;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD);
+use Carp;
+
+my $debug = 0;
+
+
+=head1 NAME
+
+FML::MTAControl - procmail utilities
+
+=head1 SYNOPSIS
+
+set up aliases and virtual maps for procmail.
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 new()
+
+=cut
+
+
+# Descriptions: install new alias entries
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: update aliases
+# Return Value: none
+sub procmail_install_alias
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+    my $config       = $curproc->{ config };
+    my $template_dir = $curproc->template_files_dir_for_newml();
+
+    use File::Spec;
+    my $alias = $config->{ procmail_aliases_file };
+    my $src   = File::Spec->catfile($template_dir, 'procmailrc');
+    my $dst   = $alias . "." . $$;
+
+    $self->_install($src, $dst, $params);
+
+    print STDERR "updating $alias\n";
+
+    use File::Utils qw(append);
+    append($dst, $alias);
+    unlink $dst;
+}
+
+
+# Descriptions: remove alias
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: update aliases
+# Return Value: none
+sub procmail_remove_alias
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+    my $config    = $curproc->{ config };
+    my $alias     = $config->{ procmail_aliases_file };
+    my $alias_new = $alias."new.$$";
+    my $ml_name   = $params->{ ml_name  };
+    my $ml_domain = $params->{ ml_domain };
+    my $removed   = 0;
+
+    my $key = $params->{ ml_name };
+
+    print STDERR "removing $key in $alias\n";
+
+    use FileHandle;
+    my $rh = new FileHandle $alias;
+    my $wh = new FileHandle "> $alias_new";
+    if (defined $rh && defined $wh) {
+      LINE:
+	while (<$rh>) {
+	    if (/\<ALIASES\s+$key\@/ .. /\<\/ALIASES\s+$key\@/) {
+		$removed++;
+		next LINE;
+	    }
+
+	    print $wh $_;
+	}
+	$wh->close;
+	$rh->close;
+
+	if ($removed > 3) {
+	    if (rename($alias_new, $alias)) {
+		print STDERR "\tremoved.\n";
+	    }
+	    else {
+		print STDERR "\twarning: fail to rename alias files.\n";
+	    }
+	}
+    }
+    else {
+	warn("cannot open $alias")     unless defined $rh;
+	warn("cannot open $alias_new") unless defined $wh;
+    }
+}
+
+
+# Descriptions: regenerate aliases.db
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: update aliases
+# Return Value: none
+sub procmail_update_alias
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+
+}
+
+
+# Descriptions: find key in aliases
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: none
+# Return Value: NUM(1 or 0)
+sub procmail_find_key_in_alias_maps
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+    my $key  = $optargs->{ key };
+    my $maps = $self->procmail_alias_maps($curproc, $optargs);
+
+    for my $map (@$maps) {
+	print STDERR "scan key = $key, map = $map\n" if $debug;
+
+	use FileHandle;
+	my $fh = new FileHandle $map;
+	if (defined $fh) {
+	    while (<$fh>) {
+		return 1 if /^$key:/;
+	    }
+	}
+	else {
+	    warn("cannot open $map");
+	}
+	$fh->close;
+    }
+
+    return 0;
+}
+
+
+# Descriptions: get { key => value } in aliases
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: none
+# Return Value: HASH_REF
+sub procmail_get_aliases_as_hash_ref
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+    my $config     = $curproc->{ config };
+    my $alias_file = $config->{ mail_aliases_file };
+    my $key        = $optargs->{ key };
+    my $mode       = $optargs->{ mode };
+    my $maps       = $self->procmail_alias_maps($curproc, $optargs);
+    my $aliases    = {};
+
+    # $0 -n shows fml only aliases
+    if ($mode eq 'fmlonly') {
+	$maps = [ $alias_file ];
+    }
+
+    for my $map (@$maps) {
+	print STDERR "scan key = $key, map = $map\n" if $debug;
+
+	use FileHandle;
+	my $fh = new FileHandle $map;
+	if (defined $fh) {
+	    my ($key, $value);
+
+	  LINE:
+	    while (<$fh>) {
+		next LINE if /^#/;
+		next LINE if /^\s*$/;
+
+		chomp;
+		($key, $value)   = split(/:/, $_, 2);
+		$value =~ s/^\s*//;
+		$value =~ s/s*$//;
+		$aliases->{ $key } = $value;
+	    }
+	}
+	else {
+	    warn("cannot open $map");
+	}
+	$fh->close;
+    }
+
+    return $aliases;
+}
+
+
+# Descriptions: return alias_maps as ARRAY_REF
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: none
+# Return Value: ARRAY_REF
+sub procmail_alias_maps
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+    my $config = $curproc->{ config };
+    my $prog   = $config->{ path_postconf };
+
+    return [];
+}
+
+
+# Descriptions: install configuratin templates
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: create include*
+# Return Value: none
+sub procmail_setup
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+    my $config       = $curproc->{ config };
+    my $template_dir = $curproc->template_files_dir_for_newml();
+    my $ml_home_dir  = $params->{ ml_home_dir };
+
+    0;
+}
+
+
+# Descriptions: rewrite $params
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: update $params
+# Return Value: none
+sub _procmail_rewrite_virtual_params
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+
+}
+
+
+# Descriptions: install procmail virtual_maps
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: install/udpate procmail virtual_maps and the .db
+# Return Value: none
+sub procmail_install_virtual_map
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+
+}
+
+
+
+# Descriptions: remove procmail virtual_maps
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: remove/udpate procmail virtual_maps and the .db
+# Return Value: none
+sub procmail_remove_virtual_map
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+
+}
+
+
+# Descriptions: regenerate virtual.db
+#    Arguments: OBJ($self)
+#               OBJ($curproc) HASH_REF($params) HASH_REF($optargs)
+# Side Effects: update aliases
+# Return Value: none
+sub procmail_update_virtual_map
+{
+    my ($self, $curproc, $params, $optargs) = @_;
+
+}
+
+
+=head1 AUTHOR
+
+Ken'ichi Fukamachi
+
+=head1 COPYRIGHT
+
+Copyright (C) 2002 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::MTAControl appeared in fml5 mailing list driver package.
+See C<http://www.fml.org/> for more details.
+
+=cut
+
+
+1;