#!/usr/bin/perl -T
#
# Webinterface for Unix Listproc V 0.1
#
# Copyright (C) 1999 Peter Palfrader <ppalfrad@cosy.sbg.ac.at>
#
# 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
#
#
#
#
# What this is and what it does:
#
# This is a small perl script I hacked together to make it simplier for
# the subscribers of one particular mailinglist to change their settings,
# subsccribe to the list, unsubscribe, get their forgotten passwords and
# so. There are no admin functions (yet?) since I never needed
# them (I automated everything).
#
# After a user logs in it displays a users settings and she may change them.
# All changes are exclusevly made by sending commands to the listserver
# as mails, so this program can be run with far less priviliges than the
# listserver itself and cannot screw up the listserver's files :)
#
# It needs however to be able to append to its log specified in $LOGFILE
# (this is the only write operation this script makes).
#
# To find out which users are subscribed to the list, this script needs
# to read the subscribers file, which is normally not possbile without
# some permissions since the subscribers file is AFAIK (and I'm just a
# poor list-owner, not a listserver admin) read only by the listserver
# itself. I came around this by writing a small C proggy named readsubs.c
# which you will also find in the source distribution of this webinterace.
# This program, once compiled is setuid listserver and executable by the
# script.
#
#
#
#
#
# Installation:
#
# Part 1: readsubs.c (you need the sys admin for this one)
#
# * Edit readsubs.c so that the SUBSCRIBERS constant matches the location of
# the subscribers file for your list. (ask the admin if you don't know)
# * compile it with 'gcc subscribers.c -o subscribers'
# * ask the system administrator to chown the executable to the listserver-user
# and make it setuid and executable by the http user (or whoever executes your
# CGI scripts).
#
#
# Part 2: webinterface.pl
#
# * edit the first line of this script to point to the location of perl
# on your system. This is usally /usr/bin/perl or /usr/local/bin/perl.
# If not sure type 'which perl' on the command line. If you don't succeed
# ask your system administrator.
# * Copy the templates to a convenient directory. Make sure the http user (or
# whoever executes your CGI scripts) can read those files.
# * touch a log file at a convenient place. ('touch webinterface_log' or whatever
# you like to name it) and make sure the script can append to it. chmod 622 would
# do, however if there's a way to not make it world-writeable this would be better
# * change a few variables at the top of the script. You will see which to change if
# you look at their names and the comments. (guess what $LOGFILE means, etc.)
# * copy the script to your cgi directory and make it executable
# (chmod 755 webinterface.pl).
#
# * change the static html pages so that the forms point to the correct location of
# the script.
# * copy the static html pages (index, forgot, signup) to a concenient directory
# that can be accessed via the web.
#
# That's it!
#
# The physical directory where all the templates are in. Including the trailing slash!
$TEMPLATES_BASE = '/home/weasel/httpd/cgi-bin/webinterface_templates/';
# Hostname with http:// in front and a / in the end
$HOSTNAME = 'http://localhost/';
# Where is the Webinterface on the Web Including the trailing slash!
$DOCBASE = $HOSTNAME.'others/tcg/webinterface/';
# Where is this script in the virtual tree
$SCRIPT_LOCATION = $HOSTNAME.'others/tcg/cgi-bin/webinterface.pl';
# The location of the log file. The log file must be writeable for the httpd!!
$LOGFILE = '/home/weasel/httpd/cgi-bin/webinterface_log';
# The executable that prints the subscribers file.
$SUBSCRIBERS = '/home/weasel/tcg/readsubs';
# Your email address. The listserver must honor owner commands from this address.
$LISTOWNER = 'weasel@giga.or.at';
# those are for the listserver
$LISTSERVER = 'listserver@giga.or.at';
$LISTNAME = 'TCG';
$LISTPASSWD = 'xxxxxxxxxxxx';
# those are displayed in several places
$LISTNAME_TO_DISPLAY = 'tcg@giga.or.at';
$LISTNAME_SHORT_TO_DISPLAY = $LISTNAME;
$MAINTAINER_ADDRESS_TO_DISPLAY = $LISTOWNER; #also used in mails to users
$MAINTAINER_NAME_TO_DISPLAY = 'Weasel';
# Location of sendmail.
# the -t option causes the recipients of the message to be obtained
# from the To, Cc, and Bcc headers in the message
# instead of from the command arguments
#
# -f set the address of the sender of a message. This option can
# normally be used only by one of the configured trusted users. So
# make sure the http is allowed to do so.
$SENDMAIL_NO_RETURN = '/usr/sbin/sendmail -t -f \<\>';
$SENDMAIL_RETURN_LISTOWNER = "/usr/sbin/sendmail -t -f $LISTOWNER";
# wheter you want to get CCs of all the commands the interface sends to the listserver
$SEND_COMMAND_CC_TO_LISTOWNER = TRUE;
# so Taint mode shuts up!
$ENV{'PATH'} = '';
#####################################################################
################### The Templates ###################################
#####################################################################
$MAIL_SENDAUTH = $TEMPLATES_BASE.'mail.sendauth';
$MAIL_CHANGEADDRESS = $TEMPLATES_BASE.'mail.change.address';
$MAIL_MAIL_PASSWD = $TEMPLATES_BASE.'mail.mail.passwd';
$PAGE_SENTAUTH = $TEMPLATES_BASE.'page.sentauth.html';
$PAGE_SENTAUTH_FOLLOWUP = $TEMPLATES_BASE.'page.sentauth.followup.html';
$PAGE_SUBS1_ER_WRONGADDR = $TEMPLATES_BASE.'page.subs.er.wrongaddr.html';
$PAGE_SUBS1_ER_ONLIST = $TEMPLATES_BASE.'page.subs.er.onlist.html';
$PAGE_SUBS2_ER_WRONGADDR = $TEMPLATES_BASE.'page.subs.er.wrongaddr.html';
$PAGE_SUBS2_ER_ONLIST = $TEMPLATES_BASE.'page.subs.er.onlist.html';
$PAGE_SUBS2_ER_WRONGAUTH = $TEMPLATES_BASE.'page.subs2.er.wrongauth.html';
$PAGE_SUBSCRIBED = $TEMPLATES_BASE.'page.subscribed.html';
$PAGE_LOGIN_ER_WRONGACCOUNT = $TEMPLATES_BASE.'page.login.er.wrongaccount.html';
$PAGE_LOGIN_ER_WRONGPASSWD = $TEMPLATES_BASE.'page.login.er.wrongpasswd.html';
$PAGE_LOGIN = $TEMPLATES_BASE.'page.login.html';
$PAGE_SIGNOFFQUERY = $TEMPLATES_BASE.'page.signoff.query.html';
$PAGE_SIGNOFF = $TEMPLATES_BASE.'page.signoff.html';
$PAGE_CHANGE_CONCEALEDQUERY = $TEMPLATES_BASE.'page.change.concealed.query.html';
$PAGE_CHANGE_CONCEALEDOK = $TEMPLATES_BASE.'page.change.concealed.ok.html';
$PAGE_CHANGE_MAILMODEQUERY = $TEMPLATES_BASE.'page.change.mailmode.query.html';
$PAGE_CHANGE_MAILMODEOK = $TEMPLATES_BASE.'page.change.mailmode.ok.html';
$PAGE_CHANGE_PASSWDQUERY = $TEMPLATES_BASE.'page.change.passwd.query.html';
$PAGE_CHANGE_PASSWD_ERR = $TEMPLATES_BASE.'page.change.passwd.err.html';
$PAGE_CHANGE_PASSWD_WAIT = $TEMPLATES_BASE.'page.change.passwd.wait.html';
$PAGE_CHANGE_PASSWDOK = $TEMPLATES_BASE.'page.change.passwd.ok.html';
$PAGE_CHANGE_ADDRESSQUERY = $TEMPLATES_BASE.'page.change.address.query.html';
$PAGE_CHANGE_ADDRESS_ERR = $TEMPLATES_BASE.'page.change.address.err.html';
$PAGE_CHANGE_ADDRESS_WAIT = $TEMPLATES_BASE.'page.change.address.wait.html';
$PAGE_CHANGE_ADDRESSOK = $TEMPLATES_BASE.'page.change.address.ok.html';
$PAGE_MAIL_PASSWD = $TEMPLATES_BASE.'page.mail.passwd.html';
$PAGE_LIST = $TEMPLATES_BASE.'page.list.html';
#####################################################################
################### Locations of the static pages ###################
#####################################################################
$PAGELNK_SIGNUP = $DOCBASE."signup.html";
$PAGELNK_FORGOTACCOUNTNAME = $DOCBASE."forgot.html";
$PAGELNK_FORGOTPASSWD = $DOCBASE."forgot.html";
$PAGELNK_WELCOME = $DOCBASE;
$SCRIPT_SIGNOFF = $SCRIPTBASE."signoff.pl";
$SCRIPT_LOGIN = $SCRIPTBASE."login.pl";
$SCRIPT_CHANGE_CONCEALED = $SCRIPTBASE."change.concealed.pl";
$SCRIPT_CHANGE_MAILMODE = $SCRIPTBASE."change.mailmode.pl";
$SCRIPT_CHANGE_PASSWD = $SCRIPTBASE."change.passwd.pl";
$SCRIPT_CHANGE_ADDRESS = $SCRIPTBASE."change.address.pl";
$SCRIPT_MAIL_PASSWD = $SCRIPTBASE."mail.passwd.pl";
$DATETIME = gmtime;
&main;
#####################################################################
################### get_input_data ##################################
#####################################################################
# Reads the input data for the cgi script.
# in : nothing
# out: a hash with the input data
sub get_input_data
{
my $input_data;
my %f;
if($ENV{'REQUEST_METHOD'} eq 'GET') { $input_data = $ENV{'QUERY_STRING'}; }
else { read(STDIN, $input_data, $ENV{'CONTENT_LENGTH'}); };
if ($ENV{'CONTENT_TYPE'} =~ m/^multipart\/form-data; boundary=(.*)$/i)
{
my $boundary = quotemeta($1);
my @blocks = split(/$boundary/, $input_data);
for (@blocks)
{
if (my $dummy = m/name="(.*?)"/i)
{
my $name = $1;
$_ =~ s/\r\n/\n/g;
m/\n\n(.*)\n/s;
my $value = $1;
$f{$name}=$value;
};
};
}
elsif ($ENV{'CONTENT_TYPE'} =~ m/^multipart\/form-data;$/i) # if the boundary is not in the enviroment variable we'll guess
{
my $dummy = $input_data =~ m/^(.*?)(\n|\r)/;
my $boundary = $1;
my @blocks = split(/$boundary/, $input_data);
for (@blocks)
{
if (my $dummy = m/name="(.*?)"/i)
{
my $name = $1;
$_ =~ s/\r\n/\n/g;
m/\n\n(.*)\n/s;
my $value = $1;
$f{$name}=$value;
};
};
}
else
{
my @form_fields = split(/&/, $input_data);
for (@form_fields)
{
my ($name, $value) = split(/=/, $_);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$f{$name} = $value;
}
};
return %f;
};
#####################################################################
################### get_file ########################################
#####################################################################
# reads a file from disk
# in : filename
# out: a scalar containing the file
sub get_file
{
my ($filename) = @_;
my $tmp;
open (FILE, "<$filename") || die("Could not open file $filename");
while (<FILE>)
{
$tmp.=$_;
};
close FILE;
return $tmp;
};
#####################################################################
################### get_subscribers_file ############################
#####################################################################
# reads the subscribers file from disk
# in : nothing
# out: a scalar containing the subscribers file
sub get_subscribers_file
{
my $tmp;
open (FILE, "$SUBSCRIBERS|") || die("Could not run $SUBSCRIBERS");
while (<FILE>)
{
$tmp.=$_;
};
close (FILE);
return $tmp;
};
#####################################################################
################### apply_vars ######################################
#####################################################################
# replaces occurences of %%some_variable%% with the corresponding
# value. The values are passed to the sub in a hash, just like the
# string with the text. The function the returns the text with the
# variables replaced. Some additional variables to the ones in the
# hash are replaced too. You can easily see which by looking at the
# code.
# in: a scalar containing the text
# the hash with the variables
# out: the text with all the variables replaced.
sub apply_vars
{
my ($str, %vars) = @_;
$vars{'datetime'} = $DATETIME;
$vars{'page.signup'} = $PAGELNK_SIGNUP;
$vars{'page.forgotaccount'} = $PAGELNK_FORGOTACCOUNTNAME;
$vars{'page.forgotpasswd'} = $PAGELNK_FORGOTPASSWD;
$vars{'page.welcome'} = $PAGELNK_WELCOME;
$vars{'script'} = $SCRIPT_LOCATION;
$vars{'listname'} = $LISTNAME_TO_DISPLAY;
$vars{'listname_short'} = $LISTNAME_SHORT_TO_DISPLAY;
$vars{'maintainer_address'} = $MAINTAINER_ADDRESS_TO_DISPLAY;
$vars{'maintainer_name'} = $MAINTAINER_NAME_TO_DISPLAY;
$vars{'ip'} = $ENV{'REMOTE_ADDR'};
$str =~ s/%%([^%]*)%%/$vars{$1}/g;
return ($str);
};
#####################################################################
################### mail_noreturn ###################################
#####################################################################
# sends the text passwd as a parameter with an envelope address of <>
# in: a scalar with the mail to send. Head lines inclusive!
# out: nothing
sub mail_noreturn
{
my ($text) = @_;
open (FILE, "|$SENDMAIL_NO_RETURN") || die ("Could not run $SENDMAIL_NO_RETURN");
print FILE $text;
close FILE;
};
#####################################################################
################### put_page ########################################
#####################################################################
# prints the html page passed as a parameter to stdout. The passed
# text must not contain the content-type line. It is printed by the
# sub.
# in: a scalar with the html page to print
# out: nothing
sub put_page
{
my ($text) = @_;
print "Content-type: text/html\n\n";
print "$text\n";
};
#####################################################################
################### log #############################################
#####################################################################
# appends a line to the log file. the date and time as well as the
# ip address of the peer is logged too.
# in: a scalar with a line to add to the log file
# out: nothing
sub log
{
my ($text) = @_;
open (FILE, ">>$LOGFILE") || die("Could not append to $LOGFILE");
print FILE "$DATETIME $ENV{'REMOTE_ADDR'} $text\n";
close(FILE);
};
#####################################################################
################### get_auth_key ####################################
#####################################################################
# create an authorization key for a email address. This is a very
# complicated and extremly safe way to prevent people subscribing
# other people. (It is at least better than nothing)
# in: a scalar with an email address
# out: an auth key
sub get_auth_key
{
my ($email) = @_;
return crypt($email, substr($email, -2));
};
#####################################################################
################### not_valid_mail ##################################
#####################################################################
# checks wheter an email address is correct, at least syntactically.
# there is no way to check in real time whether a mailbox or a server
# really exists :(
# in: a string
# out: true if the string is _not_ a valid address
# false otherwise.
sub not_valid_mail
{
my ($email) = @_;
my $ok = !($email =~ s/^[\w.-]+\@([\w-]+\.)+\w+$//);
return $ok;
};
#####################################################################
################### send_command ####################################
#####################################################################
# sends a command for a user to the listserver. the command appears
# as if it is sent by the listowner. the system command is always used.
# in: the account's email address
# the command
# out: nothing
sub send_command
{
my ($email, $cmd) = @_;
open (FILE, "|$SENDMAIL_RETURN_LISTOWNER") || die ("Could not run $SENDMAIL_RETURN_LISTOWNER");
print FILE "Content-Type: text/plain\n";
print FILE "From: $LISTOWNER\n";
print FILE "To: $LISTSERVER\n";
print FILE "CC: $LISTOWNER\n" if ($SEND_COMMAND_CC_TO_LISTOWNER);
print FILE "Subject: WIC $email: $cmd\n";
print FILE "\n";
print FILE "system $LISTNAME $LISTPASSWD $email #$cmd\n";
print FILE "\n";
close FILE;
}
#####################################################################
################### verify ##########################################
#####################################################################
# checks wheter a user with a certain email address and a password
# is on the list.
# in: email
# passwd
# out: nothing; returns only iff the user is on the list and the
# password is correct.
sub verify
{
my ($email, $passwd) = @_;
my $subscribersfile = &get_subscribers_file;
if ($subscribersfile =~ m/^$email /m)
{
# the account exists!
if ($subscribersfile =~ m/^$email [^ ]+ $passwd /m)
{
return 0; #ok
}
else
{
my %vars;
$vars{'email'} = $email;
&log("ER VERIFY $email ($passwd) wrong passwd");
&put_page( &apply_vars(&get_file($PAGE_LOGIN_ER_WRONGPASSWD), %vars) );
exit;
}
}
else
{
# the account does not exist.
my %vars;
$vars{'email'} = $email;
&log("ER VERIFY $email ($passwd) wrong account name");
&put_page( &apply_vars(&get_file($PAGE_LOGIN_ER_WRONGACCOUNT), %vars) );
exit;
}
};
#####################################################################
################### get_user_data ###################################
#####################################################################
# returns the data of a given subscriber
# in: email
# out: @userdata:
# email address
# mailmode (ACK, NOACK, DIGEST, POSTPONE)
# passwd
# concealed (YES, NO)
# user name
sub get_user_data
{
my ($email) = @_;
my $subscribersfile = &get_subscribers_file;
$subscribersfile =~ m/^($email [^\n]*)$/m;
my @result = split (/ /, $1, 5);
return @result;
};
#####################################################################
################### login ###########################################
#####################################################################
# is called on action=login
# in: email
# passwd
# out: never returns
sub login
{
my ($email, $passwd) = @_;
&verify($email, $passwd);
my %vars;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = &get_user_data($email);
$vars{'email' } = $f_email;
$vars{'mailmode' } = $f_mailmode;
$vars{'passwd' } = $f_passwd;
$vars{'concealed'} = $f_concealed;
&log("OK LOGIN $email ($passwd) logged in");
&put_page( &apply_vars(&get_file($PAGE_LOGIN), %vars) );
exit;
};
#####################################################################
################### unsubscribe_query ###############################
#####################################################################
# is called on action=unsubscribe_query
# asks a user if he/she really wants to unsubscribe
# in: email
# passwd
# out: never returns
sub unsubscribe_query
{
my ($email, $passwd) = @_;
&verify($email, $passwd);
my %vars;
$vars{'email' } = $email;
$vars{'passwd' } = $passwd;
&log("OK SIGNOFF 1 $email ($passwd) wants to unsubscribe");
&put_page( &apply_vars(&get_file($PAGE_SIGNOFFQUERY), %vars) );
exit;
};
#####################################################################
################### unsubscribe_action ##############################
#####################################################################
# is called on action=unsubscribe_action
# asks a user if he/she really wants to unsubscribe
# in: email
# passwd
# out: never returns
sub unsubscribe_action
{
my ($email, $passwd) = @_;
&verify($email, $passwd);
my %vars;
$vars{'email'} = $email;
&log("OK SIGNOFF $email ($passwd) has unsubscribed");
&send_command($email, "unsubscribe $LISTNAME");
&put_page( &apply_vars(&get_file($PAGE_SIGNOFF), %vars) );
exit;
};
#####################################################################
################### mail_passwd #####################################
#####################################################################
# is called on action=mail_passwd
# mails a user his/her settings
# in: email
# out: never returns
sub mail_passwd
{
my ($email) = @_;
my $subscribersfile = &get_subscribers_file;
if ($subscribersfile =~ m/^$email /m)
{
my %vars;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = &get_user_data($email);
$vars{'email' } = $f_email;
$vars{'mailmode' } = $f_mailmode;
$vars{'passwd' } = $f_passwd;
$vars{'concealed'} = $f_concealed;
&log("OK MAIL.PASSWD $email asked for the passwd mail");
&mail_noreturn( &apply_vars(&get_file($MAIL_MAIL_PASSWD), %vars) );
&put_page( &apply_vars(&get_file($PAGE_MAIL_PASSWD), %vars) );
exit;
}
else
{
my %vars;
$vars{'email'} = $email;
&log("ER MAIL.PASSWD $email wrong account name");
&put_page( &apply_vars(&get_file($PAGE_LOGIN_ER_WRONGACCOUNT), %vars) );
exit;
}
};
#####################################################################
################### list_subscribers ################################
#####################################################################
# prints a list of all non-concealed subscribers.
# in: nothing
# out: never returns
sub list_subscribers
{
@subs = split (/\n/, &get_subscribers_file);
my $list;
my $concealed = 0;
for (@subs)
{
$_ =~ m/^(.*?) /;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = split (/ /, $_, 5);
if ($f_concealed eq "YES")
{
$concealed += 1;
}
else
{
$f_email =~ s/\@/_AT_/;
$list .= "$f_email<br>\n";
};
};
my %vars;
$vars{'list'} = $list;
$vars{'nr_concealed'} = $concealed;
&log("OK LIST someone requested account list");
&put_page( &apply_vars(&get_file($PAGE_LIST), %vars) );
exit;
};
#####################################################################
################### send_auth #######################################
#####################################################################
# is called on action=send_auth
# mails a user his/her auth key to subscribe to the list
# in: email
# a followup URL where the user may continue after this step (optional)
# out: never returns
sub send_auth
{
my ($email, $followup) = @_;
if (¬_valid_mail($email))
{
my %vars;
$vars{'email'} = $email;
&log("ER SUBS_1 $email has asked for an auth key; email address not valid");
&put_page( &apply_vars(&get_file($PAGE_SUBS1_ER_WRONGADDR), %vars) );
exit;
};
my $subscribersfile = &get_subscribers_file;
if ($subscribersfile =~ m/^$email /m)
{
my %vars;
$vars{'email'} = $email;
&log("ER SUBS_1 $email has asked for an auth key, but was already on the list");
&put_page( &apply_vars(&get_file($PAGE_SUBS1_ER_ONLIST), %vars) );
exit;
};
my %vars;
$vars{'email'} = $email;
$vars{'auth'} = &get_auth_key($email);
&log("OK SUBS_2 $email has asked for an auth key");
&mail_noreturn( &apply_vars(&get_file($MAIL_SENDAUTH), %vars) );
if ($followup)
{
$vars{'followup'} = $followup;
&put_page( &apply_vars(&get_file($PAGE_SENTAUTH_FOLLOWUP), %vars) );
}
else
{
&put_page( &apply_vars(&get_file($PAGE_SENTAUTH), %vars) );
};
exit;
};
#####################################################################
################### subscribe #######################################
#####################################################################
# is called on action=subscribe
# subscribes a user to the list iff the supplied auth key is correct
# in: email
# auth key
# out: never returns
sub subscribe
{
my ($email, $auth) = @_;
if (¬_valid_mail($email))
{
my %vars;
$vars{'email'} = $email;
&log("ER SUBS_2 $email has asked to subscribe; email address not valid");
&put_page( &apply_vars(&get_file($PAGE_SUBS2_ER_WRONGADDR), %vars) );
exit;
};
my $subscribersfile = &get_subscribers_file;
if ($subscribersfile =~ m/^$email /m)
{
my %vars;
$vars{'email'} = $email;
&log("ER SUBS_2 $email has asked to subscribe, but was already on the list");
&put_page( &apply_vars(&get_file($PAGE_SUBS2_ER_ONLIST), %vars) );
exit;
};
if (&get_auth_key($email) ne $auth)
{
#zzzz, not ok
my %vars;
$vars{'email'} = $email;
$vars{'auth'} = $auth;
&log("ER SUBS_2 $email has asked to subscribe; auth $auth not valid");
&put_page( &apply_vars(&get_file($PAGE_SUBS2_ER_WRONGAUTH), %vars) );
exit;
}
my %vars;
$vars{'email'} = $email;
&log("OK SUBS_2 $email has subscribed");
&send_command($email, "subscribe $LISTNAME $email");
&put_page( &apply_vars(&get_file($PAGE_SUBSCRIBED), %vars) );
exit;
};
#####################################################################
################### change_mailmode_query ###########################
#####################################################################
# is called on action=change_mailmode_query
# allows a user to change his/her mailmode
# in: email
# passwd
# out: never returns
sub change_mailmode_query
{
my ($email, $passwd) = @_;
&verify($email, $passwd);
my %vars;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = &get_user_data($email);
$vars{'email' } = $f_email;
$vars{'mailmode' } = $f_mailmode;
$vars{'passwd' } = $f_passwd;
$vars{'concealed'} = $f_concealed;
if ($f_mailmode eq 'ACK')
{
$vars{'mailmode_ack' } = 'checked';
$vars{'mailmode_noack' } = '';
$vars{'mailmode_digest' } = '';
$vars{'mailmode_postpone' } = '';
};
if ($f_mailmode eq 'NOACK')
{
$vars{'mailmode_ack' } = '';
$vars{'mailmode_noack' } = 'checked';
$vars{'mailmode_digest' } = '';
$vars{'mailmode_postpone' } = '';
};
if ($f_mailmode eq 'DIGEST')
{
$vars{'mailmode_ack' } = '';
$vars{'mailmode_noack' } = '';
$vars{'mailmode_digest' } = 'checked';
$vars{'mailmode_postpone' } = '';
};
if ($f_mailmode eq 'POSTPONE')
{
$vars{'mailmode_ack' } = '';
$vars{'mailmode_noack' } = '';
$vars{'mailmode_digest' } = '';
$vars{'mailmode_postpone' } = 'checked';
};
&log("OK CHANGE.MAILMODE.1 $email ($passwd)");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_MAILMODEQUERY), %vars) );
exit;
};
#####################################################################
################### change_mailmode_action ##########################
#####################################################################
# is called on action=change_mailmode_action
# allows a user to change his/her mailmode - step 2
# in: email
# passwd
# newvalue
# out: never returns
sub change_mailmode_action
{
my ($email, $passwd, $newvalue) = @_;
&verify($email, $passwd);
my %vars;
$vars{'email'} = $email;
$vars{'passwd'} = $passwd;
$vars{'newvalue'} = $newvalue;
&log("OK CHANGE.MAILMODE.2 $email ($passwd) has changed mailmode to: $newvalue");
&send_command($email, "set $LISTNAME mail $newvalue");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_MAILMODEOK), %vars) );
exit;
};
#####################################################################
################### change_concealed_query ##########################
#####################################################################
# is called on action=change_concealed_query
# allows a user to change his/her concealed status
# in: email
# passwd
# out: never returns
sub change_concealed_query
{
my ($email, $passwd) = @_;
&verify($email, $passwd);
my %vars;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = &get_user_data($email);
$vars{'email' } = $f_email;
$vars{'mailmode' } = $f_mailmode;
$vars{'passwd' } = $f_passwd;
$vars{'concealed'} = $f_concealed;
if ($f_concealed eq 'YES')
{
$vars{'concealed_yes'} = 'checked';
$vars{'concealed_no' } = '';
}
else
{
$vars{'concealed_yes'} = '';
$vars{'concealed_no' } = 'checked';
};
&log("OK CHANGE.CONCEALED.1 $email ($passwd)");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_CONCEALEDQUERY), %vars) );
exit;
};
#####################################################################
################### change_concealed_action #########################
#####################################################################
# is called on action=change_mailmode_action
# allows a user to change his/her concealed status - step 2
# in: email
# passwd
# newvalue
# out: never returns
sub change_concealed_action
{
my ($email, $passwd, $newvalue) = @_;
&verify($email, $passwd);
my %vars;
$vars{'email'} = $email;
$vars{'passwd'} = $passwd;
$vars{'newvalue'} = $newvalue;
&log("OK CHANGE.CONCEALED.2 $email ($passwd) has changed concealed mode to: $newvalue");
&send_command($email, "set $LISTNAME conceal $newvalue");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_CONCEALEDOK), %vars) );
exit;
};
#####################################################################
################### change_passwd_query #############################
#####################################################################
# is called on action=change_passwd_query
# allows a user to change his/her passwd
# in: email
# passwd
# out: never returns
sub change_passwd_query
{
my ($email, $passwd) = @_;
&verify($email, $passwd);
my %vars;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = &get_user_data($email);
$vars{'email' } = $f_email;
$vars{'mailmode' } = $f_mailmode;
$vars{'passwd' } = $f_passwd;
$vars{'concealed'} = $f_concealed;
&log("OK CHANGE.PASSWD.1 $email ($passwd)");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_PASSWDQUERY), %vars) );
exit;
};
#####################################################################
################### change_passwd_action ############################
#####################################################################
# is called on action=change_passwd_action
# allows a user to change his/her passwd - step 2
# in: email
# passwd
# newvalue
# out: never returns
sub change_passwd_action
{
my ($email, $passwd, $newvalue) = @_;
&verify($email, $passwd);
if ($newvalue =~ m/^[A-Za-z0-9_]+$/)
{
my %vars;
$vars{'newvalue'} = $newvalue;
$vars{'email' } = $email;
$vars{'passwd' } = $passwd;
&log("OK CHANGE.PASSWD.2 $email ($passwd) has changed passwd to: $newvalue");
&send_command($email, "set $LISTNAME password $passwd $newvalue");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_PASSWD_WAIT), %vars) );
exit;
}
else
{
my %vars;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = &get_user_data($email);
$vars{'email' } = $f_email;
$vars{'mailmode' } = $f_mailmode;
$vars{'passwd' } = $f_passwd;
$vars{'concealed'} = $f_concealed;
&log("ERR CHANGE.PASSWD.2 $email ($passwd) entered not a valid passwd");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_PASSWD_ERR), %vars) );
exit;
}
};
#####################################################################
################### change_passwd_wait ##############################
#####################################################################
# is called on action=change_passwd_wait
# allows a user to change his/her passwd - step 3
# wait until the listserver processed the query
# in: email
# passwd
# newvalue
# out: never returns
sub change_passwd_wait
{
my ($email, $passwd, $newvalue) = @_;
my $subscribersfile = &get_subscribers_file;
if ($subscribersfile =~ m/^$email /m)
{
my %vars;
$vars{'email'} = $email;
$vars{'passwd'} = $passwd;
$vars{'newvalue'} = $newvalue;
if ($subscribersfile =~ m/^$email [^ ]+ $newvalue /m)
{
&log("OK CHANGE.PASSWD.WAIT.END $email ($passwd) newvalue: $newvalue");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_PASSWDOK), %vars) );
exit;
};
if ($subscribersfile =~ m/^$email [^ ]+ $passwd /m)
{
&log("OK CHANGE.PASSWD.WAIT $email ($passwd) newvalue: $newvalue");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_PASSWD_WAIT), %vars) );
exit;
};
};
&verify($email, '');
};
#####################################################################
################### change_address_query ############################
#####################################################################
# is called on action=change_address_query
# allows a user to change his/her address
# in: email
# passwd
# out: never returns
sub change_address_query
{
my ($email, $passwd) = @_;
&verify($email, $passwd);
my %vars;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = &get_user_data($email);
$vars{'email' } = $f_email;
$vars{'mailmode' } = $f_mailmode;
$vars{'passwd' } = $f_passwd;
$vars{'concealed'} = $f_concealed;
&log("OK CHANGE.ADDRESS.1 $email ($passwd)");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_ADDRESSQUERY), %vars) );
exit;
};
#####################################################################
################### change_address_action ###########################
#####################################################################
# is called on action=change_address_action
# allows a user to change his/her address - step 2
# in: email
# passwd
# newvalue
# out: never returns
sub change_address_action
{
my ($email, $passwd, $newvalue) = @_;
&verify($email, $passwd);
if (!¬_valid_mail($newvalue))
{
my %vars;
$vars{'newvalue'} = $newvalue;
$vars{'email' } = $email;
$vars{'passwd' } = $passwd;
&log("OK CHANGE.ADDRESS.2 $email ($passwd) has changed passwd to: $newvalue");
&mail_noreturn( &apply_vars(&get_file($MAIL_CHANGEADDRESS), %vars) );
&send_command($email, "set $LISTNAME address $passwd $newvalue");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_ADDRESS_WAIT), %vars) );
exit;
}
else
{
my %vars;
my ($f_email, $f_mailmode, $f_passwd, $f_concealed, $f_name) = &get_user_data($email);
$vars{'email' } = $f_email;
$vars{'mailmode' } = $f_mailmode;
$vars{'passwd' } = $f_passwd;
$vars{'concealed'} = $f_concealed;
&log("ERR CHANGE.ADDRESS.2 $email ($passwd) entered not a valid address");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_ADDRESS_ERR), %vars) );
exit;
}
};
#####################################################################
################### change_address_wait #############################
#####################################################################
# is called on action=change_address_wait
# allows a user to change his/her address - step 3
# wait until the listserver processed the query
# in: email
# passwd
# newvalue
# out: never returns
sub change_address_wait
{
my ($email, $passwd, $newvalue) = @_;
my $subscribersfile = &get_subscribers_file;
if (($subscribersfile =~ m/^$email /m) ||
($subscribersfile =~ m/^$newvalue /m))
{
my %vars;
$vars{'email'} = $email;
$vars{'passwd'} = $passwd;
$vars{'newvalue'} = $newvalue;
if ($subscribersfile =~ m/^$newvalue [^ ]+ $passwd /m)
{
&log("OK CHANGE.ADDRESS.WAIT.END $email ($passwd) newvalue: $newvalue");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_ADDRESSOK), %vars) );
exit;
};
if ($subscribersfile =~ m/^$email [^ ]+ $passwd /m)
{
&log("OK CHANGE.ADDRESS.WAIT $email ($passwd) newvalue: $newvalue");
&put_page( &apply_vars(&get_file($PAGE_CHANGE_ADDRESS_WAIT), %vars) );
exit;
};
};
&verify($email, '');
};
#####################################################################
################### main ############################################
#####################################################################
# in: nothing
# out: never returns;
sub main
{
my %input = &get_input_data();
if (defined($input{'email' })) { $input{'email' } = uc($input{'email' }); };
if (defined($input{'passwd'})) { $input{'passwd' } = uc($input{'passwd' }); };
if (defined($input{'newvalue'})) { $input{'newvalue'} = uc($input{'newvalue'}); };
if ($input{'action'} eq 'login') { &login ( $input{'email'}, $input{'passwd'} ); }
elsif ($input{'action'} eq 'mail_passwd') { &mail_passwd ( $input{'email'} ); }
elsif ($input{'action'} eq 'list_subscribers') { &list_subscribers; }
elsif ($input{'action'} eq 'send_auth') { &send_auth ( $input{'email'}, $input{'followup'} ); }
elsif ($input{'action'} eq 'subscribe') { &subscribe ( $input{'email'}, $input{'auth'} ); }
elsif ($input{'action'} eq 'unsubscribe_query') { &unsubscribe_query ( $input{'email'}, $input{'passwd'} ); }
elsif ($input{'action'} eq 'unsubscribe_action') { &unsubscribe_action ( $input{'email'}, $input{'passwd'} ); }
elsif ($input{'action'} eq 'change_mailmode_query') { &change_mailmode_query ( $input{'email'}, $input{'passwd'} ); }
elsif ($input{'action'} eq 'change_mailmode_action') { &change_mailmode_action ( $input{'email'}, $input{'passwd'}, $input{'newvalue'} ); }
elsif ($input{'action'} eq 'change_concealed_query') { &change_concealed_query ( $input{'email'}, $input{'passwd'} ); }
elsif ($input{'action'} eq 'change_concealed_action') { &change_concealed_action ( $input{'email'}, $input{'passwd'}, $input{'newvalue'} ); }
elsif ($input{'action'} eq 'change_concealed_query') { &change_concealed_query ( $input{'email'}, $input{'passwd'} ); }
elsif ($input{'action'} eq 'change_concealed_action') { &change_concealed_action ( $input{'email'}, $input{'passwd'}, $input{'newvalue'} ); }
elsif ($input{'action'} eq 'change_passwd_query') { &change_passwd_query ( $input{'email'}, $input{'passwd'} ); }
elsif ($input{'action'} eq 'change_passwd_action') { &change_passwd_action ( $input{'email'}, $input{'passwd'}, $input{'newvalue'} ); }
elsif ($input{'action'} eq 'change_passwd_wait') { &change_passwd_wait ( $input{'email'}, $input{'passwd'}, $input{'newvalue'} ); }
elsif ($input{'action'} eq 'change_address_query') { &change_address_query ( $input{'email'}, $input{'passwd'} ); }
elsif ($input{'action'} eq 'change_address_action') { &change_address_action ( $input{'email'}, $input{'passwd'}, $input{'newvalue'} ); }
elsif ($input{'action'} eq 'change_address_wait') { &change_address_wait ( $input{'email'}, $input{'passwd'}, $input{'newvalue'} ); }
print "content-type: text/plain\n\n";
print "unexpected status. Please inform $MAINTAINER_ADDRESS_TO_DISPLAY of this and\n";
print "what you did to screw everything up.\n\n\n";
print "please also provide this data:\n\n";
print "%ENV: \n", map { "$_ = $ENV{$_} \n" } keys %ENV;
print "\n\n\n";
print "%input: \n", map { "$_ = $input{$_} \n" } keys %input;
};