#!/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 ($);
sub performWebusersList ($);
sub webusersList ($); 
sub archivesConfig ($);
sub performArchiveModify ($);

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);
}

elsif ($q->param ('state') eq "webusers")
{
    webusersList ($q);
}

elsif ($q->param ('state') eq "archives")
{
    archivesConfig ($q);
}

elsif ($q->param ('state') eq "performArchiveModify")
{
    performArchiveModify ($q)
}

elsif ($q->param ('state') eq "performWebusers")
{
    performWebusersList ($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;'),
                      $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 . 
				    "?template=normal&action=subscribers&list=" .
					$list->key }, 
				'Modify...')),

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

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

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

            print $q->Tr ( esmith::cgi::genSmallCell ($q, 'ALL:'),
                           esmith::cgi::genSmallCell ($q, ''),
                           esmith::cgi::genSmallCell ($q, 'Generik webmanagement rights'),
                              esmith::cgi::genSmallCell ($q,''),

                              esmith::cgi::genSmallCell ($q,
                                $q->a ( { href => $q->url (-absolute => 1) .
                                    "?state=webusers&list=" .
                                        'ALL' },
                                'Webusers...')),

                              esmith::cgi::genSmallCell ($q,'')
                        );

#/*  future use
#	   print $q->Tr ( esmith::cgi::genSmallCell ($q, 'ALLOW_CREATE'),
#                           esmith::cgi::genSmallCell ($q, ''),
#                           esmith::cgi::genSmallCell ($q, 'future use'),
#                              esmith::cgi::genSmallCell ($q,''),
#
#                              esmith::cgi::genSmallCell ($q,
#                                $q->a ( { href => $q->url (-absolute => 1) .
#                                    "?state=webusers&list=" .
#                                        'ALLOW_CREATE' },
#                                'Webusers...')),
#
#                              esmith::cgi::genSmallCell ($q,'')
#                        );
#*/

	print '</table>';
    }

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

#------------------------------------------------------------
# 
#------------------------------------------------------------
sub archivesConfig ($)
{
    my ($q) = @_;
    my $members = "";
    my $listName = $q->param ('list');
    esmith::cgi::genHeaderNonCacheable
        ($q, undef, 'Manage Archives Display for ezmlm-www for the following mailinglist: '. $listName );

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

   if ($listName eq "ALL") {
      return 0 
   }
   elsif ($listName eq "ALLOW_CREATE") {
      return 0
   }
  return unless $accounts->get($listName);
  my $DisplayArchives = $accounts->get($listName)->prop('DisplayArchives') || 'disabled';
  my $conceal_senders = $accounts->get($listName)->prop('conceal_senders') || 'enabled';
  my $Description = $accounts->get($listName)->prop('Description') || '';
  my $default_sorting = $accounts->get($listName)->prop('default_sorting') || 'thread';
  my $show_html = $accounts->get($listName)->prop('show_html') || 'enabled'; 
  my $highlight = $accounts->get($listName)->prop('highlight') || 'enabled';
  my $show_inline_images = $accounts->get($listName)->prop('show_inline_images') || 'enabled';
  my $subscription_info = $accounts->get($listName)->prop('subscription_info') || 'disabled';
  my $descending_by_default = $accounts->get($listName)->prop('descending_by_default') || 'enabled';
  my $search = $accounts->get($listName)->prop('search') || 'disabled';
  my @sorting = qw(thread date subject);
  my @yesno = qw(enabled disabled);

  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::genWidgetRow ($q,
                              "Display archives",
                              $q->popup_menu (-name    => 'DisplayArchives',
                                              -values  => \@yesno,
                                              -default => $DisplayArchives)),
  esmith::cgi::genNameValueRow ($q,
                                      "Brief description",
                                      "Description",
                                      "$Description"),
  esmith::cgi::genWidgetRow ($q,
                             "Conceal senders",
                              $q->popup_menu (-name    => 'conceal_senders',
                                              -values  => \@yesno,
                                              -default => $conceal_senders)),
  esmith::cgi::genWidgetRow ($q,
                             "Show HTML",
                              $q->popup_menu (-name    => 'show_html',
                                              -values  => \@yesno,
                                              -default => $show_html)),
  esmith::cgi::genWidgetRow ($q,
                             "Highlight parts of messages such as replies, signatures, URLs",
                              $q->popup_menu (-name    => 'highlight',
                                              -values  => \@yesno,
                                              -default => $highlight)),
  esmith::cgi::genWidgetRow ($q,
                             "Display inline images",
                              $q->popup_menu (-name    => 'show_inline_images',
                                              -values  => \@yesno,
                                              -default => $show_inline_images)),
  esmith::cgi::genWidgetRow ($q,
                             "Display subscription information",
                              $q->popup_menu (-name    => 'subscription_info',
                                              -values  => \@yesno,
                                              -default => $subscription_info)),
  esmith::cgi::genWidgetRow ($q,
                             "Default sorting of list",
                              $q->popup_menu (-name    => 'default_sorting',
                                              -values  => \@sorting,
                                              -default => $default_sorting)),
  esmith::cgi::genWidgetRow ($q,
                             "Sorting descending by default",
                              $q->popup_menu (-name    => 'descending_by_default',
                                              -values  => \@yesno,
                                              -default => $descending_by_default)),

  esmith::cgi::genWidgetRow ($q,
                             "Display search box (need search indexing)",
                              $q->popup_menu (-name    => 'search',
                                              -values  => \@yesno,
                                              -default => $search)),



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

  print '</table>';

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

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

  print $q->endform;

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

}

#------------------------------------------------------------
# 
#------------------------------------------------------------
sub performArchiveModify ($)
{
  my $q  = shift;
  
  my $listName = $q->param('list');
  # Untaint groupName before use in system()
  ($listName) = ($listName =~ /^([a-zA-Z][\-\_\.a-zA-Z0-9]*)$/);
  my %sorting = qw(thread thread 
		date date
		subject  subject);
  my %yesno = qw(enabled enabled
		disabled disabled);

  my $DisplayArchives = $yesno{$q->param('DisplayArchives')}||""; #; 
	$accounts->get($listName)->set_prop('DisplayArchives', $DisplayArchives) unless  $DisplayArchives eq "";
  my $conceal_senders = $yesno{$q->param('conceal_senders')}||""; 
	$accounts->get($listName)->set_prop('conceal_senders',$conceal_senders) unless $conceal_senders eq "";
  my $Description =  $q->param('Description')||"";
    	($Description) = ($Description=~ /^([a-zA-Z][\-_.a-zA-Z0-9 ]*)$/);
	$accounts->get($listName)->set_prop('Description',$Description) unless $Description eq "";
  my $default_sorting = $sorting{$q->param('default_sorting')}||"";
	$accounts->get($listName)->set_prop('default_sorting',$default_sorting)  unless $default_sorting eq "";;
  my $show_html = $yesno{$q->param('show_html')}||"";
	$accounts->get($listName)->set_prop('show_html', $show_html) unless $show_html eq "";
  my $highlight = $yesno{$q->param('highlight')}||"";
	$accounts->get($listName)->set_prop('highlight',$highlight ) unless $highlight eq "";
  my $show_inline_images = $yesno{$q->param('show_inline_images')}||"";
	$accounts->get($listName)->set_prop('show_inline_images', $show_inline_images) unless $show_inline_images eq "";
  my $subscription_info = $yesno{$q->param('subscription_info')}||"";
	$accounts->get($listName)->set_prop('subscription_info', $subscription_info) unless $subscription_info eq "";
  my $descending_by_default = $yesno{$q->param('descending_by_default')}||"";
	$accounts->get($listName)->set_prop('descending_by_default',$descending_by_default ) unless $descending_by_default eq "";
  my $search = $yesno{$q->param('search')}||"";
        $accounts->get($listName)->set_prop('search', $search ) unless  $search eq "";
  
  return ( system ('/sbin/e-smith/signal-event', 'mailinglist-modify', $listName) == 0 ) ?
  showInitial ($q, "Error: updating Archive for $listName") : showInitial ($q, "Successfully updated Archive for $listName.");
  #return;


}

#------------------------------------------------------------
# 
#------------------------------------------------------------
sub webusersList ($)
{
    my ($q) = @_;
    my $members = "";
    my $listName = $q->param ('list');
    esmith::cgi::genHeaderNonCacheable
        ($q, undef, 'Manage webusers for the following mailinglist: '. $listName );

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


   if ($listName eq "ALL") {
      $members = $conf->get('ezmlm')->prop('ALL') || '';
   }
   elsif ($listName eq "ALLOW_CREATE") {
      $members = $conf->get('ezmlm')->prop('ALLOW_CREATE') || '';
   }
   elsif ($accounts->get($listName)) {
      $members = $accounts->get($listName)->prop('webusers') || '';
    }
    my %members;
    foreach my $member ( split ( /,/, $members ) ) {
        $members{$member} = 1;
    }
    my @users = sort { $a->key() cmp $b->key() } ( $accounts->users() , $accounts->get('admin') );


    my $out = "<tr>\n        <td class=\"sme-noborders-label\">"
      . 'Webusers :' #$fm->localise('GROUP_MEMBERS')
      . "</td>\n        <td>\n"
      . "          <table border='0' cellspacing='0' cellpadding='0'>\n"
      . "            <tr>\n";
    foreach my $user (@users) {
        my $checked = "";
        if ( $members{ $user->key() } ) {
            $checked = "checked";
        }
        my $name;
            $name = $user->prop('FirstName') . " " . $user->prop('LastName');

        $out .="            <tr>\n"
             . "              <td><input type=\"checkbox\" name=\"groupMembers\" $checked value=\""
          . $user->key
          . "\"></td>\n              <td>$name (".$user->key.")</td>\n            </tr>\n";

    }

    $out .= "          </table>\n        </td>\n    </tr>\n";

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

            $q->p ('Please select the users who need to be able to manage the list ',
                   'using the web panel. Any user present in the generic list "ALL"',
                   'will be able to administer all existing and future lists.',
                   'The admin is always member of the list ALL.') . ' ' ),

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

    print '</table>';


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


 print $q->endform;

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

#------------------------------------------------------------
# 
#------------------------------------------------------------
sub performWebusersList ($)
{
    my $q  = shift;

    my @members   = $q->param('groupMembers');
    my $listName = $q->param('list');
    # Untaint groupName before use in system()
    ($listName) = ($listName =~ /^([a-zA-Z][\-\_\.a-zA-Z0-9]*)$/);

    if ($listName eq "ALL") {
        $conf->get('ezmlm')->prop('ALL');
        $conf->get('ezmlm')->set_prop( 'ALL', join ( ',', @members ) );
    }
    elsif ($listName eq "ALLOW_CREATE") {
        $conf->get('ezmlm')->set_prop( 'ALLOW_CREATE', join ( ',', @members ) );  
    }
    else {
    	$accounts->get($listName)->set_prop( 'webusers', join ( ',', @members ) );
    }
    return system("/sbin/e-smith/expand-template", "/home/e-smith/files/ezmlm/lists/webusers") ?
     showInitial ($q, "Error: updating webusers for $listName") : showInitial ($q, "Successfully updated webusers for $listName.");
    return;
}

#------------------------------------------------------------
# 
#------------------------------------------------------------
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");
    my $webusers = ($listOwner eq "admin") ? $listOwner : "admin,$listOwner";
    #------------------------------------------------------------
    # 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,
		  webusers => $webusers,
		} );

    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.");
    }
}

