codekasten/ql-web/trunk/ql-web.pl

#!/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;
use Digest::MD5;

# Net::LDAP will care about base64 encoding for multiline ldap entries
#use MIME::Base64;

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];
use vars qw[$LDAP_SPAM_OPTIONS %LDAP_PASSWD];

# 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 = defined($ENV{'REMOTE_USER'})? $ENV{'REMOTE_USER'} : '';
&fatal_error("undefined REMOTE_USER variable - you have to use http authentication for ql-web!") if ($mail_user eq '');

my $pagedata = load_hdf();
my $action = defined($q->param('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') {
	if (defined($q->param('pw_type'))) {
		if (&update_password()) {
			$success = 'UpdatePassword';
			$pagename = 'overview';
		} else {
			$pagename = 'password_form';
		}
	} else {
		$error = 'ParameterMissing';
		$pagename = 'password_form';
	}
} elsif ($action eq 'forward_form') {
	$pagename = 'forward_form';
} elsif ($action eq 'forward_add') {
	# add a forwarding address
	if (defined($q->param('fw_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('fw_delete'))) {
		$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_action_update') {
	# update filtering setting
	$success = 'UpdateFilterAction' if (&update_filter_action());
	$pagename = 'filter_form';
} elsif ($action eq 'filter_options_update') {
	# update filtering setting
	$success = 'UpdateFilterOptions' if (&update_filter_options());
	$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 {
	# filtering actions
	$pagedata->setValue('Data.isSpamMove', &is_spam_move()? 1 : 0);
	$pagedata->setValue('Data.isSpamMark', &is_spam_mark()? 1 : 0);
	$pagedata->setValue('Data.UserName', $mail_user);

	# filtering options
	$pagedata->setValue('Data.Filter.Score', &get_spamassassin_option('required_score'));
	$pagedata->setValue('Data.Filter.AttachText', (&get_spamassassin_option('report_safe') eq 2)? 1 : 0);
	$pagedata->setValue('Data.Filter.Subject', &get_spamassassin_option('rewrite_header Subject'));
	$pagedata->setValue('Data.Filter.Bayes', &get_spamassassin_option('use_bayes'));
	$pagedata->setValue('Data.Filter.WhiteList', &get_spamassassin_option('whitelist_from'));

	{
		# retrieve frowarding addresses
		my $one_forward;
		my $i = 0;
		foreach $one_forward (&get_ldap_values('mailForwardingAddress')) {
			$pagedata->setValue("Data.ForwardAddresses.$i", $one_forward);
			$i++;
		}
	}

	# vacation reply
	{
		my $vacation_text = &get_ldap_values('mailReplyText');
		# encoding is not necessary -> automatically done by Net::LDAP
		#$vacation_text = MIME::Base64::decode_base64($vacation_text);
		my $vacation_state = &compare_ldap_attr('deliveryMode', 'reply');
		$pagedata->setValue('Data.VacationText', $vacation_text);
		$pagedata->setValue('Data.isVacation', $vacation_state? 1 : 0);
	}

	{
		# password information
		my $pw_type;
		my $i = 0;
		foreach $pw_type (keys %LDAP_PASSWD) {
			$pagedata->setValue("Data.Password.Types.$i", $pw_type);
			$i++;
		}
	}
}

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

sub add_forward {
	my $user_dn = $LDAP_USER_DN;
	$user_dn =~ s/_USERNAME_/$mail_user/g;
	my $password = $q->param('pw');
	my $new_forward = $q->param('fw_address');

	if ($new_forward eq '') {
		$warning = 'EmptyAddress';
		return (0==1);
	}
	
	$new_forward =~ /^([\w\_\-\.]*\@[\w\_\-\.]*)/;
	$new_forward = $1;

	if ($new_forward eq '') {
		$warning = 'InvalidAddress';
		return (0==1);
	}
	
	my $ldap = Net::LDAP->new($LDAP_HOST);
	my $result = $ldap->bind($user_dn, password => $password);
	if ($result->is_error) {
		$warning = 'WrongPassword';
		return (0==1);
	}

	if (&compare_ldap_attr('mailForwardingAddress', $new_forward)) {
		$warning = 'ExistingForward';
		$ldap->unbind;
		return (0==1);
	}

	$result = $ldap->modify($user_dn, add => { mailForwardingAddress => $new_forward });
	$ldap->unbind;

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

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

sub del_forward {
	my $user_dn = $LDAP_USER_DN;
	$user_dn =~ s/_USERNAME_/$mail_user/g;
	my $password = $q->param('pw');
	if ($q->param('fw_delete') eq '') {
		$warning = 'EmptyAddress';
		return (0==1);
	}

	my $ldap = Net::LDAP->new($LDAP_HOST);
	my $result = $ldap->bind($user_dn, password => $password);
	if ($result->is_error) {
		$warning = 'WrongPassword';
		return (0==1);
	}

	my $address;
	my $successes = 0;
	foreach $address ($q->param('fw_delete')) {
		$address =~ /^([\w\_\-\.]*\@[\w\_\-\.]*)/;
		$address = $1;
		if ($address eq '') {
			$warning = 'InvalidAddress' unless ($warning);
		} else {
			if (&compare_ldap_attr('mailForwardingAddress', $address)) {
				$result = $ldap->modify($user_dn,
					delete => { mailForwardingAddress => $address });
				if ($result->is_error) {
					$warning = 'DelForward';
				} else {
					$successes++;
				}
				return (0==1);
			} else {
				$warning = 'ForwardNotFound';
			}
		}
	}

	$ldap->unbind;
	return ($successes > 0);
}

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

sub update_vacation {
	my $failure = 0;
	my $user_dn = $LDAP_USER_DN;
	$user_dn =~ s/_USERNAME_/$mail_user/g;
	my $password = $q->param('pw');
	if (defined($q->param('vacation_enabled')) && ($q->param('vacation_text') eq '')) {
		$warning = 'EmptyVacationText';
		return (0==1);
	}

	my $ldap = Net::LDAP->new($LDAP_HOST);
	my $result = $ldap->bind($user_dn, password => $password);
	if ($result->is_error) {
		$warning = 'WrongPassword';
		return (0==1);
	}

	# set vacation state
	$result = undef;
	if (defined($q->param('vacation_enabled'))) {
		$result = $ldap->modify($user_dn, add => [ deliveryMode => 'reply' ])
			unless (&compare_ldap_attr("deliveryMode", "reply"));
	} else {
		$result = $ldap->modify($user_dn, delete => { deliveryMode => 'reply' })
			if (&compare_ldap_attr("deliveryMode", "reply"));
	}
	if (defined($result) && ($result->is_error)) {
		$warning = 'ToggleVacation';
		warn $result->error_text;
		$failure = 1;
	}

	# set vacation text
	$result = undef;
	# a multiline vacation text has to be base64 encoded
	# we encode it without a trailing line feed
	my $vacation_text = $q->param('vacation_text');
	# encoding is not necessary -> automatically done by Net::LDAP
	#$vacation_text = MIME::Base64::encode_base64($vacation_text);
	$ldap->modify($user_dn, delete => [ 'mailReplyText' ]);	# may return an error
	$result = $ldap->modify($user_dn, add => [ mailReplyText => $vacation_text ])
		unless ($vacation_text eq '');
	if (defined($result) && ($result->is_error)) {
		$warning = 'SetVacationText';
		$failure = 1;
	}

	$ldap->unbind;
	return ($failure == 0);
}

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

sub update_filter_options {
	my $password = $q->param('pw');
	my $user_dn = $LDAP_USER_DN;
	$user_dn =~ s/_USERNAME_/$mail_user/g;
	
	my $ldap = Net::LDAP->new($LDAP_HOST);
	my $result = $ldap->bind($user_dn, password => $password);
	if ($result->is_error) {
		$warning = 'WrongPassword';
		return (0==1);
	}
	
	{
		my @spam_options = &get_ldap_values('spamassassin');
		if ($#spam_options > 0) {
			$result = $ldap->modify($user_dn, delete => ['spamassassin'] );
			if ($result->is_error) {
				warn $result->error_text;
				$warning = 'UpdateFilterOptions';
				$ldap->unbind;
				return (1==0);
			}
		}
	}

	{
		my $spam_score = $q->param('spam_score');
		$spam_score =~ s/[^0-9\.]//g;
		if (($spam_score ne '') &&
			($spam_score ne &get_spamassassin_option_default('required_score'))) {
			$result = $ldap->modify($user_dn,
				add => { 'spamassassin' => "required_score $spam_score" });
			$warning = 'UpdateFilterOptions' && warn $result->error_text
				if ($result->is_error);
		}
	}

	{
		my $spam_attach_text = defined($q->param('spam_attach_text'))? 2 : 1;
		if ($spam_attach_text ne &get_spamassassin_option_default('report_safe')) {
			$result = $ldap->modify($user_dn,
				add => { 'spamassassin' => "report_safe $spam_attach_text" });
			$warning = 'UpdateFilterOptions' && warn $result->error_text
				if ($result->is_error);
		}
	}

	{
		my $spam_subject = $q->param('spam_subject');
		$spam_subject =~ s/\n//mg;
		chomp $spam_subject;
		if ($spam_subject ne &get_spamassassin_option_default('rewrite_header Subject')) {
			$result = $ldap->modify($user_dn,
				add => { 'spamassassin' => "rewrite_header Subject $spam_subject" });
			$warning = 'UpdateFilterOptions' && warn $result->error_text
				if ($result->is_error);
		}
	}

	{
		my $spam_bayes = defined($q->param('spam_bayes'))? 1 : 0;
		if ($spam_bayes ne &get_spamassassin_option_default('use_bayes')) {
			$result = $ldap->modify($user_dn,
				add => { 'spamassassin' => "use_bayes $spam_bayes" });
			$warning = 'UpdateFilterOptions' && warn $result->error_text
				if ($result->is_error);
		}
	}

	{
		my $spam_whitelist = $q->param('spam_whitelist');
		$spam_whitelist =~ s/[^\w_\-\@\.\n]//g;
		my $one_white;
		foreach $one_white (split /\n/, $spam_whitelist) {
			if ($one_white ne '') {
				$result = $ldap->modify($user_dn,
					add => { 'spamassassin' => "whitelist_from $one_white" });
				$warning = 'UpdateFilterOptions' && warn $result->error_text
					if ($result->is_error);
			}
		}
	}
	
	$ldap->unbind;
	return ($warning ne 'UpdateFilterOptions');
}

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

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

	$ldif_move = &substitute_username($LDAP_SPAM_MOVE);
	$ldif_mark = &substitute_username($LDAP_SPAM_MARK);

	if ($q->param('filter_type') eq 'none') {
		$result = $ldap->modify($user_dn, delete => { @$ldif_move })
			if (&is_spam_move());
		$result = $ldap->modify($user_dn, delete => { @$ldif_mark })
			if (&is_spam_mark());
	} elsif ($q->param('filter_type') eq 'move') {
		if (!&is_spam_move()) {
			$ldap->modify($user_dn, delete => { @$ldif_mark })
				if (&is_spam_mark());
			$result = $ldap->modify($user_dn, add => $ldif_move);
		}
	} elsif ($q->param('filter_type') eq 'mark') {
		if (!&is_spam_mark()) {
			$ldap->modify($user_dn, delete => { @$ldif_move })
				if (&is_spam_move());
			$result = $ldap->modify($user_dn, add => $ldif_mark);
		}
	} else {
		$error = 'ParameterMissing';
		warn "unknown filter_type: " . $q->param('filter_type');
	}
	$ldap->unbind;

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

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

sub update_password {
	my $pw_type = $q->param('pw_type');
	my $old_pw = $q->param('oldpassword');
	my $new_pw = $q->param('newpassword');
	my $new_pw2 = $q->param('newpassword2');

	$warning = '';

	$warning = 'EmptyOldPassword' if ($old_pw eq '');
	$warning = 'EmptyNewPassword' if ($new_pw eq '');
	$warning = 'DifferentNewPasswords' if ($new_pw ne $new_pw2);

	# the previous checks are critical
	return (0==1) if ($warning ne '');

	my $password = $q->param('oldpassword');

	my $current_pw_type;
	# first: check for right password before changing anything
	foreach $current_pw_type (keys %LDAP_PASSWD) {
		if (($current_pw_type eq $pw_type) || ($pw_type eq 'all')) {
			my $ldap = Net::LDAP->new($LDAP_HOST);
			my $current_pw_info = $LDAP_PASSWD{$current_pw_type};
			my $user_dn = $current_pw_info->{'dn'};
			$user_dn =~ s/_USERNAME_/$mail_user/g;
			my $result = $ldap->bind($user_dn, password => $password);
			if ($result->is_error) {
				$warning = 'WrongPassword';
				return (0==1);
			}
			$ldap->unbind;
		}
	}

	# ok - passwords are good - now change the passwords
	foreach $current_pw_type (keys %LDAP_PASSWD) {
		if (($current_pw_type eq $pw_type) || ($pw_type eq 'all')) {
			my $ldap = Net::LDAP->new($LDAP_HOST);
			my $current_pw_info = $LDAP_PASSWD{$current_pw_type};
			my $user_dn = $current_pw_info->{'dn'};
			$user_dn =~ s/_USERNAME_/$mail_user/g;
			my $result = $ldap->bind($user_dn, password => $password);
			if ($result->is_error) {
				# this should only happen in race conditions
				$warning = 'WrongPassword';
				return (0==1);
			}

			# TODO: for now only md5 is supported
			my $new_pw_hash;
			if ($current_pw_info->{'hash'} =~ /^md5/i ) {
				$new_pw_hash = '{MD5}' . Digest::MD5::md5_base64($new_pw) . '==';
			} else {
				warn "[ql-web]: this hash type is not supported yet (only md5 is available). Please take a look at ql-web.pl - it is very easy to add support for other hash types.";
				$error = 'UnknownPasswordHash';
				return (0==1);
			}

			$result = $ldap->modify($user_dn,
				replace => [ $current_pw_info->{'attr'} => $new_pw_hash ]);
			if ($result->is_error) {
				$warning = 'UpdatePassword';
				warn $result->error_text;
			}
			
			$ldap->unbind;
		}
	}

	return (0==0);
}

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

sub substitute_username {
	my ($input) = @_;
	my $value;
	my @array;
	my $count = 0;
	foreach $value (@$input) {
		# substitute only values - not keys
		if ($count == 0) {
			$count++;
		} else {
			$value =~ s/_USERNAME_/$mail_user/g;
			$count = 0;
		}
		push @array, $value;
	}
	return \@array;
}

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

sub is_spam_move {
	my $key;
	my $value;
	my $count = 0;
	my $failed = 0;
	foreach $value (@$LDAP_SPAM_MOVE) {
		if ($count == 0) {
			$key = $value;
			$count++;
		} else {
			$failed++ unless &compare_ldap_attr($key, $value);
			$count = 0;
		}
	}
	return ($failed == 0);
}

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

sub is_spam_mark {
	my $key;
	my $value;
	my $count = 0;
	my $failed = 0;
	foreach $value (@$LDAP_SPAM_MARK) {
		if ($count == 0) {
			$key = $value;
			$count++;
		} else {
			$failed++ unless &compare_ldap_attr($key, $value);
			$count = 0;
		}
	}
	return ($failed == 0);
}

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

sub get_spamassassin_option {
	my $option = shift;
	my @sa_options = &get_ldap_values('spamassassin');
	my $result = '';
	my $entry;
	foreach $entry (@sa_options) {
		$result .= "$1\n" if ($entry =~ /^$option\s(.*)$/);
	}
	if ($result eq '') {
		$result = &get_spamassassin_option_default($option);
		chomp $result;
		return $result;
	} else {
		chomp $result;
		return $result;
	}
}

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

sub get_spamassassin_option_default {
	my $option = shift;
	my $current;
	my $found = 0;
	foreach $current (@$LDAP_SPAM_OPTIONS) {
		return $current if ($found eq 1);
		$found = 1 if ($current eq $option);
	}
	warn "[ql-web]: default value of spamassassin option '$option' not found";
	return '';

}

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

# values will get substituted (e.g. _USERNAME_ ...)
sub compare_ldap_attr {
	my ($attr, $value) = @_;
	my $ldap = Net::LDAP->new($LDAP_HOST);
	my $result;

	my $user_dn = $LDAP_USER_DN;
	$user_dn =~ s/_USERNAME_/$mail_user/g;
	
	$value =~ s/_USERNAME_/$mail_user/g;
	
	$result = $ldap->bind;
	if ($result->is_error) {
		$warning = 'LdapConnect' unless ($warning);
		return (0==1);
	}
	$result = $ldap->compare($user_dn,
			attr => $attr,
			value => $value);
	$ldap->unbind;
	return ($result->code eq Net::LDAP::Constant->LDAP_COMPARE_TRUE);
}

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

sub get_ldap_values {
	my $attr = shift;
	my $user_dn = $LDAP_USER_DN;
	$user_dn =~ s/_USERNAME_/$mail_user/g;
	
	my $ldap = Net::LDAP->new($LDAP_HOST);
	my $result = $ldap->bind;
	if ($result->is_error) {
		$warning = 'LdapConnect' if ($warning eq '');
		return (0==1);
	}

	$result = $ldap->search( base => $user_dn,
			scope => 'base',
			filter => "($attr=*)",
			attrs => [$attr]);
	my $entry;
	my @values;
	# there will be only one entry
	foreach $entry ($result->entries) {
		@values = $entry->get_value($attr);
	}

	$ldap->unbind;

	if (wantarray) {
		return @values;
	} else {
		return $values[0] if (@values);
		return '';
	}
}

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

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/");
	my $scriptname = defined($ENV{'SCRIPT_NAME'})? $ENV{'SCRIPT_NAME'} : '';
	$hdf->setValue("Config.ScriptName", $scriptname);
	$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/