#!/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 (&not_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 (&not_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 (!&not_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;
  };