senselab/codekasten
4
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity
codekasten/ezmlm-web-ng/contrib-patches/ezmlm-web-jose-celestino-20020208.txt

1573 lines
63 KiB
Text
Raw Normal View History

overview of contrib-patches from http://rucus.ru.ac.za/~guy/ezmlm/contrib/
2005-01-22 04:52:04 +01:00
From japc@co.sapo.pt Fri Feb 8 20:01:34 2002
Return-Path: <japc@co.sapo.pt>
Delivered-To: guy-ezmlm@rucus.ru.ac.za
Received: (qmail 72201 invoked from network); 8 Feb 2002 18:01:34 -0000
Received: from isengard.sl.pt (HELO morgoth.sl.pt) (212.55.140.11)
by server.rucus.ru.ac.za with SMTP; 8 Feb 2002 18:01:34 -0000
Received: (qmail 4347 invoked by uid 500); 8 Feb 2002 17:56:07 -0000
Date: Fri, 8 Feb 2002 17:56:07 +0000
From: Jose Celestino <japc@co.sapo.pt>
To: guy-ezmlm@rucus.ru.ac.za
Cc: japc@co.sapo.pt
Subject: Ezmlm-Web
Message-ID: <20020208175607.GB4210@co.sapo.pt>
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="bg08WKrSYDhXBjb5"
Content-Disposition: inline
Content-Transfer-Encoding: 8bit
User-Agent: Mutt/1.3.27i
X-URL: http://xpto.org/~japc
X-System: Linux morgoth 2.4.18pre1 i686
X-Subliminal: Exchange Microsoft
Status: RO
Content-Length: 63760
Lines: 1546
--bg08WKrSYDhXBjb5
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
Hello Guy,
don't know if you still maintain Ezmlm-Web but I've done some minor
changes/improvements;
- subscriber list can be filtered by the start character or by regexp
(we had lists of nearly 50000 subscribers and it was a pain for the page to open);
- support for $LIST/domains (for submission acls per domain):
In $LIST/editor top you should add the following line (one line only):
|export SENDER=`echo $SENDER | sed s/^.*@/@/g`; /servers/ezmlm/bin/ezmlm-issubn
'/servers/virtualdomains/lists.mydomain.com/list1/domains' || { echo
"Sorry, I'm reject mail from your domain ($SENDER).
Contact sysadmin@mydomain.com if you have any questions about it.(#5.7.2)"; exit 100 ; }
ad an extra list directory similar to mod for instance, $LIST/domains.
- and, finally, support for newsletter administration (we use ezmlm here
for newsletter sending - games, technology, health, etc.) for the
non-technical dudes to manage and send issues for all the mailing list
subscribers.
I found the subscripter filter to be extremely useful :)
--
Jose Celestino <japc@co.sapo.pt>
---------------------------------
Systems Administration - SAPO.pt
--bg08WKrSYDhXBjb5
Content-Type: text/plain; charset=iso-8859-1
Content-Disposition: attachment; filename="ezmlm-web.cgi"
Content-Transfer-Encoding: 8bit
#!/usr/bin/perl
#===========================================================================
# ezmlm-web.cgi - version 2.1 - 25/09/2000
# $Id: ezmlm-web.cgi,v 1.3 2000/09/25 19:58:07 guy Exp $
#
# Copyright (C) 1999/2000, Guy Antony Halse, All Rights Reserved.
# Please send bug reports and comments to guy-ezmlm@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.
#
# ==========================================================================
# All user configuration happens in the config file ``ezmlmwebrc''
# POD documentation is at the end of this file
# ==========================================================================
# Modules to include
use strict;
use Getopt::Std;
use Mail::Ezmlm;
use Mail::Address;
use DB_File;
use CGI;
use CGI::Carp qw(fatalsToBrowser set_message);
# These two are actually included later and are put here so we remember them.
#use File::Find if ($UNSAFE_RM == 1);
#use File::Copy if ($UNSAFE_RM == 0);
my @searchable=("TODOS","0-9","A","B","C","D","E","F","G","H","I","J","K",
"L","M","N","O","P","Q","R","S","T","U","V","X","W","Y","Z","_");
my $q = new CGI;
$q->import_names('Q');
use vars qw[$opt_c $opt_d $opt_C];
getopts('cd:C:');
# Suid stuff requires a secure path.
$ENV{'PATH'} = '/bin';
# We run suid so we can't use $ENV{'HOME'} and $ENV{'USER'} to determine the
# user. :( Don't alter this line unless you are _sure_ you have to.
my @tmp = getpwuid($>); my $USER=$tmp[0];
# use strict is a good thing++
use vars qw[$HOME_DIR]; $HOME_DIR=$tmp[7];
use vars qw[$DEFAULT_OPTIONS %EZMLM_LABELS $UNSAFE_RM $ALIAS_USER $LIST_DIR];
use vars qw[$QMAIL_BASE $EZMLM_CGI_RC $EZMLM_CGI_URL $HTML_BGCOLOR $PRETTY_NAMES];
use vars qw[%HELPER $HELP_ICON_URL $HTML_HEADER $HTML_FOOTER $HTML_TEXT $HTML_LINK];
use vars qw[%BUTTON %LANGUAGE $HTML_VLINK $HTML_TITLE $FILE_UPLOAD];
# Get user configuration stuff
if(defined($opt_C)) {
require "$opt_C"; # Command Line
} elsif(-e "$HOME_DIR/.ezmlmwebrc") {
require "$HOME_DIR/.ezmlmwebrc"; # User
} elsif(-e "/etc/ezmlm/ezmlmwebrc") {
require "/etc/ezmlm/ezmlmwebrc"; # System
} elsif(-e "./ezmlmwebrc") {
require "./ezmlmwebrc"; # Install
} else {
die "Unable to read config file";
}
# Allow suid wrapper to over-ride default list directory ...
if(defined($opt_d)) {
$LIST_DIR = $1 if ($opt_d =~ /^([-\@\w.\/]+)$/);
}
# Work out default domain name from qmail (for David Summers)
my($DEFAULT_HOST);
open (GETHOST, "<$QMAIL_BASE/me") || open (GETHOST, "<$QMAIL_BASE/defaultdomain") || die "Unable to read $QMAIL_BASE/me: $!";
chomp($DEFAULT_HOST = <GETHOST>);
close GETHOST;
# Untaint form input ...
&untaint;
# redirect must come before headers are printed
if(defined($Q::action) && $Q::action eq '[Web Archive]') {
print $q->redirect(&ezmlmcgirc);
exit;
}
# Print header on every page ...
print $q->header(-pragma=>'no-cache', '-cache-control'=>'no-cache', -expires=>'-1d');
print $q->start_html(-title=>$HTML_TITLE, -author=>'guy-ezmlm@rucus.ru.ac.za', -BGCOLOR=>$HTML_BGCOLOR, -LINK=>$HTML_LINK, -VLINK=>$HTML_VLINK, -TEXT=>$HTML_TEXT, -expires=>'-1d');
print $HTML_HEADER;
# This is where we decide what to do, depending on the form state and the
# users chosen course of action ...
unless (defined($q->param('state'))) {
# Default action. Present a list of available lists to the user ...
&select_list;
} elsif ($Q::state eq 'select') {
# User selects an action to perorm on a list ...
if ($Q::action eq "[$BUTTON{'create'}]") { # Create a new list ...
&allow_create_list;
} elsif (defined($Q::list)) {
if ($Q::action eq "[$BUTTON{'edit'}]") { # Edit an existing list ...
&display_list("NONE");
# open (ZBR,">>/tmp/123");
# print ZBR "FILTER:" . $q->param('filt') ."\n";
# while (defined($q->param('filt'))) {
# print ZBR "DONEEEEEEEE\n";
# &display_list($q->param('filt'));
# }
# close ZBR;
} elsif ($Q::action eq "[$BUTTON{'delete'}]") { # Delete a list ...
&confirm_delete;
}
} else {
&select_list; # NOP - Blank input ...
}
} elsif ($Q::state eq 'edit') {
# User chooses to edit a list
my($list); $list = $LIST_DIR . '/' . $q->param('list');
if ($Q::action eq "[$BUTTON{'deleteaddress'}]") { # Delete a subscriber ...
&delete_address($list);
&display_list("NONE");
} elsif ($Q::action eq "[$BUTTON{'addaddress'}]") { # Add a subscriber ...
&add_address($list);
&display_list("NONE");
} elsif ($Q::action eq "[$BUTTON{'edit_newsletter'}]") { # Send a newsletter issue...
&edit_newsletter($list);
} elsif ($Q::action eq "[$BUTTON{'moderators'}]") { # Edit the moderators ...
&part_subscribers('mod');
} elsif ($Q::action eq "[$BUTTON{'domains'}]") { # Edit the domains ...
&part_subscribers('domains');
} elsif ($Q::action eq "[$BUTTON{'denylist'}]") { # Edit the deny list ...
&part_subscribers('deny');
} elsif ($Q::action eq "[$BUTTON{'allowlist'}]") { # edit the allow list ...
&part_subscribers('allow');
} elsif ($Q::action eq "[$BUTTON{'digestsubscribers'}]") { # Edit the digest subscribers ...
&part_subscribers('digest');
} elsif ($Q::action eq "[$BUTTON{'configuration'}]") { # Edit the config ...
&list_config;
} elsif (defined($q->param('filt'))) {
&display_list($q->param('filt'));
} elsif (defined($q->param('search')) && defined($q->param('searchfor'))) {
&display_list($q->param('searchfor'));
} else { # Cancel - Return a screen ...
&select_list;
}
} elsif ($Q::state eq 'allow' || $Q::state eq 'mod' || $Q::state eq 'deny' || $q->param('state') eq 'digest') {
# User edits moderators || deny || digest ...
my($part);
# Which list directory are we using ...
if($Q::state eq 'mod') {
$part = 'mod';
} elsif($Q::state eq 'deny' ) {
$part = 'deny';
} elsif($Q::state eq 'allow') {
$part = 'allow';
} else {
$part = 'digest';
}
if ($Q::action eq '[Delete Address]') { # Delete a subscriber ...
&delete_address("$LIST_DIR/$Q::list", $part);
&part_subscribers($part);
} elsif ($Q::action eq "[$BUTTON{'addaddress'}]") { # Add a subscriber ...
&add_address("$LIST_DIR/$Q::list", $part);
&part_subscribers($part);
} else { # Cancel - Return to the list ...
&display_list("NONE");
}
} elsif ($Q::state eq 'confirm_delete') {
# User wants to delete a list ...
&delete_list if($q->param('confirm') eq "[$BUTTON{'yes'}]"); # Do it ...
$q->delete_all;
&select_list;
} elsif ($Q::state eq 'create') {
# User wants to create a list ...
if ($Q::action eq "[$BUTTON{'createlist'}]") {
if (&create_list) { # Return if list creation is unsuccessful ...
&allow_create_list;
} else {
&select_list; # Else choose a list ...
}
} else { # Cancel ...
&select_list;
}
} elsif ($Q::state eq 'configuration') {
# User updates configuration ...
if ($Q::action eq "[$BUTTON{'updateconfiguration'}]") { # Save current settings ...
&update_config;
&display_list("NONE");
} elsif ($Q::action eq "[$BUTTON{'edittexts'}]") { # Edit DIR/text ...
&list_text;
} else { # Cancel - Return to list editing screen ...
&display_list("NONE");
}
} elsif ($Q::state eq 'list_text') {
# User wants to edit texts associated with the list ...
if ($Q::action eq "[$BUTTON{'editfile'}]") {
&edit_text;
} else {
&list_config; # Cancel ...
}
} elsif ($Q::state eq 'edit_text') {
# User wants to save a new version of something in DIR/text ...
&save_text if ($Q::action eq "[$BUTTON{'savefile'}]");
&list_text;
} elsif ($Q::state eq 'edit_newsletter') {
# User wants to do something related with the newsletter
if ($Q::action eq "[$BUTTON{'updateconfiguration'}]") {
my $issue=$q->param('newsletterissue');
$issue="0$issue" if (($issue < 10) && ($issue !~ m/^0/));
my ($list) = new Mail::Ezmlm("$LIST_DIR/$Q::list");
# THOU SHALL NOT MESS $list->setpart("newsletter/localizacao", $q->param('newslettertree'));
$list->setpart("newsletter/ficheiro", $q->param('newsletterhtml'));
$list->setpart("newsletter/subject-da-edicao", $q->param('newslettersubject'));
# THOU SHALL NOT MESS $list->setpart("newsletter/sender", $q->param('newslettersender'));
$list->setpart("newsletter/edicao", $issue);
&edit_newsletter;
}
&edit_newsletter if ($Q::action eq "[$BUTTON{'resetform'}]");
&sendnewsletter if ($Q::action eq "[$BUTTON{'sendnewsletter'}]");
&display_list("NONE") if ($Q::action eq "[$BUTTON{'cancel'}]");
} else {
print "<H1 ALIGN=CENTER>$Q::action</H1><H2 ALIGN=CENTER>$LANGUAGE{'nop'}</H2><HR ALIGN=center WIDTH=25%>";
}
# Print HTML footer and exit :) ...
print $HTML_FOOTER, $q->end_html;
exit;
# =========================================================================
sub select_list {
# List all mailing lists (sub directories) in the list directory.
# Allow the user to choose a course of action; either editing an existing
# list, creating a new one, or deleting an old one.
my (@lists, @files, $i, $scrollsize);
# Read the list directory for mailing lists.
opendir DIR, $LIST_DIR || die "Unable to read $LIST_DIR: $!";
@files = grep !/^\./, readdir DIR;
closedir DIR;
# Check that they actually are lists ...
foreach $i (0 .. $#files) {
if (-e "$LIST_DIR/$files[$i]/lock") {
if (-e "$LIST_DIR/webusers") {
if (&webauth($files[$i]) == 0) {
$lists[$#lists + 1] = $files[$i];
}
} else {
$lists[$#lists + 1] = $files[$i];
}
}
}
# Keep selection box a resonable size - suggested by Sebastian Andersson
$scrollsize = 25 if(($scrollsize = $#lists + 1) > 25);
# Print a form
$q->delete_all;
print $q->startform;
print $q->hidden(-name=>'state', -default=>'select');
print '<CENTER><TABLE BORDER="0" CELLPADDING="10"><TR><TD ALIGN="center" VALIGN="top" ROWSPAN="2">';
print $q->scrolling_list(-name=>'list', -size=>$scrollsize, -values=>\@lists) if defined(@lists);
print '</TD><TD ALIGN="left" VALIGN="top">', $LANGUAGE{'chooselistinfo'};
print $q->submit(-name=>'action', -value=>"[$BUTTON{'create'}]"), ' ' if (!defined($opt_c));
print $q->submit(-name=>'action', -value=>"[$BUTTON{'edit'}]"), ' ' if(defined(@lists));
# JAPC // print $q->submit(-name=>'action', -value=>"[$BUTTON{'delete'}]") if(defined(@lists));
print '</TD></TR><TR><TD> </TD></TR></TABLE></CENTER>';
print $q->endform;
}
# ------------------------------------------------------------------------
sub confirm_delete {
# Make sure that the user really does want to delete the list!
# Print a form ...
$q->delete('state');
print $q->startform;
print $q->hidden(-name=>'state', -default=>'confirm_delete');
print $q->hidden(-name=>'list', -default=>$q->param('list'));
print '<H2 ALIGN="center">', $LANGUAGE{'confirmdelete'}, ' ', $q->param('list'), '</H3><BR><CENTER>';
print $q->submit(-name=>'confirm', -value=>"[$BUTTON{'no'}]"), ' ';
print $q->submit(-name=>'confirm', -value=>"[$BUTTON{'yes'}]"), '</CENTER>';
}
# ------------------------------------------------------------------------
sub display_list {
# Show a list of subscribers to the user ...
my ($i, $list, $listaddress, $moderated, @subscribers, $scrollsize);
my ($filt) = @_;
my @subscribersfilt;
# Work out the address of this list ...
$list = new Mail::Ezmlm("$LIST_DIR/$Q::list");
$listaddress = &this_listaddress;
# Get a list of subscribers from ezmlm ...
@subscribers = $list->subscribers;
if ("$filt" ne "NONE") {
if ($filt eq "0-9") { $filt='\d' };
if ($filt eq "TODOS") { $filt='.*$' };
for (@subscribers) {
if (defined($q->param('search'))) {
push @subscribersfilt, $_ if (m/$filt/i);
} else {
push @subscribersfilt, $_ if (m/^$filt/i);
}
}
}
# Keep selection box a resonable size - suggested by Sebastian Andersson
$scrollsize = 25 if(($scrollsize = $#subscribers + 1) > 25);
# Print out a form of options ...
$q->delete('state');
print "<H2 ALIGN=center>$LANGUAGE{'subscribersto'} $Q::list ($listaddress)</H2><HR ALIGN=center WIDTH=25%>";
print $q->start_multipart_form;
print '<CENTER><TABLE ALIGN="center" CELLPADDING="10"><TR><TD ROWSPAN="2" VALIGN="top" ALIGN="center">';
print $q->hidden(-name=>'state', -default=>'edit');
print $q->hidden(-name=>'list', -default=>$Q::list);
print $q->scrolling_list(-name=>'delsubscriber', -size=>$scrollsize, -values=>\@subscribersfilt, -labels=>&pretty_names, -multiple=>'true');# if defined(@subscribersfilt) && ($#subscribers <= 50);
print '</TD><TD VALIGN="top" ALIGN="left">';
print '<hr><font color=red><b> ', ($#subscribers + 1), ' ', $LANGUAGE{'subscribers'}, ' || ', ($#subscribersfilt + 1), ' ', $LANGUAGE{'selected'},' (', $filt ,')<b></font><hr><BR>' if defined(@subscribers);
if (defined(@subscribers)) {
print "<b>Filtrar</b>:<br>";
for (@searchable) {
print $q->submit(-name=>'filt', -value=>"$_");
}
print "<br><b>[regexp]</b>:" . $q->textfield(-name=>'searchfor', -size=>'40');
print $q->submit(-name=>'search', -value=>"[$BUTTON{'search'}]"), '<P>';
}
print $q->submit(-name=>'action', -value=>"[$BUTTON{'deleteaddress'}]"), '<P>'; # if (defined(@subscribers) && ($#subscribers >= 51));
print $q->textfield(-name=>'addsubscriber', -size=>'40'), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'addaddress'}, '"><BR>';
print $q->filefield(-name=>'addfile', -size=>20, -maxlength=>100), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'addaddressfile'}, '"><br>' if ($FILE_UPLOAD);
print $q->submit(-name=>'action', -value=>"[$BUTTON{'addaddress'}]"), '<P>';
print '<STRONG>', $LANGUAGE{'additionalparts'}, ':</STRONG><BR>' if($list->ismodpost || $list->ismodsub || $list->isremote || $list->isdeny || $list->isallow || $list->isdigest);
# JAPC //
print $q->submit(-name=>'action', -value=>"[$BUTTON{'edit_newsletter'}]"), '<IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'edit_newsletter'}, '"> ';
#if ($list->ismodpost || $list->ismodsub || $list->isremote);
print $q->submit(-name=>'action', -value=>"[$BUTTON{'moderators'}]"), '<IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'moderator'}, '"> ' if ($list->ismodpost || $list->ismodsub || $list->isremote);
print $q->submit(-name=>'action', -value=>"[$BUTTON{'domains'}]"), '<IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'domains'}, '"> ' if (-d "$LIST_DIR/domains");
print $q->submit(-name=>'action', -value=>"[$BUTTON{'denylist'}]"), '<IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'deny'}, '"> ' if ($list->isdeny);
print $q->submit(-name=>'action', -value=>"[$BUTTON{'allowlist'}]"), '<IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'allow'}, '"> ' if ($list->isallow);
print $q->submit(-name=>'action', -value=>"[$BUTTON{'digestsubscribers'}]"), '<IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'digest'}, '"> ' if ($list->isdigest);
print '<P>';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'webarchive'}]"), '<IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'webarch'}, '"> ' if(&ezmlmcgirc);
print $q->submit(-name=>'action', -value=>"[$BUTTON{'configuration'}]"), '<IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'config'}, '">&nbsp;&nbsp;&nbsp;';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'selectlist'}]");
print '</TD></TR><TR><TD> </TD></TR></TABLE></CENTER>';
print $q->endform;
}
# ------------------------------------------------------------------------
sub delete_list {
# Delete a list ...
# Fixes a bug from the previous version ... when the .qmail file has a
# different name to the list. We use outlocal to handle vhosts ...
my ($list, $listaddress, $listadd);
$list = new Mail::Ezmlm("$LIST_DIR/$Q::list");
if ($listadd = $list->getpart('outlocal')) {
chomp($listadd);
} else {
$listadd = $q->param('list');
}
$listaddress = $1 if ($listadd =~ /-?(\w+)$/);
if ($UNSAFE_RM == 0) {
# This doesn't actually delete anything ... It just moves them so that
# they don't show up. That way they can always be recovered by a helpful
# sysadmin should he be in the mood :)
use File::Copy;
my ($oldfile); $oldfile = "$LIST_DIR/$Q::list";
my ($newfile); $newfile = "$LIST_DIR/.$Q::list";
move($oldfile, $newfile) or die "Unable to rename list: $!";
mkdir "$HOME_DIR/deleted.qmail", 0700 if(!-e "$HOME_DIR/deleted.qmail");
opendir(DIR, "$HOME_DIR") or die "Unable to get directory listing: $!";
my @files = map { "$HOME_DIR/$1" if m{^(\.qmail.+)$} } grep { /^\.qmail-$listaddress/ } readdir DIR;
closedir DIR;
foreach (@files) {
unless (move($_, "$HOME_DIR/deleted.qmail/")) {
die "Unable to move .qmail files: $!";
}
}
warn "List '$oldfile' moved (deleted)";
} else {
# This, however, does DELETE the list. I don't like the idea, but I was
# asked to include support for it so ...
if (!rmtree("$LIST_DIR/$Q::list")) {
die "Unable to delete list: $!";
}
opendir(DIR, "$HOME_DIR") or die "Unable to get directory listing: $!";
my @files = map { "$HOME_DIR/$1" if m{^(\.qmail.+)$} } grep { /^\.qmail-$listaddress/ } readdir DIR;
closedir DIR;
if (unlink(@files) <= 0) {
die "Unable to delete .qmail files: $!";
}
warn "List '$list->thislist()' deleted";
}
}
# ------------------------------------------------------------------------
sub untaint {
$DEFAULT_HOST = $1 if $DEFAULT_HOST =~ /^([\w\d\.-]+)$/;
# Go through all the CGI input and make sure it is not tainted. Log any
# tainted data that we come accross ... See the perlsec(1) man page ...
my (@params, $i, $param);
@params = $q->param;
foreach $i (0 .. $#params) {
my(@values);
next if($params[$i] eq 'addfile');
foreach $param ($q->param($params[$i])) {
next if $param eq '';
if ($param =~ /^([#-\@\w\.\/\[\]\:\n\r\>\< ]+)$/) {
push @values, $1;
} else {
warn "Tainted input in '$params[$i]': " . $q->param($params[$i]);
}
$q->param(-name=>$params[$i], -values=>\@values);
}
}
$q->import_names('Q');
}
# ------------------------------------------------------------------------
sub add_address {
# Add an address to a list ..
my ($address, $list, @addresses, $count); my ($listname, $part) = @_;
$list = new Mail::Ezmlm($listname);
if($q->param('addfile')) {
# Sanity check
die "File upload must be of type text/*" unless($q->uploadInfo($q->param('addfile'))->{'Content-Type'} =~ m{^text/});
# Handle file uploads of addresses
my($fh) = $q->upload('addfile');
return unless (defined($fh));
while (<$fh>) {
next if (/^\s*$/ or /^#/); # blank, comments
next unless (/\@/); # email address ...
chomp();
push @addresses, $_;
}
} else {
# User typed in an address
return if ($q->param('addsubscriber') eq '');
$address = $q->param('addsubscriber');
$address .= $DEFAULT_HOST if ($q->param('addsubscriber') =~ /\@$/);
push @addresses, $address;
}
foreach $address (@addresses) {
my($add) = Mail::Address->parse($address);
if(defined($add->name()) && $PRETTY_NAMES) {
my(%pretty);
tie %pretty, "DB_File", "$LIST_DIR/$Q::list/webnames";
$pretty{$add->address()} = $add->name();
untie %pretty;
}
if ($list->sub($add->address(), $part) != 1) {
die "Unable to subscribe to list: $!";
}
$count++;
}
$q->delete('addsubscriber');
}
# ------------------------------------------------------------------------
sub delete_address {
# Delete an address from a list ...
my ($list, @address); my($listname, $part) = @_;
$list = new Mail::Ezmlm($listname);
return if ($q->param('delsubscriber') eq '');
@address = $q->param('delsubscriber');
if ($list->unsub(@address, $part) != 1) {
die "Unable to unsubscribe from list $list: $!";
}
if($PRETTY_NAMES) {
my(%pretty, $add);
tie %pretty, "DB_File", "$LIST_DIR/$Q::list/webnames";
foreach $add (@address) {
delete $pretty{$add};
}
untie %pretty;
}
$q->delete('delsubscriber');
}
# ------------------------------------------------------------------------
sub part_subscribers {
my($part) = @_;
# Deal with list parts ....
my ($i, $list, $listaddress, @subscribers, $moderated, $scrollsize, $type);
# Work out the address of this list ...
$list = new Mail::Ezmlm("$LIST_DIR/$Q::list");
$listaddress = &this_listaddress;
if($part eq 'mod') {
# Lets know what is moderated :)
# do we store things in different directories?
my $config = $list->getconfig;
my($postpath) = $config =~ m{7\s*'([^']+)'};
my($subpath) = $config =~ m{8\s*'([^']+)'};
my($remotepath) = $config =~ m{9\s*'([^']+)'};
$moderated = '<BLINK><FONT COLOR=#ff0000>' if ($postpath);
$moderated .= "[$LANGUAGE{'posting'}]" if ($list->ismodpost);
$moderated .= '</FONT><IMG SRC="' . $HELP_ICON_URL . '" ALT="Posting Moderators are stored in a non-standard location (' . $postpath . '). You will have to edit them manually."></BLINK>' if ($postpath);
$moderated .= '<BLINK><FONT COLOR=#ff0000>' if ($subpath);
$moderated .= " [$LANGUAGE{'subscription'}]" if($list->ismodsub);
$moderated .= '</FONT><IMG SRC="' . $HELP_ICON_URL . '" ALT="Subscriber Moderators are stored in a non-standard location (' . $subpath . '). You will have to edit them manually"></BLINK>' if ($subpath);
$moderated .= '<BLINK><FONT COLOR=#ff0000>' if ($remotepath);
$moderated .= " [$LANGUAGE{'remoteadmin'}]" if($list->isremote);
$moderated .= '</FONT><IMG SRC="' . $HELP_ICON_URL . '" ALT="Remote Administrators are stored in a non-standard location (' . $remotepath . '). You will have to edit them manually"></BLINK>' if ($remotepath);
}
# What type of sublist is this?
($type) = $Q::action =~ m/^\[(.+)\]$/;
# Get a list of moderators from ezmlm ...
@subscribers = $list->subscribers($part);
# Keep selection box a resonable size - suggested by Sebastian Andersson
$scrollsize = 25 if(($scrollsize = $#subscribers + 1) > 25);
# Print out a form of options ...
$q->delete('state');
print "<H2 ALIGN=center>$type $LANGUAGE{'for'} $listaddress</H2><HR ALIGN=center WIDTH=25%>";
print "<CENTER>$moderated</CENTER><P>" if(defined($moderated));
print $q->start_multipart_form;
print '<CENTER><TABLE ALIGN="center" CELLPADDING="10"><TR><TD ROWSPAN="2" VALIGN="top" ALIGN="center">';
print $q->hidden(-name=>'state', -default=>$part);
print $q->hidden(-name=>'list', -default=>$Q::list), "\n";
print $q->scrolling_list(-name=>'delsubscriber', -size=>$scrollsize, -values=>\@subscribers, -multiple=>'true', -labels=>&pretty_names) if defined(@subscribers);
print '</TD></TR><TR><TD VALIGN="top" ALIGN="left">';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'deleteaddress'}]"), '<P>' if defined(@subscribers);
print $q->textfield(-name=>'addsubscriber', -size=>'40'), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'addaddress'}, '"><BR>';
print $q->filefield(-name=>'addfile', -size=>20, -maxlength=>100), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'addaddressfile'}, '"><br>' if ($FILE_UPLOAD);
print $q->submit(-name=>'action', -value=>"[$BUTTON{'addaddress'}]"), '<P>';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'subscribers'}]");
print '</TD></TR><TR><TD> </TD></TR></TABLE></CENTER>';
print $q->endform;
}
# ------------------------------------------------------------------------
sub allow_create_list {
# Let the user select options for list creation ...
my($username, $hostname, %labels, $j);
# Work out if this user has a virtual host and set input accordingly ...
if(-e "$QMAIL_BASE/virtualdomains") {
open(VD, "<$QMAIL_BASE/virtualdomains") || warn "Can't read virtual domains file: $!";
while(<VD>) {
last if(($hostname) = /(.+?):$USER/);
}
close VD;
}
if(!defined($hostname)) {
$username = "$USER-" if ($USER ne $ALIAS_USER);
$hostname = $DEFAULT_HOST;
}
# Print a form of options ...
$q->delete_all;
print '<H2 ALIGN=CENTER>', $LANGUAGE{'createnew'}, '</H2><HR ALIGN=center WIDTH=25%>';
print $q->startform;
print $q->hidden(-name=>'state', -value=>'create');
print '<BIG><STRONG>', $LANGUAGE{'listname'}, ': </STRONG></BIG>', $q->textfield(-name=>'list', -size=>'20'), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'listname'}, '"><P>';
print '<BIG><STRONG>', $LANGUAGE{'listaddress'}, ': </STRONG></BIG>';
print $q->textfield(-name=>'inlocal', -default=>$username, -size=>'10');
print ' <BIG><STRONG>@</STRONG></BIG> ', $q->textfield(-name=>'inhost', -default=>$hostname, -size=>'30'), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'listadd'}, '"><P>';
print '<P><BIG><STRONG>', $LANGUAGE{'listoptions'}, ':</STRONG></BIG>';
&display_options($DEFAULT_OPTIONS);
# Allow creation of mysql table if the module allows it
if($Mail::Ezmlm::MYSQL_BASE) {
print '<P> ', $q->checkbox(-name=>'sql', -label=>$LANGUAGE{'mysqlcreate'}, -on=>1);
print ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'mysqlcreate'}, '">';
}
print '<P><BIG><STRONG>', $LANGUAGE{'allowedtoedit'}, ': </STRONG></BIG>',
$q->textfield(-name=>'webusers', -value=>$ENV{'REMOTE_USER'}||'ALL', -size=>'30'), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'webusers'}, '">',
'<BR><FONT SIZE="-1">', $HELPER{'allowedit'}, '</FONT>'
if(-e "$LIST_DIR/webusers");
print '<P>', $q->submit(-name=>'action', -value=>"[$BUTTON{'createlist'}]"), ' ';
print $q->reset(-value=>"[$BUTTON{'resetform'}]"), ' ';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'cancel'}]");
print $q->endform;
}
# ------------------------------------------------------------------------
sub create_list {
# Create a list acording to user selections ...
# Check the list directory exists and create if necessary ...
if(!-e $LIST_DIR) {
die "Unable to create directory ($LIST_DIR): $!" unless mkdir $LIST_DIR, 0700;
}
my ($qmail, $listname, $options, $i);
# Some taint checking ...
$qmail = $1 if $q->param('inlocal') =~ /(?:$USER-)?([^\<\>\\\/\s]+)$/;
$listname = $q->param('list'); $listname =~ s/ /_/g; # In case some git tries to put a space in the file name
# Sanity Checks ...
return 1 if ($listname eq '' || $qmail eq '');
if(-e ("$LIST_DIR/$listname/lock") || -e ("$HOME_DIR/.qmail-$qmail")) {
print "<H1 ALIGN=CENTER>List '$listname' already exists :(</H1>";
return 1;
}
# Work out the command line options
foreach $i (grep {/\D/} keys %EZMLM_LABELS) {
if (defined($q->param($i))) {
$options .= $i;
} else {
$options .= uc($i);
}
}
foreach $i (grep {/\d/} keys %EZMLM_LABELS) {
if (defined($q->param($i))) {
$options .= " -$i '" . $q->param("$i-value") . "'";
}
}
my($list) = new Mail::Ezmlm;
unless ($list->make(-dir=>"$LIST_DIR/$listname",
-qmail=>"$HOME_DIR/.qmail-$qmail",
-name=>$q->param('inlocal'),
-host=>$q->param('inhost'),
-switches=>$options,
-user=>$USER)
) {
die 'List creation failed', $list->errmsg();
}
# handle MySQL stuff
if($q->param('sql') && $options =~ m/-6\s+/) {
unless($list->createsql()) {
die 'SQL table creation failed: ', $list->errmsg();
}
}
# Handle authentication stuff
if ($Q::webusers) {
open(WEBUSER, ">>$LIST_DIR/webusers") || die "Unable to open webusers: $!";
print WEBUSER "$Q::list: $Q::webusers\n";
close WEBUSER;
}
return 0;
}
# ------------------------------------------------------------------------
sub list_config {
# Allow user to alter the list configuration ...
my ($list, $listaddress, $listname, $options);
my ($headeradd, $headerremove, $mimeremove, $prefix, $j);
# Store some variables before we delete them ...
$list = new Mail::Ezmlm("$LIST_DIR/$Q::list");
$listname = $q->param('list');
$listaddress = &this_listaddress;
# Print a form of options ...
$q->delete_all;
print '<H2 ALIGN="center">', $LANGUAGE{'editconfiguration'}, '</H2><HR ALIGN=center WIDTH=25%>';
print $q->startform;
print $q->hidden(-name=>'state', -value=>'configuration');
print $q->hidden(-name=>'list', -value=>$listname);
print '<BIG><STRONG>', $LANGUAGE{'listname'}, ": <EM>$listname</EM><BR>";
print "$LANGUAGE{'listaddress'}: <EM>$listaddress</EM></STRONG></BIG><P>";
print '<BIG><STRONG>', $LANGUAGE{'listoptions'}, ':</BIG></STRONG><BR>';
# Print a list of options, selecting the ones that apply to this list ...
&display_options($list->getconfig);
# Get the contents of the headeradd, headerremove, mimeremove and prefix files
$headeradd = $list->getpart('headeradd');
$headerremove = $list->getpart('headerremove');
$mimeremove = $list->getpart('mimeremove');
$prefix = $list->getpart('prefix');
print '<P><BIG><STRONG>', $LANGUAGE{'prefix'}, ': </STRONG></BIG>', $q->textfield(-name=>'prefix', -default=>$prefix, -size=>12), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'prefix'}, '">' if defined($prefix);
print '<P><BIG><STRONG>', $LANGUAGE{'headerremove'}, ':</BIG></STRONG> <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'headerremove'}, '"><BR>', $q->textarea(-name=>'headerremove', -default=>$headerremove, -rows=>5, -columns=>70);
print '<P><BIG><STRONG>', $LANGUAGE{'headeradd'}, ':</BIG></STRONG> <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'headeradd'}, '"><BR>', $q->textarea(-name=>'headeradd', -default=>$headeradd, -rows=>5, -columns=>70);
print '<P><BIG><STRONG>', $LANGUAGE{'mimeremove'}, ':</BIG></STRONG> <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'mimeremove'}, '"><BR>', $q->textarea(-name=>'mimeremove', -default=>$mimeremove, -rows=>5, -columns=>70) if defined($mimeremove);
if(open(WEBUSER, "<$LIST_DIR/webusers")) {
my($webusers);
while(<WEBUSER>) {
last if (($webusers) = m{^$listname\s*\:\s*(.+)$});
}
close WEBUSER;
$webusers ||= $ENV{'REMOTE_USER'} || 'ALL';
print '<P><BIG><STRONG>', $LANGUAGE{'allowedtoedit'}, ': </STRONG></BIG>',
$q->textfield(-name=>'webusers', -value=>$webusers, -size=>'30'), ' <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'webusers'}, '">',
'<BR><FONT SIZE="-1">', $HELPER{'allowedit'}, '</FONT>';
}
print '<P>', $q->submit(-name=>'action', -value=>"[$BUTTON{'updateconfiguration'}]"), ' ';
print $q->reset(-value=>"[$BUTTON{'resetform'}]"), ' ';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'cancel'}]"), ' ';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'edittexts'}]");
print $q->endform;
}
# ------------------------------------------------------------------------
sub update_config {
# Save the new user entered config ...
my ($list, $options, $i, @inlocal, @inhost);
$list = new Mail::Ezmlm("$LIST_DIR/$Q::list");
# Work out the command line options ...
foreach $i (grep {/\D/} keys %EZMLM_LABELS) {
if (defined($q->param($i))) {
$options .= $i;
} else {
$options .= uc($i);
}
}
foreach $i (grep {/\d/} keys %EZMLM_LABELS) {
if (defined($q->param($i))) {
$options .= " -$i '" . $q->param("$i-value") . "'";
}
}
# Actually update the list ...
unless($list->update($options)) {
die "List update failed";
}
# Update headeradd, headerremove, mimeremove and prefix ...
$list->setpart('headeradd', $q->param('headeradd'));
$list->setpart('headerremove', $q->param('headerremove'));
$list->setpart('mimeremove', $q->param('mimeremove')) if defined($q->param('mimeremove'));
$list->setpart('prefix', $q->param('prefix')) if defined($q->param('prefix'));
if($Q::webusers) {
# Back up web users file
open(TMP, ">/tmp/ezmlm-web.$$");
open(WU, "<$LIST_DIR/webusers");
while(<WU>) { print TMP; }
close TMP; close WU;
open(TMP, "</tmp/ezmlm-web.$$");
open(WU, ">$LIST_DIR/webusers");
while(<TMP>) {
if(/^$Q::list\s*:/) {
print WU "$Q::list\: $Q::webusers\n";
} else {
print WU;
}
}
close TMP; close WU;
unlink "/tmp/ezmlm-web.$$";
}
}
# ------------------------------------------------------------------------
sub this_listaddress {
# Work out the address of this list ... Used often so put in its own subroutine ...
my ($list, $listaddress);
$list = new Mail::Ezmlm("$LIST_DIR/$Q::list");
chomp($listaddress = $list->getpart('outlocal'));
$listaddress .= '@';
chomp($listaddress .= $list->getpart('outhost'));
return $listaddress;
}
# ------------------------------------------------------------------------
sub list_text {
# Show a listing of what is in DIR/text ...
my(@files, $list);
$list = $LIST_DIR . '/' . $q->param('list');
# Read the list directory for text ...
opendir DIR, "$list/text" || die "Unable to read DIR/text: $!";
@files = grep !/^\./, readdir DIR;
closedir DIR;
# Print a form ...
$q->delete('state');
print $q->startform;
print $q->hidden(-name=>'state', -default=>'list_text');
print $q->hidden(-name=>'list', -default=>$q->param('list'));
print '<CENTER><TABLE BORDER="0" CELLPADDING="10" ALIGN="center"><TR><TD ALIGN="center" VALIGN="top" ROWSPAN="2">';
print $q->scrolling_list(-name=>'file', -values=>\@files);
print '</TD><TD ALIGN="center" VALIGN="top">';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'editfile'}]"), ' ';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'cancel'}]");
print '<P>', $LANGUAGE{'edittextinfo'}, '</TD></TR><TR><TD> </TD></TR></TABLE></CENTER>';
print $q->endform;
}
# ------------------------------------------------------------------------
sub edit_text {
# Allow user to edit the contents of DIR/text ...
my ($content);
my($list) = new Mail::Ezmlm("$LIST_DIR/$Q::list");
$content = $list->getpart("text/$Q::file");
# Print a form ...
$q->delete('state');
print '<H2 ALIGN="CENTER">', $LANGUAGE{'editingfile'}, ': ', $Q::file, '</H2>';
print '<CENTER><TABLE ALIGN="center" CELLPADDING="5"><TR><TD VALIGN="top" ROWSPAN="2">';
print $q->startform;
print $q->hidden(-name=>'state', -default=>'edit_text');
print $q->hidden(-name=>'list', -default=>$q->param('list'));
print $q->hidden(-name=>'file', -default=>$q->param('file'));
print $q->textarea(-name=>'content', -default=>$content, -rows=>'25', -columns=>'72');
print '</TD><TD VALIGN="top" ALIGN="left">';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'savefile'}]"), ' ';
print $q->reset(-value=>"[$BUTTON{'resetform'}]"), ' ';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'cancel'}]");
print '<P>', $LANGUAGE{'editfileinfo'};
print $q->endform;
print '</TD></TR><TR><TD> <TD></TR></TABLE><CENTER>'
}
# ------------------------------------------------------------------------
sub save_text {
# Save new text in DIR/text ...
my ($list) = new Mail::Ezmlm("$LIST_DIR/$Q::list");
$list->setpart("text/$Q::file", $q->param('content'));
}
# ------------------------------------------------------------------------
sub webauth {
# Read authentication level from webusers file. Format of this file is
# somewhat similar to the unix groups file
my($listname) = @_;
open (USERS, "<$LIST_DIR/webusers") || die "Unable to read webusers file: $!";
while(<USERS>) {
if (/^($listname|ALL)\:/i) {
if (/(\:\s*|,\s+)((?:$ENV{'REMOTE_USER'})|(?:ALL))\s*(,|$)/) {
close USERS; return 0;
}
}
}
close USERS;
return 1;
}
# ---------------------------------------------------------------------------
sub display_options {
my($opts) = shift;
my($i, $j);
print "<!-- $opts -->";
print '<TABLE BORDER="0" CELLPADDING="3"><TR><TD>';
foreach $i (grep {/\D/} keys %EZMLM_LABELS) {
if ($opts =~ /^\w*$i\w*\s*/) {
print $q->checkbox(-name=>$i, -value=>$i, -label=>$EZMLM_LABELS{$i}[0], -on=>'1');
} else {
print $q->checkbox(-name=>$i, -value=>$i, -label=>$EZMLM_LABELS{$i}[0]);
}
print '<IMG SRC="', $HELP_ICON_URL, '" BORDER="0" ALT="', $EZMLM_LABELS{$i}[1] , '">';
print '</TD>'; $j++;
if ($j >= 3) {
$j = 0; print '</TR><TR>';
}
print '<TD>';
}
print '</TD></TR></TABLE>';
print '<TABLE BORDER="0" CELPADDING="3">';
foreach $i (grep {/\d/} keys %EZMLM_LABELS) {
print '<TR><TD>';
if ($opts =~ /$i (?:'(.+?)')/) {
print $q->checkbox(-name=>$i, -value=>$i, -label=>$EZMLM_LABELS{$i}[0], -on=>'1');
} else {
print $q->checkbox(-name=>$i, -value=>$i, -label=>$EZMLM_LABELS{$i}[0]);
}
print '<IMG SRC="', $HELP_ICON_URL, '" BORDER="0" ALT="', $EZMLM_LABELS{$i}[1] , '">';
print '</TD><TD>';
print $q->textfield(-name=>"$i-value", -value=>$1||$EZMLM_LABELS{$i}[2], -size=>30);
print '</TD></TR>';
}
print '</TABLE>';
}
# ---------------------------------------------------------------------------
sub edit_newsletter {
# Edit a newsletter configuration
my ($file,$subject,$sender,$tree,$issue) = ();
my $listaddress = &this_listaddress;
my ($list) = new Mail::Ezmlm("$LIST_DIR/$Q::list");
$file="newsletter.html" unless ($file = $list->getpart("newsletter/ficheiro"));
$subject="Edi<64>ao XX" unless ($subject = $list->getpart("newsletter/subject-da-edicao"));
$sender="$listaddress" unless ($sender = $list->getpart("newsletter/sender"));
$tree="/edicaoXX/" unless ($tree = $list->getpart("newsletter/localizacao"));
$issue="" unless ($issue = $list->getpart("newsletter/edicao"));
$q->delete('state');
print $q->start_multipart_form;
print $q->hidden(-name=>'state', -default=>'edit_newsletter');
print $q->hidden(-name=>'list', -default=>$q->param('list'));
print $q->hidden(-name=>'file', -default=>$q->param('file'));
print '<TABLE BORDER="0" CELLPADDING="10"><TR><TD ALIGN="left" VALIGN="top" ROWSPAN="2">';
print '<P><BIG><STRONG>', $LANGUAGE{'newslettertree'}, ':</BIG></STRONG> <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'newslettertree'}, '">';
print '<P><BIG><STRONG>', $LANGUAGE{'newsletterhtml'}, ':</BIG></STRONG> <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'newsletterhtml'}, '">';
print '<P><BIG><STRONG>', $LANGUAGE{'newslettersubject'}, ':</BIG></STRONG> <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'newslettersubject'}, '">';
print '<P><BIG><STRONG>', $LANGUAGE{'newslettersender'}, ':</BIG></STRONG> <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'newslettersender'}, '">';
print '<P><BIG><STRONG>', $LANGUAGE{'newsletterissue'}, ':</BIG></STRONG> <IMG SRC="', $HELP_ICON_URL, '" ALT="', $HELPER{'newsletterissue'}, '">';
print '</TD><TD ALIGN="left" VALIGN="top">';
# THOU SHALL NOT MESS print '<P><BIG><STRONG>', $q->textfield(-name=>'newslettertree', -size=>'50', -default=>"$tree"), '</BIG></STRONG>';
print '<P><B>', "$tree/edicao$issue", '</B>';
print '<P><BIG><STRONG>', $q->textfield(-name=>'newsletterhtml', -size=>'30', -default=>"$file"), '</BIG></STRONG>';
print '<P><BIG><STRONG>', $q->textfield(-name=>'newslettersubject', -size=>'50', -default=>"$subject"), '</BIG></STRONG>';
# THOU SHALL NOT MESS print '<P><BIG><STRONG>', $q->textbox(-name=>'newslettersender', -size=>'30', -default=>"$sender"), '</BIG></STRONG>';
print '<P><B>', "$sender", '</B>';
print '<P><BIG><STRONG>', $q->textfield(-name=>'newsletterissue', -size=>'10', -default=>"$issue"), '</BIG></STRONG>';
print '</TD></TR><TR><TD> </TD></TR></TABLE>';
print $q->hidden(-name=>'newslettertree', -default=>$q->param("$tree"));
print $q->hidden(-name=>'newslettersender', -default=>$q->param("$sender"));
print '<P>', $q->submit(-name=>'action', -value=>"[$BUTTON{'updateconfiguration'}]"), ' ';
print $q->reset(-value=>"[$BUTTON{'resetform'}]"), ' ';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'cancel'}]"), ' ';
print $q->submit(-name=>'action', -value=>"[$BUTTON{'sendnewsletter'}]");
print $q->endform;
}
# ---------------------------------------------------------------------------
sub sendnewsletter {
# Send newsletter
my ($list) = new Mail::Ezmlm("$LIST_DIR/$Q::list");
my $listaddress = &this_listaddress;
my ($file,$subject,$sender,$tree,$issue) = ();
$file="newsletter.html" unless ($file = $list->getpart("newsletter/ficheiro"));
$subject="Edi<64>ao XX" unless ($subject = $list->getpart("newsletter/subject-da-edicao"));
$sender="$listaddress" unless ($sender = $list->getpart("newsletter/sender"));
$tree="/edicaoXX/" unless ($tree = $list->getpart("newsletter/localizacao"));
$issue="" unless ($issue = $list->getpart("newsletter/edicao"));
print "<B> COMING SOON </B>";
}
# ---------------------------------------------------------------------------
sub ezmlmcgirc {
my($listno);
if(open(WWW, "<$EZMLM_CGI_RC")) {
while(<WWW>) {
last if (($listno) = m{(\d+)(\D)\d+\2$LIST_DIR/$Q::list\2});
}
close WWW;
return "$EZMLM_CGI_URL/$listno" if(defined($listno));
} return undef;
}
# ---------------------------------------------------------------------------
sub pretty_names {
return undef unless($PRETTY_NAMES);
my (%pretty, %prettymem);
tie %pretty, "DB_File", "$LIST_DIR/$Q::list/webnames";
%prettymem = %pretty;
untie %pretty;
return \%prettymem;
}
# -------------------------------------------------------------------------
sub rmtree {
# A subroutine to recursively delete a directory (like rm -f).
# Based on the one in the perl cookbook :)
use File::Find qw(finddepth);
File::Find::finddepth sub {
# assume that File::Find::name is secure since it only uses data we pass it
my($name) = $File::Find::name =~ m{^(.+)$};
if (!-l && -d _) {
rmdir($name) or warn "couldn't rmdir $name: $!";
} else {
unlink($name) or warn "couldn't unlink $name: $!";
}
}, @_;
1;
}
# ------------------------------------------------------------------------
BEGIN {
sub handle_errors {
my $msg = shift;
print << "EOM";
</table><table width="99%" cellpadding="5" cellspacing="5" align="center"><tr>
<td align="center" bgcolor="#e0e0ff">
<h2><font color="red">A fatal error has occoured</font></h2>
Something you did caused this script to bail out. The error
message we got was<p>
<tt>$msg</tt><p>
Please try what you were doing again, checking everything you entered.<br>
If you still find yourself getting this error, please
contact the <a href="mailto:webmaster\@$DEFAULT_HOST">site administrator</a>
quoting the error message above.
</td></tr></table>
EOM
}
set_message(\&handle_errors);
}
# ------------------------------------------------------------------------
# End of ezmlm-web.cgi v2.1
# ------------------------------------------------------------------------
__END__
=head1 NAME
ezmlm-web - A web configuration interface to ezmlm mailing lists
=head1 SYNOPSIS
ezmlm-web [B<-c>] [B<-C> E<lt>F<config file>E<gt>] [B<-d> E<lt>F<list directory>E<gt>]
=head1 DESCRIPTION
=over 4
=item B<-c> Disable list configuration
=item B<-C> Specify an alternate configuration file given as F<config file>
If not specified, ezmlm-web checks first in the users home directory, then in
F</etc/ezmlm> and then the current directory
=item B<-d> Specify an alternate directory where lists live. This is now
depreciated in favour of using a custom ezmlmwebrc, but is left for backward
compatibility.
=back
=head1 SUID WRAPPER
C<#include stdio.h>
C<void main (void) {>
C</* call ezmlm-web */>
C<system("/path/to/ezmlm-web.cgi");>
C<}>
=head1 DOCUMENTATION/CONFIGURATION
Please refer to the example ezmlmwebrc which is well commented, and
to the README file in this distribution.
=head1 FILES
F<~/.ezmlmwebrc>
F</etc/ezmlm/ezmlmwebrc>
F<./ezmlmwebrc>
=head1 AUTHOR
Guy Antony Halse <guy-ezmlm@rucus.ru.ac.za>
=head1 BUGS
None known yet. Please report bugs to the author.
=head1 S<SEE ALSO>
ezmlm(5), ezmlm-cgi(1), Mail::Ezmlm(3)
http://rucus.ru.ac.za/~guy/ezmlm/
http://www.ezmlm.org/
http://www.qmail.org/
--bg08WKrSYDhXBjb5
Content-Type: text/plain; charset=iso-8859-1
Content-Disposition: attachment; filename="ezmlmwebrc.PT"
Content-Transfer-Encoding: 8bit
# $Id: ezmlmwebrc,v 1.5 2000/09/25 18:25:26 guy Exp $
# Configuration file for ezmlm-web 2.1
# ===========================================================================
# This file is not just an ordinary configuration file - it contains valid
# perl statements that are executed just like any other perl script. When
# editing this file, be careful that it is still valid perl when you have
# finished (perl -w ezmlmwebrc ;-)
# It is divided into to logical parts. The first part configures the way
# ezmlm-web runs, and the second changes the language, etc of ezmlm-web. You
# can not arbitarilly exclude any statement, since the script doesn't define
# any defaults of its own. You could, however, always split this file up and
# include the parts with
#
# require('/path/to/other/part');
# ---------------------------------------------------------------------------
# Where do we store lists on this server ... Try "$HOME_DIR/lists".
# This directory will automatically be created if needed.
$LIST_DIR = "/servers/virtualdomains/lists.mydomain.com";
# Safe list deletion?
# 0 = move list to .list and the .qmails to deleted.qmail/. Recoverable :)
# 1 = allow user to delete list completely. No backup, therefore no recovery.
$UNSAFE_RM = 0;
# Who is the alias user on this system (usually alias ;)
$ALIAS_USER = 'alias';
# Where do the qmail control files live on this system ...
$QMAIL_BASE = $Mail::Ezmlm::QMAIL_BASE . '/control';
# The url to our web interface - so we can use ezmlm-cgi if necessary
$EZMLM_CGI_URL = 'http://listadmin.mydomain.com/';
# Where our ezcgirc file lives (probably /etc/ezmlm/ezcgirc
$EZMLM_CGI_RC = '/etc/ezmlm/ezcgirc';
# Do we want to allow ``pretty'' names - ie more human readable ones
# This will slow ezmlm-web down a bit for large lists
$PRETTY_NAMES = 1;
# Do we want to allow the users to be allowed to upload a file containing
# lists of email addresses to subscribe?
$FILE_UPLOAD = 1;
# What switches to we want ezmlm-web to have on as default. The ezmlm-make
# defaults are aBDFGHIJKLMNOpQRSTUWX (small means enabled, CAPITALS mean
# disabled). The defaults below should be reasonable - I use them ;)
$DEFAULT_OPTIONS = 'aBDFGHiJkLMNOpQRSTUWx';
# Where do we find the nice little help icon - by default HELP_ICON_URL
# points to resources on http://rucus.ru.ac.za/. This will work, but we
# would appreciate it if you changed this to a local site.
$HELP_ICON_URL = 'http://mail-int.sl.pt/images/q.gif';
# Header for every page (.= concatinates)
$HTML_HEADER = '<TABLE BORDER="0" ALIGN="CENTER" CELLPADDING="0"><TR><TD BGCOLOR="#000000"><FONT SIZE=+3 COLOR=#FFFFFF><STRONG><IMG SRC="images/nladmin.gif"><br>Lists Admin - mydomain.com </STRONG></FONT></TD></TR></TABLE></CENTER><P>';
$HTML_HEADER .= '<TABLE BORDER="0" CELLPADDING="5" CELLSPACING="5" ALIGN="CENTER" WIDTH="99%"><TR><TD BGCOLOR="#e0e0ff"><BR>';
# Footer for every page (.= concatinates)
$HTML_FOOTER = '</TD></TR></TABLE>';
$HTML_FOOTER .= '<TABLE BORDER="0" CELLPADDING="5" CELLSPACING="5" ALIGN="CENTER" WIDTH="99%"><TR><TD BGCOLOR="#e0e0ff">';
$HTML_FOOTER .= '<FONT SIZE="-1"><A HREF="http://rucus.ru.ac.za/~guy/ezmlm/#ezmlm-web" TARGET="_blank">ezmlm-web</A> (v2.1) -- Contactar <A HREF="mailto:sysadmin@mydomain.com" TARGET="_blank">mydomain.com</A></FONT></TD></TR></TABLE>';
# What colour do we want the background to be?
$HTML_BGCOLOR = '#000000';
# What colour do we want text?
$HTML_TEXT = '#0f0f0f';
# What color do we want links?
$HTML_LINK = '#3333ff';
# What color to we want visited links?
$HTML_VLINK = '#8888ff';
# What is the title of this document?
$HTML_TITLE = 'mydomain.com - List Admin';
# ---------------------------------------------------------------------------
# The meanings of the various ezmlm-make command line switches. The default
# ones match the ezmlm-idx 0.4 default ezmlmrc ... Alter them to suit your
# own ezmlmrc. Removing options from this list makes them unavailable
# through ezmlm-web - this could be useful for things like -w
%EZMLM_LABELS = (
# option => ['Short Name',
# 'Long Help Description'],
a => ['Arquivadas',
'O sistema arquivar<61> mensagens novas'],
b => ['Arquivo Bloqueado',
'Apenas aos moderadores <20> permitido aceder ao arquivo'],
# c => config. This is implicity called, so is not defined here
d => ['Digest',
'Constituir uma lista de "digest" das mensagens da lista'],
# e => edit. Also implicity called, so not defined here
f => ['Prefixo',
'O subject das mensagens sera alterado com este prefixo'],
g => ['Arquivo Guardado',
'Pedidos de acesso ao arquivo originados de SENDERs desconhecidos s<>o rejeitados'],
h => ['Ajuda na Subscri<72><69>o',
'As subscri<72><69>es n<>o precisam de confirma<6D><61>o'],
i => ['Indexada',
'Indexada para arquivo acess<73>vel via WWW'],
j => ['Sa<53>da R<>pida',
'As dessubscri<72><69>es n<>o necessitam de confirma<6D><61>o'],
k => ['Kill',
'As mensagens origin<69>rias de endere<72>os listados em dir/deny/ s<>o rejeitadas'],
l => ['Lista de Subscritos',
'Os administradores remotos podem requerer uma lista dos subscritos'],
m => ['Modera<72><61>o das Mensagens',
'Todas as mensagens recebidas s<>o moderadas'],
n => ['Edi<64><69>o de Textos',
'<27> permitida aos administradores remotos a edi<64><69>o de ficheiros em dir/text/'],
o => ['Rejei<65><69>o de Outros',
'Mensagens de endere<72>os que n<>o os dos moderadores ser<65>o rejeitadas'],
p => ['Publica',
'A lista responder<65> a pedidos administrativos e a pedidos do arquivo'],
q => ['Endere<72>o de Pedidos e Servi<76>os',
'Processar comandos enviados no subject para local-request@host'],
r => ['Administra<72><61>o Remota',
'Permitir a administra<72><61>o remota da lista'],
s => ['Subscri<72><69>o Moderada',
'Subscri<72><69>es para a lista principal e para a digest s<>o moderadas'],
t => ['Trailer',
'Adicionar um trailer a todas as mensagens enviadas'],
u => ['Apenas de Subscritos',
'Mensagens origin<69>rias de remetentes desconhecidos s<>o rejeitadas'],
# v => version. I doubt you will really need this ;-)
w => ['Remover Warn',
'Remover as invoca<63><61>es do ezmlm-warn(1) da configura<72><61>o da lista. Parte-se do princ<6E>pio que o ezmlm-warn(1) ser<65> invocado de outra forma'],
x => ['Extra',
'Remover certos mimetypes, etc'],
# y => not used
# z => not used
# These all take an extra argument, which is the default value to use
0 => ['Sublista',
'Fazer a lista uma sublista da lista mainlist@host',
'mainlist@host'],
# 1 => not used
# 2 => not used
3 => ['Do Endere<72>o',
'Substituir o header &quot;From:&quot; da mensagem por &quot;From: fromarg&quot;',
'fromarg'],
4 => ['Op<4F><70>es de Digest',
'Switches para o ezmlm-tstdig(1)',
'-t24 -m30 -k64'],
5 => ['Dono da Lista',
'Endere<72>o e-mail do dono da lista',
''],
6 => ['Base de dados SQL',
'Dados para liga<67><61>o <20> base de dados SQL. Necessita de suporte para SQL',
'host:port:user:password:datab:table'],
7 => ['Caminho para a Modera<72><61>o de Mensagens',
'Caminho para a base de dados dos moderadores das mensagens, se a lista tiver sido configurada para modera<72><61>o de mensagens',
'/some/full/path'],
8 => ['Caminho para a Modera<72><61>o de Subscri<72><69>es',
'Caminho para a base de dados dos moderadores das subscri<72><69>es, se a lista tiver sido configurada para modera<72><61>o de subscri<72><69>es',
'/some/full/path'],
9 => ['Caminho para a Administra<72><61>o Remota',
'Caminho para a base de dados dos administradores, se a lista tiver sido configurada para administra<72><61>o remota',
'/some/full/path']
);
# This list defines most of the context sensitive help in ezmlm-web. What
# isn't defined here is the options, which are defined above ... You can
# alter these if you feel something else would make more sense to your users
# Just be careful of what can fit on a screen!
%HELPER = (
# These should be self explainitory
addaddress => 'Poder<65> introduzir um endere<72>o conforme o RFC822, incluindo a parte de coment<6E>rio. Por exemplo Zacarias Albertino <zabr@sapo.pt>',
addaddressfile => 'ou poder<65> introduzir o nome de um ficheiro de texto contendo m<>ltiplos endere<72>os RFC822, um por linha',
moderator => 'Moderadores: Controlam quem se pode subscrever ou enviar mail para uma lista',
deny => 'Deny: Uma lista de endere<72>os que est<73>o explicitamente impedidos de enviar mail para a lista',
allow => 'Allow: A list of address that are allowed to mail the list even if the configuration otherwise restricts it',
digest => 'Digest: Endere<72>os que recebem o digest de todas as mensagens da lista',
webarch => 'Ver o arquivo web desta lista',
config => 'Alterar as configura<72><61>es desta lista',
listname => 'Nome da lista. <20> tamb<6D>m o nome do subdirect<63>rio que cont<6E>m a lista',
listadd => 'Endere<72>o de e-mail da lista. Por defeito vem da configura<72><61>o do qmail. Apenas dever<65> ser alterada a parte local (antes da @)',
webusers => 'NB! Por enquanto quaisquer utilizadores especificados dever<65>o existir. A cria<69><61>o de utilizadores ser<65> adicionada numa vers<72>o futura',
prefix => 'Texto a adicionar ao subject de todas as mensagens enviadas',
headerremove => 'Lista de headers a remover de todas as mensagens enviadas',
headeradd => 'Lista de headers a adicionar a todas as mensagens enviadas',
mimeremove => 'Qualquer mensagem cujo "Content-Type" coincida com um destes mime types ser<65> devolvida ao remetente',
allowedit => 'Lista (separada por v<>rgulas) dos utilizadores, ou <CODE>ALL</CODE> (todos os utilizadores v<>lidos)',
domains => 'Aos dominios nesta lista <20> permitido enviar mail para a mailing list',
mysqlcreate => 'Isto permite criar as tabelas de MySQL necess<73>rias se a configura<72><61>o da lista acima assim o exigir',
edit_newsletter => 'Clique para editar e enviar a newsletter associada a esta lista',
newsletterhtml => 'Nome do ficheiro html que cont<6E>m a newsletter',
newslettersubject => 'Subject da newsletter',
newslettersender => 'Sender da newsletter',
newslettertree => 'Localiza<7A><61>o em disco (ou ftp) do ficheiro que cont<6E>m a newsletter',
newsletterissue => 'N<>mero desta edi<64><69>o da newsletter',
);
# This defines the captions of each of the buttons in ezmlm-web, and allows
# you to configure them for your own language or taste. Since these are used
# by the switching algorithm it is important that every button has a unique
# caption - ie we can't have two 'Edit' buttons doing different things.
%BUTTON = (
# These MUST all be unique!
create => 'Criar',
createlist => 'Criar Lista',
edit => 'Editar',
delete => 'Remover',
deleteaddress => 'Remover Endere<72>o',
addaddress => 'Adicionar Endere<72>o',
moderators => 'Moderadores',
denylist => 'Lista "Deny"',
allowlist => 'Lista "Allow"',
digestsubscribers => 'Subscritores do "Digest"',
configuration => 'Configura<72><61>o',
yes => 'Sim',
no => 'N<>o',
updateconfiguration => 'Actualizar a Configura<72><61>o',
edittexts => 'Editar Textos',
editfile => 'Editar Ficheiro',
savefile => 'Guardar Ficheiro',
webarchive => 'Arquivo Web',
selectlist => 'Seleccionar Lista',
subscribers => 'Subscritos',
search => 'Procurar',
domains => 'Dominios',
cancel => 'Cancelar',
resetform => 'Reset do Form',
edit_newsletter => 'Editar Newsletter',
sendnewsletter => 'Enviar Newsletter'
);
# This defines the fixed text strings that are used in ezmlm-web. By editing
# these along with the button labels and help texts, you can convert ezmlm-web
# to another language :-) If anyone gets arround to doing complete templates
# for other languages I would appreciate a copy so that I can include it in
# future releases of ezmlm-web.
%LANGUAGE = (
nop => 'Ac<41><63>o por implementar',
chooselistinfo => "<UL><LI>Escolha a Lista da caixa <20> esquerda ou clique em [$BUTTON{'create'}].<LI>Clique em [$BUTTON{'edit'}] para editar a Lista seleccionada.<LI>Clique em [$BUTTON{'delete'}] para remover a Lista seleccionada.</UL>",
confirmdelete => 'Confirme a remo<6D><6F>o de', # list name
subscribersto => 'Subscritos na', # list name
subscribers => 'subscritos',
selected => 'seleccionados',
additionalparts => 'Configura<72><61>o da Lista',
posting => 'Posting',
subscription => 'Subscri<72><69>o',
remoteadmin => 'Administra<72><61>o Remota',
for => 'de', # as in; moderators for blahlist
createnew => 'Criar uma nova Lista',
listname => 'Nome da Lista',
listaddress => 'Endere<72>o da Lista',
listoptions => 'Op<4F><70>es da Lista',
allowedtoedit => 'Utilizadores com acesso para edi<64><69>o desta Lista',
editconfiguration => 'Editar a configura<72><61>o da Lista',
prefix => 'Prefixo para os subjects das mensagens',
headerremove => 'Headers a excluir de todas as mensagens enviadas',
headeradd => 'Headers a incluir em todas as mensagens enviadas',
mimeremove => 'Mime types a excluir de todas as mensagens enviadas',
edittextinfo => "A caixa <20> esquerda cont<6E>m uma lista dos ficheiros dispon<6F>veis no direct<63>rio <BR>DIR/text. Estes ficheiros s<>o enviados nas respostas a certos pedidos (via e-mail) dos utilizadores, ou como parte de todas as mensagens enviadas. <P>Para editar um ficheiro seleccione o seu nome na caixa, de seguida clique em [$BUTTON{'editfile'}]. <P>Clique em [$BUTTON{'cancel'}] quando tiver terminado a edi<64><69>o.",
editingfile => 'A editar o ficheiro',
editfileinfo => '<BIG><STRONG>ezmlm-manage</STRONG></BIG><BR><TT><STRONG>&lt;#l#&gt;</STRONG></TT> O nome da Lista<BR><TT><STRONG>&lt;#A#&gt;</STRONG></TT> O endere<72>o de subscri<72><69>o<BR><TT><STRONG>&lt;#R#&gt;</STRONG></TT> O endere<72>o de resposta para os subscritores<P><BIG><STRONG>ezmlm-store</STRONG></BIG><BR><TT><STRONG>&lt;#l#&gt;</STRONG></TT> O nome da Lista<BR><TT><STRONG>&lt;#A#&gt;</STRONG></TT> O endere<72>o de aceita<74><61>o<BR><TT><STRONG>&lt;#R#&gt;</STRONG></TT> O endere<72>o de rejei<65><69>o</UL>',
mysqlcreate => 'Criar as tabelas para a base de dados MySQL se necess<73>rio',
newsletterhtml => 'Conte<74>do',
newslettersubject => 'Subject',
newslettersender => 'Sender',
newslettertree => 'Localiza<7A><61>o',
newsletterissue => 'Edi<64><69>o',
);
# === Configuration file ends ===
--bg08WKrSYDhXBjb5--
Reference in a new issue Copy permalink