#!/usr/local/bin/perl

# majordomo: a person who speaks, makes arrangements, or takes charge
#	for another.
#
# Copyright 1992, D. Brent Chapman.  All Rights Reserved.  For use by
# permission only.
#
# $Source: /sources/cvsrepos/majordomo/majordomo,v $
# $Revision: 1.35 $
# $Date: 1994/05/08 21:07:37 $
# $Author: rouilj $
# $State: Exp $
#
# $Locker:  $

# set our path explicitly
# PATH it is set in the wrapper, so there is no need to set it here.
#$ENV{'PATH'} = "/bin:/usr/bin:/usr/ucb";

# What shall we use for temporary files?
$tmp = "/tmp/majordomo.$$";


# 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] eq "-C") {
        $cf = $ARGV[1];
        shift(@ARGV); 
        shift(@ARGV); 
    }
    elsif ($ARGV[0] eq "-l") {
        $deflist = $ARGV[1];
        shift(@ARGV); 
        shift(@ARGV); 
    }
}
if (! -r $cf) {
    die("$cf not readable; stopped");
}
eval(`cat $cf`) || die "eval of majordomo.cf failed $@";

# Go to the home directory specified by the .cf file
chdir("$homedir");

# All these should be in the standard PERL library
unshift(@INC, $homedir);
require "ctime.pl";		# 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

# 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);


# who do we send the body to if we step on a landmine?
&set_abort_addr($whoami_owner);

# who do sendmail messages appear to come from, by default?
&set_mail_from($whoami);
&set_mail_sender($whoami_owner);
if (defined($mailer)) { &set_mailer($mailer); }

# 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;
    }
}

# set our hostname (for use in log messages).
$hostname = &chop_nl(`hostname`);

# 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);

# Set up the log file
&set_log($log, $hostname, "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)) {
    print STDERR "$whoami punting to avoid mail loop.\n";
    exit 0;
}

if (! &valid_addr($reply_to)) {
    print STDERR "$whoami: $reply_to is not a valid return address.\n";
    exit 2;
}

if ($return_subject && defined $hdrs{'subject'}) {
	$sub_addin = ": " . substr($hdrs{'subject'}, 0, 40);
 } else {
	$sub_addin = '';
 }
# 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]);

# Process the rest of the message as commands
while (<>) {
    $approved = 0;			# all requests start as un-approved
    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/#.*//g;				# strip comments
    s/^\s*//g;				# strip leading whitespace
    s/\s*$//g;				# strip trailing whitespace
    s/\\ /\001/g;			# protected escaped whitepace	
    @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 =~ /^-/) { 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 "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 "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); }
    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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 			# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }

    # figure out who's trying to subscribe, and check that it's a valid address
    local($subscriber) = join(" ", @_);
    if ($subscriber eq "") {
	$subscriber = $reply_to;
    }
    if (! &valid_addr($subscriber)) {
	&squawk("subscribe: 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);

	# 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 
	    || ($config_opts{$clean_list,"subscribe_policy"} eq "auto" )
	    || (($config_opts{$clean_list,"subscribe_policy"} ne "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";
		} else {
		    print LIST $subscriber, "\n";
		}
		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
		&welcome($clean_list, $subscriber);
	    }
	    &lclose(LIST);
	} else {
	    &check_and_request("subscribe", $clean_list, $subscriber);
	}
    } else {
	&squawk("subscribe: unknown list '$list'.");
    }
}

sub do_unsubscribe {
    local($match_count) = 0;
    # figure out what list we are trying to unsubscribe from
    # and check to see if the list is valid
    local($sm) = "unsubscribe";
    local($list) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }

    # figure out who's trying to unsubscribe, and check it's a valid address
    local($subscriber) = join(" ", @_);
    if ($subscriber eq "") {
	$subscriber = $reply_to;
    }
    if (! &valid_addr($subscriber)) {
	&squawk("unsubscribe: invalid address '$subscriber'");
	return 0;
    }

    if ($clean_list ne "") {
	# The list is valid.
	# get configuration info
	&get_config($listdir, $clean_list) 
			if !&cf_ck_bool($clean_list, '', 1);

	# Check to see if the subscriber really is subscribed to the list.
	if (! &is_list_member($subscriber, $listdir, $clean_list)) {
	    print REPLY
    "**** unsubscribe: '$subscriber' is not a member of list '$list'.\n";
	    return 0;
	}
	# Check to see if this request is approved, 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
	    || ($config_opts{$clean_list,"subscribe_policy"} eq "auto" )
	    || &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: $!");
	    open(NEW, ">$listdir/$clean_list.new") ||
		&abort("Can't open $listdir/$clean_list.new: $!");
	    chmod(0664, "$listdir/$clean_list.new") ||
		&abort("chmod(0664, \"$listdir/$clean_list.new\"): $!");
	    while (<LIST>) {
		if (! &addr_match($subscriber, $_,
		     (&cf_ck_bool($clean_list,"mungedomain") ? 2 : undef))) {
		    print NEW $_;
		} else {
		    $match_count++;
		    if ($match_count != 1) {
    &squawk("unsubscribe: '$subscriber' matches multiple list members.");
			last;
		    }
		}
	    }
	    close(NEW);
	    if ($match_count == 1) {
		# 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\"): $!");
		unlink("$listdir/$clean_list");
		link("$listdir/$clean_list.new", "$listdir/$clean_list") ||
    &abort("link(\"$listdir/$clean_list.new\", \"$listdir/$clean_list\"): $!");
		unlink("$listdir/$clean_list.old");
		print REPLY "Succeeded.\n";
		&log("unsubscribe $clean_list $subscriber");
		&sendmail(BYE, "$clean_list-approval",
		    "UNSUBSCRIBE $clean_list");
		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 {
	    &check_and_request("unsubscribe", $clean_list, $subscriber);
	}
    } else {
	&squawk("unsubscribe: unknown list '$list'.");
    }
}

sub do_approve {
    # Check to see we've got all the arguments
    (local($passwd) = shift)	|| &squawk("approve: needs passwd");
    (local($cmd) = shift)	|| &squawk("approve: 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($sm) = "approve";
    local($list) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }


    (local($subscriber) = join(" ",@_))	|| &squawk("approve: who?");
    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") {
		&log("approve PASSWORD subscribe $clean_list $subscriber");
		&do_subscribe($clean_list, $subscriber);
	    } elsif ($cmd eq "unsubscribe") {
		&log("approve PASSWORD unsubscribe $clean_list $subscriber");
		&do_unsubscribe($clean_list, $subscriber);
	    } else {
		# you can only approve "subscribe" and "unsubscribe"
		&squawk("approve: invalid command '$cmd'");
	    }
	} else {
	    &squawk("approve: invalid list or password.");
	}
    } else {
	&squawk("approve: 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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }


    (local($passwd) = shift)	|| &squawk("passwd: need old password");
    (local($new_passwd) = shift)|| &squawk("passwd: need new password");
    if ($clean_list eq "") {
	&squawk("passwd: 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("passwd: null 'new_passwd'.");
	    return;
	}
	# The new password is valid, too, so write it.
	if (&lopen(PASSWD, ">", "$listdir/$clean_list.passwd")) {
	    print PASSWD $new_passwd, "\n";
	    &lclose(PASSWD);
	    # set the file mode appropriately
	    chmod(0660, "$listdir/$clean_list.passwd");
	    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);
    # 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";
    while (<${listdir}/*>) {
	s,^.*/,,;			# strip off the leading path
	/[^-_0-9a-zA-Z]/ && next;	# skip non-list files (*.info, etc.)
	$list = $_;

	# get configuration info
	&get_config($listdir, $_) if !&cf_ck_bool($_, '', 1);

	if ( &cf_ck_bool($list,"private_which")
		&& (! &is_list_member($reply_to, $listdir, $list))) {
	    # skip private lists that the requestor isn't a member of
	    next;
	}
	open(LIST, "$listdir/$list") || &abort("Can't open list $listdir/$_");
	while (<LIST>) {
	    $_ = &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++;
	    }
	}
	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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }


    # 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 ( &cf_ck_bool($clean_list,"private_who")
		&& ! &is_list_member($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 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 $_;
	    }
	    &lclose(LIST);
	    &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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }


    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);

	if ( ( !&cf_ck_bool($clean_list,"private_info") ||
		&is_list_member($reply_to, $listdir, $clean_list)) &&
	     &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("info: 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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list))) 
	&& defined($deflist)) {
        unshift(@_,$list) ;			# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?"); 	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }


    (local($passwd) = shift)	|| &squawk("newinfo: needs password");
    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 (@time) = localtime if &cf_ck_bool($clean_list,"date_info");
	    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);
		chmod(0664, "$listdir/$clean_list.info");
		print REPLY "New info for list $clean_list accepted.\n";
		&log("newinfo $clean_list PASSWORD");
		# if we read to actual end-of-file, we are done
		if (eof) {
		    &done();
		}
	    } else {
		&abort("Can't write $listdir/$clean_list.info: $!");
	    }
	} else { 
	    &squawk("newinfo: invalid password.");
	    &log("FAILED newinfo $clean_list PASSWORD");
	    while (<>) {
		$_ = &chop_nl($_);
		if ($_ eq "EOF") {
		    last;
		}
	    }
	    # if we read to actual end-of-file, we are done
	    if (eof) {
		&done();
	    }
	}
    } else {
	&squawk("newinfo: unknown list '$list'.");
        while (<>) {
	    $_ = &chop_nl($_);
	    if ($_ eq "EOF") {
	        last;
	    }
        }
	# if we read to actual end-of-file, we are done
	if (eof) {
	    &done();
	}
    }
}

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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }

    (local($passwd) = shift)	|| &squawk("config: needs password");
    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 send the new config if it exists

	    if (&lopen(LCONFIG, "", "$listdir/$clean_list.config")) {
	    while (<LCONFIG>) {
		print REPLY $_;
	    }
	    print REPLY "\n#[Last updated ", 
			&chop_nl(&ctime((stat(LCONFIG))[9])), "]\n";
	    &lclose(LCONFIG);
	   
	    } else {
	    print REPLY "#### No config available for $clean_list.\n";
	    }
        } else {
	    &squawk("config: invalid password.");
	    &log("FAILED config $clean_list PASSWORD");
        }
    } else {
	&squawk("config: 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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }

    (local($passwd) = shift)	|| &squawk("newconfig: needs password");
    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 write the new config
	    # off to the side to validate it.
	    if (&lopen(NCONFIG, ">", "$listdir/$clean_list.new.config")) {
		while (<>) {
		    $_ = &chop_nl($_);
		    if ($_ eq "EOF") {
			last;
		    }
		    print NCONFIG $_, "\n";
		}
		&lclose(NCONFIG);

		if ( &get_config($listdir, "$clean_list.new"))  {
		    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");
		    unlink "$listdir/$clean_list.new.config";
		    return (1);
		} 

		&shlock( "$listdir/$clean_list.config.LOCK");
		$rename_fail = 0;
		do { print REPLY "rename current -> old failed $!";
			$rename_fail = 1; } 
			if ( !rename("$listdir/$clean_list.config",
			             "$listdir/$clean_list.old.config") );
		do { print REPLY "rename new -> current failed $!";
			$rename_fail = 1; } 
			if ( !$rename_fail && 
			     !rename("$listdir/$clean_list.new.config",
			             "$listdir/$clean_list.config"));

		unlink( "$listdir/$clean_list.config.LOCK");

		print REPLY "New config for list $clean_list accepted.\n"
			if !$rename_fail;

		&log("newconfig $clean_list PASSWORD");
		&get_config($listdir, $clean_list);
	    } else {
		&abort("Can't write $listdir/$clean_list.info: $!");
	    }
	} else {
	    &squawk("newconfig: invalid password.");
	    &log("FAILED newconfig $clean_list PASSWORD");
	    while (<>) {
		$_ = &chop_nl($_);
		if ($_ eq "EOF") {
		    last;
		}
	    }
	    # if we read to actual end-of-file, we are done
	    if (eof) {
		&done();
	    }	
	}
    } else {
	&squawk("newconfig: unknown list '$list'.");
        while (<>) {
	    $_ = &chop_nl($_);
	    if ($_ eq "EOF") {
		    last;
	    }
	}
        # if we read to actual end-of-file, we are done
	if (eof) {
	    &done();
	}	
    }
}

sub do_writeconfig {
    # Check to make sure we've got the right arguments
    # and Check that the list is valid
    local($sm) = "writeinfo";
    local($list) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }

    (local($passwd) = shift)	|| &squawk("writeconfig: needs password");
    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 write current config
		&config'writeconfig($listdir, $list);
		print REPLY "wrote new config for list $clean_list.\n";
		&log("writeconfig $clean_list PASSWORD");
	} else {
	    &squawk("writeconfig: invalid password.");
	    &log("FAILED writeconfig $clean_list PASSWORD");
	}
    } else {
	&squawk("writeconfig: unknown list '$list'.");
    }
}

sub do_mkdigest { 
    # Check to make sure we've got the right arguments
    (local($list) = shift)	|| &squawk("config: which list?");
    (local($passwd) = shift)	|| &squawk("config: 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 "*** dodigest: Failure on exec of digest $!\n";
		print REPLY @digest_errors;
	    	&log("FAILED dodigest $list: exec error");
	    } else {
		if ($? != 0 ) { # hey the exec worked
		   print REPLY "*** digest: failed errors follow\n";
		   print REPLY @digest_errors;
	    	   &log("FAILED dodigest $list: errors during digest");
	        } else {
		    print REPLY @digest_errors;
	 	    &log("dodigest $clean_list");
	        }
            }
        } else {
	    &squawk("dodigest: invalid password.");
	    &log("FAILED dodigest $clean_list PASSWORD");
        }
    } else {
	&squawk("dodigest: unknown list '$list'.");
    }
}

sub do_lists {
    # Tell the requester what lists we serve
    local($list);
    local($command_advert, $command_noadvert);	
    local($reply_addr) = &ParseAddrs($reply_to);

    select((select(REPLY), $| = 1)[0]);

    print REPLY "$whoami serves the following lists:\n\n";

    while(<${listdir}/*>) {
	$list = $_;
	$list =~ s,^.*/,,;		# strip off leading path
	$list =~ /[^-_0-9a-zA-Z]/ && next; # skip non-list files (*.info, etc.)

	&get_config($listdir, $list) if !&cf_ck_bool($list, '', 1);

	if (    ($'config_opts{$list, 'advertise'} ne '') 
	     || ($'config_opts{$list, 'noadvertise'} ne '') ) {

	    local(@array) = ();
	    local($i, $command, $result) = ();
		$result = 0;
		
		if ($'config_opts{$list, 'advertise'} ne '') {
		   @array = split(/\001/,$'config_opts{$list, 'advertise'});
		   foreach $i (@array) {
		      $command = "(qq~$reply_addr~ =~ $i)";
		      $result = 1, last if (eval $command);
		   }
                } else { $result = 1; }

		@array = ();
		if ($result) {
		   @array = split(/\001/,$'config_opts{$list, 'noadvertise'});

		   foreach $i (@array) {
		      $command = "(qq~$reply_addr~ =~ $i)";
		      $result = 0, last if (eval $command);
                   }
		}

		$result	 = &is_list_member($reply_to, $listdir, $list)
			if ! $result;

		printf REPLY "  %-20s %-56s\n", $list,
			$config_opts{$list, 'description'} if $result;
	} else {
		printf REPLY "  %-20s %-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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }


    (local($filename) = shift) ||	&squawk("get: which file?");

    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 ((&cf_ck_bool($clean_list,"private_get") )
		&& ! &is_list_member($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("get: invalid file '$filename' for list '$clean_list'.");
	}
    } else {
	&squawk("get: 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) = shift;
    local($clean_list);
    if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
	&& defined($deflist)) {
        unshift(@_,$list) ; 				# Not a list name, put it back.
	$list=$deflist || &squawk("$sm: which list?");	# set the list to deflist
        $clean_list = &valid_list($listdir, $list);
    }


    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 ((&cf_ck_bool($clean_list,"private_index"))
		&& ! &is_list_member($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" ) {
		chdir "$filedir/$clean_list$filedir_suffix" ||
		    &squawk("index: cannot access directory");
		open(INDEX,"$index_command|") ||
		    &squawk("index: index command failed");
		while (<INDEX>) {
		    print REPLY $_;
		}
		close INDEX ||
		    &squawk("index: index command failed");;
	    } else {
		print REPLY "#### No files available for $clean_list.\n";
	    }
	}
    } else {
	&squawk("index: unknown list '$list'.");
    }
    &log("index $list");
    chdir("$homedir");
}

sub do_help {

    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\".\n";

    $listrequest = "." unless $majordomo_request;

    print REPLY <<"EOM"; 
This is Brent Chapman's "Majordomo" mailing list manager, version $majordomo_version. 

In the description below items contained in []'s are optional. When
providing the item, do not include the []'s around it.

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>.

    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>.

    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

Commands in the "Subject:" line NOT processed.

If you have any questions or problems, please contact
"$whoami_owner".

EOM

    &log("help");
}

# 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", "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

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);

    # delete all the temporary files; do it this long ugly way
    # because of a bug in PERL filename globbing
    $_ = `echo $tmp.*`;
    $_ = &chop_nl($_);
    foreach (split(" ", $_)) {
	unlink($_) || warn("Can't unlink $_: $!") if ! /\*$/;
    }

    # 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(" ", @_);

    # 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";


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 command
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 command
EOM
}

print MSG <<"EOM";
in the body of your email message:

    unsubscribe $list $subscriber

Here's the general information for the list you've
subscribed to, in case you don't already have it:

EOM
    
    # send them the info for the list, if it's available
    if (&lopen(INFO, "", "$listdir/$list.info")) {
	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
    &sendmail(NOTICE, "$list-approval", "SUBSCRIBE $list");
    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.

sub check_and_request {
    local($request) = shift;
    local($clean_list) = shift;
    local($subscriber) = shift;

    # 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("subscribe: 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
    } else {
	&request_approval($request, $clean_list, $subscriber);
    }
}
