#!/usr/bin/perl
###########################################################################
#
# Fiesta
#
# Copyright (c) 2005 Henrique Dias <hdias@aesbuc.pt>. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
# Last Change: Mon Apr 11 19:23:33 WEST 2005
#
###########################################################################
use strict;
use Fcntl qw(:DEFAULT :flock);
use Getopt::Long();
use vars qw($VERSION);
use Mail::Salsa::Config;

$VERSION = 0.03;

my $cf = "/etc/cucaracha.conf";
my $virtusertable = "/etc/mail/virtusertable";
my $salsa_aliases = "/etc/mail/salsa.aliases";
my $deliver = "";

for my $dir ("/usr/adm/sm.bin", "/etc/smrsh") {
	$deliver = join("/", $dir, "cucaracha");
	last if(-e $deliver);
}
$deliver or die("$!");

my ($list, $owner, $action, $personalized) = ("", "", "", "");

my $config = Mail::Salsa::Config::get_config(
	file     => $cf,
	defaults => {
		'list_dir'    => "/usr/local/salsa/lists",
		'logs_dir'    => "/usr/local/salsa/logs",
		'archive_dir' => "/usr/local/salsa/archives",
	},
);

my @dirs = ($config->{'list_dir'}, $config->{'archive_dir'}, $config->{'logs_dir'});

my $opt = {};
Getopt::Long::GetOptions($opt,
	'help|?'           => \&usage,
        'add|a'            => sub { $action = "add"},
        'remove|r'         => sub { $action = "remove"},
	'owner|o=s'        => \$owner,
	'personalized|p=s' => \$personalized,
	'list|l=s'         => \$list,
	'update|u'         => sub { $action = "update"},
	'version|v'        => \&showversion,
) or die <<EOUSAGE;
usage: $0

  --list=<email>
  --owner=<email>
  --personalized=<bool>
  --add
  --remove
  --update
  --help
  --version

EOUSAGE

my %actions = (
	'add'    => "",
	'remove' => "",
	'update' => ""
);

exists($actions{$action}) or &usage();

($list =~ /^[^\@]+\@[^\@]+/) or &usage();
if($action eq "add") { $owner =~ /^[^\@]+\@[^\@]+/ or &usage(); }
if($action eq "update") {
	($owner or $personalized) or &usage();
	if($owner) { $owner =~ /^[^\@]+\@[^\@]+/ or &usage(); }
	if($personalized) { ($personalized eq "yes" or $personalized eq "no") or &usage(); }
}

&main();

#---main--------------------------------------------------------------------

sub main {
	my $update = 0;
	if($action eq "add") {
		print "Add the mailing list \"$list\":\n";

		if(&add_mlist($virtusertable, "vtable", $list, $owner, $personalized)) {
			print "already exists in";
		} else {
			$update = 1;
			print "has been added to";
		}
		print " \"$virtusertable\" file...\n";

		if(&add_mlist($salsa_aliases, "aliases", $list, $owner, $personalized)) {
			print "already exists in";
		} else {
			$update = 1;
			print "has been added to";
		}
		print " \"$salsa_aliases\" file...\n";
	} elsif($action eq "remove") {
		print "Remove the mailing list \"$list\":\n";

		print "Are you sure? [y/n]: ";
		my $ok = <>;
		chomp $ok;
		($ok eq "y" or $ok eq "Y") or exit();

		if(&remove_mlist($virtusertable, "vtable", $list)) {
			print "not exists in";
		} else {
			$update = 1;
			print "has been removed from";
		}
		print " \"$virtusertable\" file...\n";

		if(&remove_mlist($salsa_aliases, "aliases", $list)) {
			print "not exists in";
		} else {
			$update = 1;
			print "has been removed from";
		}
		print " \"$salsa_aliases\" file...\n";
	} elsif($action eq "update") {
		if($owner) {
			print "Update the owner of mailing list \"$list\":\n";
			if(my $id = &update_vutable($list, $virtusertable, $owner)) {
				if($id == 2) { print "The owner is the same.\n"; }
				elsif($id == 1) { print "The mailing list not exists.\n"; }
			} else {
				$update = 1;
				print "The owner has been changed.\n";
			}
		}
		if($personalized) {
			print "Change the type of \"$list\" mailing list:\n";
			if(my $id = &update_aliases($list, $salsa_aliases, $personalized)) {
				if($id == 2) { print "The type is the same.\n"; }
				elsif($id == 1) { print "The mailing list not exists.\n"; }
			} else {
				$update = 1;
				print "The type has been changed.\n";
			}
		}
	}
	if($update) {
		if($action eq "remove") {
			print "\n";
			&rmlistfiles(\@dirs, $list);
		}
		unless($action eq "update") {
			print "\n";
			print "Rebuild the data base for the mail aliases file:\n";
			my @args = ("/usr/sbin/sendmail", "-bi");
			system(@args) == 0 or die("system @args failed: $?");
		}
		print "\n";
		print "Rebuild virtusertable.db with makemap\n";

		$? = 0;
		my $pid;
		defined($pid = open(VTABLEDB, "|-")) or die("Cannot fork: $!");
		if($pid) {
			open(FILE, "<", $virtusertable) or die("$!");
			flock(FILE, LOCK_EX);
			while(<FILE>) { print VTABLEDB $_; }
			flock(FILE, LOCK_UN);
			close(FILE);
		} else {
			my @args = ("hash", "$virtusertable\.db");
			exec("makemap", @args) or die("Can't exec program: $!");
		}
	}
	exit();
}

#---rmlistfiles-------------------------------------------------------------

sub rmlistfiles {
	my $dirs = shift;
	my $list = shift;

	print "Clean mailing list directories and files:\n";
	my ($name, $domain) = split(/\@/, $list);
	for my $dir (@{$dirs}) {
		$dir =~ s/\/+$//;
		$dir =~ /\/salsa\/?/ or die("$!\n");
		unless(-d $dir) {
			print "The directory \"$dir\" not exists!\n";
			next;
		}
		opendir(DIRECTORY, $dir) or die("Can't opendir $dir: $!\n");
		while(defined(my $file = readdir(DIRECTORY))) {
			next if($file =~ /^\.\.?$/);
			$file eq $domain or next;
			(-d "$dir/$file") or next;
			my $path = join("/", $dir, $domain, $name);
			(-d $path) or next;

			opendir(DIR, $path) or die("Can't opendir $path: $!\n");
			while(defined(my $file = readdir(DIR))) {
				next if($file =~ /^\.\.?$/);
				unlink("$path/$file") or die("Couldn't unlink file $path/$file: $!");
				print "The file \"$path/$file\" has been removed...\n";
			}
			closedir(DIR);
			rmdir($path) or die("Couldn't remove dir $path: $!");
			print "The directory \"$path\" has been removed...\n";

			$path =~ s/\/[^\/]+$//;
			my $count = 0;
			opendir(DIR, $path) or die("Can't opendir $path: $!\n");
			while(defined(my $file = readdir(DIR))) {
				next if($file =~ /^\.\.?$/);
				$count++;
			}
			closedir(DIR);
			unless($count) {
				rmdir($path) or die("Couldn't remove dir $path: $!");
				print "The directory \"$path\" has been removed...\n";
			}
		}
		closedir(DIRECTORY);
	}
	return();
}

#---update_file-------------------------------------------------------------

sub update_file {
	my $file = shift;
	my $callback = shift;

	die("The file \"$file\.lock\" already exists: $!") if(-e "$file\.lock");
	my $notexist = 1;
	open(FILE, "<", $file) or die("$!");
	flock(FILE, LOCK_EX);
	open(UPDATE, ">", "$file\.lock") or die("$!");
	select(UPDATE);
	while(<FILE>) {
		if($notexist == 1 || $notexist == 3) {
			my $res = $callback->($notexist);
			if($res == 1) { next; }
			elsif($res == 2) { last; }
		}
		print UPDATE $_;
	}
	$notexist = 0 if($notexist == 3);
	close(UPDATE);
	flock(FILE, LOCK_UN);
	close(FILE);

	if($notexist) { unlink("$file\.lock") or die("$!"); }
	else { rename("$file\.lock", $file) or die("$!"); }
	select(STDOUT);

	return($notexist);
}

#---update_aliases----------------------------------------------------------

sub update_aliases {
	my $list = shift;
	my $file = shift;
	my $personalized = shift;

	my ($name, $domain) = split(/\@/, $list);
	my $pattern = "\^$name\\\_at_$domain\\\: +\\\"[^\\\"]+ (P[a-z]+)\\\"\\s\$";
	my $type = $personalized eq "yes" ? "Personalize" : "Post";

	my $callback = sub {
		if(/$pattern/) {
			my $oldtype = $1;
			if($type eq $oldtype) {
				$_[0] = 2;
				return(2);
			} else {
				s/$oldtype(?=\")/$type/;
				$_[0] = 0;
			}
		}
		return(0);
	};

	return(&update_file($file, $callback));
}

#---upadte_vutable----------------------------------------------------------

sub update_vutable {
	my $list = shift;
	my $file = shift;
	my $owner = shift;

	my ($name, $domain) = split(/\@/, $list);
	my $pattern = "\^$name-owner\\\@$domain\[ \\t\]\+(\[\^\\\@\]\+\\\@\[\^\\\@\]\+)\\s\$";

	my $callback = sub {
		if(/$pattern/) {
			if($1 eq $owner) {
				$_[0] = 2;
				return(2);
			} else {
				$_[0] = 0;
				$_ = "$name-owner\@$domain\t$owner\n";
			}
		}
		return(0);
	};
	return(&update_file($file, $callback));
}

#---remove_mlist------------------------------------------------------------

sub remove_mlist {
	my $file = shift;
	my $type = shift;
	my $list = shift;

	my ($name, $domain) = split(/\@/, $list);
	my %pattern = (
		'aliases' => "\^$name\-\?\[\^_\]\*_at_$domain\: \+",
		'vtable'  => "\^$name\-\?\[\^\@\]\*\@$domain\[ \\t\]\+"
	);

	my $callback = sub {
		if(/$pattern{$type}/) {
			$_[0] = 3;
			return(1);
		}
		return(0);
	};
	return(&update_file($file, $callback));
}

#---add_mlist---------------------------------------------------------------

sub add_mlist {
	my $file = shift;
	my $type = shift;
	my $list = shift;
	my $owner = shift;
	my $personalized = shift || "no";

	my ($name, $domain) = split(/\@/, $list);
	my $exist = 0;

	my %pattern = (
		'aliases' => "\^$name\_at_$domain\:\[ \\t\]\+",
		'vtable'  => "\^$list\[ \\t\]\+",
	);

	die("The file \"$file\.lock\" already exists: $!") if(-e "$file\.lock");

	open(FILE, "<", $file) or die("$!");
	flock(FILE, LOCK_EX);
	open(UPDATE, ">", "$file\.lock") or die("$!");
	select(UPDATE);
	while(<FILE>) {
		if(/$pattern{$type}/) { $exist = 1; last; }
		print UPDATE $_;
        }
	unless($exist) {
		&addlines2aliases(\*UPDATE, $list, $personalized) if($type eq "aliases");
		&addlines2vtable(\*UPDATE, $list, $owner) if($type eq "vtable");
	}
	close(UPDATE);
	flock(FILE, LOCK_UN);
	close(FILE);

	if($exist) { unlink("$file\.lock") or die("$!"); } 
	else { rename("$file\.lock", $file) or die("$!"); }
	select(STDOUT);

	return($exist);
}

#---addlines2aliases--------------------------------------------------------

sub addlines2aliases {
	my $fh = shift;
	my $list = shift;
	my $personalized = shift;

	my ($name, $domain) = split(/\@/, $list);
	my $flag = ($personalized eq "yes" ? "Personalize" : "Post");

	print $fh <<"EOA";
$name\_at_$domain: "\|$deliver $list $flag"
$name-subscribe_at_$domain: "\|$deliver $list Subscribe"
$name-unsubscribe_at_$domain: "\|$deliver $list Unsubscribe"
$name-admin_at_$domain: "\|$deliver $list Admin"
$name-help_at_$domain: "\|$deliver $list Help"
$name-return_at_$domain: "\|$deliver $list Return"
$name-outgoing_at_$domain: $name-owner\@$domain
EOA
	return();
}

#---addlines2vtable---------------------------------------------------------

sub addlines2vtable {
	my $fh = shift;
	my $list = shift;
	my $owner = shift;

	my ($name, $domain) = split(/\@/, $list);

	print $fh <<"EOA";
$name-owner\@$domain	$owner
$name\@$domain	$name\_at_$domain
$name-subscribe\@$domain	$name-subscribe_at_$domain
$name-unsubscribe\@$domain	$name-unsubscribe_at_$domain
$name-admin\@$domain	$name-admin_at_$domain
$name-help\@$domain	$name-help_at_$domain
$name-return\@$domain	$name-return_at_$domain
EOA
	return();
}

#---usage-------------------------------------------------------------------

sub usage {
	print STDERR <<"USAGE";
Usage: perl $0 [options]

Possible options are:

	--list=<email>          Where <email> is the address of the 
                                mailing list "name\@domain".

	--owner=<email>         Where <email> is the owner address of the
                                mailing list.

        --personalized=<bool>   Set this option if you pretended to have
                                personalized messages, where <bool> is
                                "yes" or "no" (default is no).
 
        --add                   Add a new mailing list to the system.

        --remove                Remove the mailing list from the system.

        --update                Change the owner of mailing list.

        --version               Show program version

        --help                  Print this message and exit

Example:

  * Add "salsa-dev\@mydomain.org" mailing list

    fiesta --add --list=salsa-dev\@mydomain.org --owner=hdias\@aesbuc.pt

  * Add a personalized "salsa-dev\@mydomain.org" mailing list

    fiesta --add --list=salsa-dev\@mydomain.org --owner=hdias\@aesbuc.pt \
    --personalized=yes

  * Remove "salsa-dev\@mydomain.org" mailing list

    fiesta --remove --list=salsa-dev\@mydomain.org

  * Change the owner of "salsa-dev\@mydomain.org" mailing list

    fiesta --update --list=salsa-dev\@mydomain.org --owner=hdias\@perl.org

  * Change the type of "salsa-dev\@mydomain.org" mailing list from
    "Post" to "Personalize"

    fiesta --update --list=salsa-dev\@mydomain.org --personalized=yes

USAGE
	exit 1;
}

#---showversion-------------------------------------------------------------

sub showversion {
	print <<"EOV";
Fiesta $VERSION
Copyright (c) 2005 Henrique Dias <hdias\@aesbuc.pt>
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
EOV
	exit();
}

#---end---------------------------------------------------------------------

1;