added tags for 0.06 and 0.07

Ezmlm/tags/Ezmlm-0.06/Changes

@@ -0,0 +1,35 @@
+$Id: Changes,v 1.5 2005/03/05 14:14:27 guy Exp $
+
+Revision history for Perl extension Mail::Ezmlm.
+
+0.01  Sun Oct 31 12:58:16 1999
+   - original version; created by h2xs 1.1.1.1.2.1
+
+0.02  Wed Jan 26 07:59:10 SAST 2000
+   - Added functions to check various options
+      (ismodsub, ismodpost, isremote, isdeny, isallow, isdigest)
+   - Allowed sub, unsub, list, subscribers, issub to work with list subparts
+      (ie, the allow, deny, mod, digest sub directories)
+   - Changed system() calls to safer ones (ie command, switches)
+   - Made error handling better (errmsg() and errno())
+   - Added support for creating MySQL tables via ezmlm-mktab
+
+0.03 Mon Sep 25 11:49:26 SAST 2000
+   - fixed the issub() function
+	- fixed the problem with dashes in hostnames.
+   - hopefully got rid of some of the warnings from sub() and unsub()
+
+0.04 Mon May 26 18:15:38 SAST 2003
+   - fixed return value of Makefile.PL (Andrew Pam <xanni@glasswings.com.au>)
+   - fixed issub() (again) to handle parts properly (bug 602; moguo@servism.com)
+   - converted module global variables to instance variables
+
+0.05 Sat Mar  5 12:47:10 SAST 2005
+   - fixed forced scalar return in subscribers() (Jon Coulter <ledjon@ledjon.com>)
+   - fixed handling of dashes in hostnames (bug 5571; Lars Braeuer <lbraeuer@mpex.net>)
+   - fixed some tainting problems (Scott Beck <sbeck@gossamer-threads.com> and Matt Simerson <matt@tnpi.biz>)
+   - fixed order of control/defaulthost and control/me (bug 1515)
+   - fixed a bug in Makefile.PL (bug 11771).  does not affect most users, so released as 0.05.1
+
+0.06 Mon Dec 26 18:55:12 CET 2005
+   - support for ezmlm-idx-5.0.0 added

Ezmlm/tags/Ezmlm-0.06/Ezmlm.pm

@@ -0,0 +1,870 @@
+# ===========================================================================
+# Ezmlm.pm - version 0.04 - 26/05/2003
+# $Id: Ezmlm.pm,v 1.10 2005/03/05 14:11:11 guy Exp $
+#
+# Object methods for ezmlm mailing lists
+#
+# Copyright (C) 1999-2005, Guy Antony Halse, All Rights Reserved.
+# Please send bug reports and comments to guy@rucus.ru.ac.za
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met: 
+#
+# Redistributions of source code must retain the above copyright notice,
+# this list of conditions and the following disclaimer.
+#
+# 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.
+#
+# Neither name Guy Antony Halse nor the names of any contributors
+# may be used to endorse or promote products derived from this software
+# without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
+# IS'' AND ANY EXPRESS 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 THE REGENTS OR 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.
+#
+# ==========================================================================
+# POD is at the end of this file. Search for '=head' to find it
+package Mail::Ezmlm;
+
+use strict;
+use vars qw($QMAIL_BASE $EZMLM_BASE $MYSQL_BASE $VERSION @ISA @EXPORT @EXPORT_OK);
+use Carp;
+
+require Exporter;
+
+@ISA = qw(Exporter);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+@EXPORT = qw(
+   
+);
+$VERSION = '0.06';
+
+require 5.005;
+
+# == Begin site dependant variables ==
+$EZMLM_BASE = '/usr/local/bin'; #Autoinserted by Makefile.PL 
+$QMAIL_BASE = '/var/qmail'; #Autoinserted by Makefile.PL 
+$MYSQL_BASE = ''; #Autoinserted by Makefile.PL 
+# == End site dependant variables ==
+
+use Carp;
+
+# == clean up the path for taint checking ==
+local $ENV{'PATH'} = $EZMLM_BASE;
+
+# == Initialiser - Returns a reference to the object ==
+sub new { 
+	my($class, $list) = @_;
+	my $self = {};
+	bless $self, ref $class || $class || 'Mail::Ezmlm';
+	$self->setlist($list) if(defined($list) && $list);      
+	return $self;
+}
+
+# == Make a new mailing list and set it to current ==
+sub make {
+	my($self, %list) = @_;
+	my($VHOST, $comandline, $hostname);
+
+	# Do we want to use command line switches
+	my $commandline = '';
+	$commandline = '-' . $list{'-switches'} if(defined($list{'-switches'}));
+	my @commandline;
+	# UGLY!
+	foreach (split(/["'](.+?)["']|(\s-\w+)/, $commandline)) {
+		next if (!defined($_) or !$_ or $_ eq ' ');
+		push @commandline, $_;
+	}
+
+	# These three variables are essential
+	($self->_seterror(-1, 'must define -dir in a make()') && return 0) unless(defined($list{'-dir'}));
+	($self->_seterror(-1, 'must define -qmail in a make()') && return 0) unless(defined($list{'-qmail'})); 
+	($self->_seterror(-1, 'must define -name in a make()') && return 0) unless(defined($list{'-name'}));
+
+	# Determine hostname if it is not supplied
+	$hostname = $self->_getdefaultdomain;
+	if(defined($list{'-host'})) {
+		$VHOST = 1 unless ($list{'-host'} eq $hostname);
+	} else {
+		$list{'-host'} = $hostname;
+	}
+
+	# Attempt to make the list if we can.
+	unless(-e $list{'-dir'}) {
+		system("$EZMLM_BASE/ezmlm-make", @commandline, $list{'-dir'}, $list{'-qmail'}, $list{'-name'}, $list{'-host'}) == 0
+			|| ($self->_seterror($?) && return undef);
+	} else {
+		($self->_seterror(-1, '-dir must be defined in make()') && return 0);
+	}   
+
+	# Sort out the DIR/inlocal problem if necessary
+	if(defined($VHOST)) {
+		unless(defined($list{'-user'})) {
+			($self->_seterror(-1, '-user must match virtual host user in make()') && return 0) unless($list{'-user'} = $self->_getvhostuser($list{'-host'}));
+		}
+
+		open(INLOCAL, ">$list{'-dir'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in make()') && return 0);
+		print INLOCAL $list{'-user'} . '-' . $list{'-name'} . "\n";
+		close INLOCAL;
+	}   
+
+	$self->_seterror(undef);
+	return $self->setlist($list{'-dir'});
+}
+
+# == Update the current list ==
+sub update {
+	my($self, $switches) = @_;
+	my($outhost, $inlocal);
+	   
+	# Do we have the command line switches
+	($self->_seterror(-1, 'nothing to update()') && return 0) unless(defined($switches));
+	$switches = '-e' . $switches;
+	my @switches;
+
+	# UGLY!
+	foreach (split(/["'](.+?)["']|(-\w+)/, $switches)) {
+		next if (!defined($_) or !$_ or $_ eq ' ');
+		# untaint input
+		$_ =~ m/^([\w _\/,\.@:'"-]*)$/;
+		push @switches, $1;
+	}
+
+	# can we actually alter this list;
+	($self->_seterror(-1, 'must setlist() before you update()') && return 0) unless(defined($self->{'LIST_NAME'}));
+	# check for important files: 'config' (idx < v5.0) or 'flags' (idx >= 5.0)
+	($self->_seterror(-1, "$self->{'LIST_NAME'} does not appear to be a valid list in update()") && return 0) unless((-e "$self->{'LIST_NAME'}/config") || (-e "$self->{'LIST_NAME'}/flags"));
+
+	# Work out if this is a vhost.
+	open(OUTHOST, "<$self->{'LIST_NAME'}/outhost") || ($self->_seterror(-1, 'unable to read outhost in update()') && return 0);
+	chomp($outhost = <OUTHOST>);
+	close(OUTHOST);
+
+	# Save the contents of inlocal if it is a vhost
+	unless($outhost eq $self->_getdefaultdomain) {
+		open(INLOCAL, "<$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to read inlocal in update()') && return 0);
+		chomp($inlocal = <INLOCAL>);
+		close(INLOCAL);
+	}
+
+	# Attempt to update the list if we can.
+	system("$EZMLM_BASE/ezmlm-make", @switches, $self->{'LIST_NAME'}) == 0
+		|| ($self->_seterror($?) && return undef);
+
+	# Sort out the DIR/inlocal problem if necessary
+	if(defined($inlocal)) {
+		open(INLOCAL, ">$self->{'LIST_NAME'}/inlocal") || ($self->_seterror(-1, 'unable to write inlocal in update()') && return 0);
+		print INLOCAL "$inlocal\n";
+		close INLOCAL;
+	}   
+
+	$self->_seterror(undef);
+	return $self->{'LIST_NAME'};
+}
+
+# == Get a list of options for the current list ==
+sub getconfig {
+	my($self) = @_;
+	my($options);
+
+	# Read the config file
+	if(-e "$self->{'LIST_NAME'}/flags") { 
+		# this file exists since ezmlm-idx-5.0.0
+		# 'config' is not authorative anymore since that version
+		$options = $self->_getconfig_idx5();
+	} elsif(open(CONFIG, "<$self->{'LIST_NAME'}/config")) { 
+		# 'config' contains the authorative information
+		while(<CONFIG>) {
+			if (/^F:-(\w+)/) {
+				$options = $1;
+			} elsif (/^(\d):(.+)$/) {
+				$options .= " -$1 '$2'";
+			}
+		}
+		close CONFIG;
+	} else {
+		# Try manually - this will ignore all string settings, that can only be found
+		# in the config file
+		$options = $self->_getconfigmanual(); 
+	}
+
+	($self->_seterror(-1, 'unable to read configuration in getconfig()') && return undef) unless (defined($options));   
+
+	$self->_seterror(undef);
+	return $options;
+}
+
+# == Return the name of the current list ==
+sub thislist {
+	my($self) = shift;
+	$self->_seterror(undef);
+	return $self->{'LIST_NAME'};
+}
+
+# == Set the current mailing list ==
+sub setlist {
+	my($self, $list) = @_;
+	if ($list =~ m/^([\w\d\_\-\.\/]+)$/) {
+		$list = $1;
+		if (-e "$list/lock") {
+          $self->_seterror(undef);
+			return $self->{'LIST_NAME'} = $list;
+		} else {
+			$self->_seterror(-1, "$list does not appear to be a valid list in setlist()");
+			return undef;
+		}
+	} else {
+		$self->_seterror(-1, "$list contains tainted data in setlist()");
+		return undef;
+	}
+}
+
+# == Output the subscribers to $stream ==
+sub list {
+	my($self, $stream, $part) = @_;
+	$stream = *STDOUT unless (defined($stream));
+	if(defined($part)) {
+		print $stream $self->subscribers($part); 
+	} else {
+		print $stream $self->subscribers;
+	}
+}
+
+# == Return an array of subscribers ==
+sub subscribers {
+	my($self, $part) = @_;
+	my(@subscribers);
+	($self->_seterror(-1, 'must setlist() before returning subscribers()') && return undef) unless(defined($self->{'LIST_NAME'}));
+	if(defined($part) && $part) {
+		($self->_seterror(-1, "$part part of $self->{'LIST_NAME'} does not appear to exist in subscribers()") && return undef) unless(-e "$self->{'LIST_NAME'}/$part");
+		@subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}/$part`;
+	} else {
+		@subscribers = map { s/[\r\n]// && $_ } sort `$EZMLM_BASE/ezmlm-list $self->{'LIST_NAME'}`;
+	}
+
+	if($?) {
+		$self->_seterror($?, 'error during ezmlm-list in subscribers()'); 
+		return (scalar @subscribers ? @subscribers : undef);
+	} else {
+		$self->_seterror(undef);
+		return @subscribers;   
+	}
+}
+
+# == Subscribe users to the current list ==
+sub sub {
+	my($self, @addresses) = @_;
+	($self->_seterror(-1, 'sub() must be called with at least one address') && return 0) unless @addresses;
+	my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
+	my($address); 
+	($self->_seterror(-1, 'must setlist() before sub()') && return 0) unless(defined($self->{'LIST_NAME'}));
+
+	if(defined($part) && $part) {
+		($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in sub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
+		foreach $address (@addresses) {
+			next unless $self->_checkaddress($address);
+			system("$EZMLM_BASE/ezmlm-sub", "$self->{'LIST_NAME'}/$part", $address) == 0 || 
+            ($self->_seterror($?) && return undef);
+		}
+	} else {
+		foreach $address (@addresses) {
+			next unless $self->_checkaddress($address);
+			system("$EZMLM_BASE/ezmlm-sub", $self->{'LIST_NAME'}, $address) == 0 ||
+            ($self->_seterror($?) && return undef);
+		}
+	}
+	$self->_seterror(undef);
+	return 1;
+}
+
+# == Unsubscribe users from a list == 
+sub unsub {
+	my($self, @addresses) = @_;
+	($self->_seterror(-1, 'unsub() must be called with at least one address') && return 0) unless @addresses;
+	my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
+	my($address); 
+	($self->_seterror(-1, 'must setlist() before unsub()') && return 0) unless(defined($self->{'LIST_NAME'}));
+
+	if(defined($part) && $part) {
+		($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in unsub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
+		foreach $address (@addresses) {
+			next unless $self->_checkaddress($address);
+			system("$EZMLM_BASE/ezmlm-unsub", "$self->{'LIST_NAME'}/$part", $address) == 0 || 
+            ($self->_seterror($?) && return undef);
+		}   
+	} else {
+		foreach $address (@addresses) {
+			next unless $self->_checkaddress($address);
+			system("$EZMLM_BASE/ezmlm-unsub", $self->{'LIST_NAME'}, $address) == 0 || 
+            ($self->_seterror($?) && return undef);
+		}   
+	}
+	$self->_seterror(undef);
+	return 1;
+}
+
+# == Test whether people are subscribed to the list ==
+sub issub {
+	my($self, @addresses) = @_;
+	my($part) = pop @addresses unless ($#addresses < 1 or $addresses[$#addresses] =~ /\@/);
+	my($address, $issub); $issub = 1; 
+	($self->_seterror(-1, 'must setlist() before issub()') && return 0) unless(defined($self->{'LIST_NAME'}));
+
+	local $ENV{'SENDER'};
+
+	if(defined($part) && $part) {
+		($self->_seterror(-1, "$part of $self->{'LIST_NAME'} does not appear to exist in issub()") && return 0) unless(-e "$self->{'LIST_NAME'}/$part");
+		foreach $address (@addresses) {
+			$ENV{'SENDER'} = $address;
+			undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", "$self->{'LIST_NAME'}/$part") / 256) != 0)
+		}   
+	} else {
+		foreach $address (@addresses) {
+			$ENV{'SENDER'} = $address;
+			undef($issub) if ((system("$EZMLM_BASE/ezmlm-issubn", $self->{'LIST_NAME'}) / 256) != 0)
+		}   
+	}
+
+	$self->_seterror(undef);
+	return $issub;
+}
+
+# == Is the list posting moderated ==
+sub ismodpost {
+	my($self) = @_;
+	($self->_seterror(-1, 'must setlist() before ismodpost()') && return 0) unless(defined($self->{'LIST_NAME'}));
+	$self->_seterror(undef);
+	return -e "$self->{'LIST_NAME'}/modpost"; 
+}
+
+# == Is the list subscriber moderated ==
+sub ismodsub {
+	my($self) = @_;
+	($self->_seterror(-1, 'must setlist() before ismodsub()') && return 0) unless(defined($self->{'LIST_NAME'}));
+	$self->_seterror(undef);
+	return -e "$self->{'LIST_NAME'}/modsub"; 
+}
+
+# == Is the list remote adminable ==
+sub isremote {
+	my($self) = @_;
+	($self->_seterror(-1, 'must setlist() before isremote()') && return 0) unless(defined($self->{'LIST_NAME'}));
+	$self->_seterror(undef);
+	return -e "$self->{'LIST_NAME'}/remote"; 
+}
+
+# == Does the list have a kill list ==
+sub isdeny {
+	my($self) = @_;
+	($self->_seterror(-1, 'must setlist() before isdeny()') && return 0) unless(defined($self->{'LIST_NAME'}));
+	$self->_seterror(undef);
+	return -e "$self->{'LIST_NAME'}/deny"; 
+}
+
+# == Does the list have an allow list ==
+sub isallow {
+	my($self) = @_;
+	($self->_seterror(-1, 'must setlist() before isallow()') && return 0) unless(defined($self->{'LIST_NAME'}));
+	$self->_seterror(undef);
+	return -e "$self->{'LIST_NAME'}/allow"; 
+}
+
+# == Is this a digested list ==
+sub isdigest {
+	my($self) = @_;
+	($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'}));
+	$self->_seterror(undef);
+	return -e "$self->{'LIST_NAME'}/digest"; 
+}
+
+# == retrieve file contents ==
+sub getpart {
+	my($self, $part) = @_;
+	my(@contents, $content);
+	if(open(PART, "<$self->{'LIST_NAME'}/$part")) {
+		while(<PART>) {
+			chomp($contents[$#contents++] = $_);
+			$content .= $_;
+		}
+		close PART;
+		if(wantarray) {
+			return @contents;
+		} else {
+			return $content;
+		}
+	} ($self->_seterror($?) && return undef);
+}
+
+# == set files contents ==
+sub setpart {
+	my($self, $part, @content) = @_;
+	my($line);
+	if(open(PART, ">$self->{'LIST_NAME'}/$part")) {
+		foreach $line (@content) {
+			$line =~ s/[\r]//g; $line =~ s/\n$//;
+			print PART "$line\n";
+		}
+		close PART;
+		return 1;
+	} ($self->_seterror($?) && return undef);
+}
+
+# == return an error message if appropriate ==
+sub errmsg {
+	my($self) = @_;
+	return $self->{'ERRMSG'};
+}
+
+sub errno {
+	my($self) = @_;
+	return $self->{'ERRNO'};
+}
+
+# == Test the compatiblity of the module ==
+sub check_version {
+	my($self) = @_;
+	my $version = `$EZMLM_BASE/ezmlm-make -V 2>&1`;
+	$self->_seterror(undef);
+
+	my ($ezmlm, $idx) = $version =~ m/^ezmlm-make\s+version:\s+ezmlm-([\d\.]+)(?:\+ezmlm-idx-([\d\.]+))?/;
+	if($ezmlm >= 0.53) {
+		if (defined($idx)) {
+			if ($idx >= 0.40) {
+				return 0;
+			} elsif ($idx =~ m/^(\d)/) {
+				if ($1 >= 5) {
+					return 1;
+				} else {
+					return 0;
+				}
+			} else {
+				return $version;
+			}
+		}
+		return 0;
+	}
+	return $version;
+}
+
+# == Create SQL Database tables if defined for a list ==
+sub createsql {
+	my($self) = @_;
+
+	($self->_seterror(-1, 'MySQL must be compiled into Ezmlm for createsql() to work') && return 0)  unless(defined($MYSQL_BASE) && $MYSQL_BASE);
+	($self->_seterror(-1, 'must setlist() before isdigest()') && return 0) unless(defined($self->{'LIST_NAME'}));
+	my($config) = $self->getconfig();
+
+	if($config =~ m/-6\s+'(.+?)'\s*/){
+		my($sqlsettings) = $1;
+		my($host, $port, $user, $password, $database, $table) = split(':', $sqlsettings, 6);
+
+		($self->_seterror(-1, 'error in list configuration while trying createsql()') && return 0) 
+			unless (defined($host) && defined($port) && defined($user) 
+            && defined($password) && defined($database) && defined($table));
+
+		system("$EZMLM_BASE/ezmlm-mktab -d $table | $MYSQL_BASE/mysql -h$host -P$port -u$user -p$password -f $database") == 0 ||
+		($self->_seterror($?) && return undef);
+
+	} else {
+		$self->_seterror(-1, 'config for thislist() must include SQL options');
+		return 0;
+	}
+
+	($self->_seterror(undef) && return 1);
+
+}
+
+
+# == Internal function to set the error to return ==
+sub _seterror {
+	my($self, $no, $mesg) = @_;
+
+	if(defined($no) && $no) {
+		if($no < 0) {
+			$self->{'ERRNO'} = -1;
+			$self->{'ERRMSG'} = $mesg || 'An undefined error occoured';
+		} else {
+			$self->{'ERRNO'} = $no / 256;
+			$self->{'ERRMSG'} = $! || $mesg || 'An undefined error occoured in a system() call';
+		}
+	} else {
+		$self->{'ERRNO'} = 0;
+		$self->{'ERRMSG'} = undef;
+	}
+	return 1;
+}
+
+# == Internal function to test for valid email addresses ==
+sub _checkaddress {
+	my($self, $address) = @_;
+	return 1 unless defined($address);
+	return 0 unless ($address =~ m/^(\S+\@\S+\.\S+)$/);
+	$_[1] = $1;
+	return 1;
+}
+
+# == Internal function to work out a list configuration (idx >= v5.0) ==
+sub _getconfig_idx5 {
+	my($self) = @_;
+	my ($options, %optionfiles);
+	my ($file, $opt_num, $temp);
+
+	# read flag file (available since ezmlm-idx 5.0.0)
+	chomp($options = $self->getpart('flags'));
+	# remove prefixed '-'
+	$options =~ s/^-//;
+   
+	# since ezmlm-idx v5, we have to read the config
+	# values from different files
+	# first: preset a array with "filename" and "option_number"
+	%optionfiles = (
+		'sublist', '0',
+		'fromheader', '3',
+		'tstdigopts', '4',
+		'owner', '5',
+		'sql', '6',
+		'modpost', '7',
+		'modsub', '8');
+		# "-9" seems to be ignored - this is a good change (tm)
+	while (($file, $opt_num) = each(%optionfiles)) {
+		if (-e "$self->{'LIST_NAME'}/$file") {
+			chomp($temp = $self->getpart($file));
+			$options .= " -$opt_num '$temp'" if ($temp ne '');
+		}
+	}
+
+	return $options;
+}
+
+# == Internal function to work out a list configuration manually (idx < v5.0.0 ) ==
+sub _getconfigmanual {
+	# use this function for strange lists without
+	# 'config' (idx < v5.0) and 'flags' (idx >= v5.0)
+	my($self) = @_;
+	my ($savedollarslash, $options, $manager, $editor, $i);
+
+	# Read the whole of DIR/editor and DIR/manager in
+	$savedollarslash = $/;
+	undef $/;
+	# $/ = \0777;
+
+	open (EDITOR, "<$self->{'LIST_NAME'}/editor") || ($self->_seterror($?) && return undef);
+	open (MANAGER, "<$self->{'LIST_NAME'}/manager") || ($self->_seterror($?) && return undef);
+	$editor = <EDITOR>; $manager = <MANAGER>;
+	close(EDITOR), close(MANAGER);
+
+	$/ = $savedollarslash;
+   
+	$options = '';
+	$options .= 'a' if (-e "$self->{'LIST_NAME'}/archived");
+	$options .= 'd' if (-e "$self->{'LIST_NAME'}/digest");
+	$options .= 'f' if (-e "$self->{'LIST_NAME'}/prefix");
+	$options .= 'g' if ($manager =~ /ezmlm-get -\w*s/ );
+	$options .= 'i' if (-e "$self->{'LIST_NAME'}/indexed");
+	$options .= 'k' if (-e "$self->{'LIST_NAME'}/blacklist" || -e "$self->{'LIST_NAME'}/deny");
+	$options .= 'l' if ($manager =~ /ezmlm-manage -\w*l/ );
+	$options .= 'm' if (-e "$self->{'LIST_NAME'}/modpost");
+	$options .= 'n' if ($manager =~ /ezmlm-manage -\w*e/ );
+	$options .= 'p' if (-e "$self->{'LIST_NAME'}/public");
+	$options .= 'q' if ($manager =~ /ezmlm-request/ );
+	$options .= 'r' if (-e "$self->{'LIST_NAME'}/remote");
+	$options .= 's' if (-e "$self->{'LIST_NAME'}/modsub");
+	$options .= 't' if (-e "$self->{'LIST_NAME'}/text/trailer");
+	$options .= 'u' if (($options !~ /m/ && $editor =~ /ezmlm-issubn \'/ )
+                      || $editor =~ /ezmlm-gate/ );
+	$options .= 'x' if (-e "$self->{'LIST_NAME'}/extra" || -e "$self->{'LIST_NAME'}/allow");
+
+	# Add the unselected options too
+	# but we will skip invalid options (any of 'cevz')
+	foreach $i ('a' .. 'z') {
+		$options .= uc($i) unless (('cevz' =~ /$i/) || ($options =~ /$i/i))
+	}
+   
+	# there is no way to get the other string settings, that are only
+	# defined in 'config' - sorry ...
+   
+	return $options;
+}
+
+# == Internal Function to try to determine the vhost user ==
+sub _getvhostuser {
+	my($self, $hostname) = @_;
+	my($username);
+
+	open(VD, "<$QMAIL_BASE/control/virtualdomains") || ($self->_seterror($?) && return undef);
+	while(<VD>) {
+		last if(($username) = /^\s*$hostname:(\w+)$/);
+	}
+	close VD;
+
+	return $username;
+}
+
+# == Internal function to work out default host name ==
+sub _getdefaultdomain {
+	my($self) = @_;
+	my($hostname);
+
+	open (GETHOST, "<$QMAIL_BASE/control/defaultdomain") 
+		|| open (GETHOST, "<$QMAIL_BASE/control/me") 
+		|| ($self->_seterror($?) && return undef);
+	chomp($hostname = <GETHOST>);
+	close GETHOST;
+
+	return $hostname;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Ezmlm - Object Methods for Ezmlm Mailing Lists
+
+=head1 SYNOPSIS
+
+ use Mail::Ezmlm;
+ $list = new Mail::Ezmlm;
+ 
+The rest is a bit complicated for a Synopsis, see the description.
+
+=head1 ABSTRACT
+
+Ezmlm is a Perl module that is designed to provide an object interface to
+the ezmlm mailing list manager software. See the ezmlm web page
+(http://www.ezmlm.org/) for a complete description of the software.
+
+This version of the module is designed to work with ezmlm version 0.53.
+It is fully compatible with ezmlm's IDX extensions (version 0.40). Both
+of these can be obtained via anon ftp from ftp://ftp.ezmlm.org/pub/patches/
+
+=head1 DESCRIPTION
+
+=head2 Setting up a new Ezmlm object:
+
+   use Mail::Ezmlm;
+   $list = new Mail::Ezmlm;
+   $list = new Mail::Ezmlm('/home/user/lists/moolist');
+
+=head2 Changing which list the Ezmlm object points at:
+ 
+
+   $list->setlist('/home/user/lists/moolist');
+
+=head2 Getting a list of current subscribers:
+
+=item Two methods of listing subscribers is provided. The first prints a list
+of subscribers, one per line, to the supplied FILEHANDLE. If no filehandle is
+given, this defaults to STDOUT. An optional second argument specifies the
+part of the list to display (mod, digest, allow, deny). If the part is
+specified, then the FILEHANDLE must be specified.
+
+   $list->list;
+   $list->list(\*STDERR);
+   $list->list(\*STDERR, 'deny');
+
+=item The second method returns an array containing the subscribers. The
+optional argument specifies which part of the list to display (mod, digest,
+allow, deny).
+
+   @subscribers = $list->subscribers;
+   @subscribers = $list->subscribers('allow');
+
+=head2 Testing for subscription:
+
+   $list->issub('nobody@on.web.za');
+   $list->issub(@addresses);
+   $list->issub(@addresses, 'mod');
+
+issub() returns 1 if all the addresses supplied are found as subscribers 
+of the current mailing list, otherwise it returns undefined. The optional
+argument specifies which part of the list to check (mod, digest, allow,
+deny).
+
+=head2 Subscribing to a list:
+
+   $list->sub('nobody@on.web.za');
+   $list->sub(@addresses);
+   $list->sub(@addresses, 'digest');
+
+sub() takes a LIST of addresses and subscribes them to the current mailing list.
+The optional argument specifies which part of the list to subscribe to (mod,
+digest, allow, deny).
+
+
+=head2 Unsubscribing from a list:
+
+   $list->unsub('nobody@on.web.za');
+   $list->unsub(@addresses);
+   $list->unsub(@addresses, 'mod');
+
+unsub() takes a LIST of addresses and unsubscribes them (if they exist) from the
+current mailing list. The optional argument specifies which part of the list
+to unsubscribe from (mod, digest, allow, deny).
+
+
+=head2 Creating a new list:
+
+   $list->make(-dir=>'/home/user/list/moo',
+         -qmail=>'/home/user/.qmail-moo',
+         -name=>'user-moo',
+         -host=>'on.web.za',
+         -user=>'onwebza',
+         -switches=>'mPz');
+
+make() creates the list as defined and sets it to the current list. There are
+three variables which must be defined in order for this to occur; -dir, -qmail and -name.
+
+=over 6
+
+=item -dir is the full path of the directory in which the mailing list is to
+be created.
+
+=item -qmail is the full path and name of the .qmail file to create.
+
+=item -name is the local part of the mailing list address (eg if your list
+was user-moo@on.web.za, -name is 'user-moo').
+
+=item -host is the name of the host that this list is being created on. If
+this item is omitted, make() will try to determine your hostname. If -host is
+not the same as your hostname, then make() will attempt to fix DIR/inlocal for
+a virtual host.
+
+=item -user is the name of the user who owns this list. This item only needs to
+be defined for virtual domains. If it exists, it is prepended to -name in DIR/inlocal.
+If it is not defined, the make() will attempt to work out what it should be from
+the qmail control files.
+
+=item -switches is a list of command line switches to pass to ezmlm-make(1).
+Note that the leading dash ('-') should be ommitted from the string.
+
+=back
+
+make() returns the value of thislist() for success, undefined if there was a
+problem with the ezmlm-make system call and 0 if there was some other problem.
+
+See the ezmlm-make(1) man page for more details
+
+=head2 Determining which list we are currently altering:
+
+   $whichlist = $list->thislist;
+   print $list->thislist;
+
+=head2 Getting the current configuration of the current list:
+
+   $list->getconfig;
+
+getconfig() returns a string that contains the command line switches that
+would be necessary to re-create the current list. It does this by reading the
+DIR/config file (idx < v5.0) or DIR/flags (idx >= v5.0) if one of them exists.
+If it can't find these files it attempts to work things out for itself (with
+varying degrees of success). If both these methods fail, then getconfig()
+returns undefined.
+
+   $list->ismodpost;
+   $list->ismodsub;
+   $list->isremote;
+   $list->isdeny;
+   $list->isallow;
+
+The above five functions test various features of the list, and return a 1
+if the list has that feature, or a 0 if it doesn't.
+
+=head2 Updating the configuration of the current list:
+
+   $list->update('msPd');
+
+update() can be used to rebuild the current mailing list with new command line
+options. These options can be supplied as a string argument to the procedure.
+Note that you do not need to supply the '-' or the 'e' command line switch.
+
+   @part = $list->getpart('headeradd');
+   $part = $list->getpart('headeradd');
+   $list->setpart('headerremove', @part);
+
+getpart() and setpart() can be used to retrieve and set the contents of
+various text files such as headeradd, headerremove, mimeremove, etc.
+
+=head2 Creating MySQL tables:
+
+   $list->createsql();
+
+Currently only works for MySQL.
+
+createsql() will attempt to create the table specified in the SQL connect
+options of the current mailing list. It will return an error if the current
+mailing list was not configured to use SQL, or is Ezmlm was not compiled
+with MySQL support. See the MySQL info pages for more information.
+
+=head2 Checking the Mail::Ezmlm and ezmlm version numbers
+
+The version number of the Mail::Ezmlm module is stored in the variable
+$Mail::Ezmlm::VERSION. The compatibility of this version of Mail::Ezmlm
+with your system installed version of ezmlm can be checked with
+
+   $list->check_version();
+
+This returns 0 for compatible, or the version string of ezmlm-make(2) if
+the module is incompatible with your set up.
+
+=head1 RETURN VALUES
+
+All of the routines described above have return values. 0 or undefined are
+used to indicate that an error of some form has occoured, while anything
+>0 (including strings, etc) are used to indicate success.
+
+If an error is encountered, the functions
+
+   $list->errno();
+   $list->errmsg();
+
+can be used to determine what the error was. 
+
+errno() returns;  0  or undef if there was no error.
+                 -1  for an error relating to this module.
+                 >0  exit value of the last system() call.
+
+errmsg() returns a string containing a description of the error ($! if it
+was from a system() call). If there is no error, it returns undef.
+
+For those who are interested, in those sub routines that have to make system
+calls to perform their function, an undefined value indicates that the
+system call failed, while 0 indicates some other error. Things that you would
+expect to return a string (such as thislist()) return undefined to indicate 
+that they haven't a clue ... as opposed to the empty string which would mean
+that they know about nothing :)
+
+=head1 AUTHOR
+
+ Guy Antony Halse <guy-ezmlm@rucus.net>
+
+=head1 BUGS
+
+ May have problems with newer versions of Perl.
+
+ Please report bugs to the author.
+
+=head1 SEE ALSO
+
+ ezmlm(5), ezmlm-make(2), ezmlm-sub(1), 
+ ezmlm-unsub(1), ezmlm-list(1), ezmlm-issub(1)
+
+ http://rucus.ru.ac.za/~guy/ezmlm/
+ http://www.ezmlm.org/
+ http://www.qmail.org/
+
+=cut

Ezmlm/tags/Ezmlm-0.06/MANIFEST

@@ -0,0 +1,7 @@
+Changes
+Ezmlm.pm
+MANIFEST
+README
+Makefile.PL
+test.pl
+META.yml

Ezmlm/tags/Ezmlm-0.06/META.yml

@@ -0,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Ezmlm
+version:      0.05
+version_from: Ezmlm.pm
+installdirs:  site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17

Ezmlm/tags/Ezmlm-0.06/Makefile.PL

@@ -0,0 +1,119 @@
+# $Id: Makefile.PL,v 1.3 2005/03/05 14:15:20 guy Exp $
+
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    'CONFIGURE'    => \&set_paths,
+    'NAME'         => 'Mail::Ezmlm',
+    'VERSION_FROM' => 'Ezmlm.pm', # finds $VERSION
+    'DISTNAME'     => 'Ezmlm',
+    'dist'         => { COMPRESS => 'gzip', SUFFIX => 'gz' },
+    'clean'        => { FILES => 'ezmlmtmp' }
+);
+
+sub set_paths {
+   my($qmail_path, $ezmlm_path);
+
+   # special case to handle the FreeBSD ports system
+   if ($ENV{BSD_BATCH_INSTALL}) {
+      print STDERR "\$BSD_BATCH_INSTALL is set in your environment, assuming port defaults\n";
+      return {};
+   }
+
+   print << 'EOM';
+
+We now need to know where some things live on your system. I'll try and make
+some intelligent guesses - if I get it right, please just press enter at the
+prompt. If I get them wrong, please type in the correct path for me and then
+press enter.
+
+First I need to know where the Ezmlm binaries live (ie where I can find
+ezmlm-make, ezmlm-sub, etc).
+
+EOM
+
+   *prompt = \&ExtUtils::MakeMaker::prompt;
+
+   foreach (1..10) {
+      $ezmlm_path = prompt('Ezmlm binary directory?', '/usr/local/bin');
+      last if (-e "$ezmlm_path/ezmlm-make");
+      print "I can't find $ezmlm_path/ezmlm-make. Please try again\n";
+      if (! -e "$ezmlm_path/ezmlm-make") {
+         print STDERR "No correct input after $_ attempts.  Exiting Makefile.PL.\n";
+         exit (2);
+      }
+   }
+
+   print << 'EOM';
+
+Now I need to know where Qmail resides on your system. The Qmail base 
+directory is the one in which the Qmail bin, control, etc directories
+live in.
+
+EOM
+
+   foreach (1..10) {
+      $qmail_path = prompt('Qmail base directory?', '/var/qmail');
+      last if (-d "$qmail_path/control");
+      print "I can't find $qmail_path/control. Please try again\n";   
+      if (! -e "$qmail_path/control") {
+         print STDERR "No correct input after $_ attempts.  Exiting Makefile.PL.\n";
+         exit (2);
+      }
+   }
+
+   if(`strings $ezmlm_path/ezmlm-sub | grep -i 'MySQL'`) {
+
+      print << 'EOM';
+
+It appears you have compiled MySQL support into your version of Ezmlm. If
+this is correct, I now need to know where the MySQL client (mysql) lives on
+your machine.
+
+Please leave this blank if you do not want to enable MySQL support in the
+Mail::Ezmlm module.
+
+EOM
+
+      foreach (1..10) {
+         $mysql_path = prompt('MySQL binary directory?', '');
+         last if (-e "$mysql_path/mysql" || $mysql_path eq '');
+         print "I can't find $mysql_path/mysql. Please enter the full path\n";
+         print "or leave this option blank if you don't want to use MySQL\n";
+         if ((! -e "$mysql_path/mysql") && ($mysql_path ne '')) {
+            print STDERR "No correct input after $_ attempts.  Exiting Makefile.PL.\n";
+            exit (2);
+         }
+      }
+
+   }
+
+   print << 'EOM';
+
+Thank you. I will use this information to configure Mail::Ezmlm for you
+
+EOM
+
+   # Back up file
+   open(EZMLM, '<Ezmlm.pm') or die "Unable to open Ezmlm.pm for read: $!";
+   open(TMP, ">Ezmlm.pm.tmp.$$") or die "Unable to create temp file: $!";
+   while(<EZMLM>) { print TMP; }
+   close TMP; close EZMLM;
+
+   # Do variable substitution
+   open(EZMLM, '>Ezmlm.pm') or die "Unable to open Ezmlm.pm for write: $!";
+   open(TMP, "<Ezmlm.pm.tmp.$$") or die "Unable to read temp file: $!";
+   while(<TMP>) {
+      s{^\$EZMLM_BASE\s*=\s*['"].+?['"]\s*;}{\$EZMLM_BASE = '$ezmlm_path'; #Autoinserted by Makefile.PL};
+      s{^\$QMAIL_BASE\s*=\s*['"].+?['"]\s*;}{\$QMAIL_BASE = '$qmail_path'; #Autoinserted by Makefile.PL}; 
+      s{^\$MYSQL_BASE\s*=\s*['"].*?['"]\s*;}{\$MYSQL_BASE = '$mysql_path'; #Autoinserted by Makefile.PL}; 
+     print EZMLM;
+   }
+   close TMP; close EZMLM;
+
+   unlink "Ezmlm.pm.tmp.$$";
+
+   return {};
+
+}

Ezmlm/tags/Ezmlm-0.06/README

@@ -0,0 +1,22 @@
+$Id: README,v 1.3 2005/03/05 14:14:06 guy Exp $
+
+Ezmlm.pm
+
+Object methods for ezmlm mailing lists.
+
+Install by doing the following ...
+# perl Makefile.PL
+# make test
+# make install
+
+One thing. For some reason MakeMaker doesn't like symlinks. Please make sure
+you use the full cantonical path for the qmail and ezmlm binaries.
+
+Documentation is in pod format. Please run perldoc Mail::Ezmlm after you have
+installed it.
+
+Much as I'd like to, I don't have the time to regularly maintain this.  New
+releases are infrequent at best.  Check http://guy.rucus.net/ezmlm/contrib/
+for patches, etc that may be useful.
+
+- Guy Antony Halse <guy-ezmlm@rucus.ru.ac.za>

Ezmlm/tags/Ezmlm-0.06/test.pl

@@ -0,0 +1,140 @@
+# ===========================================================================
+# test.pl - version 0.02 - 25/09/2000
+# $Id: test.pl,v 1.5 2005/03/05 14:08:30 guy Exp $
+# Test suite for Mail::Ezmlm
+#
+# Copyright (C) 1999, Guy Antony Halse, All Rights Reserved.
+# Please send bug reports and comments to guy-ezmlm@rucus.ru.ac.za
+#
+# This program is subject to the restrictions set out in the copyright
+# agreement that can be found in the Ezmlm.pm file in this distribution
+#
+# ==========================================================================
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+$failed = 0;
+
+BEGIN { $| = 1; print "1..9\n"; }
+END {($failed++ && print "not ok 1\n") unless $loaded;}
+use Mail::Ezmlm;
+$loaded = 1;
+print "Loading: ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+use Cwd;
+use File::Find;
+$list = new Mail::Ezmlm;
+
+# create a temp directory if necessary
+$TMP = cwd() . '/ezmlmtmp';
+mkdir $TMP, 0755 unless (-d $TMP);
+
+print 'Checking list creation: ';
+$test1 = $list->make(-name=>"ezmlm-test1-$$", 
+            -qmail=>"$TMP/.qmail-ezmlm-test1-$$", 
+            -dir=>"$TMP/ezmlm-test1-$$"); 
+if($test1 eq "$TMP/ezmlm-test1-$$") {
+   print "ok 2\n";
+} else {
+   print 'not ok 2 [', $list->errmsg(), "]\n";
+   $failed++;
+}
+
+print 'Checking vhost list creation: ';
+$test2 = $list->make(-name=>"ezmlm-test2-$$",
+            -qmail=>"$TMP/.qmail-ezmlm-test2-$$",
+            -dir=>"$TMP/ezmlm-test2-$$",
+            -host=>'on.web.za',
+            -user=>'onwebza');
+if($test2 eq "$TMP/ezmlm-test2-$$") {
+   open(INLOCAL, "<$TMP/ezmlm-test2-$$/inlocal");
+   chomp($test2 = <INLOCAL>);
+   close INLOCAL;
+   if($test2 eq "onwebza-ezmlm-test2-$$") {
+      print "ok 3\n";
+   } else {
+      print 'not ok 3 [', $list->errmsg(), "]\n";
+      $failed++;
+   }
+} else {
+   print 'not ok 3 [', $list->errmsg(), "]\n";
+   $failed++;
+}
+
+print 'Testing list update: ';
+if($list->update('ms')) {
+   print "ok 4\n";
+} else {
+   print 'not ok 4 [', $list->errmsg(), "]\n";
+   $failed++;
+}
+
+print 'Testing setlist() and thislist(): ';
+$list->setlist("$TMP/ezmlm-test1-$$");
+if($list->thislist eq "$TMP/ezmlm-test1-$$") {
+   print "ok 5\n";
+} else {
+   print 'not ok 5 [', $list->errmsg(), "]\n";
+   $failed++;
+}
+
+print 'Testing list subscription and subscription listing: ';
+$list->sub('nobody@on.web.za');
+$list->sub('anonymous@on.web.za', 'test@on.web.za');
+@subscribers = $list->subscribers;
+if($subscribers[1] =~ /nobody\@on.web.za/) {
+   print "ok 6\n";
+} else {
+   print 'not ok 6 [', $list->errmsg(), "]\n";
+   $failed++;
+}
+
+print 'Testing issub(): ';
+if(defined($list->issub('nobody@on.web.za'))) {
+   if(defined($list->issub('some@non.existant.address'))) {
+      print 'not ok 7 [', $list->errmsg(), "]\n";
+      $failed++;
+   } else {
+      print "ok 7\n";
+   }
+} else {
+   print 'not ok 7 [', $list->errmsg(), "]\n";
+   $failed++;
+}
+
+print 'Testing list unsubscription: ';
+$list->unsub('nobody@on.web.za');
+$list->unsub('anonymous@on.web.za', 'test@on.web.za');
+@subscribers = $list->subscribers;
+unless(@subscribers) {
+   print "ok 8\n";
+} else {
+   print 'not ok 8 [', $list->errmsg(), "]\n";
+   $failed++;
+}
+
+print 'Testing installed version of ezmlm: ';
+my($version) = $list->check_version();
+if ($version) {
+   $version =~ s/\n//;
+   print 'not ok 9 [Ezmlm.pm is designed to work with ezmlm-idx > 0.40.  Your version reports as: ', $version, "]\n";
+} else {
+   print "ok 9\n";
+}
+
+if($failed > 0) {
+   print "\n$failed tests were failed\n";
+   exit $failed;
+} else {
+   print "\nSuccessful :-)\n";
+   finddepth(sub { (-d $File::Find::name) ? rmdir ($File::Find::name) : unlink ($File::Find::name) }, cwd() . "/ezmlmtmp");
+   exit;
+}

Ezmlm/tags/make-tar.sh

@@ -0,0 +1,15 @@
+#!/bin/sh
+
+set -eu
+
+PREFIX=Ezmlm
+
+[ $# -ne 1 ] && echo "Syntax: `basename $0` VERSION" && echo && exit 1
+[ ! -d "${PREFIX}-${1}" ] && echo "the directory '${PREFIX}-${1}' does not exist!" && exit 2
+
+TMP_DIR=/tmp/${PREFIX}-${1}
+[ -e "$TMP_DIR" ] && rm -rf "$TMP_DIR"
+
+svn export "${PREFIX}-${1}" "$TMP_DIR"
+tar czf "packages/${PREFIX}-${1}.tar.gz" -C "$(dirname $TMP_DIR)" --owner=0 --group=0 "$(basename $TMP_DIR)"
+rm -rf "$TMP_DIR"