#!/usr/bin/perl 
#===========================================================================
# ql-web v0.1
# ==========================================================================

package ql_web;

# Modules to include
use strict;
use ClearSilver;
use Mail::Address;
use CGI;
use IO::File;
use Net::LDAP;

my $q = new CGI;
$q->import_names('Q');

# Suid stuff requires a secure path.
$ENV{'PATH'} = '/bin';

# use strict is a good thing++

# We run suid so we can't use $ENV{'HOME'} and $ENV{'USER'} to determine the user
my @tmp = getpwuid($>);

use vars qw[$HOME_DIR]; $HOME_DIR=$tmp[7];
use vars qw[$HTML_TITLE];
use vars qw[$CSS_URL $TEMPLATE_DIR $LANGUAGE_DIR $HTML_LANGUAGE];
use vars qw[$LDAP_HOST $LDAP_USER_DN $LDAP_SPAM_MOVE $LDAP_SPAM_MARK];

# set default TEXT_ENCODE
use vars qw[$TEXT_ENCODE]; $TEXT_ENCODE='us-ascii';

# pagedata contains the hdf tree for clearsilver
# pagename refers to the template file that should be used
use vars qw[$pagedata $pagename $error $customError $warning $customWarning $success];
use vars qw[$mail_user];

# Get user configuration stuff
if(-e "$HOME_DIR/.ql-web.conf") {
   require "$HOME_DIR/.ql-web.conf"; # User
} elsif(-e "./ql-web.conf") {
   require "./ql-web.conf"; # Install
} elsif(-e "/etc/ql-web/ql-web.conf") {
   require "/etc/ql-web/ql-web.conf"; # System (new style)
} else {
   &fatal_error("Unable to read config file");
}

# check optional stylesheet
$CSS_URL = '' unless defined($CSS_URL);

# check template directory
$TEMPLATE_DIR = 'template' unless defined($TEMPLATE_DIR);

# Untaint form input ...
&untaint;

$mail_user = $ENV{'REMOTE_USER'};

my $pagedata = load_hdf();
my $action = $q->param('action');

# This is where we decide what to do, depending on the form state and the
# users chosen course of action ...
# TODO: unify all these "is list param set?" checks ...
if ($action eq '' || $action eq 'overview') {
	# Default action - display the current mail account configuration
	$pagename = 'overview';
} elsif ($action eq 'password_form') {
	# display password change dialog
	$pagename = 'password_form';
} elsif ($action eq 'password_update') {
	$success = 'UpdatePassword' if (&update_password());
} elsif ($action eq 'forward_form') {
	$pagename = 'forward_form';
} elsif ($action eq 'forward_add') {
	# add a forwarding address
	if (defined($q->param('options_forward_add_address'))) {
		$success = 'AddForward' if (&add_forward());
		$pagename = 'forward_form';
	} else {
		$error = 'ParameterMissing';
		$pagename = 'forward_form';
	}
} elsif ($action eq 'forward_del') {
	# remove a forwarding address
	# no selected address -> no error
	if (defined($q->param('options_forward_del_address'))) {
		$success = 'DelForward' if (&del_forward());
		$pagename = 'forward_form';
	} else {
		$error = 'ParameterMissing';
		$pagename = 'forward_form';
	}
} elsif ($action eq 'filter_form') {
	$pagename = 'filter_form';
} elsif ($action eq 'filter_update') {
	# update filtering setting
	$success = 'UpdateFilter' if (&update_filter());
	$pagename = 'filter_form';
} elsif ($action eq 'vacation_form') {
	$pagename = 'vacation_form';
} elsif ($action eq 'vacation_update') {
	# update vacation reply setting
	$success = 'UpdateVacation' if (&update_vacation());
	$pagename = 'vacation_form';
} else {
	$pagename = 'overview';
	$error = 'UnknownAction';
}

# read the current state (after the changes are done)
&set_pagedata();

# Print page and exit :) ...
&output_page;
exit;


# =========================================================================

sub set_pagedata {
	$pagedata->setValue('Data.isSpamMove', &is_spam_move()? 1 : 0);
	$pagedata->setValue('Data.isSpamMark', &is_spam_mark()? 1 : 0);
}

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

sub update_filter {

	my $ldif;
	my $password = $q->param('pw');
	my $result;
	my $ldap;
	my $user_dn = $LDAP_USER_DN;
	$user_dn =~ s/_USERNAME_/$mail_user/g;
	
	$ldap = Net::LDAP->new($LDAP_HOST);
	$result = $ldap->bind($mail_user, password => $password);
	if ($result->is_error) {
		$warning = 'WrongPassword';
		return (0==1);
	}

	if ($q->param('filter_type') eq 'none') {
		if (&is_spam_mark() || &is_spam_move()) {
			$result = $ldap->modify($user_dn, delete => ['deliveryProgramPath']);
		}
	} elsif ($q->param('filter_type') eq 'move') {
		if (!&is_spam_move()) {
			$ldif = $LDAP_SPAM_MOVE;
			$ldif =~ s/_USERNAME_/$mail_user/g;
			$ldap->modify($user_dn, delete => [ 'deliveryProgramPath' ])
				if (&is_spam_mark());
			$result = $ldap->modify($user_dn, add => { deliveryProgramPath => $ldif });
		}
	} elsif ($q->param('filter_type') eq 'mark') {
		if (!&is_spam_mark()) {
			$ldif = $LDAP_SPAM_MARK;
			$ldif =~ s/_USERNAME_/$mail_user/g;
			$ldap->modify($user_dn, delete => [ 'deliveryProgramPath' ])
				if (&is_spam_move());
			$result = $ldap->modify($user_dn, add => { deliveryProgramPath => $ldif });
		}
	} else {
		$error = 'ParameterMissing';
		warn "unknown filter_type: " . $q->param('filter_type');
	}
	$ldap->unbind;

	if ($result->is_error) {
		$warning = 'FilterConfig';
		return (0==1);
	} else {
		return (0==0);
	}
}

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

sub is_spam_move {
	
}

# ---------------------------------------------------------------------------
sub is_spam_mark {
	
}

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

sub load_hdf {
	# initialize the data for clearsilver
	my $hdf = ClearSilver::HDF->new();

	$hdf->readFile($LANGUAGE_DIR . '/' . $HTML_LANGUAGE . '.hdf');

	&fatal_error("Template dir ($TEMPLATE_DIR) not found!") unless (-e $TEMPLATE_DIR);
	$hdf->setValue("Config.TemplateDir", "$TEMPLATE_DIR/");
	&fatal_error("Language data dir ($LANGUAGE_DIR) not found!") unless (-e $LANGUAGE_DIR);
	$hdf->setValue("Config.LanguageDir", "$LANGUAGE_DIR/");
	$hdf->setValue("Config.ScriptName", $ENV{'SCRIPT_NAME'});
	$hdf->setValue("Config.Stylesheet", "$CSS_URL");
	$hdf->setValue("Config.PageTitle", "$HTML_TITLE");

	return $hdf;
}

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

sub output_page {
	# Print the page

	$pagedata->setValue('Data.Success', "$success") if (defined($success));
	$pagedata->setValue('Data.Error', "$error") if (defined($error));
	$pagedata->setValue('Data.Warning', "$warning") if (defined($warning));
	$pagedata->setValue('Data.CustomError', "$customError") if (defined($customError));
	$pagedata->setValue('Data.CustomWarning', "$customWarning") if (defined($customWarning));

	$pagedata->setValue('Data.Action', "$pagename");

	my $pagefile = $TEMPLATE_DIR . "/main.cs";
	&fatal_error("main template ($pagefile) not found!") unless (-e "$pagefile");
	&fatal_error("sub template ($TEMPLATE_DIR/$pagename.cs) not found!") unless (-e "$TEMPLATE_DIR/$pagename.cs");

	# print http header
	print "Content-Type: text/html; charset=utf-8\n\n";

	my $cs = ClearSilver::CS->new($pagedata);

	$cs->parseFile($pagefile);

	print $cs->render();
}

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

sub untaint {

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

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

sub check_language {
	my ($list, $lang) = @_;
	my $found = 0;
	my $item;
	foreach $item ($list->get_available_languages()) {
		$found++ if ($item eq $q->param('list_language'));
	}
	return ($found > 0);
}

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

sub fatal_error() {
	my $text = shift;

	print "Content-Type: text/html; charset=utf-8\n\n";
	print "<html><head>\n";
	print "<title>ezmlm-web</title></head>\n";
	print "<body><h1>a fatal error occoured!</h1>\n";
	print "<p><strong><big>$text</big></strong></p>\n";
	print "<p>check the error log of your web server for details</p>\n";
	print "</body></html>\n";
	die "$text";
}

# ------------------------------------------------------------------------
# End of ql-web.pl
# ------------------------------------------------------------------------
__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> 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>
 Lars Kruse <ezmlm-web@sumpfralle.de>

=head1 BUGS

 None known yet. Please report bugs to the author.

=head1 S<SEE ALSO>
 
 ezmlm(5), ezmlm-cgi(1), Mail::Ezmlm(3)
   
 https://systemausfall.org/toolforge/ezmlm-web
 http://rucus.ru.ac.za/~guy/ezmlm/
 http://www.ezmlm.org/
 http://www.qmail.org/