354 lines
9.7 KiB
Perl
Executable file
354 lines
9.7 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;
|
|
|
|
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/
|