#!/usr/bin/perl -wT

#----------------------------------------------------------------------
# heading     : Collaboration
# description : Mailing lists
# navigation  : 3000 3600
# 
# copyright (C) 2000-2006 Gormand Pty Ltd
# copyright (C) 2001,2006 Mitel Networks Corporation
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
# 		
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 		
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307  USA
# 
# Technical support for this program is available from Gorman Pty Ltd
# Please visit our web site www.gormand.com.au for contact details.
#----------------------------------------------------------------------

package esmith;

use strict;
use CGI ':all';
use CGI::Carp qw(fatalsToBrowser);

use esmith::cgi;
use esmith::ConfigDB;
use esmith::AccountsDB;
use esmith::DomainsDB;
use esmith::util;
use User::pwent;

sub showInitial ($$);
sub createList ($);
sub performCreateList ($);
sub refreshList ($);
sub modifyList ($);
sub performModifyList ($);
sub deleteList ($);
sub performDeleteList ($);

BEGIN
{
    # Clear PATH and related environment variables so that calls to
    # external programs do not cause results to be tainted. See
    # "perlsec" manual page for details.

    $ENV {'PATH'} = '';
    $ENV {'SHELL'} = '/bin/bash';
    delete $ENV {'ENV'};
}

esmith::util::setRealToEffective ();

$CGI::POST_MAX=1024 * 100;  # max 100K posts
$CGI::DISABLE_UPLOADS = 1;  # no uploads

use constant EZMLMWEB => '/ezmlm-web';

my $conf = esmith::ConfigDB->open;
my $accounts = esmith::AccountsDB->open;
my $domains = esmith::DomainsDB->open;

#------------------------------------------------------------
# examine state parameter and display the appropriate form
#------------------------------------------------------------

my $q = new CGI;

if (! grep (/^state$/, $q->param))
{
    showInitial ($q, '');
}

elsif ($q->param ('state') eq "create")
{
    createList ($q);
}
elsif ($q->param ('state') eq "performCreate")
{
    performCreateList ($q);
}

elsif ($q->param ('state') eq "modify")
{
    modifyList ($q);
}

elsif ($q->param ('state') eq "performModify")
{
    performModifyList ($q);
}

elsif ($q->param ('state') eq "delete")
{
    deleteList ($q);
}

elsif ($q->param ('state') eq "performDelete")
{
    performDeleteList ($q);
}
else
{
    esmith::cgi::genStateError ($q, undef);
}

exit (0);

#------------------------------------------------------------
# subroutine to display initial form
#------------------------------------------------------------

sub showInitial ($$)
{
    my ($q, $msg) = @_;

    #------------------------------------------------------------
    # If there's a message, we just finished an operation so show the
    # status report. If no message, this is a new list of lists.
    #------------------------------------------------------------

    if ($msg eq '')
    {
	esmith::cgi::genHeaderNonCacheable
	    ($q, undef, 'Create, remove, or modify mailing lists');
    }
    else
    {
	esmith::cgi::genHeaderNonCacheable
	    ($q, undef, 'Operation status report');

	print $q->p ($msg);
	print $q->hr;
    }

    #------------------------------------------------------------
    # Look up current lists
    #------------------------------------------------------------

    my @mailingLists = $accounts->get_all_by_prop('type' => 'mailinglist');

    print $q->p ($q->a ({href => $q->url (-absolute => 1) . "?state=create"},
			'Click here'),
		 'to create a mailing list.');

    if (scalar @mailingLists == 0)
    {
	print $q->h4 ('There are no mailing lists in the system.');
    }
    else
    {
	print $q->p ('You can modify or remove a mailing list',
		     'by clicking on the',
		     'corresponding command next to the list.');

	print $q->h4 ('Current Mailing Lists');

	print $q->table ({border => 1, cellspacing => 1, cellpadding => 4});

	print $q->Tr (esmith::cgi::genSmallCell ($q, $q->b ('List Name')),
		      esmith::cgi::genSmallCell ($q, $q->b ('Domain')),
		      esmith::cgi::genSmallCell ($q, $q->b ('Description')),
		      $q->td ('&nbsp;'),
                      $q->td ('&nbsp;')
		    );

	foreach my $list (@mailingLists)
	{
	    my $domain = $list->prop('Domain');
            my $description = $list->prop('Description');

	    print $q->Tr ( esmith::cgi::genSmallCell ($q, $list->key),
			   esmith::cgi::genSmallCell ($q, $domain),
			   esmith::cgi::genSmallCell ($q, $description),
                              esmith::cgi::genSmallCell ($q,
			   	$q->a ( { href => EZMLMWEB . 
				    "?state=select&action=[Edit]&list=" .
					$list->key }, 
				'Modify...')),

                              esmith::cgi::genSmallCell ($q,
                                $q->a ({href => $q->url (-absolute => 1)
                                             . "?state=delete&list="
                                             . $list->key}, 'Remove...'))
			);
	}

	print '</table>';
    }

    esmith::cgi::genFooter ($q);
}

#------------------------------------------------------------
# 
#------------------------------------------------------------
sub createList ($)
{
    my ($q) = @_;

    esmith::cgi::genHeaderNonCacheable
	($q, undef, 'Create a new mailing list');

    print $q->startform (-method => 'POST',
			 -action => $q->url (-absolute => 1));

    my @existingDomains = map { $_->key } $domains->domains;

    my @existingAccounts = ( "Administrator", map { $_->key } $accounts->users );

    print $q->table ({border => 0, cellspacing => 0, cellpadding => 4},

	esmith::cgi::genTextRow ($q,

            $q->p ('The list name should contain only lower-case',
                   'letters, numbers, and hyphens and must start with ',
		   'a lower-case',
                   'letter. For example "betty", "hjohnson", and "abc-12" are',
                   'all valid account names, but "3friends", "John Smith"',
                   'and "Henry-Miller" are not.') . ' ' ),

	esmith::cgi::genNameValueRow ($q,
				      "List name",
				      "listName",
				      ""),

       esmith::cgi::genWidgetRow ($q,
                             "Select list domain",
                              $q->popup_menu (-name    => 'listDomain',
        		                      -values  => \@existingDomains)),

        esmith::cgi::genNameValueRow ($q,
                                      "Brief description",
                                      "listDescription",
                                      ""),

       esmith::cgi::genWidgetRow ($q,
                             "List owner (for administrative mail)",
                              $q->popup_menu (-name    => 'listOwner',
                                              -values  => \@existingAccounts)),

        esmith::cgi::genButtonRow ($q,
                 $q->submit (-name => 'action',
                    -value => 'Create')));

    print '</table>';


    print $q->hidden (-name => 'state',
		      -override => 1,
		      -default => 'performCreate');

    print $q->endform;
    
    esmith::cgi::genFooter ($q);
    return;
}

#------------------------------------------------------------
# 
#------------------------------------------------------------
sub performCreateList ($)
{
    my ($q) = @_;

    #------------------------------------------------------------
    # Validate parameters and untaint them
    #------------------------------------------------------------

    my $listName = $q->param ('listName');
    if ($listName =~ /^([a-z][a-z\-0-9]*)$/)
    {
	$listName = $1;
    }
    else
    {
	showInitial ($q,
		     "Error: unexpected characters in list name: " .
		     "\"$listName\". The list name should contain only " .
		     "lower-case letters, numbers and hypens, and " .
		     "must start " .
		     "with a lower-case letter. For example \"betty\", " .
		     "\"hjohnson\", and \"abc-12\" are all valid list " .
		     "names, but \"3friends\", \"John Smith\" and " .
		     "\"Henry-Miller\" are not.");
	return;
    }

    my $listDomain = $q->param ('listDomain');

    my $listDescription = $q->param ('listDescription');
    if ($listDescription =~ /^([\-\'\w][\-\'\w\s]*)$/)
    {
        $listDescription = $1;
    }
    else
    {
        showInitial ($q,
                     "Error: unexpected or missing characters in description " .
                     "\"$listDescription\". Did not create new mailing list.");
        return;
    }

    my $listOwner = $q->param ('listOwner');
    $listOwner = "admin" if ($listOwner eq "Administrator");

    #------------------------------------------------------------
    # Looks good. Find out if this account has been taken
    #------------------------------------------------------------
    my $list = $accounts->get($listName);
    if ($list)
    {
	showInitial ($q,
		     "Error: account \"$listName\" is an existing " .
		     $list->prop('type') . " account.");
	return;
    }

    #------------------------------------------------------------
    # Account is available! Update accounts database and signal the
    # mailinglist-create event.
    #------------------------------------------------------------

    $accounts->new_record($listName,
		{
		  type => 'mailinglist',
		  Domain => $listDomain,
                  Description => $listDescription,
	          Owner => $listOwner,
		} );

    system ('/sbin/e-smith/signal-event', 'mailinglist-create', $listName) == 0
	or die ("Error occurred while creating mailing list.\n");

    showInitial ($q, "Successfully created mailing list $listName.");
}

#------------------------------------------------------------
# 
#------------------------------------------------------------

sub deleteList ($)
{
    my ($q) = @_;

    esmith::cgi::genHeaderNonCacheable ($q, undef, 'Remove mailing list');

    print $q->startform
	(-method => 'POST', -action => $q->url (-absolute => 1));

    my $listName = $q->param ('list');

    my $list = $accounts->get($listName);
    if ($list)
    {
	print $q->p ("You are about to remove the mailing list \"$listName\"");
	
	print $q->p ('The mailing list address will no longer be usable',
		     'and current items and the list archives will be removed');
	
	print $q->p ($q->b ('Are you sure you wish to remove this list?'));
	
	print $q->submit (-name => 'action', -value => 'Remove');
	print $q->hidden (-name => 'list', -override => 1, -default => $listName);

	print $q->hidden (-name	    => 'state',
			  -override => 1,
			  -default  => 'performDelete');
    }

    print $q->endform;
    esmith::cgi::genFooter ($q);
    return;
}

#------------------------------------------------------------
# 
#------------------------------------------------------------

sub performDeleteList ($)
{
    my ($q) = @_;

    #------------------------------------------------------------
    # Attempt to delete list
    #------------------------------------------------------------
    my $listName = $q->param ('list');
    if ($listName =~ /^([a-z][a-z\-0-9]*)$/)
    {
        $listName = $1;
    }
    else
    {
        showInitial ($q,
                     "Error: unexpected characters in list name: " .
                     "\"$listName\". The list name should contain only " .
                     "lower-case letters, numbers and hypens, and " .
                     "must start " .
                     "with a lower-case letter. For example \"betty\", " .
                     "\"hjohnson\", and \"abc-12\" are all valid list " .
                     "names, but \"3friends\", \"John Smith\" and " .
                     "\"Henry-Miller\" are not.");
        return;
    }

    my $list = $accounts->get($listName);
    if ($list)
    {
	system ('/sbin/e-smith/signal-event', 'mailinglist-delete', $listName) == 0
	    or die ("Error occurred while deleting list.\n");
	$list->delete;
	showInitial ($q, "Successfully deleted mailing list $listName.");
    }
}

