1952 lines
61 KiB
Perl
1952 lines
61 KiB
Perl
#!/bin/perl
|
|
# $Modified: Thu Jan 13 18:29:15 2000 by cwilson $
|
|
|
|
# majordomo: a person who speaks, makes arrangements, or takes charge
|
|
# for another.
|
|
#
|
|
# Copyright 1992, D. Brent Chapman. See the Majordomo license agreement for
|
|
# usage rights.
|
|
#
|
|
# $Source: /sources/cvsrepos/majordomo/majordomo,v $
|
|
# $Revision: 1.95 $
|
|
# $Date: 2000/01/13 17:29:31 $
|
|
# $Author: cwilson $
|
|
# $State: Exp $
|
|
#
|
|
# $Locker: $
|
|
|
|
# set our path explicitly
|
|
# PATH it is set in the wrapper, so there is no need to set it here.
|
|
# until we run suid...
|
|
#$ENV{'PATH'} = "/bin:/usr/bin:/usr/ucb";
|
|
|
|
# Before doing anything else tell the world I am majordomo
|
|
# The mj_ prefix is reserved for tools that are part of majordomo proper.
|
|
$main'program_name = 'mj_majordomo';#';
|
|
|
|
# Read and execute the .cf file
|
|
$cf = $ENV{"MAJORDOMO_CF"} || "/etc/majordomo.cf";
|
|
|
|
while ($ARGV[0]) { # parse for config file or default list
|
|
if ($ARGV[0] =~ /^-C$/i) { # sendmail v8 clobbers case
|
|
$cf = $ARGV[1];
|
|
shift(@ARGV);
|
|
shift(@ARGV);
|
|
} elsif ($ARGV[0] eq "-l") {
|
|
$deflist = $ARGV[1];
|
|
shift(@ARGV);
|
|
shift(@ARGV);
|
|
} else {
|
|
die "Unknown argument $ARGV[0]\n";
|
|
}
|
|
}
|
|
if (! -r $cf) {
|
|
die("$cf not readable; stopped");
|
|
}
|
|
|
|
require "$cf";
|
|
|
|
# Go to the home directory specified by the .cf file
|
|
chdir("$homedir") || die "chdir to $homedir failed, $!\n";
|
|
|
|
# If standard error is not attached to a terminal, redirect it to a file.
|
|
if (! -t STDERR) {
|
|
close STDERR;
|
|
open (STDERR, ">>$TMPDIR/majordomo.debug");
|
|
}
|
|
|
|
print STDERR "$0: starting\n" if $DEBUG;
|
|
|
|
# All these should be in the standard PERL library
|
|
unshift(@INC, $homedir);
|
|
use POSIX qw(ctime); # To get MoY definitions for month abbrevs
|
|
require "majordomo_version.pl"; # What version of Majordomo is this?
|
|
require "majordomo.pl"; # all sorts of general-purpose Majordomo subs
|
|
require "shlock.pl"; # NNTP-style file locking
|
|
require "config_parse.pl"; # functions to parse the config files
|
|
|
|
print STDERR "$0: requires succeeded. Setting defaults.\n" if $DEBUG;
|
|
|
|
# Here's where the fun begins...
|
|
# check to see if the cf file is valid
|
|
die("\$listdir not defined. Is majordomo.cf being included correctly?")
|
|
if !defined($listdir);
|
|
|
|
# Define all of the mailer properties:
|
|
# It is possible that one or both of $sendmail_command and $bounce_mailer
|
|
# are not defined, so we provide reasonable defaults.
|
|
$sendmail_command = "/usr/lib/sendmail"
|
|
unless defined $sendmail_command;
|
|
$bounce_mailer = "$sendmail_command -f\$sender -t"
|
|
unless defined $bounce_mailer;
|
|
|
|
|
|
&set_abort_addr($whoami_owner);
|
|
&set_mail_from($whoami);
|
|
&set_mail_sender($whoami_owner);
|
|
&set_mailer($bounce_mailer);
|
|
|
|
$majordomo_dont_reply = $majordomo_dont_reply
|
|
|| '(mailer-daemon|uucp|listserv|majordomo)\@';
|
|
|
|
# where do we look for files, by default?
|
|
if (!defined($filedir)) {
|
|
$filedir = $listdir;
|
|
}
|
|
if (!defined($filedir_suffix)) {
|
|
$filedir_suffix = ".archive";
|
|
}
|
|
|
|
# what command do we use to generate an index, by default?
|
|
if (!defined($index_command)) {
|
|
$index_command = "/bin/ls -lRL";
|
|
}
|
|
|
|
# where are we for FTP, by default? (note: only set this if $ftpmail is set)
|
|
if (defined($ftpmail_address)) {
|
|
if (!defined($ftpmail_location)) {
|
|
$ftpmail_location = $whereami;
|
|
}
|
|
}
|
|
|
|
print STDERR "$0: done with defaults, parsing mail header.\n" if $DEBUG;
|
|
|
|
# Parse the mail header of the message, so we can figure out who to reply to
|
|
&ParseMailHeader(STDIN, *hdrs);
|
|
|
|
# Now we try to figure out who to send the replies to.
|
|
# $reply_to also becomes the default target for subscribe/unsubscribe
|
|
$reply_to = &RetMailAddr(*hdrs);
|
|
|
|
print STDERR "$0: setting log file.\n" if $DEBUG;
|
|
|
|
# Set up the log file
|
|
&set_log($log, $whereami, "majordomo", $reply_to);
|
|
|
|
# if somebody has set $reply_to to be our own input address, there's a problem.
|
|
if (&addr_match($reply_to, $whoami)) {
|
|
&abort( "$whoami punting to avoid mail loop.\n");
|
|
exit 0;
|
|
}
|
|
|
|
if (! &valid_addr($reply_to)) {
|
|
&abort( "$whoami: $reply_to is not a valid return address.\n");
|
|
exit 2;
|
|
}
|
|
|
|
# robots should not reply to other robots...
|
|
if ($reply_to =~ m/$majordomo_dont_reply/i) {
|
|
&abort( "$whoami: not replying to $1 to avoid mail loop.\n");
|
|
exit 0;
|
|
}
|
|
|
|
if ($return_subject && defined $hdrs{'subject'}) {
|
|
$sub_addin = ": " . substr($hdrs{'subject'}, 0, 40);
|
|
} else {
|
|
$sub_addin = '';
|
|
}
|
|
|
|
print STDERR "$0: some quick sanity checks on permissions.\n" if $DEBUG;
|
|
|
|
# do some sanity checking on permissions
|
|
# This bails out via abort if needed.
|
|
#
|
|
&check_permissions;
|
|
|
|
print STDERR "$0: opening sendmail process.\n" if $DEBUG;
|
|
|
|
# Open the sendmail process to send the results back to the requestor
|
|
&sendmail(REPLY, $reply_to, "Majordomo results$sub_addin");
|
|
|
|
select((select(REPLY), $| = 1)[0]);
|
|
|
|
print STDERR "$0: processing commands in message body.\n" if $DEBUG;
|
|
|
|
# Process the rest of the message as commands
|
|
while (<>) {
|
|
$approved = 0; # all requests start as un-approved
|
|
$quietnonmember = 0; # show non-member on unsubscribe
|
|
while ( /\\\s*$/ ) { # if the last non-whitespace
|
|
&chop_nl($_); # character is '\', chop the nl
|
|
s/\\\s*$/ /; # replace \ with space char
|
|
$_ .= scalar(<>); # append the next line
|
|
}
|
|
print REPLY ">>>> $_"; # echo the line we are processing
|
|
$_ = &chop_nl($_); # strip any trailing newline
|
|
s/^\s*#.*//; # strip comments
|
|
s/^\s+//; # strip leading whitespace
|
|
s/\s+$//; # strip trailing whitespace
|
|
s/\\ /\001/g; # protected escaped whitepace
|
|
if (/^begin\s+\d+\s+\S+$/) { # bail on MSMail uuencode attachments
|
|
print REPLY "ATTACHMENT DETECTED; COMMAND PROCESSING TERMINATED.\n";
|
|
last;
|
|
}
|
|
|
|
@parts = split(" "); # split into component parts
|
|
grep(s/\001/ /, @parts); # replace protected whitespace with
|
|
# whitespace
|
|
$cmd = shift(@parts); # isolate the command
|
|
$cmd =~ tr/A-Z/a-z/; # downcase the command
|
|
if ($cmd eq "") { next; } # skip blank lines
|
|
# figure out what to do and do it
|
|
# the "do_*" routines implement specific Majordomo commands.
|
|
# they are all passed the same arguments: @parts.
|
|
$count++; # assume it's a valid command, so count it.
|
|
if ($cmd eq "end") { print REPLY "END OF COMMANDS\n"; last; }
|
|
elsif ($cmd =~ /^-/ &&
|
|
(!defined($hdrs{'content-type'}) ||
|
|
$hdrs{'content-type'} !~ /multipart/i))
|
|
{
|
|
# treat lines beginning with "-" as END only if this is NOT a MIME
|
|
# multipart msg. MIME messages should have "Content-Type:"
|
|
# headers, and multipart messages should have the string
|
|
# "multipart" somewhere in that header. If we just look for
|
|
# Content-Type: we trap messages with Content-Type: text/plain,
|
|
# which is pretty common these days.
|
|
print REPLY "END OF COMMANDS\n";
|
|
last;
|
|
}
|
|
elsif ($cmd eq "subscribe") { &do_subscribe(@parts); }
|
|
elsif ($cmd eq "unsubscribe") { &do_unsubscribe(@parts); }
|
|
elsif ($cmd eq "signoff") { &do_unsubscribe(@parts); }
|
|
elsif ($cmd eq "cancel") { &do_unsubscribe(@parts); }
|
|
elsif ($cmd eq "approve") { &do_approve(@parts); }
|
|
elsif ($cmd eq "passwd") { &do_passwd(@parts); }
|
|
elsif ($cmd eq "which") { &do_which(@parts); }
|
|
elsif ($cmd eq "who") { &do_who(@parts); }
|
|
elsif ($cmd eq "info") { &do_info(@parts); }
|
|
elsif ($cmd eq "newinfo") { &do_newinfo(@parts); }
|
|
elsif ($cmd eq "intro") { &do_intro(@parts); }
|
|
elsif ($cmd eq "newintro") { &do_newintro(@parts); }
|
|
elsif ($cmd eq "config") { &do_config(@parts); }
|
|
elsif ($cmd eq "newconfig") { &do_newconfig(@parts); }
|
|
elsif ($cmd eq "writeconfig") { &do_writeconfig(@parts); }
|
|
elsif ($cmd eq "mkdigest") { &do_mkdigest(@parts); }
|
|
elsif ($cmd eq "lists") { &do_lists(@parts); }
|
|
elsif ($cmd eq "help") { &do_help(@parts); }
|
|
elsif ($cmd eq "get") { &do_get(@parts); }
|
|
elsif ($cmd eq "index") { &do_index(@parts); }
|
|
elsif ($cmd eq "auth") { &do_auth(@parts); }
|
|
else {
|
|
&squawk("Command '$cmd' not recognized.");
|
|
$count--; # if we get to here, it wasn't really a command
|
|
}
|
|
}
|
|
|
|
# we've processed all the commands; let's clean up and go home
|
|
&done();
|
|
|
|
# Everything from here on down is subroutine definitions
|
|
|
|
sub do_subscribe {
|
|
# figure out what list we are trying to subscribe to
|
|
# and check to see if the list is valid
|
|
local($sm) = "subscribe";
|
|
local($list, $clean_list, @args) = &get_listname($sm, 1, @_);
|
|
|
|
# figure out who's trying to subscribe, and check that it's a valid address
|
|
local($subscriber) = join(" ", @args);
|
|
if ($subscriber eq "") {
|
|
$subscriber = $reply_to;
|
|
}
|
|
if (! &valid_addr($subscriber, $clean_list)) {
|
|
&squawk("$sm: invalid address '$subscriber'");
|
|
return 0;
|
|
}
|
|
|
|
local($FLAGIT);
|
|
if ($clean_list ne "") {
|
|
# The list is valid
|
|
# parse its config file if needed
|
|
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
local($sub_policy) = $config_opts{$clean_list,"subscribe_policy"};
|
|
|
|
# check to see if this is a list with a 'confirm' subscribe policy,
|
|
# and check the cookie if so.
|
|
#
|
|
if (! $approved
|
|
&& (($sub_policy =~ /confirm/)
|
|
&& (&gen_cookie($sm, $clean_list, $subscriber) ne $auth_info)))
|
|
{
|
|
# We want to send the stripped address in the confirmation
|
|
# message if strip = yes.
|
|
if (&cf_ck_bool($clean_list,"strip")) {
|
|
$subscriber = (&ParseAddrs($subscriber))[0];
|
|
}
|
|
&send_confirm("subscribe", $clean_list, $subscriber);
|
|
return 0;
|
|
}
|
|
|
|
|
|
# Check to see if this request is approved, or if the list is an
|
|
# auto-approve list, or if the list is an open list and the
|
|
# subscriber is the person making the request
|
|
if ($approved
|
|
|| ($sub_policy =~ /auto/i &&
|
|
# I don't think this check is doing the right thing. Chan 95/10/19
|
|
&check_and_request($sm, $clean_list, $subscriber, "check_only"))
|
|
|| (($sub_policy !~ /closed/ )
|
|
&& &addr_match($reply_to, $subscriber,
|
|
(&cf_ck_bool($clean_list,"mungedomain") ? 2 : undef)))
|
|
) {
|
|
# Either the request is approved, or the list is open and the
|
|
# subscriber is the requester, so check to see if they're
|
|
# already on the list, and if not, add them to the list.
|
|
# Lock and open the list first, even though &is_list_member()
|
|
# will reopen it read-only, to prevent a race condition
|
|
&lopen(LIST, ">>", "$listdir/$clean_list")
|
|
|| &abort("Can't append to $listdir/$clean_list: $!");
|
|
if (&is_list_member($subscriber, $listdir, $clean_list)) {
|
|
print REPLY "**** Address already subscribed to $clean_list\n";
|
|
&log("DUPLICATE subscribe $clean_list $subscriber");
|
|
} else {
|
|
if ( &cf_ck_bool($clean_list,"strip") ) {
|
|
print LIST &valid_addr($subscriber), "\n" ||
|
|
&abort("Error writing $listdir/$clean_list: $!");
|
|
} else {
|
|
print LIST $subscriber, "\n" ||
|
|
&abort("Error writing $listdir/$clean_list: $!");
|
|
}
|
|
if (defined $deflist) {
|
|
print REPLY "Succeeded (to list $deflist).\n";
|
|
}
|
|
else {
|
|
print REPLY "Succeeded.\n";
|
|
}
|
|
&log("subscribe $clean_list $subscriber");
|
|
# Send the new subscriber a welcoming message, and
|
|
# a notice of the new subscriber to the list owner
|
|
if ( &cf_ck_bool($clean_list,"strip") ) {
|
|
local($clean_sub) = &valid_addr($subscriber);
|
|
&welcome($clean_list, $clean_sub);
|
|
} else {
|
|
&welcome($clean_list, $subscriber);
|
|
}
|
|
}
|
|
&lclose(LIST) || &abort("Error closing $listdir/$clean_list: $!");
|
|
} else {
|
|
&check_and_request($sm, $clean_list, $subscriber);
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
}
|
|
|
|
sub do_unsubscribe_all {
|
|
local(@parts) = @_;
|
|
local($list);
|
|
|
|
opendir(RD_DIR, $listdir) || &abort("opendir failed $!");
|
|
@lists = grep(!/[^-\w]/, readdir(RD_DIR)); # skip non-list files (*.info, etc.)
|
|
closedir(RD_DIR);
|
|
|
|
$quietnonmember=1;
|
|
|
|
foreach $list (sort @lists) {
|
|
print REPLY "Doing 'unsubscribe $list ", join(' ', @parts), "'.\n"
|
|
if $DEBUG;
|
|
&do_unsubscribe($list, @parts);
|
|
}
|
|
}
|
|
|
|
sub do_unsubscribe {
|
|
if ($_[0] =~ /^\*$/) {
|
|
shift;
|
|
&do_unsubscribe_all(@_);
|
|
return 0;
|
|
}
|
|
local($match_count) = 0;
|
|
local($match_length);
|
|
# figure out what list we are trying to unsubscribe from
|
|
# and check to see if the list is valid
|
|
local($sm) = "unsubscribe";
|
|
local($list, $clean_list, @args) = &get_listname($sm, 1, @_);
|
|
|
|
# figure out who's trying to unsubscribe, and check it's a valid address
|
|
local($subscriber) = join(" ", @args);
|
|
if ($subscriber eq "") {
|
|
$subscriber = $reply_to;
|
|
}
|
|
if (! &valid_addr($subscriber)) {
|
|
&squawk("$sm: invalid address '$subscriber'");
|
|
return 0;
|
|
}
|
|
|
|
print STDERR "do_unsubscribe: $subscriber from $clean_list\n" if $DEBUG;
|
|
|
|
|
|
if ($clean_list ne "") {
|
|
# The list is valid.
|
|
# get configuration info
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
local($unsub_policy) = $config_opts{$clean_list,"unsubscribe_policy"};
|
|
|
|
# Check to see if the subscriber really is subscribed to the list.
|
|
if (! &is_list_member($subscriber, $listdir, $clean_list)) {
|
|
unless ($quietnonmember) {
|
|
print REPLY <<"EOM";
|
|
**** unsubscribe: '$subscriber' is not a member of list '$list'.
|
|
**** contact "$list-approval\@$whereami" if you need help.
|
|
EOM
|
|
}
|
|
return 0;
|
|
}
|
|
|
|
print STDERR "do_unsubscribe: valid list, valid subscriber.\n"
|
|
if $DEBUG;
|
|
|
|
# check to see if this is a list with a 'confirm' unsubscribe policy,
|
|
# and check the cookie if so and the subscriber is not the person
|
|
# making the request.
|
|
#
|
|
if (! $approved
|
|
&& ! ((&addr_match($reply_to, $subscriber,
|
|
(&cf_ck_bool($clean_list,"mungedomain")
|
|
? 2 : undef))))
|
|
&& (($unsub_policy =~ /confirm/)
|
|
&& (&gen_cookie($sm, $clean_list, $subscriber) ne $auth_info)))
|
|
{
|
|
# We want to send the stripped address in the confirmation
|
|
# message if strip = yes.
|
|
if (&cf_ck_bool($clean_list,"strip")) {
|
|
$subscriber = (&ParseAddrs($subscriber))[0];
|
|
}
|
|
&send_confirm("unsubscribe", $clean_list, $subscriber);
|
|
return 0;
|
|
}
|
|
|
|
# Check to see if this request is approved, if the unsub policy is
|
|
# auto, or if the subscriber is the person making the request (even
|
|
# on a closed list, folks can unsubscribe themselves without the
|
|
# owner's approval).
|
|
if ($approved
|
|
|| ($unsub_policy =~ /auto/i &&
|
|
&check_and_request($sm, $clean_list, $subscriber, "check_only"))
|
|
|
|
|| ((&addr_match($reply_to, $subscriber,
|
|
(&cf_ck_bool($clean_list,"mungedomain") ? 2 : undef))))) {
|
|
|
|
# Either the request is approved, or the subscriber is the
|
|
# requester, so drop them from the list
|
|
&lopen(LIST, "", "$listdir/$clean_list") ||
|
|
&abort("Can't open $listdir/$clean_list: $!");
|
|
(local($mode, $uid, $gid) = (stat(LIST))[2,4,5]) ||
|
|
&abort("Can't stat listdir/$clean_list: $!");
|
|
open(NEW, ">$listdir/$clean_list.new") ||
|
|
&abort("Can't open $listdir/$clean_list.new: $!");
|
|
chmod($mode, "$listdir/$clean_list.new") ||
|
|
&abort("chmod($mode, \"$listdir/$clean_list.new\"): $!");
|
|
chown($uid, $gid, "$listdir/$clean_list.new") ||
|
|
&abort("chown($uid, $gid, \"$listdir/$clean_list.new\"): $!");
|
|
while (<LIST>) {
|
|
if (! &addr_match($subscriber, $_,
|
|
(&cf_ck_bool($clean_list,"mungedomain") ? 2 : undef))) {
|
|
print NEW $_ ||
|
|
&abort("Error writing $listdir/$clean_list.new: $!");
|
|
} else {
|
|
$match_count++;
|
|
$match_length = length;
|
|
if ($match_count != 1) {
|
|
&squawk("$sm: '$subscriber' matches multiple list members.");
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
close(NEW) || &abort("Error closing $listdir/$clean_list.new: $!");
|
|
if ($match_count == 1) {
|
|
if ((-s "$listdir/$clean_list.new") + $match_length !=
|
|
(-s "$listdir/$clean_list")) {
|
|
&abort("Unsubscribe failed: $listdir/$clean_list.new is wrong length!");
|
|
}
|
|
# we deleted exactly 1 name, so now we shuffle the files
|
|
link("$listdir/$clean_list", "$listdir/$clean_list.old") ||
|
|
&abort("link(\"$listdir/$clean_list\", \"$listdir/$clean_list.old\"): $!");
|
|
rename("$listdir/$clean_list.new", "$listdir/$clean_list") ||
|
|
&abort("rename(\"$listdir/$clean_list.new\", \"$listdir/$clean_list\"): $!");
|
|
unlink("$listdir/$clean_list.old");
|
|
if (defined $deflist) {
|
|
print REPLY "Succeeded (from list $deflist).\n";
|
|
}
|
|
elsif ($quietnonmember) {
|
|
print REPLY "Succeeded (from list $clean_list).\n";
|
|
}
|
|
else {
|
|
print REPLY "Succeeded.\n";
|
|
}
|
|
&log("unsubscribe $clean_list $subscriber");
|
|
if ( &cf_ck_bool($list,"announcements")) {
|
|
&sendmail(BYE, "$clean_list-approval\@$whereami",
|
|
"UNSUBSCRIBE $clean_list $subscriber");
|
|
print BYE "$subscriber has unsubscribed from $clean_list.\n";
|
|
print BYE "No action is required on your part.\n";
|
|
close(BYE);
|
|
}
|
|
}
|
|
elsif ($match_count == 0) {
|
|
print REPLY "**** No matches found for '$subscriber'\n";
|
|
}
|
|
else {
|
|
print REPLY "**** FAILED.\n";
|
|
}
|
|
unlink("$listdir/$clean_list.new");
|
|
&lclose(LIST);
|
|
} else {
|
|
print STDERR "do_unsubscribe: authorization failed, calling check_and_request.\n" if $DEBUG;
|
|
&check_and_request($sm, $clean_list, $subscriber);
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
}
|
|
|
|
sub do_auth {
|
|
# Check to see we've got all the arguments; the address is allowed to
|
|
# contain spaces, so since our argument list was split on spaces we
|
|
# have to join them back together.
|
|
local($auth_info, $cmd, $list, @sub) = @_;
|
|
if ( !length($auth_info)
|
|
|| ($cmd ne 'subscribe'
|
|
&& $cmd ne 'unsubscribe') # can only authorize [un]subscribes at the moment
|
|
) {
|
|
&squawk("auth: needs key");
|
|
return 0;
|
|
}
|
|
$sub = join(' ',@sub);
|
|
if ( $cmd eq "subscribe" ) {
|
|
&do_subscribe($list, $sub);
|
|
}
|
|
elsif ( $cmd eq "unsubscribe" ) {
|
|
&do_unsubscribe($list, $sub);
|
|
}
|
|
|
|
|
|
}
|
|
|
|
sub do_approve {
|
|
# Check to see we've got all the arguments
|
|
local($sm) = "approve";
|
|
local($passwd, $cmd);
|
|
($passwd = shift) || &squawk("$sm: needs passwd");
|
|
($cmd = shift) || &squawk("$sm: which command?");
|
|
$cmd =~ tr/A-Z/a-z/; # downcase the command
|
|
# Check to see if the list is valid or use default list.
|
|
# and check to see if we've got a valid list
|
|
local($list, $clean_list, @args) = &get_listname($sm, -1, @_);
|
|
|
|
if ($clean_list ne "") {
|
|
# get the config info for the command
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
# The list is valid; now check to see if the password is
|
|
if (&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
# The password is valid, so set "approved" and do the request
|
|
$approved = 1;
|
|
if ($cmd eq "subscribe") {
|
|
local($subscriber);
|
|
($subscriber = join(" ",@args)) || &squawk("$sm: who?");
|
|
&log("approve PASSWORD subscribe $clean_list $subscriber");
|
|
&do_subscribe($clean_list, $subscriber);
|
|
} elsif ($cmd eq "unsubscribe") {
|
|
local($subscriber);
|
|
($subscriber = join(" ",@args)) || &squawk("$sm: who?");
|
|
&log("approve PASSWORD unsubscribe $clean_list $subscriber");
|
|
&do_unsubscribe($clean_list, $subscriber);
|
|
} elsif ($cmd eq "get"
|
|
|| $cmd eq "index"
|
|
|| $cmd eq "info"
|
|
|| $cmd eq "intro"
|
|
|| $cmd eq "who"
|
|
|| $cmd eq "which") {
|
|
&log("approve PASSWORD $cmd $clean_list " . join(" ", @args));
|
|
$sub = "do_$cmd";
|
|
&$sub($clean_list, @args);
|
|
} else {
|
|
# you can only approve the above
|
|
&squawk("$sm: invalid command '$cmd'");
|
|
}
|
|
} else {
|
|
&squawk("$sm: invalid list or password.");
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
}
|
|
|
|
sub do_passwd {
|
|
# check to see that we've got all the arguments
|
|
# and check to see if we've got a valid list
|
|
local($sm) = "passwd";
|
|
local($list, $clean_list, $passwd, $new_passwd) = &get_listname($sm, 2, @_);
|
|
&squawk("$sm: need old password") unless $passwd;
|
|
&squawk("$sm: need new password") unless $new_passwd;
|
|
|
|
if ($clean_list eq "") {
|
|
&squawk("$sm: invalid list '$list'");
|
|
return;
|
|
}
|
|
# We've got a valid list; now see if the old password is valid
|
|
# get the config info for the command
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
if (&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
# The old password is correct, so make sure the new one isn't null
|
|
if ($new_passwd eq "") {
|
|
&squawk("$sm: null 'new_passwd'.");
|
|
return;
|
|
}
|
|
# The new password is valid, too, so write it.
|
|
local($mode, $uid, $gid) =
|
|
(stat("$listdir/$clean_list.passwd"))[2,4,5];
|
|
$mode = (0660) if !$mode;
|
|
if (&lopen(PASSWD, ">", "$listdir/$clean_list.passwd")) {
|
|
print PASSWD $new_passwd, "\n";
|
|
&lclose(PASSWD);
|
|
# set the file mode appropriately
|
|
chmod($mode, "$listdir/$clean_list.passwd");
|
|
chown($uid, $gid, "$listdir/$clean_list.passwd") if defined($uid);
|
|
print REPLY "Password changed.\n";
|
|
} else {
|
|
&abort("Can't open $listdir/$clean_list.passwd: $!");
|
|
}
|
|
&log("passwd $clean_list OLD NEW");
|
|
} else {
|
|
print REPLY "**** Sorry; old password incorrect.\n";
|
|
&log("FAILED passwd $clean_list OLD NEW");
|
|
}
|
|
}
|
|
|
|
sub do_which {
|
|
local($subscriber) = join(" ", @_) || &valid_addr($reply_to);
|
|
local($count, $per_list_hits) = 0;
|
|
# Tell the requestor which lists they are on by reading through all
|
|
# the lists, comparing their address to each address from each list
|
|
print REPLY "The string '$subscriber' appears in the following\n";
|
|
print REPLY "entries in lists served by $whoami:\n\n";
|
|
|
|
opendir(RD_DIR, $listdir) || &abort("opendir failed $!");
|
|
@lists = readdir(RD_DIR);
|
|
closedir(RD_DIR);
|
|
|
|
foreach (sort @lists) {
|
|
/[^-_0-9a-zA-Z]/ && next; # skip non-list files (*.info, etc.)
|
|
$list = $_;
|
|
|
|
# get configuration info
|
|
&get_config($listdir, $_) if !&cf_ck_bool($_, '', 1);
|
|
|
|
# access check
|
|
#
|
|
next if ! &access_check("which", $reply_to, $listdir, $list);
|
|
|
|
open(LIST, "$listdir/$list") ||
|
|
&abort("Can't open list $listdir/$list");
|
|
while (<LIST>) {
|
|
|
|
if (! $approved
|
|
&& $max_which_hits
|
|
&& $max_which_hits < $per_list_hits) {
|
|
print REPLY "Maximum number of hits ($max_which_hits) exceeded\n";
|
|
last;
|
|
}
|
|
|
|
$_ = &chop_nl($_);
|
|
if (&addr_match($_, $subscriber, 1)) {
|
|
if ($count == 0) {
|
|
printf REPLY "%-23s %s\n", "List", "Address";
|
|
printf REPLY "%-23s %s\n", "====", "=======";
|
|
}
|
|
printf REPLY "%-23s %s\n", $list, $_;
|
|
$count++;
|
|
$per_list_hits++;
|
|
}
|
|
}
|
|
close(LIST);
|
|
}
|
|
if ($count == 0) {
|
|
print REPLY "**** No matches found\n";
|
|
}
|
|
print REPLY "\n";
|
|
&log("which $subscriber");
|
|
return 1;
|
|
}
|
|
|
|
sub do_who {
|
|
# Make sure we've got the right arguments
|
|
# and check to see if we've got a valid list
|
|
local($sm) = "who";
|
|
local($list, $clean_list) = &get_listname($sm, 0, @_);
|
|
local($counter) = 0;
|
|
|
|
# Check to see that the list is valid
|
|
if ($clean_list ne "") {
|
|
# The list is valid, so now check make sure that it's not a private
|
|
# list, or if it is, that the requester is on the list.
|
|
# get configuration info
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
if ( !$approved
|
|
&& $config_opts{$clean_list, 'who_access'} =~ /closed/ ) {
|
|
print REPLY "**** Command disabled.\n";
|
|
return 0;
|
|
}
|
|
|
|
if ( !$approved
|
|
&& ! &access_check("who", $reply_to, $listdir, $clean_list)) {
|
|
print REPLY "**** List '$clean_list' is a private list.\n";
|
|
print REPLY "**** Only members of the list can do a 'who'.\n";
|
|
print REPLY "**** You [ $reply_to ] aren't a member of list '$clean_list'.\n";
|
|
return 0;
|
|
}
|
|
#open it up and tell who's on it
|
|
print REPLY "Members of list '$clean_list':\n\n";
|
|
if (&lopen(LIST, "", "$listdir/$clean_list")) {
|
|
while (<LIST>) {
|
|
print REPLY $_;
|
|
$counter++;
|
|
}
|
|
&lclose(LIST);
|
|
printf REPLY "\n%s subscriber%s\n\n", ($counter ? $counter : "No"),
|
|
($counter == 1 ? "" : "s");
|
|
&log("who $clean_list");
|
|
} else {
|
|
&abort("Can't open $listdir/$clean_list: $!");
|
|
}
|
|
} else {
|
|
print REPLY "**** who: no such list '$list'\n";
|
|
}
|
|
}
|
|
|
|
sub do_info {
|
|
# Make sure we've got the arguments we need
|
|
# and Check that the list is OK
|
|
local($sm) = "info";
|
|
local($list, $clean_list) = &get_listname($sm, 0, @_);
|
|
|
|
if ($clean_list ne "") {
|
|
# The list is OK, so give the info, or a message that none is available
|
|
# get configuration info
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
local($allow);
|
|
|
|
# check access
|
|
$allow = &access_check("info", $reply_to, $listdir, $clean_list);
|
|
|
|
if ((local($passwd) = shift) &&
|
|
&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
$allow = 1; # The password is valid, so show info
|
|
}
|
|
if ($allow &&
|
|
&lopen(INFO, "", "$listdir/$clean_list.info")) {
|
|
while (<INFO>) {
|
|
print REPLY $_;
|
|
}
|
|
print REPLY "\n[Last updated ", &chop_nl(&ctime((stat(INFO))[9])),
|
|
"]\n" if !&cf_ck_bool($clean_list,"date_info");
|
|
&lclose(INFO);
|
|
} else {
|
|
print REPLY "#### No info available for $clean_list.\n";
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
&log("info $clean_list");
|
|
}
|
|
|
|
sub do_newinfo {
|
|
# Check to make sure we've got the right arguments
|
|
# and Check that the list is valid
|
|
local($sm) = "newinfo";
|
|
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
|
|
&squawk("$sm: needs password") unless $passwd;
|
|
|
|
if ($clean_list ne "") {
|
|
&get_config($listdir, $clean_list) if !&cf_ck_bool($clean_list, '', 1);
|
|
# The list is valid, so check the password
|
|
if (&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
# The password is valid, so write the new info
|
|
local($mode, $uid, $gid) =
|
|
(stat("$listdir/$clean_list.info"))[2,4,5];
|
|
$mode = (0664) if !$mode;
|
|
if (&lopen(INFO, ">", "$listdir/$clean_list.info")) {
|
|
print INFO "[Last updated on: ", &chop_nl(&ctime(time())),
|
|
"]\n" if &cf_ck_bool($clean_list,"date_info");
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
print INFO $_, "\n";
|
|
}
|
|
&lclose(INFO);
|
|
if (-s "$listdir/$clean_list.info" > 0) {
|
|
chmod($mode, "$listdir/$clean_list.info");
|
|
chown($uid, $gid, "$listdir/$clean_list.info")
|
|
if defined($uid);
|
|
}
|
|
else {
|
|
unlink("$listdir/$clean_list.info");
|
|
}
|
|
|
|
print REPLY "New info for list $clean_list accepted.\n";
|
|
&log("newinfo $clean_list PASSWORD");
|
|
} else {
|
|
&abort("Can't write $listdir/$clean_list.info: $!");
|
|
}
|
|
} else {
|
|
&squawk("$sm: invalid password.");
|
|
&log("FAILED newinfo $clean_list PASSWORD");
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub do_intro {
|
|
# Make sure we've got the arguments we need
|
|
# and Check that the list is OK
|
|
local($sm) = "intro";
|
|
local($list, $clean_list) = &get_listname($sm, 0, @_);
|
|
|
|
if ($clean_list ne "") {
|
|
# The list is OK, so give the intro, or a message that none is available
|
|
# get configuration info
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
local($allow) = 0;
|
|
|
|
# check access
|
|
$allow = &access_check("intro", $reply_to, $listdir, $clean_list);
|
|
|
|
if ((local($passwd) = shift) &&
|
|
&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
$allow = 1; # The password is valid, so show info
|
|
}
|
|
if ($allow &&
|
|
&lopen(INFO, "", "$listdir/$clean_list.intro")) {
|
|
while (<INFO>) {
|
|
print REPLY $_;
|
|
}
|
|
print REPLY "\n[Last updated ", &chop_nl(&ctime((stat(INFO))[9])),
|
|
"]\n" if !&cf_ck_bool($clean_list,"date_intro");
|
|
&lclose(INFO);
|
|
} else {
|
|
print REPLY "#### No intro available for $clean_list.\n";
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
&log("intro $clean_list");
|
|
}
|
|
sub do_newintro {
|
|
# Check to make sure we've got the right arguments
|
|
# and Check that the list is valid
|
|
local($sm) = "newintro";
|
|
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
|
|
&squawk("$sm: needs password") unless $passwd;
|
|
|
|
if ($clean_list ne "") {
|
|
&get_config($listdir, $clean_list) if !&cf_ck_bool($clean_list, '', 1);
|
|
# The list is valid, so check the password
|
|
if (&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
# The password is valid, so write the new intro
|
|
if (&lopen(INFO, ">", "$listdir/$clean_list.intro")) {
|
|
print INFO "[Last updated on: ", &chop_nl(&ctime(time())),
|
|
"]\n" if &cf_ck_bool($clean_list,"date_intro");
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
print INFO $_, "\n";
|
|
}
|
|
&lclose(INFO);
|
|
if (-s "$listdir/$clean_list.intro" > 0) {
|
|
chmod(0664, "$listdir/$clean_list.intro");
|
|
}
|
|
else {
|
|
unlink("$listdir/$clean_list.intro");
|
|
}
|
|
print REPLY "New intro for list $clean_list accepted.\n";
|
|
&log("newintro $clean_list PASSWORD");
|
|
} else {
|
|
&abort("Can't write $listdir/$clean_list.intro: $!");
|
|
}
|
|
} else {
|
|
&squawk("$sm: invalid password.");
|
|
&log("FAILED newintro $clean_list PASSWORD");
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
sub do_config {
|
|
# Check to make sure we've got the right arguments
|
|
# and Check that the list is valid
|
|
local($sm) = "config";
|
|
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
|
|
&squawk("$sm: needs password") unless $passwd;
|
|
|
|
if ($clean_list ne "") {
|
|
# The list is valid, parse the config file
|
|
&set_lock("$listdir/$clean_list.config.LOCK") ||
|
|
&abort( "Can't get lock for $listdir/$clean_list.config");
|
|
&get_config($listdir, $clean_list, "locked")
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
#so check the password
|
|
if (&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
# The password is valid, so send the new config if it exists
|
|
|
|
if (open(LCONFIG, "$listdir/$clean_list.config")) {
|
|
while (<LCONFIG>) {
|
|
print REPLY $_;
|
|
}
|
|
print REPLY "\n#[Last updated ",
|
|
&chop_nl(&ctime((stat(LCONFIG))[9])), "]\n";
|
|
close(LCONFIG) ||
|
|
print REPLY "Error writing config for $clean_list: $!";
|
|
|
|
} else {
|
|
print REPLY "#### No config available for $clean_list.\n";
|
|
}
|
|
} else {
|
|
&squawk("$sm: invalid password.");
|
|
&log("FAILED config $clean_list PASSWORD");
|
|
}
|
|
&free_lock("$listdir/$clean_list.config.LOCK");
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
&log("config $clean_list");
|
|
}
|
|
|
|
sub do_newconfig {
|
|
# Check to make sure we've got the right arguments
|
|
# and Check that the list is valid
|
|
local($sm) = "newconfig";
|
|
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
|
|
&squawk("$sm: needs password") unless $passwd;
|
|
|
|
if ($clean_list ne "") {
|
|
# The list is valid, parse the config file
|
|
&set_lock("$listdir/$clean_list.config.LOCK") ||
|
|
&abort( "Can't get lock for $listdir/$clean_list.config");
|
|
&get_config($listdir, $clean_list, "locked")
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
# so check the password
|
|
if (&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
# The password is valid, so write the new config
|
|
# off to the side to validate it.
|
|
local($oldumask) = umask($config_umask);
|
|
if (open(NCONFIG, ">$listdir/$clean_list.new.config")) {
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
print NCONFIG $_, "\n";
|
|
}
|
|
close(NCONFIG) ||
|
|
&abort("Can't write $listdir/$clean_list.config: $!");
|
|
umask($oldumask);
|
|
|
|
if ( &get_config($listdir, "$clean_list.new", "locked")) {
|
|
unlink "$listdir/$clean_list.new.config";
|
|
&free_lock("$listdir/$clean_list.config.LOCK");
|
|
print REPLY "The new config file for $clean_list was NOT accepted because:\n";
|
|
print REPLY @config'errors;
|
|
&log("FAILED (syntax) newconfig $clean_list PASSWORD");
|
|
return (1);
|
|
}
|
|
|
|
$rename_fail = 0;
|
|
if ( !rename("$listdir/$clean_list.config",
|
|
"$listdir/$clean_list.old.config") ) {
|
|
print REPLY "rename current -> old failed $!";
|
|
$rename_fail = 1;
|
|
}
|
|
elsif ( !rename("$listdir/$clean_list.new.config",
|
|
"$listdir/$clean_list.config")) {
|
|
print REPLY "rename new -> current failed $!";
|
|
$rename_fail = 1;
|
|
}
|
|
|
|
print REPLY "New config for list $clean_list accepted.\n"
|
|
if !$rename_fail;
|
|
|
|
&log("newconfig $clean_list PASSWORD");
|
|
&get_config($listdir, $clean_list, "locked");
|
|
} else {
|
|
&abort("Can't write $listdir/$clean_list.config: $!");
|
|
}
|
|
} else {
|
|
&squawk("$sm: invalid password.");
|
|
&log("FAILED newconfig $clean_list PASSWORD");
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
&free_lock("$listdir/$clean_list.config.LOCK");
|
|
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
while (<>) {
|
|
$_ = &chop_nl($_);
|
|
if ($_ eq "EOF") {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
sub do_writeconfig {
|
|
# Check to make sure we've got the right arguments
|
|
# and Check that the list is valid
|
|
local($sm) = "writeconfig";
|
|
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
|
|
&squawk("$sm: needs password") unless $passwd;
|
|
|
|
if ($clean_list ne "") {
|
|
# The list is valid, parse the config file
|
|
&set_lock("$listdir/$clean_list.config.LOCK") ||
|
|
&abort( "Can't get lock for $listdir/$clean_list.config");
|
|
&get_config($listdir, $clean_list, "locked")
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
# so check the password
|
|
if (&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
# The password is valid, so write current config
|
|
&config'writeconfig($listdir, $clean_list);
|
|
print REPLY "wrote new config for list $clean_list.\n";
|
|
&log("writeconfig $clean_list PASSWORD");
|
|
} else {
|
|
&squawk("$sm: invalid password.");
|
|
&log("FAILED writeconfig $clean_list PASSWORD");
|
|
}
|
|
&free_lock("$listdir/$clean_list.config.LOCK");
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
}
|
|
|
|
sub do_mkdigest {
|
|
# Check to make sure we've got the right arguments
|
|
local($list, $clean_list, @args) = &get_listname($sm, -1, @_);
|
|
|
|
# We allow the specification of the outgoing alias for the digest so
|
|
# that list owners can change it to be something secret, but we have to
|
|
# remain backwards compatible, so we allow 2 or 3 args.
|
|
local($list_outgoing);
|
|
if ($#args == 1) { # Called with 2 or 3 args, one already shifted off
|
|
$list_outgoing = shift @args;
|
|
}
|
|
else {
|
|
$list_outgoing = "$list-outgoing";
|
|
}
|
|
local($passwd);
|
|
($passwd = shift @args) || &squawk("$sm: needs password");
|
|
local(@digest_errors) = ();
|
|
# Check that the list is valid
|
|
local($clean_list) = &valid_list($listdir, $list);
|
|
if ($clean_list ne "") {
|
|
# The list is valid, parse the config file
|
|
&get_config($listdir, $clean_list) if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
#so check the password
|
|
if (&valid_passwd($listdir, $clean_list, $passwd)) {
|
|
# The password is valid, so run digest
|
|
|
|
open(DIGEST,
|
|
"$homedir/digest -m -C -l $list $list_outgoing 2>&1 |");
|
|
@digest_errors = <DIGEST>;
|
|
close(DIGEST);
|
|
|
|
if ( $? == 256 ) {
|
|
print REPLY "*** mkdigest: Failure on exec of digest $!\n";
|
|
print REPLY @digest_errors;
|
|
&log("FAILED mkdigest $list: exec error");
|
|
} else {
|
|
if ($? != 0 ) { # hey the exec worked
|
|
print REPLY "*** digest: failed errors follow\n";
|
|
print REPLY @digest_errors;
|
|
&log("FAILED mkdigest $list: errors during digest");
|
|
} else {
|
|
print REPLY @digest_errors;
|
|
&log("mkdigest $clean_list");
|
|
}
|
|
}
|
|
} else {
|
|
&squawk("$sm: invalid password.");
|
|
&log("FAILED mkdigest $clean_list PASSWORD");
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
}
|
|
|
|
sub do_lists {
|
|
# Tell the requester what lists we serve
|
|
local($list);
|
|
local($reply_addr) = &ParseAddrs($reply_to);
|
|
|
|
select((select(REPLY), $| = 1)[0]);
|
|
|
|
print REPLY "$whoami serves the following lists:\n\n";
|
|
|
|
opendir(RD_DIR, $listdir) || &abort("opendir failed $!");
|
|
@lists = readdir(RD_DIR);
|
|
closedir(RD_DIR);
|
|
|
|
foreach (sort @lists) {
|
|
$list = $_;
|
|
$list =~ /[^-_0-9a-zA-Z]/ && next; # skip non-list files (*.info, etc.)
|
|
next if /^(RCS|CVS|core)$/; # files and directories to ignore
|
|
next if (-d "$listdir/$list"); # skip directories
|
|
|
|
&get_config($listdir, $list) if !&cf_ck_bool($list, '', 1);
|
|
|
|
if ( ($'config_opts{$list, 'advertise'} ne '')
|
|
|| ($'config_opts{$list, 'noadvertise'} ne '') ) {
|
|
|
|
local(@array, $i);
|
|
local($result) = 0;
|
|
local($_) = $reply_addr;
|
|
|
|
if ($'config_opts{$list, 'advertise'} ne '') {
|
|
@array = split(/\001/,$'config_opts{$list, 'advertise'});
|
|
foreach $i (@array) {
|
|
$result = 1, last if (eval $i); # Expects $_ = $reply_addr
|
|
}
|
|
} else { $result = 1; }
|
|
|
|
@array = ();
|
|
if ($result) {
|
|
@array = split(/\001/,$'config_opts{$list, 'noadvertise'});
|
|
|
|
foreach $i (@array) {
|
|
$result = 0, last if (eval $i); # Expects $_ = $reply_addr
|
|
}
|
|
}
|
|
|
|
|
|
$result = &is_list_member($reply_to, $listdir, $list)
|
|
if ! $result;
|
|
|
|
printf REPLY " %-23s %-.56s\n", $list,
|
|
$config_opts{$list, 'description'} if $result;
|
|
} else {
|
|
printf REPLY " %-23s %-.56s\n", $list,
|
|
$config_opts{$list, 'description'};
|
|
}
|
|
|
|
}
|
|
print REPLY "\nUse the 'info <list>' command to get more information\n";
|
|
print REPLY "about a specific list.\n";
|
|
&log("lists");
|
|
}
|
|
|
|
# Subroutines do_get and do_index handle files for the requestor.
|
|
# Majordomo will look for the files in directory "$filedir/$list$filedir_suffix"
|
|
# You need to specify a directory in majordomo.cf such as:
|
|
# $filedir = "/usr/local/mail/files";
|
|
# $filedir_suffix = "";
|
|
# to have it check directory "/usr/local/mail/files/$list" or
|
|
# $filedir = "$listdir";
|
|
# $filedir_suffix = ".archive";
|
|
# to have it check directory "$listdir/$list.archive".
|
|
#
|
|
# If you want majordomo to do the basic file handling, don't
|
|
# set the ftpmail options. Set the index command using:
|
|
# $index_command = "/bin/ls -lRL";
|
|
#
|
|
# If you want FTPMail to do the file handling, also put in:
|
|
# $ftpmail_location = "$whereami"
|
|
# $ftpmail_address = "ftpmail@$whereami";
|
|
# or
|
|
# $ftpmail_address = "ftpmail@decwrl.dec.com";
|
|
# as appropriate.
|
|
#
|
|
# Note that "$ftpmail_location" might NOT be the same as "$whereami";
|
|
# for instance, at GreatCircle.COM, "$whereami" is "GreatCircle.COM" (which
|
|
# is an MX record) but "$ftpmail_location" needs to be "FTP.GreatCircle.COM"
|
|
# (which is an alias for actual machine)
|
|
|
|
sub do_get {
|
|
# Make sure we've got the arguments we need
|
|
# and Check that the list is OK
|
|
local($sm) = "get";
|
|
local($list, $clean_list, $filename) = &get_listname($sm, 1, @_);
|
|
&squawk("$sm: which file?") unless $filename;
|
|
|
|
if ($clean_list ne "") {
|
|
# The list is valid, so now check make sure that it's not a private
|
|
# list, or if it is, that the requester is on the list.
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
|
|
if ( !$approved
|
|
&& $config_opts{$clean_list, 'get_access'} =~ /closed/ ) {
|
|
print REPLY "**** Command disabled.\n";
|
|
return 0;
|
|
}
|
|
|
|
if ( !$approved
|
|
&& ! &access_check("get", $reply_to, $listdir, $clean_list)) {
|
|
print REPLY "**** List '$clean_list' is a private list.\n";
|
|
print REPLY "**** Only members of the list can do a 'get'.\n";
|
|
print REPLY "**** You aren't a member of list '$clean_list'.\n";
|
|
return 0;
|
|
}
|
|
# The list is OK, so check the file name
|
|
local($clean_file) = &valid_filename($filedir, $clean_list,
|
|
$filedir_suffix, $filename);
|
|
if (defined($clean_file)) {
|
|
# the file name was OK and exists
|
|
# see if file handling is done by ftpmail
|
|
if (defined($ftpmail_address)) {
|
|
# File handling is done by ftpmail
|
|
if ($ftpmail_location eq "") {$ftpmail_location = $whereami; };
|
|
&sendmail(FTPMAILMSG, $ftpmail_address, "get $filename",
|
|
$reply_to);
|
|
print FTPMAILMSG "open $ftpmail_location\n";
|
|
print FTPMAILMSG "cd $filedir/$clean_list$filedir_suffix\n";
|
|
print FTPMAILMSG "get $filename\n";
|
|
close (FTPMAILMSG);
|
|
print REPLY "'get' request forwarded to $ftpmail_address\n";
|
|
} else {
|
|
# file handling is done locally.
|
|
if (&lopen(GETFILE, " ", "$clean_file")) {
|
|
# Set up the sendmail process to send the file
|
|
&sendmail(GETFILEMSG, $reply_to,
|
|
"Majordomo file: list '$clean_list' file '$filename'");
|
|
while (<GETFILE>) {
|
|
print GETFILEMSG $_;
|
|
}
|
|
# close (and thereby send) the file
|
|
close(GETFILEMSG);
|
|
&lclose(GETFILE);
|
|
print REPLY <<"EOM";
|
|
List '$clean_list' file '$filename'
|
|
is being sent as a separate message.
|
|
EOM
|
|
} else {
|
|
print REPLY
|
|
"#### No such file '$filename' for list '$clean_list'\n";
|
|
}
|
|
}
|
|
} else {
|
|
&squawk("$sm: invalid file '$filename' for list '$clean_list'.");
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
&log("get $clean_list $filename");
|
|
}
|
|
|
|
sub do_index {
|
|
# Make sure we've got the arguments we need
|
|
# and Check that the list is OK
|
|
local($sm) = "index";
|
|
local($list, $clean_list) = &get_listname($sm, 0, @_);
|
|
|
|
if ($clean_list ne "") {
|
|
&get_config($listdir, $clean_list)
|
|
if !&cf_ck_bool($clean_list, '', 1);
|
|
# The list is valid, so now check make sure that it's not a private
|
|
# list, or if it is, that the requester is on the list.
|
|
if ( !$approved
|
|
&& $config_opts{$clean_list, 'index_access'} =~ /closed/ ) {
|
|
print REPLY "**** Command disabled.\n";
|
|
return 0;
|
|
}
|
|
|
|
if ( !$approved
|
|
&& ! &access_check("index", $reply_to, $listdir, $clean_list)) {
|
|
print REPLY "**** List '$clean_list' is a private list.\n";
|
|
print REPLY "**** Only members of the list can do an 'index'.\n";
|
|
print REPLY "**** You aren't a member of list '$clean_list'.\n";
|
|
return 0;
|
|
}
|
|
# The list is OK; see if file handling is done by ftpmail
|
|
if (defined($ftpmail_address)) {
|
|
# File handling is done by ftpmail
|
|
&sendmail(FTPMAILMSG, $ftpmail_address, "index $clean_list", $reply_to);
|
|
print FTPMAILMSG "open $ftpmail_location\n";
|
|
print FTPMAILMSG "cd $filedir/$clean_list$filedir_suffix\n";
|
|
print FTPMAILMSG "dir\n";
|
|
close (FTPMAILMSG);
|
|
print REPLY "'index' request forwarded to $ftpmail_address\n";
|
|
} else {
|
|
if (-d "$filedir/$clean_list$filedir_suffix") {
|
|
if (chdir "$filedir/$clean_list$filedir_suffix") {
|
|
open(INDEX,"$index_command|")
|
|
|| &abort("Can't fork to run $index_command, $!");
|
|
while (<INDEX>) {
|
|
print REPLY $_;
|
|
}
|
|
unless (close INDEX) {
|
|
&bitch("Index command $index_command failed.\n$! $?");
|
|
&squawk("$sm: index command failed");
|
|
}
|
|
}
|
|
else {
|
|
&bitch("Cannot chdir to $filedir/$clean_list$filedir_suffix to build index\n$!");
|
|
&squawk("$sm: index command failed");
|
|
}
|
|
} else {
|
|
print REPLY "#### No files available for $clean_list.\n";
|
|
}
|
|
}
|
|
} else {
|
|
&squawk("$sm: unknown list '$list'.");
|
|
}
|
|
&log("index $list");
|
|
chdir("$homedir");
|
|
}
|
|
|
|
sub do_help {
|
|
print STDERR "$0: do_help()\n" if $DEBUG;
|
|
|
|
local($list4help) = $majordomo_request ? "[<list>]" : "<list>";
|
|
|
|
local($listrequest) = " or to \"<list>-request\@$whereami\".\n";
|
|
$listrequest .= "\nThe <list> parameter is only optional if the ";
|
|
$listrequest .= "message is sent to an address\nof the form ";
|
|
$listrequest .= "\"<list>-request\@$whereami\".";
|
|
|
|
$listrequest = "." unless $majordomo_request;
|
|
|
|
print REPLY <<"EOM";
|
|
|
|
This help message is being sent to you from the Majordomo mailing list
|
|
management system at $whoami.
|
|
|
|
This is version $majordomo_version of Majordomo.
|
|
|
|
If you're familiar with mail servers, an advanced user's summary of
|
|
Majordomo's commands appears at the end of this message.
|
|
|
|
Majordomo is an automated system which allows users to subscribe
|
|
and unsubscribe to mailing lists, and to retrieve files from list
|
|
archives.
|
|
|
|
You can interact with the Majordomo software by sending it commands
|
|
in the body of mail messages addressed to "$whoami".
|
|
Please do not put your commands on the subject line; Majordomo does
|
|
not process commands in the subject line.
|
|
|
|
You may put multiple Majordomo commands in the same mail message.
|
|
Put each command on a line by itself.
|
|
|
|
If you use a "signature block" at the end of your mail, Majordomo may
|
|
mistakenly believe each line of your message is a command; you will
|
|
then receive spurious error messages. To keep this from happening,
|
|
either put a line starting with a hyphen ("-") before your signature,
|
|
or put a line with just the word
|
|
|
|
end
|
|
|
|
on it in the same place. This will stop the Majordomo software from
|
|
processing your signature as bad commands.
|
|
|
|
Here are some of the things you can do using Majordomo:
|
|
|
|
I. FINDING OUT WHICH LISTS ARE ON THIS SYSTEM
|
|
|
|
To get a list of publicly-available mailing lists on this system, put the
|
|
following line in the body of your mail message to $whoami:
|
|
|
|
lists
|
|
|
|
Each line will contain the name of a mailing list and a brief description
|
|
of the list.
|
|
|
|
To get more information about a particular list, use the "info" command,
|
|
supplying the name of the list. For example, if the name of the list
|
|
about which you wish information is "demo-list", you would put the line
|
|
|
|
info demo-list
|
|
|
|
in the body of the mail message.
|
|
|
|
II. SUBSCRIBING TO A LIST
|
|
|
|
Once you've determined that you wish to subscribe to one or more lists on
|
|
this system, you can send commands to Majordomo to have it add you to the
|
|
list, so you can begin receiving mailings.
|
|
|
|
To receive list mail at the address from which you're sending your mail,
|
|
simply say "subscribe" followed by the list's name:
|
|
|
|
subscribe demo-list
|
|
|
|
If for some reason you wish to have the mailings go to a different address
|
|
(a friend's address, a specific other system on which you have an account,
|
|
or an address which is more correct than the one that automatically appears
|
|
in the "From:" header on the mail you send), you would add that address to
|
|
the command. For instance, if you're sending a request from your work
|
|
account, but wish to receive "demo-list" mail at your personal account
|
|
(for which we will use "jqpublic\@my-isp.com" as an example), you'd put
|
|
the line
|
|
|
|
subscribe demo-list jqpublic\@my-isp.com
|
|
|
|
in the mail message body.
|
|
|
|
Based on configuration decisions made by the list owners, you may be added
|
|
to the mailing list automatically. You may also receive notification
|
|
that an authorization key is required for subscription. Another message
|
|
will be sent to the address to be subscribed (which may or may not be the
|
|
same as yours) containing the key, and directing the user to send a
|
|
command found in that message back to $whoami. (This can be
|
|
a bit of extra hassle, but it helps keep you from being swamped in extra
|
|
email by someone who forged requests from your address.) You may also
|
|
get a message that your subscription is being forwarded to the list owner
|
|
for approval; some lists have waiting lists, or policies about who may
|
|
subscribe. If your request is forwarded for approval, the list owner
|
|
should contact you soon after your request.
|
|
|
|
Upon subscribing, you should receive an introductory message, containing
|
|
list policies and features. Save this message for future reference; it
|
|
will also contain exact directions for unsubscribing. If you lose the
|
|
intro mail and would like another copy of the policies, send this message
|
|
to $whoami:
|
|
|
|
intro demo-list
|
|
|
|
(substituting, of course, the real name of your list for "demo-list").
|
|
|
|
III. UNSUBSCRIBING FROM MAILING LISTS
|
|
|
|
Your original intro message contains the exact command which should be
|
|
used to remove your address from the list. However, in most cases, you
|
|
may simply send the command "unsubscribe" followed by the list name:
|
|
|
|
unsubscribe demo-list
|
|
|
|
(This command may fail if your provider has changed the way your
|
|
address is shown in your mail.)
|
|
|
|
To remove an address other than the one from which you're sending
|
|
the request, give that address in the command:
|
|
|
|
unsubscribe demo-list jqpublic\@my-isp.com
|
|
|
|
In either of these cases, you can tell $whoami to remove
|
|
the address in question from all lists on this server by using "*"
|
|
in place of the list name:
|
|
|
|
unsubscribe *
|
|
unsubscribe * jqpublic\@my-isp.com
|
|
|
|
IV. FINDING THE LISTS TO WHICH AN ADDRESS IS SUBSCRIBED
|
|
|
|
To find the lists to which your address is subscribed, send this command
|
|
in the body of a mail message to $whoami:
|
|
|
|
which
|
|
|
|
You can look for other addresses, or parts of an address, by specifying
|
|
the text for which Majordomo should search. For instance, to find which
|
|
users at my-isp.com are subscribed to which lists, you might send the
|
|
command
|
|
|
|
which my-isp.com
|
|
|
|
Note that many list owners completely or fully disable the "which"
|
|
command, considering it a privacy violation.
|
|
|
|
V. FINDING OUT WHO'S SUBSCRIBED TO A LIST
|
|
|
|
To get a list of the addresses on a particular list, you may use the
|
|
"who" command, followed by the name of the list:
|
|
|
|
who demo-list
|
|
|
|
Note that many list owners allow only a list's subscribers to use the
|
|
"who" command, or disable it completely, believing it to be a privacy
|
|
violation.
|
|
|
|
VI. RETRIEVING FILES FROM A LIST'S ARCHIVES
|
|
|
|
Many list owners keep archives of files associated with a list. These
|
|
may include:
|
|
- back issues of the list
|
|
- help files, user profiles, and other documents associated with the list
|
|
- daily, monthly, or yearly archives for the list
|
|
|
|
To find out if a list has any files associated with it, use the "index"
|
|
command:
|
|
|
|
index demo-list
|
|
|
|
If you see files in which you're interested, you may retrieve them by
|
|
using the "get" command and specifying the list name and archive filename.
|
|
For instance, to retrieve the files called "profile.form" (presumably a
|
|
form to fill out with your profile) and "demo-list.9611" (presumably the
|
|
messages posted to the list in November 1996), you would put the lines
|
|
|
|
get demo-list profile.form
|
|
get demo-list demo-list.9611
|
|
|
|
in your mail to $whoami.
|
|
|
|
VII. GETTING MORE HELP
|
|
|
|
To contact a human site manager, send mail to $whoami_owner.
|
|
To contact the owner of a specific list, send mail to that list's
|
|
approval address, which is formed by adding "-approval" to the user-name
|
|
portion of the list's address. For instance, to contact the list owner
|
|
for demo-list\@$whereami, you would send mail to demo-list-approval\@$whereami.
|
|
|
|
To get another copy of this help message, send mail to $whoami
|
|
with a line saying
|
|
|
|
help
|
|
|
|
in the message body.
|
|
|
|
VIII. COMMAND SUMMARY FOR ADVANCED USERS
|
|
|
|
In the description below items contained in []'s are optional. When
|
|
providing the item, do not include the []'s around it. Items in angle
|
|
brackets, such as <address>, are meta-symbols that should be replaced
|
|
by appropriate text without the angle brackets.
|
|
|
|
It understands the following commands:
|
|
|
|
subscribe $list4help [<address>]
|
|
Subscribe yourself (or <address> if specified) to the named <list>.
|
|
|
|
unsubscribe $list4help [<address>]
|
|
Unsubscribe yourself (or <address> if specified) from the named <list>.
|
|
"unsubscribe *" will remove you (or <address>) from all lists. This
|
|
_may not_ work if you have subscribed using multiple addresses.
|
|
|
|
get $list4help <filename>
|
|
Get a file related to <list>.
|
|
|
|
index $list4help
|
|
Return an index of files you can "get" for <list>.
|
|
|
|
which [<address>]
|
|
Find out which lists you (or <address> if specified) are on.
|
|
|
|
who $list4help
|
|
Find out who is on the named <list>.
|
|
|
|
info $list4help
|
|
Retrieve the general introductory information for the named <list>.
|
|
|
|
intro $list4help
|
|
Retrieve the introductory message sent to new users. Non-subscribers
|
|
may not be able to retrieve this.
|
|
|
|
lists
|
|
Show the lists served by this Majordomo server.
|
|
|
|
help
|
|
Retrieve this message.
|
|
|
|
end
|
|
Stop processing commands (useful if your mailer adds a signature).
|
|
|
|
Commands should be sent in the body of an email message to
|
|
"$whoami"$listrequest Multiple commands can be processed provided
|
|
each occurs on a separate line.
|
|
|
|
Commands in the "Subject:" line are NOT processed.
|
|
|
|
If you have any questions or problems, please contact
|
|
"$whoami_owner".
|
|
|
|
EOM
|
|
#'
|
|
print STDERR "$0: do_help(): finished writing help text, now logging.\n" if $DEBUG;
|
|
|
|
&log("help");
|
|
|
|
print STDERR "$0: do_help(): done\n" if $DEBUG;
|
|
}
|
|
|
|
sub send_confirm {
|
|
local($cmd) = shift;
|
|
local($list) = &valid_list($listdir, shift);
|
|
local($subscriber) = @_;
|
|
local($cookie) = &gen_cookie($cmd, $list, $subscriber);
|
|
local(*AUTH);
|
|
|
|
&sendmail(AUTH, $subscriber, "Confirmation for $cmd $list");
|
|
|
|
print AUTH <<"EOM";
|
|
Someone (possibly you) has requested that your email address be added
|
|
to or deleted from the mailing list "$list\@$whereami".
|
|
|
|
If you really want this action to be taken, please send the following
|
|
commands (exactly as shown) back to "$whoami":
|
|
|
|
auth $cookie $cmd $list $subscriber
|
|
|
|
If you do not want this action to be taken, simply ignore this message
|
|
and the request will be disregarded.
|
|
|
|
If your mailer will not allow you to send the entire command as a single
|
|
line, you may split it using backslashes, like so:
|
|
|
|
auth $cookie $cmd $list \\
|
|
$subscriber
|
|
|
|
If you have any questions about the policy of the list owner, please
|
|
contact "$list-approval\@$whereami".
|
|
|
|
Thanks!
|
|
|
|
$whoami
|
|
EOM
|
|
close(AUTH);
|
|
|
|
print REPLY <<"EOM";
|
|
**** Your request to $whoami:
|
|
****
|
|
**** $cmd $list $subscriber
|
|
****
|
|
**** must be authenticated. To accomplish this, another request must be
|
|
**** sent in with an authorization key, which has been sent to:
|
|
**** $subscriber
|
|
****
|
|
**** If the message is not received, there is generally a problem with
|
|
**** the address. Before reporting this as a problem, please note the
|
|
**** following:
|
|
****
|
|
**** You only need to give an address to the subscribe command if you want
|
|
**** to receive list mail at a different address from where you sent the
|
|
**** command. Otherwise you can simply omit it.
|
|
****
|
|
**** If you do give an address to the subscribe command, it must be a legal
|
|
**** address. It should not consist solely of your name. The address must
|
|
**** point to a machine that is reachable from the list server.
|
|
****
|
|
**** If you have any questions about the policy of the list owner, please
|
|
**** contact "$list-approval\@$whereami".
|
|
****
|
|
**** Thanks!
|
|
****
|
|
**** $whoami
|
|
EOM
|
|
&log("send_confirm $cmd $list $subscriber");
|
|
}
|
|
|
|
|
|
|
|
# Send a request for subscribe or unsubscribe approval to a list owner
|
|
# Usage: &request_approval($cmd, $list, @subscriber)
|
|
sub request_approval {
|
|
# Get the arguments
|
|
local($cmd) = shift;
|
|
local($list) = &valid_list($listdir, shift);
|
|
local($subscriber) = @_;
|
|
local(*APPROVE);
|
|
|
|
# open a sendmail process for the approval request
|
|
&sendmail(APPROVE, "$list-approval\@$whereami", "APPROVE $list");
|
|
|
|
# Generate the approval request
|
|
print APPROVE <<"EOM";
|
|
$reply_to requests that you approve the following:
|
|
|
|
$cmd $list $subscriber
|
|
|
|
If you approve, please send a message such as the following back to
|
|
$whoami (with the appropriate PASSWORD filled in, of course):
|
|
|
|
approve PASSWORD \\
|
|
$cmd $list \\
|
|
$subscriber
|
|
|
|
[The above is broken into multiple lines to avoid mail reader linewrap
|
|
problems. Commands can be on one line, or multi-line with '\\' escapes.]
|
|
|
|
If you disapprove, do nothing.
|
|
|
|
|
|
Thanks!
|
|
|
|
$whoami
|
|
EOM
|
|
# close (and thereby send) the approval request
|
|
close(APPROVE);
|
|
|
|
# tell the requestor that their request has been forwarded for approval.
|
|
print REPLY <<"EOM";
|
|
Your request to $whoami:
|
|
|
|
$cmd $list $subscriber
|
|
|
|
has been forwarded to the owner of the "$list" list for approval.
|
|
This could be for any of several reasons:
|
|
|
|
You might have asked to subscribe to a "closed" list, where all new
|
|
additions must be approved by the list owner.
|
|
|
|
You might have asked to subscribe or unsubscribe an address other than
|
|
the one that appears in the headers of your mail message.
|
|
|
|
When the list owner approves your request, you will be notified.
|
|
|
|
If you have any questions about the policy of the list owner, please
|
|
contact "$list-approval\@$whereami".
|
|
|
|
|
|
Thanks!
|
|
|
|
$whoami
|
|
EOM
|
|
|
|
&log("request $cmd $list $subscriber");
|
|
}
|
|
|
|
# We are done processing the request; append help if needed, send the reply
|
|
# to the requestor, clean up, and exit
|
|
|
|
sub done {
|
|
# append help, if needed.
|
|
if ($count == 0) {
|
|
print REPLY "**** No valid commands found.\n";
|
|
print REPLY "**** Commands must be in message BODY, not in HEADER.\n\n";
|
|
}
|
|
if ($needs_help || ($count == 0)) {
|
|
print REPLY "**** Help for $whoami:\n\n";
|
|
&do_help();
|
|
}
|
|
|
|
# close (and thereby send) the reply
|
|
close(REPLY);
|
|
|
|
# good bye!
|
|
exit(0);
|
|
}
|
|
|
|
# Welcome a new subscriber to the list, and tell the list owner of his/her
|
|
# existance.
|
|
sub welcome {
|
|
local($list) = shift;
|
|
local($subscriber) = join(" ", @_);
|
|
|
|
# welcome/intro message controlled by 'welcome=yes/no'
|
|
if ( &cf_ck_bool($list,"welcome")) {
|
|
|
|
# Set up the sendmail process to welcome the new subscriber
|
|
&set_mail_sender($config_opts{$list,"sender"} . "\@" . $whereami);
|
|
&sendmail(MSG, $subscriber, "Welcome to $list");
|
|
&set_mail_sender($whoami_owner);
|
|
|
|
print MSG "Welcome to the $list mailing list!\n\n";
|
|
|
|
print MSG "Please save this message for future reference. Thank you.\n";
|
|
|
|
if ( $majordomo_request ) {
|
|
print MSG <<"EOM";
|
|
|
|
If you ever want to remove yourself from this mailing list,
|
|
send the following command in email to
|
|
\<${clean_list}-request\@$whereami\>:
|
|
|
|
unsubscribe
|
|
|
|
Or you can send mail to \<$whoami\> with the following
|
|
EOM
|
|
|
|
} else {
|
|
print MSG <<"EOM";
|
|
|
|
If you ever want to remove yourself from this mailing list,
|
|
you can send mail to \<$whoami\> with the following
|
|
EOM
|
|
}
|
|
|
|
print MSG <<"EOM";
|
|
command in the body of your email message:
|
|
|
|
unsubscribe $list
|
|
|
|
or from another account, besides $subscriber:
|
|
|
|
unsubscribe $list $subscriber
|
|
|
|
EOM
|
|
print MSG <<"EOM";
|
|
If you ever need to get in contact with the owner of the list,
|
|
(if you have trouble unsubscribing, or have questions about the
|
|
list itself) send email to \<owner-$clean_list\@$whereami\> .
|
|
This is the general rule for most mailing lists when you need
|
|
to contact a human.
|
|
|
|
EOM
|
|
|
|
# send them the info for the list, if it's available
|
|
# the <list>.intro file has information for subscribers only
|
|
if (&lopen(INFO, "", "$listdir/$list.intro")) {
|
|
while (<INFO>) {
|
|
print MSG $_;
|
|
}
|
|
&lclose(INFO);
|
|
} elsif (&lopen(INFO, "", "$listdir/$list.info")) {
|
|
print MSG <<"EOM";
|
|
Here's the general information for the list you've subscribed to,
|
|
in case you don't already have it:
|
|
|
|
EOM
|
|
#';
|
|
while (<INFO>) {
|
|
print MSG $_;
|
|
}
|
|
&lclose(INFO);
|
|
} else {
|
|
print MSG "#### No info available for $list.\n";
|
|
}
|
|
|
|
# close (and thereby send) the welcome message to the subscriber
|
|
close(MSG);
|
|
|
|
}
|
|
|
|
# tell the list owner of the new subscriber (optional: announcements=yes/no)
|
|
if ( &cf_ck_bool($list,"announcements")) {
|
|
&sendmail(NOTICE, "$list-approval\@$whereami", "SUBSCRIBE $list $subscriber");
|
|
print NOTICE "$subscriber has been added to $list.\n";
|
|
print NOTICE "No action is required on your part.\n";
|
|
close(NOTICE);
|
|
}
|
|
}
|
|
|
|
# complain about a user screwup, and note that the user needs help appended
|
|
# to the reply
|
|
sub squawk {
|
|
print REPLY "**** @_\n";
|
|
$needs_help++;
|
|
}
|
|
|
|
# check to see if the subscriber is a LISTSERV-style "real name", not an
|
|
# address. If it contains white space and no routing characters ([!@%:]),
|
|
# then it's probably not an address. If it's valid, generate the proper
|
|
# request for approval; if it's not, bitch to the user.
|
|
|
|
# if a fourth parameter is added to the check_and_request call, only
|
|
# check the subscribe request for a valid address. This allows
|
|
# the same routine to be used for checking when handling an auto list.
|
|
|
|
sub check_and_request {
|
|
local($request,$clean_list, $subscriber, $do_request) = @_;
|
|
|
|
# check to see if the subscriber looks like a LISTSERV-style
|
|
# "real name", not an address; if so, send a message to the
|
|
# requestor, and if not, ask the list owner for approval
|
|
local($addr) = &valid_addr($subscriber);
|
|
if ($addr =~ /\s/ && $addr !~ /[!%\@:]/) {
|
|
# yup, looks like a LISTSERV-style request to me.
|
|
&squawk("$request: LISTSERV-style request failed");
|
|
print REPLY <<"EOM";
|
|
This looks like a BITNET LISTSERV style '$request' request, because
|
|
the part after the list name doesn't look like an email address; it looks
|
|
like a person's name. Majordomo is not LISTSERV. In a Majordomo '$request'
|
|
request, the part after the list name is optional, but if it's there, it
|
|
should be an email address, NOT a person's real name.
|
|
EOM
|
|
|
|
return(0);
|
|
} else {
|
|
return(1) if defined($do_request);
|
|
&request_approval($request, $clean_list, $subscriber);
|
|
}
|
|
}
|
|
|
|
sub gen_cookie {
|
|
local($combined) = join('/', $cookie_seed ? $cookie_seed : $homedir, @_);
|
|
local($cookie) = 0;
|
|
local($i, $carry);
|
|
|
|
# Because of backslashing and all of the splitting on whitespace and
|
|
# joining that goes on, we need to ignore whitespace.
|
|
$combined =~ s/\s//g;
|
|
|
|
for ($i = 0; $i < length($combined); $i++) {
|
|
$cookie ^= ord(substr($combined, $i));
|
|
$carry = ($cookie >> 28) & 0xf;
|
|
$cookie <<= 4;
|
|
$cookie |= $carry;
|
|
}
|
|
return (sprintf("%08x", $cookie));
|
|
}
|
|
|
|
|
|
# Extracts the list name from the argument list to the do_* functions
|
|
# or uses the default list name, depending on invocation options and
|
|
# available arguments. Returns the raw list name, the validated list
|
|
# name, and the remaining argument list.
|
|
|
|
sub get_listname {
|
|
local($request, $required, @args) = @_;
|
|
local($raw_list, $clean_list);
|
|
|
|
if (defined($deflist)) { # -l option specified
|
|
if (scalar(@args) <= $required) { # minimal arguments, use default list
|
|
if ( !( ($raw_list = $deflist)
|
|
&& ($clean_list = &valid_list($listdir, $raw_list)) ) ) {
|
|
$raw_list = shift(@args) || &squawk("$request: which list?");
|
|
$clean_list = &valid_list($listdir, $raw_list);
|
|
}
|
|
}
|
|
elsif ( !( ($raw_list = shift(@args))
|
|
&& ($clean_list = &valid_list($listdir, $raw_list)) ) ) {
|
|
unshift(@args, $raw_list); # Not a list name, put it back.
|
|
$raw_list = $deflist || &squawk("$request: which list?");
|
|
$clean_list = &valid_list($listdir, $raw_list);
|
|
}
|
|
}
|
|
|
|
else {
|
|
$raw_list = shift(@args);
|
|
$clean_list = &valid_list($listdir, $raw_list);
|
|
}
|
|
|
|
return ($raw_list, $clean_list, @args);
|
|
}
|