#!/usr/bin/perl
###########################################################################
#
# Fiesta
#
# Copyright (c) 2004 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: Fri Nov  5 16:53:37 WET 2004
#
###########################################################################
use strict;
use Fcntl qw(:DEFAULT :flock);
use Getopt::Long();
use vars qw($VERSION);
use Mail::Salsa::Config;

$VERSION = 0.01;

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) = ("", "", "");

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,
	'list|l=s'  => \$list,
	'update|u'  => sub { $action = "update"},
	'version|v' => \&showversion,
) or die <<EOUSAGE;
usage: $0

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

EOUSAGE

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

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

($list =~ /^[^\@]+\@[^\@]+/) or &usage();
if($action eq "add" or $action eq "update") {
	$owner =~ /^[^\@]+\@[^\@]+/ 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)) {
			print "already exists in";
		} else {
			$update = 1;
			print "has been added to";
		}
		print " \"$virtusertable\" file...\n";

		if(&add_mlist($salsa_aliases, "aliases", $list, $owner)) {
			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 exist in";
		} else {
			$update = 1;
			print "has been removed from";
		}
		print " \"$virtusertable\" file...\n";

		if(&remove_mlist($salsa_aliases, "aliases", $list)) {
			print "not exist in";
		} else {
			$update = 1;
			print "has been removed from";
		}
		print " \"$salsa_aliases\" file...\n";
	} elsif($action eq "update") {
		print "Update the owner of the mailing list \"$list\":\n";
		if(my $id = &update_mlist($list, $owner, $virtusertable)) {
			if($id == 2) {
				print "The owner is the same.\n";
			} elsif($id == 1) {
				print "The mailing list not exist.\n";
			}
		} else {
			$update = 1;
			print "The owner 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");
		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_mlist------------------------------------------------------------

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

	my ($name, $domain) = split(/\@/, $list);
	my $pattern = "\^$name-owner\\\@$domain\[ \\t\]\+(\[\^\\\@\]\+\\\@\[\^\\\@\]\+)\\s\$";
	my $notexist = 1;
	open(FILE, "<", $file) or die("$!");
	flock(FILE, LOCK_EX);
	open(BACKUP, ">", "$file\.bak") or die("$!");
	select(BACKUP);
	while(<FILE>) {
		if(/$pattern/) {
			if($1 eq $owner) {
				$notexist = 2;
				last;
			} else {
				$notexist = 0;
				print BACKUP "$name-owner\@$domain\t$owner\n";
				next;
			}
		}
		print BACKUP $_;
	}
	close(BACKUP);
	flock(FILE, LOCK_UN);
	close(FILE);

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

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

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

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

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

	open(FILE, "<", $file) or die("$!");
	flock(FILE, LOCK_EX);
	open(BACKUP, ">", "$file\.bak") or die("$!");
	select(BACKUP);
	while(<FILE>) {
		if(/$pattern{$type}/) { $notexist = 0; next; }
		print BACKUP $_;
	}
	close(BACKUP);
	flock(FILE, LOCK_UN);
	close(FILE);
                                                                                
	if($notexist) { unlink("$file\.bak") or die("$!"); }
	else { rename("$file\.bak", $file) or die("$!"); }
	select(STDOUT);
	return($notexist);
}

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

sub add_mlist {
	my $file = shift;
	my $type = shift;
	my $list = shift;
	my $owner = shift;

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

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

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

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

	return($exist);
}

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

sub addlines2aliases {
	my $fh = shift;
	my $list = shift;
	
	my ($name, $domain) = split(/\@/, $list);

	print $fh <<"EOA";
$name\_at_$domain: "\|$deliver $list Post"
$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-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-bounces\@$domain	$name-owner\@$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.
 
        --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

  * 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

USAGE
	exit 1;
}

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

sub showversion {
	print <<"EOV";
Fiesta $VERSION
Copyright (c) 2004 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;
