#!/usr/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);
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

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 "Die Zeichenkette '$subscriber' taucht in folgenden\n";
    print REPLY "Listen auf, die $whoami verwaltet:\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 "Maximale Anzahl von Treffern ($max_which_hits) ueberschritten\n";
		last;
	    }

	    $_ = &chop_nl($_);
	    if (&addr_match($_, $subscriber, 1)) {
		if ($count == 0) {
		    printf REPLY "%-23s %s\n", "Liste", "Adresse";
		    printf REPLY "%-23s %s\n", "=====", "=======";
		}
		printf REPLY "%-23s %s\n", $list, $_;
		$count++;
		$per_list_hits++;
	    }
	}
	close(LIST);
    }
    if ($count == 0) {
	print REPLY "**** Keine Uebereinstimmung gefunden\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 "**** Befehl deaktiviert.\n";
	    return 0;
	}
	    
	if ( !$approved 
	    && ! &access_check("who", $reply_to, $listdir, $clean_list)) {
	    print REPLY "**** Die Liste '$clean_list' ist eine geschlossene Liste.\n";
	    print REPLY "**** Nur Teilnehmer der Liste koennen 'who' nutzen.\n";
	    print REPLY "**** Du [ $reply_to ] bist nicht in der Liste '$clean_list'.\n";
	    return 0;
	}
	#open it up and tell who's on it
	print REPLY "Teilnehmer der Liste '$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: Die Liste '$list' gibt es hier nicht\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 "#### Keine info fuer $clean_list verfuegbar.\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 "#### Keine intro fuer $clean_list verfuegbar.\n";
	}
    } else {
	&squawk("$sm: Unbekannte Liste '$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 verwaltet folgende Listen:\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 "\nNutze den Befehl 'info <list>', um mehr Infos zu einer\n";
    print REPLY "speziellen Liste zu bekommen.\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 "**** Befehl deaktiviert.\n";
	    return 0;
	}

	if ( !$approved 
	    && ! &access_check("get", $reply_to, $listdir, $clean_list)) {
	    print REPLY "**** Die Liste '$clean_list' ist eine geschlossene Liste.\n";
	    print REPLY "**** Nur Teilnehmer der List koennen 'get' Kommandos nutzen.\n";
	    print REPLY "**** Du [ $reply_to ] bist nicht in der Liste '$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' Anfrage an $ftpmail_address weitergeleitet\n";
	    } else {
		# file handling is done locally.
		if ($clean_file) {
#		if (&lopen(GETFILE, " ", "$clean_file")) {
#		    # Set up the sendmail process to send the file
#		    &sendmail(GETFILEMSG, $reply_to,
#			"Majordomo Datei: '$clean_list/$filename'");
#		    while (<GETFILE>) {
#			print GETFILEMSG $_;
#		    }
#		    # close (and thereby send) the file
#		    close(GETFILEMSG);
#		    &lclose(GETFILE);
		    print REPLY <<"EOM";
Mail ist kein File-Transfer-Programm!
Nutze folgenden URL, um die Datei '$filename' der Liste '$clean_list'
herunterzuladen:

  http://www.$whereami/mail/lists/$clean_list/$filename

Benutze den dir bekannten Login + Passwort oder erfrage selbigen
vom webmaster\@$whereami.
EOM
		} else {
		    print REPLY
		    "#### Die Datei '$filename' existiert nicht fuer die Liste '$clean_list'\n";
		}
	    }
	} else {
	    &squawk("$sm: ungueltige Datei '$filename' fuer Liste '$clean_list'.");
	}
    } else {
	&squawk("$sm: unbekannte Liste '$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 "**** Befehl deaktiviert.\n";
	    return 0;
	}

	if ( !$approved 
	    && ! &access_check("index", $reply_to, $listdir, $clean_list)) {
	    print REPLY "**** Die Liste '$clean_list' ist eine geschlossene Liste.\n";
	    print REPLY "**** Nur Teilnehmer der Liste koennen 'index' nutzen.\n";
	    print REPLY "**** Du [ $reply_to ] bist nicht in der Liste '$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' Anfrage an $ftpmail_address weitergeleitet\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 Befel $index_command fehlgeschlagen.\n$! $?");
			&squawk("$sm: index Befel fehlgeschlagen");
		    }
		}
		else {
		    &bitch("Cannot chdir to $filedir/$clean_list$filedir_suffix to build index\n$!");
		    &squawk("$sm: index Befel fehlgeschlagen");
		}
	    } else {
		print REPLY "#### Keine Dateien fuer $clean_list verfuegbar.\n";
	    }
	}
    } else {
	&squawk("$sm: unbekannte Liste '$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 .= "\nDer <list> Parameter ist nur optional, wenn die";
    $listrequest .= "Nachricht an eine Adresse der Form ";
    $listrequest .= "\"<list>-request\@$whereami\"\n gesendet wird.";

    $listrequest = "." unless $majordomo_request;

    print REPLY <<"EOM"; 

Diese Hilfe wurde dir vom Majordomo mailing list management system
$whoami zugesendet.

Verwendet wird Majordomo, Version $majordomo_version.

Falls du dich im Umgang mit Mail-Verteilern auskennst: eine Zusammenfassung
von Majordomo's Befehlen befindet sich am Ende dieser Nachricht.

Majordomo ist ein automatisiertes System, das Nutzern erlaubt,
sich in Mailing-Listen ein- und auszutragen als auch Dateien
aus List-Archiven abzurufen.

Du kannst mit der Majordomo Software interagieren, indem du Nachrichten
an "$whoami" schickst, die im Mail-Body ein oder mehrere
Befehle enthalten, die wiederum per email beantwortet werden.

Bitte schreibe die Befehle nicht in die Betreff-Zeile (Subject:),
da Majordomo diese Zeile nicht verarbeitet.

Jeder Befehl muss in einer separaten Zeile stehen.

Falls du eine Signatur am Ende deiner Mail verwendest, koennte
Majordomo diese u.U. als Befehl interpretieren und diverse
Fehlermeldungen zur folge haben. Um selbiges zu vermeiden,
fuege entweder eine Zeile vor der Signatur ein, die mit einem
Bindestrich ("-") beginnt oder nur das Wort 

	end

enthaelt. An dieser Stelle hoert Majordomo auf, nach weiteren
Befehlen in der Nachricht zu suchen.


Im folgenden einige Sachen, die du mittels Majordomo nutzen kannst:


I.      WELCHE LISTEN GIBT ES AUF DIESEM SYSTEM ?

Um eine Liste aller oeffentlich verfuegbaren Listen auf diesem System
zu bekommen, sende eine Nachricht mit folgenden Befehl an $whoami:

	lists


Die Anwort enthaelt dann in jeder Zeile den Namen und eine kurze
Beschreibung der Liste.

Um weitere Informationen zu einer bestimmten Liste zu bekommen, verwende
den "info" Befehl, der den Namen der jeweiligen Liste enthaelt.
Wenn beispielsweise der Name der Liste, ueber die du weitere Informationen
haben moechtest, "demo-list" ist, muesstest du den Befehl:

	info demo-list

in deine Nachricht an $whoami einfuegen.


II.	EINTRAGEN IN EINE LISTE

Um alle Mails einer oder mehrerer Listen dieses Systems zugesendet
zu bekommen, ist es notwendig, sich in die entsprechenden Listen
einzutragen. Dies wird mit dem Majordomo Befehl "subscribe" bewerkstelligt.

Um alle Mails einer Liste an die Adresse geschickt zu bekommen, 
die in deinen emails im Kopf als Absender-Adresse steht, schicke
einfach ein den Befehl "subscribe" gefolgt von dem gewuenschten
Mailing-Listen-Namen an $whoami:

	subscribe demo-list

Falls du jedoch wünschst, dass nicht deine Absender-Adresse sondern
eine andere (z.B. generische, d.h. nutzer\@do.main statt nutzer\@xy.do.main)
Adresse eingetragen werden soll, kannst du diese hinter den Listen-Namen
im subscribe-Befehl schreiben. Beispiel:

	subscribe demo-list jqpublic\@my-isp.com

Je nach Konfiguration der Liste wirst deine Adresse automatisch eingetragen
oder zuvor noch einer Bestaetigung der "subscribe"-Anfrage von der
jeweiligen email-Adresse angefordert. Die entsprechende Mail enthaelt
den Befehl inklusive Schlüssel der an $whoami zum Vollzug der Eintragung
in die jeweilig Mailing-Liste notwendig ist.

Desweiteren bekommst du noch eine Nachricht mit der Info, dass
dein Wunsch nach Eintragung in die Liste zur Bewilligung an den 
jeweiligen Moderator geschickt wurde, wenn die jeweilige Liste
eine geschlossene/nicht oeffentliche Liste ist. Hat der Moderator
den Eintrag bewilligt, erhaelst du automatisch eine eine Info
darueber vom System.

Nach dem Eintrag in die jeweilige Liste solltest du eine Nachricht
mit einer kurzen Einfuehrung (Intro bzgl. Zweck, Policy und Features)
in die Liste bekommen. Diese Nachricht solltest du zwecks spaeterer
Verwendung abspeichern; Sie enthält die exakten Anweisungen, um sich
aus der Liste wieder austragen zu lassen. 

Falls du diese Nachricht verlierst, du aber noch einmal eine Einfuehrung
in die Liste haben moechtest, sende folgenden Befehl an $whoami:

	intro demo-list

(selbstverstaendlich sollte "demo-list" mit dem jeweils beabsichtigten
Listen-Namen ersetzt werden).


III.	AUSTRAGEN AUS EINER MAILING LISTE

Deine originale Intro-Nachricht enthaelt den exakten Befehl, der
genutzt werden sollte, um deine Adresse aus der Mailing-Liste 
auszutragen. Wie auch immer, in den meisten Faellen reicht es,
einfach den Befehl "unsubscribe" gefolgt von dem jeweiligen 
Listen-Namen an $whoami zu senden:

	unsubscribe demo-list

(Falls dein Provider die Form der im Kopf von Nachrichten gezeigten
Absender-Adresse geaendert hat, kann dieser Befehl fehlschlagen. In
diesem Falle nutze die nachfolgende Variante.)

Um eine Adresse aus der Liste auszutragen, die nicht mit der 
Absender-Adresse der "Befehls"-Mail uebereinstimmt, ist es notwendig,
die gewuenschte Adresse hinter dem Listen-Namen im "unsubscribe"-
Befehl zu schreiben:

	unsubscribe demo-list jqpublic\@my-isp.com

In jedem Falle kannst du $whoami befehlen, die fragliche Adresse
aus allen Listen des Systems auszutragen, indem anstelle des 
Listen-Namens ein "*" eingesetzt wird:

	unsubscribe *
	unsubscribe * jqpublic\@my-isp.com


IV.	IN WELCHEN LISTEN BIN ICH EINGETRAGEN

Um herauszufinden, in welchen Listen du eingetragen bist, sende
folgenden Befehl an $whoami:

	which

Desweiteren kannst du nach anderen Adressen oder Teilen von Adressen
suchen, indem der jeweilige Text an den befehl angehangen wird.
Um beispielsweise herauszufinden, welche Nutzer von my-isp.com in
der Liste eingetragen sind, koennte man folgenden Befehl nutzen:

	which my-isp.com

Dies funktioniert aber nur, wenn der Listen-Administrator diesen
Befehl freigegben hat. 


V.	WER IST ALLES IN EINER BESTIMMTEN LISTE

Um herauszufinden, wer alles in einer bestimmten Liste eingetragen ist,
kann der "who"-Befehl, gefolgt von dem jeweiligen Listen-Namen genutzt
werden:

	who demo-list

Dies funktioniert aber nur, wenn der Listen-Administrator diesen
Befehl freigegben hat. I.d.R. ist dieser Befehl nur fuer in die
Liste eingetragene Nutzer freigeschaltet.


VI.	ABRUFEN VON DATEIN EINES LISTEN-ARCHIVS

Viele Listen-Administratoren (aka Owner) bewahren alle ueber eine Liste
versendeten Mails in zugehorigen Archiven bzw. zu der Liste gehörige
Informationen und Dokumente in Form von Dateien auf.

Um herauszufinden, welche dateien zu einer bestimmten Liste existieren,
kann der "index"-Befehl genutzt werden:

	index demo-list

Falls du Dateien siehst, die dich interessieren, kannst du selbige
mittels "get"-Befehl, gefolgt vom Listen-Namen und der jeweiligen
Datei abrufen.

Um beispielsweise eine Datei namens "profile.form" und eine namens
"demo-list.9611" abzurufen, wuerde man folgende Befehle verwenden:

	get demo-list profile.form
	get demo-list demo-list.9611


VII.	WEITERE HILFE

Um einen Administratoren (owner) des Systems zu kontaktieren,
sende deine email an  $whoami_owner.

Um einen Administratoren einer speziellen Liste zu kontaktieren,
sende deine email an die "approval"-Adresse der jeweiligen Liste.
Selbige setzt sich aus dem Namen der Liste, angehangenem 
"-approval" und dem Domain-Teil (\@do.main) zusammen.

Um beispielsweise den Admin der Liste demo-list\@$whereami
zu kontaktieren, muesste man eine Mail an
demo-list-approval\@$whereami schicken.


Um eine Kopie dieser Hilfe zu erhalten, sende man eine Mail
mit folgendem Befehl an $whoami:

	help


VIII.	BEFEHLS-ZUSAMMENFASSUNG FÜR FORTGESCHRITTENE

In der folgenden Beschreibung sind alle in [] eingeschlossene Parameter
optional. Ergo, wenn du den jeweiligen Parameter nutzt, lass die Klammern
weg - sie sind nicht Teil des Befehls ! 
In < > eingeschlossene Begriffe (wie z.B. Adressen) stellen Meta-Symbole
bzw. Variable dar, welche durch einen entsprechenden Text ohne die
Klammern ersetzt werden sollten.

Majordomo versteht folgende Befehle:

    subscribe $list4help [<address>]
	Trage Absender der mail bzw. die angegeben Adresse (falls angegeben)
	in die Liste ein.
	
    unsubscribe $list4help [<address>]
	Trage Absender der mail bzw. die angegeben Adresse (falls angegeben)
	in die Liste aus. Ein "*" anstelle des Listen-Namens bewirkt ein
	Austragen aus allen Listen des Systems.

    get $list4help <filename>
        Abruf der zur <list> gehoerenden Datei <filename>.

    index $list4help
	Zeige alle fuer <list> abrufbaren Dateien.

    which [<address>]
	Finde heraus, in welchen Listen der Absender bzw. die angegebene
	Adresse (falls vorhanden) eingetragen ist.

    who $list4help
	Finde heraus, wer alles in der <list> eingetragen ist.

    info $list4help
	Schicke allgemeine Informationen zur genannten <list>.

    intro $list4help
	Schicke eine Einfuehrung fuer die genannten <list>. Nicht
	eingetragene Nutzer koennen diesen Befehl i.d.R. nicht nutzen. 

    lists
	Zeige alle Listen, die dieser Majordomo server pflegt.

    help
	Schicke diese Hilfe.

    end
	Beende die Suche nach weiteren Befehlen zur Verarbeitung
	(sinnvoll vor Signaturen).

Befehle sollten im Körper (body) an folgende Adresse gesendet werden:
"$whoami"$listrequest. Mehrere Befehle koennen in einer einizigen
Mail korrekt verarbeitet werden, solange sie jeweils auf einer
separaten Zeile stehen.

Befehle in der Betreff-Zeile ("Subject:") werden nicht verarbeitet.

Falls du irgendwelche Fragen oder Probleme hast, kontaktiere:
"$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";
Jemand (wahrscheinlich du) hat die Ein- bzw. Austragung deiner
email-Adresse in die Mailing-Liste "$list\@$whereami" beantragt.

Falls du dass wirklich wuenschst, sende das folgende Kommando
(genau so, wie es dasteht) an die email-Adresse "$whoami":

	auth $cookie $cmd $list $subscriber

Falls du das nicht wuenschst, ignoriere einfach diese Nachricht.
Die Anfrage wird dann automatisch vom System verworfen.

Falls dein Mail-Programm es nicht unterstuetzt, das gesamte Kommando in
einer Zeile zu versenden, kannst du selbiges mittels Backslashes
splitten, wie z.B.:

        auth $cookie $cmd $list \\
        $subscriber

Falls du irgendwelche Fragen bzgl. Policy des Listen-Verwalters hast,
kontaktiere bitte "$list-approval\@$whereami".

Vielen Dank!

$whoami
EOM
	close(AUTH);

    print REPLY <<"EOM";
**** Ihre Anfrage an $whoami:
**** 
**** 	$cmd $list $subscriber
**** 
**** muss authentifiziert werden. Um dies zu bewerkstelligen, muss eine
**** weitere Anfrage mit dem Berechtigungs-Schluessel eingehen,
**** der an folgende Adresse versendet wurde:
****
**** 	$subscriber
**** 
**** Falls die Nachricht nicht eingetroffen ist, koennte das bedeuten,
**** dass es ein Probleme mit der Adresse gibt. Bevor du jedoch das Problem
**** meldest, beachte folgende Dinge:
****
**** Du musst nur eine Adress am Ende des "subscribe"-Befehls angeben,
**** wenn du eine andere als die im Absender deiner Mail generierte
**** Adresse in eine Liste ein/austragen moechtest. Anderenfalls kann
**** die Adresse weggelassen werden.
****
**** Falls du eine Adresse im "subscribe"-Befehls angegeben hast, so muss
**** dies eine regulaere Adresse sein. Sie darf nicht einfach nur dein
**** Vor- oder/und Zuname sein. Desweiteren muss die Adresse auf einen
**** Mailserver verweisen, der von diesem List-Server aus 
**** (also im Internet) erreichbar ist.
****
**** Falls du irgendwelche Fragen bzgl. Policy des List-Admins hast,
**** kontaktiere bitte "$list-approval\@$whereami".
**** 
**** Vielen Dank!
**** 
**** $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";
Deine Anfrage an $whoami:

	$cmd $list $subscriber

wurde an den Administrator der Liste "$list" zwecks Bewilligung weitergeleitet.
Das kann unterschiedliche Gruende haben:

    Du hast eine Eintragung fuer eine "geschlossene" Liste beantragt,
        bei der alle neuen Zugaenge durch den Listen-Administrator
        erst bewilligt werden muessen.

    Du hast eine Aus/Eintragung einer Adresse beantragt, die nicht 
        mit der im Kopf deiner Nachricht uebereinstimmt.

Wenn der Listen-Administrator deine Anfrage bewilligt hat, erhaelst du
eine Nachricht.

Falls du irgendwelche Fragen bzgl. Policy des Listen-Administrators hast,
kontaktiere bitte "$list-approval\@$whereami".

Vielen Dank!

$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 "**** Keine gueltigen Befehle gefunden.\n";
	print REPLY "**** Befehle muessen im Nachrichten-Körper (body) und\nnicht im Kopf (HEADER) enthalten sein.\n\n";
    }
    if ($needs_help || ($count == 0)) {
	print REPLY "**** Hilfe fuer $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 "Herzlich Willkommen auf der $list mailing list!\n\n";

     print MSG "Bitte speichere diese Nachricht zwecks spaeterer Verwendung. Vielen Dank.\n";

    if ( $majordomo_request ) {
	print MSG <<"EOM";

Falls du jemals von der Liste geloescht werden moechtest, sende folgenden
Befehl via email an:
\<${clean_list}-request\@$whereami\>:

    unsubscribe


Alternativ kannst du auch eine email mit folgendem Befehl
im Mail-Body an \<$whoami\> schicken:

EOM
    
} else {
print MSG <<"EOM";

Falls du jemals von der Liste geloescht werden moechtest, 
kannst du eine email mit folgendem Befehl im Mail-Body
an \<$whoami\> schicken:
EOM
}

print MSG <<"EOM";

    unsubscribe $list

oder fuer eine andere Adresse als $subscriber:

    unsubscribe $list $subscriber

EOM
print MSG <<"EOM";
Falls du jemals den Administrator der Liste kontaktieren moechtest
(im Falle von Problemen oder Fragen bzgl. der Liste selbst),
sende deine email an \<owner-$clean_list\@$whereami\> .
Dies ist eine allgemein übliche Adress-Regel fuer Mailing-Listen,
wenn du ein menschliches Wesen kontaktieren moechtest.

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";
 Hier sind die allgemeine Informationen fuer die Liste, in der du
 die eintragen lassen hast (fuer den Fall, dass du sie noch nicht hast):

EOM
#';
     while (<INFO>) {
	    print MSG $_;
	}
	&lclose(INFO);
    } else {
	print MSG "#### Kein Infos fuer $list verfuegbar.\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);
}