head	1.2;
access;
symbols;
locks; strict;
comment	@# @;


1.2
date	2000.05.13.17.06.37;	author jrobbins;	state dead;
branches;
next	1.1;

1.1
date	2000.03.24.20.33.58;	author jrobbins;	state Exp;
branches;
next	;


desc
@@


1.2
log
@removed files that have been replaced with newer files in helm/perl/scripts
@
text
@# ================================================================
# Copyright (c) 2000 Collab.Net.  All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met:
# 
# 1. Redistributions of source code must retain the above copyright
# notice, this list of conditions and the following disclaimer.
# 
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
# 
# 3. The end-user documentation included with the redistribution, if
# any, must include the following acknowlegement: "This product includes
# software developed by Collab.Net (http://www.Collab.Net/)."
# Alternately, this acknowlegement may appear in the software itself, if
# and wherever such third-party acknowlegements normally appear.
# 
# 4. The hosted project names must not be used to endorse or promote
# products derived from this software without prior written
# permission. For written permission, please contact info@@collab.net.
# 
# 5. Products derived from this software may not use the "Tigris" name
# nor may "Tigris" appear in their names without prior written
# permission of Collab.Net.
# 
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
# WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL COLLAB.NET OR ITS CONTRIBUTORS BE LIABLE FOR ANY
# DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
# GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
# IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
# OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
# ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# ====================================================================
# 
# This software consists of voluntary contributions made by many
# individuals on behalf of Collab.Net.
#


# Helm/ezmlm.pm
# --------------------
# Update/create mailing lists using ezmlm-idx (the qmail mailing list
# utility).
#
# Note that qmail must be set up correctly; see Helm::QmailAlias for
# more information on the requirements.
#
# We create mailing lists as both project-list@@domain.org and
# list@@project.domain.org. The cute thing is that due to the way
# qmail expands aliases, they both expand to .qmail-project-list, so
# we don't worry too much.
#
# For domain-wide lists, we use the NULL project in the table
# (project_mlists).

package Helm::ezmlm;

use Helm::ToolHook;
@@ISA = qw(Helm::ToolHook);

use strict;

use Helm::QmailUtils;


sub projectAdd {
}

sub projectDelete {
}

sub projectEdit {
}


################################################################

sub moduleAdd {
}

sub moduleDelete {
}

sub moduleEdit {
}


################################################################

sub userAdd {
}

sub userDelete {
}

sub userEdit {
}


################################################################

sub projMailAdd {
    my ($class, $project_name, $domain_name, $brand_name, $list_name, $list_options) = @@_;

    print "ezmlm: call ezmlm-make for $project_name - $list_name with $list_options\n";
}

sub projMailDelete {
    my ($class, $project_name, $domain_name, $brand_name, $list_name) = @@_;
    print "ezmlm: remove dir for list $list_name in $project_name and replace it with a\n";
    print "       sorry bounce script\n";

}

sub projMailEdit {
    my ($class, $project_name, $domain_name, $brand_name, $list_name, $list_options) = @@_;
    print "ezmlm: call ezmlm-make to change the options for $list_name in $project_name\n";
    print "       to $list_options\n";
}



################################################################

# the option columns, and the letter option they refer to
my @@options = (['archived', 'a'],
	    ['digest', 'd'],
	    ['prefix', 'f'],
	    ['guard_archive', 'g'],
	    ['indexed', 'i'],
	    ['kill_opt', 'k'],
	    ['list_subs', 'l'],
	    ['message_moderation', 'm'],
	    ['new_text_file', 'n'],
	    ['public', 'p'],
	    ['request_address', 'q'],
	    ['remote_admin', 'r'],
	    ['sub_moderation', 's'],
	    ['trailer', 't'],
	    ['user_posts_only', 'u'],
	    ['address_restriction', 'w'],
	    ['extra', 'x']);
my @@optcols = map { $_->[0]; } @@options;
my @@optswitches = map { $_->[1]; } @@options;

sub user {
    my ($class, $db) = @@_;
    return $db->config('qmail_user');
}

# update Helm::QmailLists $db;
sub update {
    my ($class, $db) = @@_;
    my $home = Helm::QmailUtils::home($db);

    my $ts = new Helm::TableSync($db, 'project_mlists', [qw(list project)],
				   "$home/tigris-ezmlm", \&_ezmlm_map);
    $ts->check($home, \&_ezmlm_add, \&_ezmlm_del, \&_ezmlm_check,
	       ['owner', 'sublist', @@optcols]);
}

# _ezmlm_map($home, $db, $cols)
sub _ezmlm_map {
    my ($home, $db, $cols) = @@_;
    my ($list, $project) = @@$cols;
    return $project ? "$home/$project-$list" : "$home/$list";
}

# _ezmlm_make($db, $home, $list, $project, $switches, $owner, $sublist, @@opts)
# Run the ezmlm-make program, for creating or updating a mailing list.
# $switches is a string with any initial options, such as -e to edit
# $xcols should be a reference to a list of the values for owner, sublist,
# and then the options listed in @@options, in order.
sub _ezmlm_make {
    my ($db, $home, $list, $project, $switches, $owner, $sublist, @@opts) = @@_;

    # pertinent config info
    my ($edir, $domain) = ($db->config('ezmlm_bindir'),
			   $db->config('domain_dns'));


    # Set up the switches
    for (my $i = 0; $i < @@optswitches; $i++) {
	# On is lowercase, off is uppercase
	if ($opts[$i] && $opts[$i] eq 'Y') {
	    $switches .= " -\l$optswitches[$i]";
	} else {
	    $switches .= " -\u$optswitches[$i]";
	}
    }
    $switches .= " -0 $sublist" if ($sublist);
    $switches .= " -5 $owner" if ($owner);

    # Call ezmlm-make to create the list. Note that we'd better have
    # permission, but that's not quite our problem yet.
    my $lname = $project ? "$project-$list" : $list;
    my $dname = $project ? "$project.$domain" : $domain;
    my $cmd = "$edir/ezmlm-make $switches $home/$lname " .
	"$home/.qmail-$lname $list $dname";
    print "QmailLists _ezmlm_make: <tt>$cmd</tt>\n";
    system($cmd)
	== 0 or die "There should be some kind of error here: $!\n";
}

# _ezmlm_add($home, $db, $cols, $dir, [$project]);
sub _ezmlm_add {
    my ($home, $db, $cols, $dir, $xcols) = @@_;
    my ($list, $project) = (@@$cols);
    my ($owner, $sublist, @@opts) = @@$xcols;

    _ezmlm_make($db, $home, $list, $project, "", $owner, $sublist, @@opts);
}


# _ezmlm_check
# Re-run make on the mailing list.
sub _ezmlm_check {
    my ($home, $db, $cols, $dir, $xcols) = @@_;
    my ($list, $project) = (@@$cols);
    my ($owner, $sublist, @@opts) = @@$xcols;
    
    # ezmlm-make is an expensive operation, and we only want to run it
    # if there have been changes. So we parse the config file to verify
    # this.
    my $changed = 0;

    open CONFIG, "$dir/config" or die "Could not open $dir/config: $!\n";
    while (my $line = <CONFIG>) {
	chomp $line;
	if ($line =~ /^F:/) {
	    # Check each of the switches to see if the option has changed
	    for (my $i = 0; $i < @@optswitches; $i++) {
		# On is lowercase, off is uppercase
		my $curr = ($opts[$i] && $opts[$i] eq 'Y')
		    ? "\l$optswitches[$i]" : "\u$optswitches[$i]";
		if ($line !~ $curr) {
		    $changed = $curr;
		    last;
		}
	    }
	    
	} elsif ($line =~ /^0:(.*)$/) {
	    if ((!$1 && $sublist) || ($1 && !$sublist)
		|| ($1 && $sublist && ($1 ne $sublist))) {
		$changed = "sublist";
		last;
	    }	    
	} elsif ($line =~ /^5:(.*)$/) {
	    if ((!$1 && $owner) || ($1 && !$owner)
		|| ($1 && $owner && ($1 ne $owner))) {
		$changed = "owner $1-$owner";
		last;
	    }
	}
    }
    close CONFIG;

    # Run ezmlm-make, and it will update the mailing list
    _ezmlm_make($db, $home, $list, $project, "-e", $owner, $sublist, @@opts)
	if $changed;
}

# _ezmlm_del($home, $db, $cols_ref, $dir)
# Doesn't ezmlm have a delete-list mechanism? Is this the best
# way to do this???
#
# Of course, one might ask if we should be deleting lists at all,
# given that you lose the archive and all other sorts of things,
# but I won't bother with that question right about now.
sub _ezmlm_del {
    my ($home, $db, $cols_ref, $dir) = @@_;
    my ($list, $project) = @@$cols_ref;
    my $lname = $project ? "$project-$list" : $list;

    # Technically we could do this straight Perl, but this is easier.
    system("/bin/rm -rf $dir");
    system("/bin/rm -f $home/.qmail-$lname*");
}

# We don't do anything particular when a project is removed or added
# (everything *in* the project should have been removed first)

sub add_project {}
sub del_project {}
@


1.1
log
@initial check in of new perl modules for more-direct config file updating
@
text
@@

