switched to new ml_home_prefix framework, which is enhanced virtual

domain operation. See fml-devel in 2003/10.

4 files changed, 306 insertions, 27 deletions

diff --git a/fml/lib/FML/Command/Admin/newdomain.pm b/fml/lib/FML/Command/Admin/newdomain.pm
index e7329c2d..1093d5f9 100644
--- a/fml/lib/FML/Command/Admin/newdomain.pm
+++ b/fml/lib/FML/Command/Admin/newdomain.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$
+# $FML: newdomain.pm,v 1.1 2003/11/15 03:09:44 fukachan Exp $
 #
 
 package FML::Command::Admin::newdomain;
@@ -55,6 +55,13 @@ sub need_lock { 0;}
 sub process
 {
     my ($self, $curproc, $command_args) = @_;
+    my $options = $command_args->{ options };
+    my $domain  = $options->[ 0 ];
+    my $prefix  = $options->[ 1 ];
+
+    use FML::HomeDir::Prefix;
+    my $ml_home_prefix = new FML::HomeDir::Prefix $curproc;
+    $ml_home_prefix->add($domain, $prefix);
 }
 
 
diff --git a/fml/lib/FML/Command/Admin/rmdomain.pm b/fml/lib/FML/Command/Admin/rmdomain.pm
index 2bb28ba4..562a1b4b 100644
--- a/fml/lib/FML/Command/Admin/rmdomain.pm
+++ b/fml/lib/FML/Command/Admin/rmdomain.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$
+# $FML: rmdomain.pm,v 1.1 2003/11/15 03:09:44 fukachan Exp $
 #
 
 package FML::Command::Admin::rmdomain;
@@ -55,6 +55,12 @@ sub need_lock { 0;}
 sub process
 {
     my ($self, $curproc, $command_args) = @_;
+    my $options = $command_args->{ options };
+    my $domain  = $options->[ 0 ];
+
+    use FML::HomeDir::Prefix;
+    my $ml_home_prefix = new FML::HomeDir::Prefix $curproc;
+    $ml_home_prefix->delete($domain);
 }
 
 
diff --git a/fml/lib/FML/HomeDir/Prefix.pm b/fml/lib/FML/HomeDir/Prefix.pm
new file mode 100644
index 00000000..bdf8ca7c
--- /dev/null
+++ b/fml/lib/FML/HomeDir/Prefix.pm
@@ -0,0 +1,228 @@
+#-*- perl -*-
+#
+#  Copyright (C) 2003 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: UserControl.pm,v 1.34 2003/11/08 06:51:49 fukachan Exp $
+#
+
+package FML::HomeDir::Prefix;
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD $debug);
+use Carp;
+use File::Spec;
+use FML::Credential;
+use FML::Restriction::Base;
+use FML::Log qw(Log LogWarn LogError);
+use IO::Adapter;
+
+# disable debug by default.
+$debug = 0;
+
+
+=head1 NAME
+
+FML::HomeDir::Prefix - create, rename and delete ml_home_prefix dir.
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=cut
+
+
+# Descriptions: standard 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: return the primary ml_home_prefix_map.
+#    Arguments: OBJ($self)
+# Side Effects: none
+# Return Value: STR
+sub primary_map
+{
+    my ($self) = @_;
+    my $curproc = $self->{ _curproc };
+    my $config  = $debug > 100 ? $curproc->{ config } : $curproc->config();
+
+    return $config->{ fml_primary_ml_home_prefix_map } || '';
+}
+
+
+# Descriptions: cheap sanity
+#    Arguments: OBJ($self)
+# Side Effects: long jump by croak() if needed.
+# Return Value: none
+sub _sanity_check
+{
+    my ($self)  = @_;
+    my $curproc = $self->{ _curproc };
+    my $map     = $self->primary_map();
+    my $error   = '';
+
+    if ($map) {
+	unless (-f $map) {
+	    use IO::Adapter;
+	    my $obj = new IO::Adapter $map;
+	    $obj->touch();
+	}
+
+	unless (-w $map) {
+	    $error = "\$primary_ml_home_prefix_map not writable";
+	}
+    }
+    else {
+	$error = "\$primary_ml_home_prefix_map undefined";
+    }
+
+    if ($error) {
+	$curproc->logerror($error);
+	croak($error);
+    }
+}
+
+
+# Descriptions: add { $domian => $dir } map to $fml_primary_ml_home_prefix_map.
+#    Arguments: OBJ($self) STR($domain) STR($dir)
+# Side Effects: update $fml_primary_ml_home_prefix_map
+# Return Value: none
+sub add
+{
+    my ($self, $domain, $dir) = @_;
+    my $curproc = $self->{ _curproc };
+    my $pri_map = $self->primary_map();
+
+    $self->_sanity_check();
+
+    # ml_home_prefix map
+    use IO::Adapter;
+    my $obj = new IO::Adapter $pri_map;
+    $obj->touch();
+
+    if ($obj->find($domain)) {
+	my $error = "already defined domain: $domain";
+	$curproc->logerror($error);
+	croak($error);
+    }
+    else {
+	$obj->add($domain, [ $dir ]);
+    }
+
+    # check the directory.
+    if (-d $dir) {
+	$curproc->logwarn("$dir already exist. reuse it.");
+    }
+    else {
+	$curproc->mkdir($dir);
+
+	if (-d $dir) {
+	    $curproc->log("$dir created");
+	}
+	else {
+	    $curproc->logerror("fail to mkdir $dir");
+	    croak("fail to mkdir $dir");
+	}
+    }
+}
+
+
+# Descriptions: delete { $domian => $dir } map
+#               from $fml_primary_ml_home_prefix_map.
+#    Arguments: OBJ($self) STR($domain)
+# Side Effects: update $fml_primary_ml_home_prefix_map
+# Return Value: none
+sub delete
+{
+    my ($self, $domain) = @_;
+    my $curproc = $self->{ _curproc };
+    my $pri_map = $self->primary_map();
+
+    $self->_sanity_check();
+
+    # directory info
+    my $dir = $curproc->ml_home_prefix($domain);
+    if ($dir) {
+	if (-d $dir) {
+	    $curproc->log("$dir left as itself");
+	}
+	else {
+	    $curproc->log("$dir no longer exist");
+	}
+    }
+    else {
+	$curproc->logerror("ml_home_prefix not found");
+	$curproc->logerror("no such domain: $domain");
+    }
+
+    # remove hash entry.
+    my $obj = new IO::Adapter $pri_map;
+    $obj->open();
+    $obj->delete($domain);
+    $obj->close();
+}
+
+
+#
+# debug
+#
+if ($0 eq __FILE__) {
+    my $domain  = "nuinui.net";
+    my $prefix  = "/tmp/nuinui.net";
+    my $map     = "/etc/fml/ml_home_prefix";
+
+    use FML::Process::Debug;
+    my $curproc = new FML::Process::Debug;
+    $curproc->{ config } = { fml_primary_ml_home_prefix_map => $map };
+
+    # special debug flag on
+    $debug = 101;
+    $|     = 1;
+
+    my $ml_home_prefix = new FML::HomeDir::Prefix $curproc;
+
+    print "\n# add { $domain => $prefix }\n";
+    $ml_home_prefix->add($domain, $prefix);
+    system "cat $map";
+
+    print "\n# delete { $domain => $prefix }\n";
+    $ml_home_prefix->delete($domain);
+    system "cat $map";
+}
+
+
+=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) 2003 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::HomeDir::Prefix 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/Process/Utils.pm b/fml/lib/FML/Process/Utils.pm
index 93644dda..757461db 100644
--- a/fml/lib/FML/Process/Utils.pm
+++ b/fml/lib/FML/Process/Utils.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: Utils.pm,v 1.91 2003/11/02 05:12:37 fukachan Exp $
+# $FML: Utils.pm,v 1.92 2003/11/02 13:37:42 fukachan Exp $
 #
 
 package FML::Process::Utils;
@@ -368,6 +368,42 @@ sub _mkpath_str
 }
 
 
+# XXX-TODO: $curproc->mkfile() is strage.
+
+# Descriptions: create a file.
+#    Arguments: OBJ($curproc) STR($file)
+# Side Effects: none
+# Return Value: none
+sub mkfile
+{
+    my ($curproc, $file) = @_;
+
+    unless (-f $file) {
+	use IO::Adapter;
+	my $obj = new IO::Adapter $file;
+	$obj->touch();
+
+	# verify 
+	unless (-f $file) {
+	    $curproc->logerror("fail to create file: $file");
+	}
+    }
+}
+
+
+# XXX-TODO: $curproc->touch() is strage.
+
+# Descriptions: create a file.
+#    Arguments: OBJ($curproc) STR($file)
+# Side Effects: none
+# Return Value: none
+sub touch
+{
+    my ($curproc, $file) = @_;
+    $curproc->mkfile($file);
+}
+
+
 # XXX-TODO: $curproc->cat() is strage.
 
 # Descriptions: concantenate files to STDOUT
@@ -902,11 +938,11 @@ sub __ml_home_prefix_from_main_cf
     if (defined $domain) {
 	my $found = '';
 
-	my ($virtual_maps) = __get_virtual_maps($main_cf);
-	if (@$virtual_maps) {
-	    $found = __ml_home_prefix_search_in_virtual_maps($main_cf,
-							     $domain,
-							     $virtual_maps);
+	my ($prefix_maps) = __get_ml_home_prefix_maps($main_cf);
+	if (@$prefix_maps) {
+	    $found = ___search_in_ml_home_prefix_maps($main_cf,
+						      $domain,
+						      $prefix_maps);
 	}
 
 	if ($found) {
@@ -939,11 +975,11 @@ sub __ml_home_prefix_from_main_cf
 }
 
 
-# Descriptions: search virtual domain in $virtual_maps.
-#               return $ml_home_prefix for the virtual domain if found.
+# Descriptions: search domain in $prefix_maps.
+#               return $ml_home_prefix for the domain if found.
 #    Arguments: HASH_REF($main_cf)
-#               STR($virtual_domain)
-#               ARRAY_REF($virtual_maps)
+#               STR($domain)
+#               ARRAY_REF($prefix_maps)
 #         bugs: currently support the only file type of IO::Adapter.
 #               This limit comes from the architecture
 #               since this function may be used
@@ -952,27 +988,27 @@ sub __ml_home_prefix_from_main_cf
 #               SUPPORT ONLY FILE TYPE MAPS NOT SQL NOR LDAP.
 # Side Effects: none
 # Return Value: STR
-sub __ml_home_prefix_search_in_virtual_maps
+sub ___search_in_ml_home_prefix_maps
 {
-    my ($main_cf, $virtual_domain, $virtual_maps) = @_;
+    my ($main_cf, $domain, $prefix_maps) = @_;
 
-    if (@$virtual_maps) {
+    if (@$prefix_maps) {
 	my $dir = '';
 	eval q{ use IO::Adapter; };
 	unless ($@) {
 	  MAP:
-	    for my $map (@$virtual_maps) {
+	    for my $map (@$prefix_maps) {
 		# XXX only support file:// map
 		my $obj = new IO::Adapter $map;
 		if (defined $obj) {
 		    $obj->open();
-		    $dir = $obj->find("^$virtual_domain");
+		    $dir = $obj->find("^$domain");
 		}
 		last MAP if $dir;
 	    }
 
 	    if ($dir) {
-		($virtual_domain, $dir) = split(/\s+/, $dir);
+		($domain, $dir) = split(/\s+/, $dir);
 		$dir =~ s/[\s\n]*$// if defined $dir;
 
 		# found
@@ -1032,36 +1068,38 @@ sub is_config_cf_exist
 }
 
 
-=head2 get_virtual_maps()
+=head2 get_ml_home_prefix_maps()
 
-return virtual maps.
+return ml_home_prefix maps. 
+By default, ml_home_prefix and virtual under $fml_config_dir.
 
 =cut
 
 
-# Descriptions: return virtual maps as array reference.
+# Descriptions: return ml_home_prefix maps as array reference.
 #    Arguments: OBJ($curproc)
 # Side Effects: none
 # Return Value: ARRAY_REF
-sub get_virtual_maps
+sub get_ml_home_prefix_maps
 {
     my ($curproc) = @_;
     my $main_cf = $curproc->{ __parent_args }->{ main_cf };
-    __get_virtual_maps($main_cf);
+    __get_ml_home_prefix_maps($main_cf);
 }
 
 
-# Descriptions: return virtual maps as array reference.
+# Descriptions: return ml_home_prefix maps as array reference.
 #    Arguments: HASH_REF($main_cf)
 # Side Effects: none
 # Return Value: ARRAY_REF
-sub __get_virtual_maps
+sub __get_ml_home_prefix_maps
 {
     my ($main_cf) = @_;
 
-    if (defined $main_cf->{ virtual_maps } && $main_cf->{ virtual_maps }) {
+    if (defined $main_cf->{ ml_home_prefix_maps } && 
+	$main_cf->{ ml_home_prefix_maps }) {
 	my (@r) = ();
-	my (@maps) = split(/\s+/, $main_cf->{ virtual_maps });
+	my (@maps) = split(/\s+/, $main_cf->{ ml_home_prefix_maps });
 	for my $map (@maps) {
 	    if (-f $map) { push(@r, $map);}
 	}