#-*- perl -*-
#
# Copyright (C) 2003,2004,2005,2007,2008 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: HomePrefix.pm,v 1.10 2007/01/16 11:39:32 fukachan Exp $
#
package FML::ML::HomePrefix;
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK $AUTOLOAD $debug);
use Carp;
use File::Spec;
use FML::Credential;
use FML::Restriction::Base;
use IO::Adapter;
# disable debug by default.
$debug = 0;
=head1 NAME
FML::ML::HomePrefix - create, rename and delete ml_home_prefix dir.
=head1 SYNOPSIS
use FML::ML::HomePrefix;
my $ml_home_prefix = new FML::ML::HomePrefix $curproc;
$ml_home_prefix->add($domain);
$ml_home_prefix->delete($domain);
=head1 DESCRIPTION
This class provides functions to create, rename and delete
ml_home_prefix directory information.
Mainly it is used to edit ml_home_prefix configuration file.
=head1 METHODS
=head2 new($curproc)
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;
}
=head2 primary_map()
return the primary ml_home_prefix_map.
=cut
# 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 check.
# 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);
}
}
=head2 add($domain, $dir)
add domain into $fml_primary_ml_home_prefix_map.
=cut
# 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 map.
# Return Value: none
sub add
{
my ($self, $domain, $dir) = @_;
my $curproc = $self->{ _curproc };
my $cred = $curproc->credential();
my $pri_map = $self->primary_map();
$self->_sanity_check();
# 1. add domain into ml_home_prefix map.
use IO::Adapter;
my $obj = new IO::Adapter $pri_map;
$obj->touch();
my $_domain = quotemeta($domain);
my ($domlist) = $obj->find($_domain, { all => 1 });
if (@$domlist) {
my $found = 0;
for my $_dom (@$domlist) {
my ($_domain) = split(/\s+/, $_dom);
$found = 1 if $cred->is_same_domain($_domain, $domain);
}
if ($found) {
my $error = "already defined domain: $domain";
$curproc->logerror($error);
croak($error);
}
else {
$obj->add($domain, [ $dir ]);
}
}
else {
$obj->add($domain, [ $dir ]);
}
$obj->close();
# change onwer and group of the created directory.
if ($< == 0) { # we can do this only when running as user "root".
my $owner = $curproc->fml_owner();
my $group = $curproc->fml_group();
$curproc->chown($owner, $group, $pri_map);
}
# 2. reuse or create the domain prefix directory.
# 2.1 check the directory.
if (-d $dir) {
$curproc->logwarn("$dir already exist. reuse it.");
}
else {
# XXX proper mode ?
$curproc->mkdir($dir);
if (-d $dir) {
$curproc->log("$dir created");
# change onwer and group of the created directory.
if ($< == 0) { # we can do this only when running as user "root".
my $owner = $curproc->fml_owner();
my $group = $curproc->fml_group();
$curproc->chown($owner, $group, $dir);
}
}
else {
$curproc->logerror("fail to mkdir $dir");
croak("fail to mkdir $dir");
}
}
}
=head2 delete($domain)
delete the specified domain from $fml_primary_ml_home_prefix_map.
=cut
# 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();
# change onwer and group of the created directory.
if ($< == 0) { # we can do this only when running as user "root".
my $owner = $curproc->fml_owner();
my $group = $curproc->fml_group();
$curproc->chown($owner, $group, $pri_map);
}
}
#
# 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::ML::HomePrefix $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 on fml coding style guide.
=head1 AUTHOR
Ken'ichi Fukamachi
=head1 COPYRIGHT
Copyright (C) 2003,2004,2005,2007,2008 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::ML::HomePrefix first appeared in fml8 mailing list driver package.
See C for more details.
=cut
1;