861 lines
23 KiB
Perl
Executable file
861 lines
23 KiB
Perl
Executable file
#!/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/
|