#!/usr/local/bin/perl5 -w
#
# majordomo2
#
# This is the completion routine for signing up for a majordomo list.
# Check the variables for sanity, and then send e-mail to sign up for
# a list.
#
# Written by Dave Regan
# 24 June 1996
# This program is in the Public Domain.
# Do what you want with it.
#
# Packages which deal with the same sort of topic:
# http://iquest.com/~fitz/www/mailserv/
# http://hellfire.hare.net.au/cgi-bin/MailServ/majordomo
# http://www.vv.com.au/cgi-bin/vv/mailserv/majordomo-admin
#
###
### Configuration
###
$DefaultHost = "peak.org";
$Mail = "/usr/lib/sendmail";
$LogFile = "/info/var/log/httpd/majordomo";
$HotList = "/info/peak_info/mlists/hotlist";
###
### Main program
###
# CheckSanePost();
$Vars{'bgcolor'} = "#FFFFFF";
$Vars{'link'} = "";
ParseFormVariables();
ParseQueryParameters();
HTMLhead("Account Validation");
print "\n";
$| = 1;
# printenv();
# printvars();
ReadHotList();
if (CheckData() == 0)
{
print "Please use the back button of your browser and correct the form.\n";
print "Once the data is corrected, resubmit the data.
\n";
}
elsif (CheckHotList())
{
print "This program has been disabled from your site. Sorry.\n";
LogAccess(0);
}
else
{
print "Your request has been sent. Expect to see results in your e-mail soon.\n";
if ($Vars{'link'} ne "")
{
print "Please continue.\n";
}
LogAccess(1);
SendMail();
}
HTMLterm();
exit 0;
###
### CheckData
###
### See if the data looks reasonable.
###
sub CheckData
{
local($retval);
$retval = 1;
# Make sure that the values exist
$Vars{'subscribe'} = "" if (!defined($Vars{'subscribe'}));
$Vars{'unsubscribe'} = "" if (!defined($Vars{'unsubscribe'}));
$Vars{'help'} = "" if (!defined($Vars{'help'}));
$Vars{'info'} = "" if (!defined($Vars{'info'}));
$Vars{'index'} = "" if (!defined($Vars{'index'}));
$Vars{'which'} = "" if (!defined($Vars{'which'}));
$Vars{'who'} = "" if (!defined($Vars{'who'}));
$Vars{'lists'} = "" if (!defined($Vars{'lists'}));
$Vars{'get'} = "" if (!defined($Vars{'get'}));
# We need an e-mail address to do anything
if ($Vars{'email'} eq "")
{
print "You must specify a valid e-mail address to do much of anything ";
print "with majordomo.
\n";
$retval = 0;
}
$Vars{'email'} = "$Vars{'email'}\@$DefaultHost" if ($Vars{'email'} !~ /\@/);
# # subscribe and unsubscribe really want a real name
# if ( ($Vars{'subscribe'} ne "" || $Vars{'unsubscribe'} ne "") && $Vars{'name'} eq "")
# {
# print "Subscriptions and unsubscriptions require your name.
\n";
# $retval = 0;
# }
# For some of the operations, a mailing list and host must be specified
if ( ($Vars{'mlist'} eq "" || $Vars{'host'} eq "") &&
($Vars{'subscribe'} ne "" ||
$Vars{'unsubscribe'} ne "" ||
$Vars{'info'} ne "" ||
$Vars{'index'} ne "" ||
$Vars{'who'} ne "" ||
$Vars{'get'} ne ""))
{
print "The options you have selected require that you specify a mailing list name\n";
print "as well as a host name.
\n";
$retval = 0;
}
# Cannot both subscribe and unsubscribe
if ($Vars{'subscribe'} ne "" && $Vars{'unsubscribe'} ne "")
{
print "Cannot subscribe and unsubscribe at the same time.
\n";
$retval = 0;
}
# Cannot specify "get" unless there is a filename
if ($Vars{'get'} ne "" && $Vars{'fname'} eq "")
{
print "Please specify a filename when using the \"GET\" option.
\n";
$retval = 0;
}
return $retval;
}
###
### CheckHotList
###
### See if either the REMOTE_HOST or REMOTE_ADDR match any
### of the hot list patterns.
###
sub CheckHotList
{
my($pat);
for $pat (@HotPattern)
{
return 1 if ($ENV{'REMOTE_HOST'} =~ /$pat/);
return 1 if ($ENV{'REMOTE_ADDR'} =~ /$pat/);
}
return 0;
}
####
#### CheckSanePost
####
#### See that this is a legitimate POST request. Die if not.
#### This assumes that the initial Content-type message has *not*
#### been sent.
####
#sub CheckSanePost
# {
# ###
# ### Ensure that the form of the request looks valid.
# ###
# if ($ENV{'REQUEST_METHOD'} ne "POST")
# {
# HTMLhead("Bad method");
# print "This script should be referenced with a METHOD of POST.\n";
# print "If you don't understand this, see this:\n";
# print "forms overview.\n";
# HTMLterm();
# exit 0;
# }
#
# if ($ENV{'CONTENT_TYPE'} ne "application/x-www-form-urlencoded")
# {
# HTMLhead("Bad encoding");
# print "This script can only be used to decode form results.\n";
# HTMLterm();
# exit 1;
# }
# }
###
### HTMLhead
###
### Put out a HTML header
###
sub HTMLhead
{
local($title) = @_;
print "Content-type: text/html\n\n";
print "
$title\n";
}
###
### HTMLterm
###
### Put out the end of an HTML body.
###
sub HTMLterm
{
print "\n";
}
###
### LogAccess
###
### Write some information out into a log file.
###
sub LogAccess
{
my($honor) = @_;
my($email, $host, $key, $mlist);
$email = $Vars{'email'};
$host = $Vars{'host'};
$host =~ s/[^-_.A-Za-z0-9]//g; # Restrict the host name.
# It may be necessary to expand this to include
# other characters. Do so if needed.
$mlist = $Vars{'mlist'};
if (!open(LOG, ">>$LogFile"))
{
# print STDERR "Cannot open $LogFile\n";
return;
}
print LOG scalar localtime;
if ($honor == 0) { $honor = " NOT"; }
else { $honor = ""; }
print LOG "\nRequest$honor honored\n";
print LOG "From: $email\n";
print LOG "To: majordomo\@$host\n";
print LOG "\n";
print LOG "subscribe $mlist $email\n" if ($Vars{'subscribe'} ne "");
print LOG "unsubscribe $mlist $email\n" if ($Vars{'unsubscribe'} ne "");
print LOG "help\n" if ($Vars{'help'} ne "");
print LOG "info $mlist\n" if ($Vars{'info'} ne "");
print LOG "index $mlist\n" if ($Vars{'index'} ne "");
print LOG "which $email\n" if ($Vars{'which'} ne "");
print LOG "who $mlist\n" if ($Vars{'who'} ne "");
print LOG "lists\n" if ($Vars{'lists'} ne "");
print LOG "get $mlist $Vars{'fname'}\n" if ($Vars{'get'} ne "");
print LOG "\nVariables passed into majordomo2\n";
for $key (sort(keys %Vars))
{
printf LOG " %-20.20s %s\n", $key, $Vars{$key};
}
print LOG "Environment variables\n";
for $key (sort(keys %ENV))
{
next if ($key =~ /^SERVER_|PATH|SCRIPT_|CONTENT_|DOCUMENT_ROOT|GATEWAY_INTERFACE/);
next if ($key =~ /^HTTP_ACCEPT|HTTP_CONNECTION|HTTP_HOST/);
printf LOG " %-20.20s %s\n", $key, $ENV{$key};
}
print LOG "\n\n";
close LOG;
}
###
### ParseInfo
###
### The work routines for parsing data.
###
sub ParseInfo
{
my($data) = @_;
my($item, $name, @table, $value);
$data =~ s/\&*\s*$//; # Remove trailing garbage
@table = split(/&/, $data); # Variables split at "&"
for $item (@table)
{
$item = unquote($item);
($name = $item) =~ s/\n//mg;
$name =~ s/=.*//m;
($value = $item) =~ s/^.*?=//;
$Vars{$name} = $value;
}
}
###
### ParseQueryParameters
###
### Read the query string and bust it up just as if it came
### from a form.
###
sub ParseQueryParameters
{
ParseInfo($ENV{'QUERY_STRING'});
}
###
### ParseFormVariables
###
### The variables from a CGI FORM come in on standard input.
### Read this string, and break it up into the Vars associative
### array.
###
sub ParseFormVariables
{
my($data, $item, $name, @tbl, $val);
$data = ;
# print STDERR "The raw data is $data
\n";
$data =~ s/query..=//g;
$data =~ s/&*\s*$//;
@tbl = split(/&/, $data); # Vars separated by &
for $item (@tbl)
{
# Process the variables. Be careful to avoid removing needed characters.
chomp($item = unquote($item));
($name, $val) = split(/=/, $item, 2);
$Vars{$name} = $val;
}
}
###
### printvars
###
### Print the contents of the Vars variable.
###
sub printvars
{
local($key);
print "Variables:
\n";
for $key (sort(keys(%Vars)))
{
print "$key = $Vars{$key}
\n";
}
}
###
### printenv
###
### Display the environment.
### This assumes that we can write on stdout. This may not
### be true if we haven't written the header line yet.
###
sub printenv
{
local(@env, $var);
@env = `printenv`;
for $var (@env)
{
print "$var
\n";
}
}
###
### ReadHotList
###
### Read in a list of Perl regular expressions to compare against the address.
###
sub ReadHotList
{
@HotPattern = ();
if (open(HOT, "<$HotList"))
{
while ()
{
chomp;
s/\s*#.*//;
next if (/^\s*$/);
s/^\s*//;
push(@HotPattern, $_);
}
close HOT;
}
}
###
### SendMail
###
### Send mail to the majordomo server.
###
### The mail needs to appear as if it is from the specified user.
### This is not as needed for the subscribe/unsubscribe, but is
### absolutely required for most commands to get information back
### to the user.
###
### The host is can be specified by the user. Make sure that it doesn't
### have any shell metacharacters.
###
sub SendMail
{
local($email, $host, $mlist);
$email = $Vars{'email'};
$host = $Vars{'host'};
$host =~ s/[^-_.A-Za-z0-9]//g; # Restrict the host name.
# It may be necessary to expand this to include
# other characters. Do so if needed.
$mlist = $Vars{'mlist'};
if (open(MAIL, "|$Mail majordomo\@$host") == 0)
{
print "Cannot start mailer\n";
return;
}
print MAIL "From: $email\n";
print MAIL "To: majordomo\@$host\n";
print MAIL "\n";
print MAIL "subscribe $mlist $email\n" if ($Vars{'subscribe'} ne "");
print MAIL "unsubscribe $mlist $email\n" if ($Vars{'unsubscribe'} ne "");
print MAIL "help\n" if ($Vars{'help'} ne "");
print MAIL "info $mlist\n" if ($Vars{'info'} ne "");
print MAIL "index $mlist\n" if ($Vars{'index'} ne "");
print MAIL "which $email\n" if ($Vars{'which'} ne "");
print MAIL "who $mlist\n" if ($Vars{'who'} ne "");
print MAIL "lists\n" if ($Vars{'lists'} ne "");
print MAIL "get $mlist $Vars{'fname'}\n" if ($Vars{'get'} ne "");
print MAIL ".\n";
close MAIL;
}
###
### unquote
###
### Unescape a CGI form variable.
###
sub unquote
{
my($raw) = @_;
my($code, @pieces, $piece);
$raw =~ s/\+/ /mg;
@pieces = split(/%/, $raw);
for ($piece = 1; $piece <= $#pieces; $piece++)
{
$pieces[$piece] =~ s/^%//;
$code = substr($pieces[$piece], 0, 2);
$code = hex($code);
$pieces[$piece] = sprintf("%c%s", $code, substr($pieces[$piece], 2));
}
return join("", @pieces);
}