#!/usr/pkg/bin/perl
## $Id: mailserv,v 3.29 2002/10/23 00:51:32 fitz Exp $
##
## MailServ - displays and processes forms for mailing list manager commands
## Copyright (C) 1996,1997 Patrick Fitzgerald <fitz@csicop.org>
## See end of file for GNU Public License information.
##
## Complete documentation is provided at the following URL:
## http://csicop.org/~fitz/www/mailserv/

 # Version of MailServ
$version = &fixVersion('$Name: v4_4 $');

 # Initial header for browser
print "Content-type: text/html\n";


##----------------------------------------------------------------------
## Initial CGI setup
##
## MailServ uses the Perl include path to find the list
## config files, and to find the cgi-lib.pl file.
##
## For security reasons, we will wipe out the existing
## include path and replace it with our own.  You might
## have to use the full directory paths if MailServ cannot
## find the required files.  Also, be sure that all of
## the include files are write-protected, otherwise someone
## could add malicious code to them.

@INC = (".", "./config", "/usr/pkg/etc/mailserv");
&cgiRequire("cgi-lib.pl");
&ReadParse();


##----------------------------------------------------------------------
## Config - you *must* change some of these.
## You can also set these in the individual config files.
##

 # debug
 # Set to 1 for some debug info in the HTML output (use your
 # browser's "view source" command to view the HTML). You can also
 # set this with $config::debug or the "debug" form input.

$debug = 0;

 # errors
 # Address to which errors should be sent.
 # Change this to your address.
 # You can override this with the "errors" form input.

$errors = 'fitz@csicop.org';

 # logfile
 # If you want to log the use of MailServ on your system,
 # (useful for hunting down certain problems)
 # specify the filename here.  If MailServ cannot write
 # the file, it just ignores it and continues.

$logfile = "LOGFILE";

 # max
 # Maximum number of commands users can select.
 # You can override this with $config::max or the "max" form input.
 # $config::max always takes precedence.

$max = 10;

 # mailer
 # Program into which mail is piped
 # You can also override this with $config::mailer.

$mailer = "/usr/sbin/sendmail -t";

 # mailer_accepts_f
 # Use "-f address" for the mailer?
 # Your sendmail must be configured correctly for this to work.
 # This is used to properly direct mailer error messages to
 # the errors address (instead of bounce messages going to the
 # web server UID).
 # You can override this with $config::mailer_accepts_f

$mailer_accepts_f = 1;

 # referrer_regexp
 # One or more regular expressions - the HTTP_REFERER env variable
 # must match one of these or the script will not be allowed to run.
 # This prevents people from linking to MailServ on your server if you
 # don't want them to.
 #
 # You should change this to your web server to prevent people from
 # "hijacking" your server to run MailServ from their web pages on
 # another server; or you can just comment out the lines to allow
 # MailServ to be run from any referrer.

@referrer_regexp =
  (
   'csicop\.org',
  );

 # address_allow_regexp
 # If you configure this variable, then only these email addresses
 # can be used for the "to" address. This prevents people from using
 # MailServ on your server for unwanted mailing lists.

@address_allow_regexp =
  (
   # 'foo\@bar\.com',
  );

 # address_refuse_regexp
 # Mailing list addresses to lock out, and the reasons they
 # are being locked out.  I use this if someone improperly
 # links to MailServ and causes bounces to be sent to me.

%address_refuse_regexp =
  (
   #'foo\@bar\.com', 'Put the reason for refusal here.',
  );

##----------------------------------------------------------------------
## END OF CONFIG
## You do not have to change anything beyond here.
##

# Untaint the input (and keep a tainted copy)
# This allows the input to be re-echoed without
# worrying about embedded HTML characters

foreach (keys %in)
{
    # Delete the empty inputs
    if ($in{$_} eq "")
    {
        delete($in{$_});
        next;
    }

    $in_tainted{$_} = $in{$_};
    $in{$_} = &untaint( $in{$_} );
}

# Size of some text fields

$size = "20";

# Password markers (used in commands to delimit passwords
# so I do not display them on the screen).  For config files,
# use the &config::hidePassword() subroutine

$password{"begin"} = "__BEGINPASS__";
$password{"end"} = "__ENDPASS__";
$password{"placeholder"} = "PASS";


# Default subject for mail messages
# You can override this with $config::subject or by setting
# the "subject" form input.

$subject = "mailing list request";


# Netscape cookie to remember e-mail address.
# Comment this out if you do not want to use cookies.

$cookie = "mailserv_from";

# HTML attributes for most tables

$table_attr = "CELLSPACING=0 CELLPADDING=0";


##----------------------------------------------------------------------
## Load the MLM config file
##

# Load the MLM config file - for example "majordomo.cf" or
# "listserv.cf".  We will use the name by which this script was invoked
# to determine which config file to load, so if this script was
# invoked as "majordomo", we will load the "majordomo.cf" config file.

($progname = $0) =~ s!.*/!!;
&cgiRequire("$progname.cf");


##---------------------------------------------------------------------- 
## Override certain values depending on the config file and the form input
##
$debug = $debug || $config::max || $in{"debug"};
$subject = $in_tainted{"subject"} || $config::subject || $subject;
$max = $config::max || $in_tainted{"max"} || $max;
$errors = $in_tainted{"errors"} || $errors;


##----------------------------------------------------------------------
## Various templates
##
$template{"mailserv"} =
  q!<A HREF="http://csicop.org/~fitz/www/mailserv/">MailServ</A>!;

$template{"form start"} = <<EOT;
<FORM METHOD="POST">
EOT

$template{"form footer"} = <<EOT;
<P>
<CENTER>
<INPUT TYPE=reset VALUE="Erase Changes">
<INPUT TYPE=submit NAME=restart VALUE="Restart MailServ">
</CENTER>
</FORM>

EOT

$template{"header"} = <<EOT;
<!-- BEGIN header -->
<TABLE WIDTH=100% BORDER=4>
 <TR>
  <TH ALIGN=left WIDTH=100%>
   $template{"mailserv"} for $config::name mailing lists
  </TH>
  <TH ALIGN=right>
   <A HREF="http://csicop.org/~fitz/www/mailserv/help/" TARGET=mailserv_help>Help</A>
  </TH>
 </TR>
</TABLE>
<!-- END header -->
EOT

$template{"signature"} = <<EOT;
<!-- BEGIN signature -->
<HR>
<CENTER>
<FONT SIZE=-1>
$template{"mailserv"} $version
is a freeware tool written by
<A HREF="http://csicop.org/~fitz/">Patrick Fitzgerald</A>
</FONT>
</CENTER>
</BODY>
</HTML>
<!-- END signature -->
EOT


# Set the Netscape cookie if we have a "from" value.
# NOTE: this must be part of the MIME header.

print &set_cookie($cookie, $in{"from"}) if ($cookie
                                                && defined $in{"from"}
                                                && $in{"from"} =~ /\w/);

# Get the cookie if it is available and the from address has not been
# entered yet
$in{"from"} = &get_cookie($cookie) if ($cookie && ! defined($in{"from"}));

# Print a blank line to mark the end of the headers

print "\n";

##----------------------------------------------------------------------
## Display standard HTML info
##

# Print some debug info

print "<!-- This source generated by the $progname script -->\n";

print &debug() if $debug;

print <<EOT;
<HTML>
<HEAD>
  <TITLE>MailServ by Patrick Fitzgerald</TITLE>
</HEAD>
<BODY>
$template{"header"}
<P>
EOT


##----------------------------------------------------------------------
## Make sure they are allowed to use this program.  Check
## referrer_regexp, address_allow_regexp, and address_refuse_regexp
## (see above for more info).
##
if (@referrer_regexp)
{
    my($allow) = 0;
    foreach (@referrer_regexp)
    {
        if ($ENV{HTTP_REFERER} =~ /$_/)
        {
            $allow = 1;
            last;
        }
    }
    &error("This CGI script is not allowed to be called from ",
           "HTTP_REFERER=$ENV{HTTP_REFERER}.  It can be called ",
           "only from authorized web servers."
          ) unless $allow;
}

if ($in{to})
{
    # If address_allow_regexp is configured, check to make sure the
    # "to" address is in the list, otherwise error out

    if (@address_allow_regexp)
    {
        my($allow) = 0;
        foreach (@address_allow_regexp)
        {
            if ($in_tainted{"to"} =~ /$_/)
            {
                $allow = 1;
                last;
            }
        }
        &error("The address",
               qq!<STRONG><A HREF="mailto:$in{to}">$in{to}</A></STRONG> !,
               "(list <STRONG>$in{list}</STRONG>) is locked out",
               "of MailServ because it is not in the allowed address list."
              ) unless $allow;
    }


    # Ifaddress_refuse_regexp is configured, then error out if the
    # "to" address is in the list.

    if (%address_refuse_regexp)
    {
        foreach (keys %address_refuse_regexp)
        {
            &error("The address",
                   qq!<STRONG><A HREF="mailto:$in{to}">$in{to}</A></STRONG> !,
                   "(list <STRONG>$in{list}</STRONG>) is locked out",
                   "of MailServ because:",
                   "<P>",
                   $address_refuse_regexp{$_},
                  ) if $in_tainted{"to"} =~ /$_/;
        }
    }
}


##--------------------------------------------------
## Split the already-selected commands into an array
##
@commands = &splitMultiple($::in_tainted{"commands"});


##--------------------------------------------------
## Main Loop
##
## The following variables control the flow of MailServ:
##
## restart	Remove all commands and start over
##
## send		Send the selected command(s)
##
## select	Process the command that the user selected
##		This also assumes that a "cmd_XXX" variable is set.
##
## default	List the available commands
##

if ($in{"restart"})
{
    delete $in{"commands"}, $in_tainted{"commands"};
    undef @commands;
    &formList();
}
elsif ($in{"send"})
{
    &processSend();
}
elsif ($in{"select"})
{
    &processCommand();
}
else
{
    &formList();
}


# If in demo mode, display a message

print("<CENTER>",
      "Running in <em>demo</em> (no send) mode.\n",
      "</CENTER>\n")
  if $in{"demo"};


# Append the signature line and exit.

print $template{"form footer"}, $template{"signature"};

exit 0;



########################################################################
##======================================================================
## Subroutines
##======================================================================
########################################################################

use strict ("subs", "vars");

sub retainState
#
# Returns a string that contains all of the information
# that we want to remember in the next form:
#
# from, cc, to, list, password, commands, max, errors,
# subject, demo, debug, url
#
{
    my($field,$cc_checked);

    $field = "<!-- BEGIN retainState -->\n";

    # Display the from address
    $cc_checked = "CHECKED" if $::in{"cc"};

    $field .=
      ("<TABLE WIDTH=100% $::table_attr>\n" .
       " <TR>\n" .
       "  <TD ALIGN=right>Your e-mail address:</TD>\n" .
     qq!  <TD><INPUT NAME=from VALUE="$::in{from}" SIZE=40></TD>\n! .
       "  <TD ALIGN=right><INPUT NAME=cc TYPE=checkbox VALUE=1 $cc_checked></TD>\n" .
       "  <TD>CC: yourself</TD>\n" .
       " </TR>\n" .
       "</TABLE>\n" .
       "<HR>\n");


    # Display the mailing list name and the address within a table

    $field .= ("<TABLE WIDTH=100% $::table_attr>\n" .
               " <TR>\n");

    # Display the mailing list name.

    unless ($config::noList)
    {
        $field .= ("  <TD ALIGN=right>List name:</TD>\n" .
                   "  <TD>\n" .
                 qq!   <INPUT NAME=list VALUE="$::in{list}" SIZE=16>\n! .
                   "  </TD>\n");
    }

    # If we are going to also prompt for a password,
    # start a new row in the table; otherwise
    # keep everything in the same table row

    $field .= (" </TR>\n" .
               " <TR>\n") if $config::needPassword;

    # Display the mailing list request address.

    $field .= ("  <TD ALIGN=right>List request address:</TD>\n" .
               "  <TD>\n" .
             qq!   <INPUT NAME=to VALUE="$::in{to}" SIZE=30>\n! .
               "  </TD>\n" .
               " </TR>\n");

    # Display a table with the list password if necessary

    if ($config::needPassword)
    {
        $field .=
          (" <TR>\n" .
           "  <TD ALIGN=right>List password:</TD>\n" .
           "  <TD>\n" .
         qq!   <INPUT TYPE=password NAME=password VALUE="$::in{password}" SIZE="$::size">\n! .
           "  </TD>\n" .
           " </TR>\n");

        # On the first screen, where they have not entered
        # their password yet, display a security warning

        unless ($::in{"password"})
        {
            $field .= (" <TR>\n" .
                       "  <TD></TD>\n" .
                       "  <TD>\n" .
                     qq!   <FONT SIZE="-1"><STRONG>Warning:</STRONG>\n! .
                       "   Passwords are not visible on the screen<BR>\n" .
                       "   but are stored in the HTML source<BR>\n" .
                       "   (in your browser cache).\n" .
                       "   </FONT>\n" .
                       "  </TD>\n" .
                       " </TR>\n");
        }
    }

    $field .= "</TABLE>\n\n";

    #--------------------------------------------------
    # Display the already-selected commands
    #
    if (@::commands)
    {
        my($cmd, $i, $col, $max_col);
        local($*);

        $max_col = 3;
        $col = 1;

        $field .= ("<HR>\n" .
                   "You have selected the following commands:<BR>\n" .
                   "<TABLE WIDTH=100% $::table_attr>\n" .
                   " <TR>\n");

        # There can be multiple commands in the variable,
        # so loop for each one

        foreach (@::commands)
        {
            $_ = &untaint($_);

            if ($col > $max_col)
            {
                $field .= (" </TR>\n" .
                           " <TR>\n");
                $col = 1;
            }
            $col++;

            # Make a copy of the command
            # (one to put in a hidden variable,
            #  the other to display on the screen).

            $cmd = $_;

            # In case the command contains multiple lines,
            # tell Perl to match across the end of line

            $* = 1;

            # If the command contains password info
            # delimited by $password{start} and $password{end},
            # then do not display it on the screen; however,
            # the password still appears in the HTML source,
            # so do not consider this real security.

            # Warning: if the config file does not use the
            # password delimeters correctly (a start delimeter
            # followed by an end delimeter) then the whole
            # screen might be commented out! To be safe, always
            # use the &config::hidePassword() subroutine.
            
            $cmd = &obscurePassword($cmd);

            # If the command contains multiple lines,
            # only display the first one.  For additional
            # lines, display "[X lines]"

            if ($cmd =~ m/\n/)
            {
                # Find the first CR

                $i = index($cmd, "\n");

                # Remove everything after the CR

                $cmd = substr($cmd, 0, $i);

                # Count the number of lines, and add
                # "[X lines]" to the screen display

                $i = split(/\n/, $_) - 1;
                $cmd .= " [<EM>$i line" . ($i > 1 ? "s" : "") . "</EM>]";
            }

            # Display the command next to a checkbox variable
            # with its value.  The user can uncheck the checkbox
            # to cancel the command.

            $field .= ("  <TD ALIGN=right>\n" .
                     qq!   <INPUT TYPE=checkbox NAME=commands VALUE="$_" CHECKED>\n! .
                       "  </TD>\n" .
                       "  <TD>$cmd</TD>\n");
        }

        $field .= (" </TR>\n" .
                   "</TABLE>\n" .
                   "<HR>\n\n");
    }

    # Remember the value of the max variable.

    $field .= qq!<INPUT TYPE=hidden NAME=max VALUE="$::max">\n\n!;

    # Remember the value of the errors variable.

    $field .= qq!<INPUT TYPE=hidden NAME=errors VALUE="$::errors">\n\n!;

    # Remember the value of the subject variable.

    $field .= qq!<INPUT TYPE=hidden NAME=subject VALUE="$::subject">\n\n!;

    # Remember the value of the demo variable.

    $field .= qq!<INPUT TYPE=hidden NAME=demo VALUE="$::in{demo}">\n\n!
        if $::in{"demo"};

    # Remember the value of the debug variable.

    $field .= qq!<INPUT TYPE=hidden NAME=debug VALUE="$::in{debug}">\n\n!
        if $::in{"debug"};

    # Remember the URL that originally called MailServ.
    # This lets you sometimes track the starting link (for logging)

    if ($ENV{"HTTP_REFERER"})
    {
        $::in{"url"} = &untaint($ENV{"HTTP_REFERER"}) unless $::in{"url"};
        $field .= qq!<INPUT TYPE=hidden NAME=url VALUE="$::in{url}">\n\n!;
    }

    $field .= "<!-- END retainState -->\n\n";

    # This subroutine does not print anything out,
    # it just returns the data

    $field;
}


sub formList
#
# Displays the list of mailserver commands,
# with a submit button next to each command.
#
{
    my(
          $text,
          @text,
          @commands,
          $num,
          );

    # Make sure we got the list of mail server commands
    # from the MLM config file

    &error("Config error - missing mail server commands.")
        unless @config::commands;

    # Display the list of commands

    print
        $::template{"form start"},
        &retainState();

    # If user has previously selected one or more commands,
    # Add the "send commands" options

    if (@::commands)
    {
        print
          "<CENTER>\n",
          qq/<INPUT TYPE=submit NAME=send VALUE="Send my commands now!">\n/,
          "</CENTER>\n",
          "<P>\n";

        $num = $#::commands + 1;

        return if ($::in{"multi"} eq "0" || $num >= $::max)
    }
    else
    {
        # The user has not yet selected any commands.

        # If the user is allowed (by the "max" parameter)
        # to submit multiple commands, display
        #   "Select: * single command,  o multiple commands"

        if ($::max > 1)
        {
            print
              "<HR>\n",
              "<TABLE WIDTH=100% $::table_attr>\n",
              " <TR>\n",
              "  <TD WIDTH=100%></TD>\n",
              "  <TD NOWRAP>Send commands:</TD>\n",
              "  <TD ALIGN=right><INPUT TYPE=radio NAME=multi VALUE=0 CHECKED></TD>\n",
              "  <TD NOWRAP>immediately, or</TD>\n",
              "  <TD WIDTH=40></TD>\n",
              "  <TD ALIGN=right><INPUT TYPE=radio NAME=multi VALUE=1></TD>\n",
              "  <TD NOWRAP>after multiple commands</TD>\n",
              " </TR>\n",
              "</TABLE>\n";
        }
        else
        {
            print
              "<TABLE WIDTH=100%>\n",
              " <TR>\n",
              "  <TD ALIGN=right>\n",
              "   Send commands: immediately\n",
              "   <INPUT TYPE=hidden NAME=multi VALUE=0>\n",
              "  </TD>\n",
              " </TR>\n",
              "</TABLE>\n\n";
        }
    }

    # Display the commands from which the user can choose

    print
      "<INPUT TYPE=hidden NAME=select VALUE=1>\n",
      "\n",
      "<!-- BEGIN main table -->\n",
      "<TABLE WIDTH=100% BORDER>\n",
      " <TR VALIGN=top>\n",
      "  <TD>\n",
      "   <!-- BEGIN column table -->\n",
      "   <TABLE WIDTH=100% $::table_attr>\n";

    my($need_hr);

    foreach (@config::commands)
    {
        # If the commands array contains a blank entry,
        # that means to add another column to the table.

        if (/^\s*$/)
        {
            print
              "   </TABLE>\n",
              "   <!--END column table-->\n",
              "  </TD>\n",
              "  <TD>\n",
              "  <!--BEGIN column table-->\n",
              "  <TABLE WIDTH=100% $::table_attr>\n";

            # Since we started a new column, we do not need an <HR>
            # in front of the next command.

            $need_hr = 0; 

            # Skip (this blank line) to the next command

            next;
        }

        # Print a <HR> before the command
        # unless it is at the top of the table column

        print "    <TR><TD COLSPAN=2><HR></TD></TR>\n" if $need_hr++;

        # Make sure the command has a description

        if ($config::description{$_})
        {
            print
              "   <!-- BEGIN COMMAND $_ -->\n",
              "   <TR VALIGN=top>\n",
              qq!    <TD><INPUT TYPE=submit name="cmd_$_" VALUE="--&gt;"></TD>\n!,
              "    <TD>\n",
              "     $config::description{$_}\n";

            # Does the command require additional input?
            # If so it will have a variable called
            # $config::command{"command-name"}, which contains HTML

            print("     <P>\n",
                  "     <FONT SIZE=-1>\n",
                  $config::command{$_}, "\n",
                  "     </FONT>\n")
              if $config::command{$_};

            print
              "    </TD>\n",
              "   </TR>\n",
              "   <!-- END COMMAND $_ -->\n\n";
        }
        else
        {
            # The command did not have a description.
            # Display a warning message

            print
                "<TR><TD></TD><TD><BLINK>Error: no description for command ",
                "$_</BLINK></TD></TR>\n\n";
        }
    }

    print
        "</TABLE>\n",
        "<!-- END column table -->\n",
        "</TD>\n",
        "</TR>\n",
        "</TABLE>\n",
        "<!-- END main table -->\n";
}


sub processCommand
#
# Runs the code for a single command.
#
{
    my($command, @new_commands, $command_function);

    $command = &commandInput();

    unless ($command)
    {
        &writeLog("ERROR\t= no selected command for browser",
                 $ENV{"HTTP_USER_AGENT"});
        &error("The form was submitted, but no command was selected.",
              "This usually indicates:\n",
              "<OL>\n",
              " <LI> that you pressed the Enter key in a text field\n",
              "      instead of clicking the command button, or\n",
              " <LI> that your browser ($ENV{HTTP_USER_AGENT}) does not\n",
              "      support multiple named submit buttons (which are\n",
              "      required for MailServ). This error has been logged,\n",
              "      and if I get enough of them perhaps I will modify\n",
              "      MailServ to support older browsers.\n",
              "</OL>\n",
             );
    }

    if ($command eq "send")
    {
        &processSend();
        return;
    }

    $command_function = "config::process_$command";
    if (defined &$command_function)
    {
        @new_commands = &$command_function();
    }
    else
    {
        &error("Error processing command: $@");
    }

    # If the command set the subject, override it here
    $::subject = $config::subject if $config::subject;

    push(@::commands, @new_commands);

    # Now send the command or display the list again
    if ($::in{"multi"} eq "0")
    {
        &processSend();
    }
    else
    {
        &formList();
    }
}


sub processSend
#
# Sends the commands.
# If all needed values are there, mails the commands
#
{
    my($msg, $msg_disp, @headers, @headers_disp, $status);

    # Check for missing/invalid input
    &error("You must select one or more commands before you send mail.")
        unless @::commands;

    &error("The <em>from</em> address (<kbd>$::in{from}</kbd>) ",
           "is not valid: $::validAddressError<P>",
           "You must specify your email address ",
           "before you send mail.")
        unless &validAddress($::in_tainted{"from"});

    &error("The <em>to</em> address (<kbd>$::in{to}</kbd>) is not valid: ",
           $::validAddressError, "<P>",
           "You must specify the list request address before you ",
           "send mail (for example, &quot;majordomo\@stooge.com&quot;).")
        unless &validAddress($::in_tainted{"to"});

    if ($::mailer_accepts_f)
    {
        # Make sure the errors address does not contain
        # illegal shell characters (to guard against security compromise)
        if (&safeForShell($::errors) &&
            &validAddress($::errors))
        {
            $::mailer .= " -f '$::errors'";
        }
        else
        {
            if ($::validAddressError)
            {
                &error(sprintf(qq{Errors address "<STRONG>%s</STRONG>"},
                               &untaint($::errors)),
                       "is invalid: $::validAddressError");
            }
            else
            {
                &error(sprintf(qq{Errors address "<STRONG>%s</STRONG>"},
                               &untaint($::errors)),
                       "contains illegal shell characters.");
            }
        }
    }

    #--------------------------------------------------
    # Make the mail headers.
    # @headers_disp is the list that will be shown to the users,
    # @headers contains additional headers for the mailed message
    #
    @headers_disp =
      (
         "To: $::in_tainted{to}",
         "From: $::in_tainted{from}",
         "Subject: $::subject",
      );
    push(@headers_disp, "CC: $::in_tainted{from}") if $::in{"cc"};
    @headers =
        (
         @headers_disp,
         "X-Comments: this request sent via the $::progname WWW form",
         "X-Www-Server-Name: $ENV{SERVER_NAME}",
         "X-Www-Remote-Host: $ENV{REMOTE_HOST}",
         "X-Www-Remote-Addr: $ENV{REMOTE_ADDR}",
         "X-Mailer: $::mailer",
         );

    push(@headers, "X-URL: $::in_tainted{url}") if $::in_tainted{"url"};

    #--------------------------------------------------
    # Create the message
    #
    $msg =      join("\n", @headers)      . "\n\n";
    $msg_disp = join("\n", @headers_disp) . "\n\n";

    unless ($config::noBody)
    {
        foreach (@::commands)
        {
            $msg .=      &unhidePassword("$_\n");
            $msg_disp .= &obscurePassword($_, "delete") . "\n";
        }
    }

    #--------------------------------------------------
    # Send the message
    #
    if ($::in{"demo"})
    {
        print
          "<h2>Demo Complete</h2>\n",
          "Use your browser's <em>Back</em> function to return ",
          "to the form.\n",
          "<P>Here is the message that would have been sent:\n";
    }
    else
    {
        open(MAILER, "| $::mailer")
          || &error("Cannot fork mailer process.");

        print MAILER $msg;

        close(MAILER);

        &error("Mailer '$::mailer' returned error status '$status'")
          if ($status = ($? >> 8));

        &writeLog();

        print
          "<h2>Your commands have been sent!</h2>\n",
          "Check your e-mail (<em>$::in{from}</em>) to get the results ",
          "of your commands.  It might take several minutes ",
          "(or longer) before you receive the results.";

        print
          "<P>You should also receive a copy of the message " .
            "that was sent to the mailing list server."
              if $::in{"cc"};


        print "<P>The following message was sent to the list request address:\n";
    }

    delete $::in{"commands"}, $::in_tainted{"commands"};
    undef @::commands;

    print
      $::template{"form start"},
      "<CENTER>\n",
      "<TEXTAREA NAME=msgText COLS=60 ROWS=6>",
      &untaint($msg_disp),
      "</TEXTAREA>\n",
      "</CENTER>\n",
      "<HR>\n",
      &retainState(),
      $::template{"form footer"};
}


sub commandInput
#
# From the main "select" screen, checks to see
# if the user clicked one of the command buttons.
# Returns the name of the selected command, or "send"
# if they clicked the "send" button.
#
{
    local($_);

    if ($::in{"cmd-out"})
    {
        return $::in{"cmd-out"};
    }
    else
    {
        return "send" if $::in{"send"};

        foreach (@config::commands)
        {
            next unless $config::description{$_};
            return $_ if $::in{"cmd_$_"};
        }
    }
}


sub writeLog
#
# Makes an entry in the MailServ log
#
{
    my($date,$entry);

    if ($::logfile &&
        open(LOGFILE, ">>$::logfile"))
    {
        $entry  = "\n";

        if (@_)
        {
            $entry = "@_\n";
        }

        chop($date = `date`);
        $entry .= "DATE\t= $date\n";
        $entry .= "FROM\t= $::in_tainted{from}\n" if $::in{"from"};
        $entry .= "TO\t= $::in_tainted{to}\n" if $::in{"to"};
        $entry .= "LIST\t= $::in_tainted{list}\n" if $::in{"list"};
        $entry .= "REFERER\t= $::in_tainted{url}\n" if $::in{"url"};
        $entry .= "REMOTE_HOST\t= $ENV{REMOTE_HOST}\n" if $ENV{"REMOTE_HOST"};
        $entry .= ("CMDS\t= " .
                   &obscurePassword( join("\\n", @::commands), "remove") .
                   "\n") if @::commands;

        print LOGFILE "$entry\n";
        close LOGFILE;
    }
}


sub splitMultiple
#
# Uses "\0" to separate multiple selects.
#
# Example:
# @array = &splitMultiple($string)
#
{
    my(
          $line,
          ) = @_;

    split(/\\0/, $line);
}



sub debug
#
# Returns a string containing the form input and environment,
# for debugging purposes.
#
{
    my($key, $out, $output);
    local($*) = 1;

    $output .= ("\n" .
                "<!-- Debug information:\n" .
                "  Form input:\n");

    foreach $key (sort keys(%::in))
    {
        ($out = $::in{$key}) =~ s/\n/ /g;
        $out = &untaint($out);
        
        $output .=  "\t$key = '$out'\n";
    }

    $output .= "  Process environment:\n";

    foreach $key (sort keys(%ENV))
    {
        ($out = $ENV{$key}) =~ s/\n/ /g;
        $out = &untaint($out);
        $output .=  "\t$key = '$out'\n";
    }
    
    $output .= "  -->\n\n";
    
    $output;
}


sub validAddress
#
# Returns 0 if the email address fails the test, otherwise
# returns 1 and sets $::validAddressError.
# USAGE: &validAddress($address) || die "bad address: $::validAddressError";
#
# Thanks to Aaron Marco <aaron@onr.com> for some of the code,
# originally taken from Matt's Script Archive mailing list.
#
{
    my($address) = @_;
    my($valid) = 1;

    $::validAddressError = "";

    if (!$address)
    {
        $valid = 0;
        $::validAddressError = "Address is missing.";
    }
    elsif ($address =~ /[,|\/\\]/)
    {
        $valid = 0;
        $::validAddressError = "Address contains invalid character '$&'.";
    }
    elsif ($address =~ /@.*@/)
    {
        $valid = 0;
        $::validAddressError = "Address has more than one '\@' character.";
    }
    elsif ($address =~ /\.\./)
    {
        $valid = 0;
        $::validAddressError = "Address contains adjacent '.' characters.";
    }
    elsif ($address =~ /\.$/)
    {
        $valid = 0;
        $::validAddressError = "Address ends with a '.' character.";
    }
    elsif (($address !~ /^[\w\-\.]+[\%\+]?[\w\-\.]*\@[0-9a-zA-Z\-]+\.[0-9a-zA-Z\-\.]+$/))
    {
        $valid = 0;
        $::validAddressError = "Address has invalid format.";
    }

    $valid;
}


sub safeForShell
#
# Returns 0 if the shell command fails the test, 1 otherwise.
#
{
    local($_) = @_;
    local($*) = 1;

    return 0
        if m/[;<>\*\|`&\$!#\(\)\[\]\{\}:'"\n\s]/;
    1;
}

sub config::hidePassword
#
# This function attempts to hide a password by placing
# special delimeters around it that will be removed later on.
# It is meant for use in the config files; thus, it is
# placed in the config package.
#
# Example (within a config file):
# $command = "approve $list " . hidePassword($pass) . " $address";
#
{
    $::password{"begin"} . "@_" . $::password{"end"};
}

sub unhidePassword
#
# This function removes all of the hidePassword markers from a
# string.
#
# Example:
# $command = &unhidePassword($command);
#
{
    my($command) = @_;
    $command =~ s/$::password{"begin"}//g;
    $command =~ s/$::password{"end"}//g;
    $command;
}

sub obscurePassword
#
# This function takes a string that contains hidden
# passwords and replaces the marked passwords with
# something that you can display on the screen without
# revealing the password.  The actual password still appears
# in the HTML source, but it is commented out.
#
# If you specify the optional DELETE argument, the
# entire password will be removed, but this has the
# (unlikely) possibility of removing too much of the command.
# This option is used when logging the command, so
# other people using MailServ will not reveal their
# passwords to me.
#
# Example:
# print &obscurePassword($command), "\n";
# printf(LOG "PASS=%s\n", &obscurePassword($command, "delete"));
#
{
    local($_) = shift;
    my($delete) = @_;
    if ($delete)
    {
        # This has the potential to remove too much,
        # but better be safe than sorry.
        s/$::password{"begin"}\S*$::password{"end"}/$::password{"placeholder"}/g;
    }
    else
    {
        s/$::password{"begin"}/$::password{"placeholder"}<!--/g;
        s/$::password{"end"}/-->/g;
    }
    $_;
}

sub untaint
#
# Removes the special HTML characters from a string,
# so you can safely display it output HTML
#
{
    my($string) = @_;

    $string =~ s/&/&amp;/g;
    $string =~ s/</&lt;/g;
    $string =~ s/>/&gt;/g;
    $string =~ s/\"/&quot;/g;

    $string;
}

sub setInput
#
# Change the CGI input, plus the untainted CGI input
# Used by the config files
#
{
    my($name,$value) = @_;
    $::in_tainted{$name} = $value;
    $::in{$name} = &untaint($value);
    $value; # return the value
}

#--------------------------------------------------
# Netscape Cookie Subroutines
#
# The Netscape browser can remember simple values for future use.
# The value is stored in a variable called a "cookie".
# I use a cookie to remember the from address, so
# if they use MailServ again, they will not have to type it in.

sub set_cookie
#
# Returns a Netscape Set-Cookie header.
# Example:
# print "Content-type: text/html\n", &set_cookie("cookiename", "value"), "\n";
#
{
    my($name, $value) = @_;

    $name =~ s/;=//g;
    $value =~ s/;=//g;

    "Set-Cookie: $name=$value; path=/; expires=Fri, 31-Dec-99 00:00:00 GMT\n";
}

sub get_cookie
#
# Returns the value of a cookie sent by the Netscape browser.
# Returns the undefined value if a cookie was not received.
#
{
    my($name) = @_;
    my(@cookies,$name_value);

    @cookies = split(/[\s;]/, $ENV{"HTTP_COOKIE"});

    foreach $name_value (@cookies)
    {
        return $1 if $name_value =~ /^$name=(.*)/;
    }
    undef;
}

sub fixVersion
#
# Fix the RCS version for display to the screen
#
{
    my($ver) = "@_";

    while ($ver =~ s/\$\w+: ([^\$]*) \$/\1/g) { }
    while ($ver =~ s/,v//g) { }
    while ($ver =~ s/_/./g) { }
    $ver = "($ver)" if ($ver);
    $ver;
}

sub error
#
# Displays an error message and then exits.
# The first blank line is important to end the MIME headers.
#
{
    print <<EOT;

<H1 ALIGN=center>Error</H1>
<HR>
<FONT SIZE="+1">@_</FONT>
<P>
Use your browser's <EM>Back</EM> function to return to previous page.
$::template{"signature"}
EOT
    exit 1;
}


sub cgiRequire
#
# Require the file and exit if an error occurs
#
{
    my($file) = @_;

    eval(qq/require "$file"/)
      || &error("<B>$@</B><P>\n", # eval error
                "Current directory is <B>", `pwd`, "</B><P>\n",
                "Include path is:\n",
                "<PRE>" . join("\n", @INC) . "</PRE>\n");
}

__END__
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., 675 Mass Ave, Cambridge, MA 02139, USA.
