| Current Path : /usr/local/majordomo/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
| Current File : //usr/local/majordomo/majordomo |
#!/usr/bin/perl
# $Modified: Thu Jan 13 18:29:15 2000 by cwilson $
use Jcode;
# 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 (not sysopen CONFIG,$cf,O_RDONLY)
{
die sprintf qq|Unable to sysopen config file "$cf"%s.\n|,$! ? ": $!" : '';
}
elsif ((stat CONFIG)[4] != $>)
{
die qq|Config file "$cf" not owned by effective UID.\n|;
}
elsif (eval(join '',<CONFIG>),$@)
{
die qq|Unable to eval "$cf": $@.\n|;
}
else
{
close CONFIG;
}
# 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
use Digest::MD5 qw( md5_hex );
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/sbin/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 ">>>> $_\n"; # 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 "----------\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 "----------\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)) {
my $msg = "**** すでに $clean_list に登録されています。\n";
print REPLY Jcode::convert(\$msg, 'jis');
&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) {
my $msg = "登録に成功しました。(to list $deflist)\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
else {
my $msg = "登録に成功しました。\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
&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) {
my $msg = "**** $subscriber は $list メンバーではありません。\n";
print MSG Jcode::convert(\$msg, 'jis');
}
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
&& (($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) {
my $msg = "登録解除に成功しました。(from list $deflist)\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
elsif ($quietnonmember) {
my $msg = "登録解除に成功しました。(from list $clean_list)\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
else {
my $msg = "登録解除に成功しました。\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
&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) {
my $msg = "**** $subscriber は登録されていません。\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
else {
my $msg = "**** 登録解除に失敗しました。\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
unlink("$listdir/$clean_list.new");
&lclose(LIST);
} else {
print STDERR "do_unsubscribe: authorization failed, calling check_and_request.\n" if $DEBUG;
&check_and_request($sm, $clean_list, $subscriber);
}
} else {
&squawk("$sm: unknown list '$list'.");
}
}
sub do_auth {
# Check to see we've got all the arguments; the address is allowed to
# contain spaces, so since our argument list was split on spaces we
# have to join them back together.
local($auth_info, $cmd, $list, @sub) = @_;
if ( !length($auth_info)
|| ($cmd ne 'subscribe'
&& $cmd ne 'unsubscribe') # can only authorize [un]subscribes at the moment
) {
&squawk("auth: needs key");
return 0;
}
$sub = join(' ',@sub);
if ( $cmd eq "subscribe" ) {
&do_subscribe($list, $sub);
}
elsif ( $cmd eq "unsubscribe" ) {
&do_unsubscribe($list, $sub);
}
}
sub do_approve {
# Check to see we've got all the arguments
local($sm) = "approve";
local($passwd, $cmd);
($passwd = shift) || &squawk("$sm: needs passwd");
($cmd = shift) || &squawk("$sm: which command?");
$cmd =~ tr/A-Z/a-z/; # downcase the command
# Check to see if the list is valid or use default list.
# and check to see if we've got a valid list
local($list, $clean_list, @args) = &get_listname($sm, -1, @_);
if ($clean_list ne "") {
# get the config info for the command
&get_config($listdir, $clean_list)
if !&cf_ck_bool($clean_list, '', 1);
# The list is valid; now check to see if the password is
if (&valid_passwd($listdir, $clean_list, $passwd)) {
# The password is valid, so set "approved" and do the request
$approved = 1;
if ($cmd eq "subscribe") {
local($subscriber);
($subscriber = join(" ",@args)) || &squawk("$sm: who?");
&log("approve PASSWORD subscribe $clean_list $subscriber");
&do_subscribe($clean_list, $subscriber);
} elsif ($cmd eq "unsubscribe") {
local($subscriber);
($subscriber = join(" ",@args)) || &squawk("$sm: who?");
&log("approve PASSWORD unsubscribe $clean_list $subscriber");
&do_unsubscribe($clean_list, $subscriber);
} elsif ($cmd eq "get"
|| $cmd eq "index"
|| $cmd eq "info"
|| $cmd eq "intro"
|| $cmd eq "who"
|| $cmd eq "which") {
&log("approve PASSWORD $cmd $clean_list " . join(" ", @args));
$sub = "do_$cmd";
&$sub($clean_list, @args);
} else {
# you can only approve the above
&squawk("$sm: invalid command '$cmd'");
}
} else {
&squawk("$sm: invalid list or password.");
}
} else {
&squawk("$sm: unknown list '$list'.");
}
}
sub do_passwd {
# check to see that we've got all the arguments
# and check to see if we've got a valid list
local($sm) = "passwd";
local($list, $clean_list, $passwd, $new_passwd) = &get_listname($sm, 2, @_);
&squawk("$sm: need old password") unless $passwd;
&squawk("$sm: need new password") unless $new_passwd;
if ($clean_list eq "") {
&squawk("$sm: invalid list '$list'");
return;
}
# We've got a valid list; now see if the old password is valid
# get the config info for the command
&get_config($listdir, $clean_list)
if !&cf_ck_bool($clean_list, '', 1);
if (&valid_passwd($listdir, $clean_list, $passwd)) {
# The old password is correct, so make sure the new one isn't null
if ($new_passwd eq "") {
&squawk("$sm: null 'new_passwd'.");
return;
}
# The new password is valid, too, so write it.
local($mode, $uid, $gid) =
(stat("$listdir/$clean_list.passwd"))[2,4,5];
$mode = (0660) if !$mode;
if (&lopen(PASSWD, ">", "$listdir/$clean_list.passwd")) {
print PASSWD $new_passwd, "\n";
&lclose(PASSWD);
# set the file mode appropriately
chmod($mode, "$listdir/$clean_list.passwd");
chown($uid, $gid, "$listdir/$clean_list.passwd") if defined($uid);
print REPLY "Password changed.\n";
} else {
&abort("Can't open $listdir/$clean_list.passwd: $!");
}
&log("passwd $clean_list OLD NEW");
} else {
print REPLY "**** Sorry; old password incorrect.\n";
&log("FAILED passwd $clean_list OLD NEW");
}
}
sub do_which {
local($subscriber) = join(" ", @_) || &valid_addr($reply_to);
local($count, $per_list_hits) = 0;
# Tell the requestor which lists they are on by reading through all
# the lists, comparing their address to each address from each list
# print REPLY "The string '$subscriber' appears in the following\n";
# print REPLY "entries in lists served by $whoami:\n\n";
opendir(RD_DIR, $listdir) || &abort("opendir failed $!");
@lists = readdir(RD_DIR);
closedir(RD_DIR);
foreach (sort @lists) {
/[^-_0-9a-zA-Z]/ && next; # skip non-list files (*.info, etc.)
$list = $_;
# get configuration info
&get_config($listdir, $_) if !&cf_ck_bool($_, '', 1);
# access check
#
next if ! &access_check("which", $reply_to, $listdir, $list);
open(LIST, "$listdir/$list") ||
&abort("Can't open list $listdir/$list");
while (<LIST>) {
if (! $approved
&& $max_which_hits
&& $max_which_hits < $per_list_hits) {
print REPLY "Maximum number of hits ($max_which_hits) exceeded\n";
last;
}
$_ = &chop_nl($_);
if (&addr_match($_, $subscriber, 1)) {
if ($count == 0) {
printf REPLY "%-23s %s\n", "List", "Address";
printf REPLY "%-23s %s\n", "====", "=======";
}
printf REPLY "%-23s %s\n", $list, $_;
$count++;
$per_list_hits++;
}
}
close(LIST);
}
if ($count == 0) {
my $msg = "**** 見つかりませんでした。\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
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/ ) {
my $msg = "**** コマンドが利用できません。\n";
print REPLY Jcode::convert(\$msg, 'jis');
return 0;
}
if ( !$approved
&& ! &access_check("who", $reply_to, $listdir, $clean_list)) {
my $msg = "**** '$clean_list' リストはメンバーのみ取得可能です。\n";
print REPLY Jcode::convert(\$msg, 'jis');
return 0;
}
#open it up and tell who's on it
my $msg = "'$clean_list' メンバーリスト\n\n";
print REPLY Jcode::convert(\$msg, 'jis');
if (&lopen(LIST, "", "$listdir/$clean_list")) {
while (<LIST>) {
print REPLY Jcode::convert(\$_, 'jis');
$counter++;
}
&lclose(LIST);
printf REPLY "\n%s member%s\n\n", ($counter ? $counter : "No"),
($counter == 1 ? "" : "s");
&log("who $clean_list");
} else {
&abort("Can't open $listdir/$clean_list: $!");
}
} else {
my $msg = "*** '$list' リストが存在しません。\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
}
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 Jcode::convert(\$_, 'jis');
}
print REPLY "\n[Last updated ", &chop_nl(&ctime((stat(INFO))[9])),
"]\n\n" if !&cf_ck_bool($clean_list,"date_info");
&lclose(INFO);
} else {
my $msg = "info メッセージ文が用意されていません。($clean_list)\n\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
} 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 Jcode::convert(\$_, 'jis');
}
print REPLY "\n[Last updated ", &chop_nl(&ctime((stat(INFO))[9])),
"]\n\n" if !&cf_ck_bool($clean_list,"date_intro");
&lclose(INFO);
} else {
my $msg = "intro メッセージ文が用意されていません。($clean_list)\n\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
} else {
&squawk("$sm: unknown list '$list'.");
}
&log("intro $clean_list");
}
sub do_newintro {
# Check to make sure we've got the right arguments
# and Check that the list is valid
local($sm) = "newintro";
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
&squawk("$sm: needs password") unless $passwd;
if ($clean_list ne "") {
&get_config($listdir, $clean_list) if !&cf_ck_bool($clean_list, '', 1);
# The list is valid, so check the password
if (&valid_passwd($listdir, $clean_list, $passwd)) {
# The password is valid, so write the new intro
if (&lopen(INFO, ">", "$listdir/$clean_list.intro")) {
print INFO "[Last updated on: ", &chop_nl(&ctime(time())),
"]\n" if &cf_ck_bool($clean_list,"date_intro");
while (<>) {
$_ = &chop_nl($_);
if ($_ eq "EOF") {
last;
}
print INFO $_, "\n";
}
&lclose(INFO);
if (-s "$listdir/$clean_list.intro" > 0) {
chmod(0664, "$listdir/$clean_list.intro");
}
else {
unlink("$listdir/$clean_list.intro");
}
print REPLY "New intro for list $clean_list accepted.\n";
&log("newintro $clean_list PASSWORD");
} else {
&abort("Can't write $listdir/$clean_list.intro: $!");
}
} else {
&squawk("$sm: invalid password.");
&log("FAILED newintro $clean_list PASSWORD");
while (<>) {
$_ = &chop_nl($_);
if ($_ eq "EOF") {
last;
}
}
}
} else {
&squawk("$sm: unknown list '$list'.");
while (<>) {
$_ = &chop_nl($_);
if ($_ eq "EOF") {
last;
}
}
}
}
sub do_config {
# Check to make sure we've got the right arguments
# and Check that the list is valid
local($sm) = "config";
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
&squawk("$sm: needs password") unless $passwd;
if ($clean_list ne "") {
# The list is valid, parse the config file
&set_lock("$listdir/$clean_list.config.LOCK") ||
&abort( "Can't get lock for $listdir/$clean_list.config");
&get_config($listdir, $clean_list, "locked")
if !&cf_ck_bool($clean_list, '', 1);
#so check the password
if (&valid_passwd($listdir, $clean_list, $passwd)) {
# The password is valid, so send the new config if it exists
if (open(LCONFIG, "$listdir/$clean_list.config")) {
while (<LCONFIG>) {
print REPLY $_;
}
print REPLY "\n#[Last updated ",
&chop_nl(&ctime((stat(LCONFIG))[9])), "]\n";
close(LCONFIG) ||
print REPLY "Error writing config for $clean_list: $!";
} else {
print REPLY "#### No config available for $clean_list.\n";
}
} else {
&squawk("$sm: invalid password.");
&log("FAILED config $clean_list PASSWORD");
}
&free_lock("$listdir/$clean_list.config.LOCK");
} else {
&squawk("$sm: unknown list '$list'.");
}
&log("config $clean_list");
}
sub do_newconfig {
# Check to make sure we've got the right arguments
# and Check that the list is valid
local($sm) = "newconfig";
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
&squawk("$sm: needs password") unless $passwd;
if ($clean_list ne "") {
# The list is valid, parse the config file
&set_lock("$listdir/$clean_list.config.LOCK") ||
&abort( "Can't get lock for $listdir/$clean_list.config");
&get_config($listdir, $clean_list, "locked")
if !&cf_ck_bool($clean_list, '', 1);
# so check the password
if (&valid_passwd($listdir, $clean_list, $passwd)) {
# The password is valid, so write the new config
# off to the side to validate it.
local($oldumask) = umask($config_umask);
if (open(NCONFIG, ">$listdir/$clean_list.new.config")) {
while (<>) {
$_ = &chop_nl($_);
if ($_ eq "EOF") {
last;
}
print NCONFIG $_, "\n";
}
close(NCONFIG) ||
&abort("Can't write $listdir/$clean_list.config: $!");
umask($oldumask);
if ( &get_config($listdir, "$clean_list.new", "locked")) {
unlink "$listdir/$clean_list.new.config";
&free_lock("$listdir/$clean_list.config.LOCK");
print REPLY "The new config file for $clean_list was NOT accepted because:\n";
print REPLY @config'errors;
&log("FAILED (syntax) newconfig $clean_list PASSWORD");
return (1);
}
$rename_fail = 0;
if ( !rename("$listdir/$clean_list.config",
"$listdir/$clean_list.old.config") ) {
print REPLY "rename current -> old failed $!";
$rename_fail = 1;
}
elsif ( !rename("$listdir/$clean_list.new.config",
"$listdir/$clean_list.config")) {
print REPLY "rename new -> current failed $!";
$rename_fail = 1;
}
print REPLY "New config for list $clean_list accepted.\n"
if !$rename_fail;
&log("newconfig $clean_list PASSWORD");
&get_config($listdir, $clean_list, "locked");
} else {
&abort("Can't write $listdir/$clean_list.config: $!");
}
} else {
&squawk("$sm: invalid password.");
&log("FAILED newconfig $clean_list PASSWORD");
while (<>) {
$_ = &chop_nl($_);
if ($_ eq "EOF") {
last;
}
}
}
&free_lock("$listdir/$clean_list.config.LOCK");
} else {
&squawk("$sm: unknown list '$list'.");
while (<>) {
$_ = &chop_nl($_);
if ($_ eq "EOF") {
last;
}
}
}
}
sub do_writeconfig {
# Check to make sure we've got the right arguments
# and Check that the list is valid
local($sm) = "writeconfig";
local($list, $clean_list, $passwd) = &get_listname($sm, 1, @_);
&squawk("$sm: needs password") unless $passwd;
if ($clean_list ne "") {
# The list is valid, parse the config file
&set_lock("$listdir/$clean_list.config.LOCK") ||
&abort( "Can't get lock for $listdir/$clean_list.config");
&get_config($listdir, $clean_list, "locked")
if !&cf_ck_bool($clean_list, '', 1);
# so check the password
if (&valid_passwd($listdir, $clean_list, $passwd)) {
# The password is valid, so write current config
&config'writeconfig($listdir, $clean_list);
print REPLY "wrote new config for list $clean_list.\n";
&log("writeconfig $clean_list PASSWORD");
} else {
&squawk("$sm: invalid password.");
&log("FAILED writeconfig $clean_list PASSWORD");
}
&free_lock("$listdir/$clean_list.config.LOCK");
} else {
&squawk("$sm: unknown list '$list'.");
}
}
sub do_mkdigest {
# Check to make sure we've got the right arguments
local($list, $clean_list, @args) = &get_listname($sm, -1, @_);
# We allow the specification of the outgoing alias for the digest so
# that list owners can change it to be something secret, but we have to
# remain backwards compatible, so we allow 2 or 3 args.
local($list_outgoing);
if ($#args == 1) { # Called with 2 or 3 args, one already shifted off
$list_outgoing = shift @args;
}
else {
$list_outgoing = "$list-outgoing";
}
local($passwd);
($passwd = shift @args) || &squawk("$sm: needs password");
local(@digest_errors) = ();
# Check that the list is valid
local($clean_list) = &valid_list($listdir, $list);
if ($clean_list ne "") {
# The list is valid, parse the config file
&get_config($listdir, $clean_list) if !&cf_ck_bool($clean_list, '', 1);
#so check the password
if (&valid_passwd($listdir, $clean_list, $passwd)) {
# The password is valid, so run digest
open(DIGEST,
"$homedir/digest -m -C -l $list $list_outgoing 2>&1 |");
@digest_errors = <DIGEST>;
close(DIGEST);
if ( $? == 256 ) {
print REPLY "**** mkdigest: Failure on exec of digest $!\n";
print REPLY @digest_errors;
&log("FAILED mkdigest $list: exec error");
} else {
if ($? != 0 ) { # hey the exec worked
print REPLY "**** digest: failed errors follow\n";
print REPLY @digest_errors;
&log("FAILED mkdigest $list: errors during digest");
} else {
print REPLY @digest_errors;
&log("mkdigest $clean_list");
}
}
} else {
&squawk("$sm: invalid password.");
&log("FAILED mkdigest $clean_list PASSWORD");
}
} else {
&squawk("$sm: unknown list '$list'.");
}
}
sub do_lists {
# Tell the requester what lists we serve
local($list);
local($reply_addr) = &ParseAddrs($reply_to);
select((select(REPLY), $| = 1)[0]);
my $msg0 = <<"LISTS_MSG0";
以下のメーリングリストが登録されています。
LISTS_MSG0
print REPLY Jcode::convert(\$msg0, 'jis');
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'};
}
}
my $msg1 = <<"LISTS_MSG1";
info <list> コマンドを利用し、さらに詳細な情報を取得出来ます。
LISTS_MSG1
print REPLY Jcode::convert(\$msg1, 'jis');
&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/ ) {
my $msg = "**** コマンドが利用できません。\n";
print REPLY Jcode::convert(\$msg, 'jis');
return 0;
}
if ( !$approved
&& ! &access_check("get", $reply_to, $listdir, $clean_list)) {
my $msg = "**** '$clean_list' リストはメンバーのみ取得可能です。\n";
print REPLY Jcode::convert(\$msg, 'jis');
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);
my $msg = "'get' 結果を $ftpmail_address に転送しました。\n";
print REPLY Jcode::convert(\$msg, 'jis');
} 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: '$filename' list '$clean_list'");
while (<GETFILE>) {
print GETFILEMSG Jcode::convert(\$_, 'jis');
}
# close (and thereby send) the file
close(GETFILEMSG);
&lclose(GETFILE);
my $msg = "ファイル '$filename' を別メールで送信しました。\n";
print REPLY Jcode::convert(\$msg, 'jis');
} else {
my $msg = "**** ファイルが存在しません。\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
}
} else {
&squawk("$sm: invalid file '$filename' for list '$clean_list'.");
}
} else {
&squawk("$sm: unknown list '$list'.");
}
&log("get $clean_list $filename");
}
sub do_index {
# Make sure we've got the arguments we need
# and Check that the list is OK
local($sm) = "index";
local($list, $clean_list) = &get_listname($sm, 0, @_);
if ($clean_list ne "") {
&get_config($listdir, $clean_list)
if !&cf_ck_bool($clean_list, '', 1);
# The list is valid, so now check make sure that it's not a private
# list, or if it is, that the requester is on the list.
if ( !$approved
&& $config_opts{$clean_list, 'index_access'} =~ /closed/ ) {
my $msg = "**** コマンドが利用できません。\n";
print REPLY Jcode::convert(\$msg, 'jis');
return 0;
}
if ( !$approved
&& ! &access_check("index", $reply_to, $listdir, $clean_list)) {
my $msg = "**** '$clean_list' リストはメンバーのみ取得可能です。\n";
print REPLY Jcode::convert(\$msg, 'jis');
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);
my $msg = "'index' 結果を $ftpmail_address に転送しました。\n";
print REPLY Jcode::convert(\$msg, 'jis');
} 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 Jcode::convert(\$_, 'jis');
}
unless (close INDEX) {
&bitch("Index command $index_command failed.\n$! $?");
&squawk("$sm: index command failed");
}
}
else {
&bitch("Cannot chdir to $filedir/$clean_list$filedir_suffix to build index\n$!");
&squawk("$sm: index command failed");
}
} else {
my $msg = "**** 利用出来ません。\n";
print REPLY Jcode::convert(\$msg, 'jis');
}
}
} else {
&squawk("$sm: unknown list '$list'.");
}
&log("index $list");
chdir("$homedir");
}
sub do_help {
print STDERR "$0: do_help()\n" if $DEBUG;
local($list4help) = $majordomo_request ? "[<list>]" : "<list>";
local($listrequest) = " or to \"<list>-request\@$whereami\".\n";
$listrequest .= "\nThe <list> parameter is only optional if the ";
$listrequest .= "message is sent to an address\nof the form ";
$listrequest .= "\"<list>-request\@$whereami\".";
$listrequest = "." unless $majordomo_request;
$do_help_msg = <<"EOM";
このヘルプメッセージは、メーリングリスト管理システム Majordomo か
ら送信しています。(バージョン $majordomo_version at $whoami)
メールサーバに詳しい方のためにこのメッセージの最後に Majordomo の
コマンドをまとめています。
Majordomo は自動化されたシステムであり、ユーザはメーリングリストへ
の登録・脱会が可能です。またアーカイブからファイルを取得することも
出来ます。
Majordomo のコマンドを本文に記述して以下のメールアドレスに送信する
ことで、Majordomo を操作することが出来ます。
$whoami
件名 (Subject) にはコマンドを記述しません。Majordomo は件名に記述
されたコマンドを処理しません。
1 つのメールに複数の Majordomo コマンドを記述出来ます。それぞれの
コマンドは 1 行ずつ記述してください。
メールの最後に署名を付加した場合、Majordomo はその行もコマンドと認
識する場合があります。その場合はエラーメッセージが配送されます。
上記現象を防ぐには、- (ハイフン) で始まる行を署名の前に挿入するか、
end
という行を署名の前に挿入してください。これにより Majordomo は署名
を不正なコマンドとして処理しません。
以下は Majordomo を利用して出来る内容を説明します。
■ システムに存在するメーリングリストを調べる
公開されているメーリングリストの一覧を取得するには、メール本文に以
下のコマンドを記述して $whoami に送信します。
lists
メーリングリスト名と簡単な説明が記載された一覧が配送されます。
特定のメーリングリストのさらに詳しい情報を取得するには、info コマ
ンドとリスト名を使います。例えば、demo-list という名前のメーリング
リストの情報を取得するには、以下の行を本文に記述します。
info demo-list
■ メーリングリストに参加する
参加を希望するメーリングリストを決めた後、Majordomo にコマンドを送
信すると、あなたをメーリングリストに登録できます。登録完了後、メー
ルが配送されます。
あなたがメールを送信するメールアドレスでメーリングリストを取得する
には、subscribe に続けてリストの名前を記述します。
subscribe demo-list
異なるメールアドレスでメーリングリストを取得したい場合は、コマンド
にそのメールアドレスを追加します。例えば、オフィスのメールアドレス
にて登録申し込みをするがプライベートなメールアドレスで demo-list
を取得したい場合は、以下の行を本文に記述します。
subscribe demo-list myprivate\@my-isp.net
メーリングリストのオーナーの決めた設定によっては、メーリングリスト
に自動的に登録されます。
また参加のために認証鍵が必要な旨の通知を受け取る場合もあります。
認証鍵を含んだ別のメッセージが、登録されるメールアドレスに送信され
ます。
その場合、以下のメールアドレスにメッセージ内のコマンドを返信する旨
が指示されます。($whoami)
または、あなたの参加申し込みが承諾のためにメーリングリストオーナー
に転送された旨の通知を受け取る場合もあります。リストによっては登録
待ちのリストがある場合や誰の参加を承諾するかポリシーが存在する場合
があります。
あなたの申し込みが転送された後、メーリングリストのオーナーはすぐに
連絡されるでしょう。
参加した後、メーリングリストの方針や特徴を含んだメッセージを受け取
ります。今後の参考のために保存してください。
そのメッセージには脱会の方法も記述されていると想われます。保存した
メッセージを紛失した場合は、
intro demo-list
と本文に記述して $whoami に送信してください。
■ メーリングリストから脱会する
intro コマンドで取得したメッセージには、あなたのメールアドレスを登
録解除するためのコマンドが記述してあります。しかしほとんどの場合は
unsubscribe コマンドにメーリングリスト名を続けて送信します。
unsubscribe demo-list
(このコマンドはあなたのメールアドレスが変更している場合には失敗し
ます)
脱会申し込みを送信しているメールアドレスとは異なる登録メールアドレ
スを解除するには、コマンドに該当するメールアドレスを追加します。
unsubscribe demo-list myprivate\@my-isp.net
いずれの場合も、すべての登録を一度で解除するには、以下のコマンドを
$whoami に送信してください。
unsubscribe *
unsubscribe * myprivate\@my-isp.net
■ メールアドレスが登録されているメーリングリストを調べる
あなたのメールアドレスが登録されているメーリングリストを調べるには、
以下のコマンドを $whoami に送信してください。
which
他のメールアドレスやメールアドレスの一部の検索も可能です。例えば、
my-isp.net のどのユーザがどのメーリングリストに参加しているかを調
べるには、以下の行を本文に記述します。
which my-isp.net
* 多くのメーリングリストオーナーは、プライバシー保護のために which
コマンドを完全に使用不能にしています。
■ メーリングリストの参加者を調べる
特定のメーリングリストの参加者メールアドレスを取得するには、who コ
マンドを使い、メーリングリスト名を付加します。
who demo-list
* 多くのメーリングリストオーナーは、プライバシー保護のために who
コマンドをメーリングリスト参加者にのみ許可しています。
■ メーリングリストアーカイブからファイルを取得する
多くのメーリングリストオーナーは、メーリングリストに関連したファイ
ルを保管しています。これらには以下の内容が含まれます。
- メーリングリストの過去メール
- ヘルプファイル・ユーザプロファイルやその他の関連文書
- 日・月・年毎のアーカイブ
メーリングリストに関連したファイルの検索には index コマンドを使い
ます。
index demo-list
興味のあるファイルを見つけた際には、メーリングリスト名を保管ファイ
ル名を指定して get コマンドで取得出来ます。
例えば、demo-list.200312 を取得するには、メール本文に以下のコマン
ドを記述して $whoami に送信します。
get demo-list demo-list.200312
■ もっとヘルプ
サイト管理者に連絡をするには以下のメールアドレスにメールを送信して
ください。
$whoami_owner
特定のメーリングリストオーナーに連絡をするには、メーリングリストの
承認 (approval) メールアドレスにメールを送信します。例えば、
demo-list\@$whereami
のメーリングリストオーナーに連絡をする時は、
demo-list-approval\@$whereami
にメールを送信します。
このヘルプメッセージのコピーを取得するには、以下の行を本文に記述し
て $whoami にメールを送信します。
help
■ コマンドサマリ
以下のコマンドが使用できます。[] で囲まれている部分は省略可能です。
[]は省略可能という意味ですので、実際にその部分に文字列をする場合は
[ や ] は付加しません。
subscribe $list4help [メールアドレス]
あなた自身 (または指定したメールアドレス) を <list> に登録し
ます。
unsubscribe $list4help [メールアドレス]
あなた自身 (または指定したメールアドレス) を <list> から登録
解除します。
unsubscribe * であなた自身 (または指定したメールアドレス) を
すべてのメーリングリストから登録解除します。ただし複数のメー
ルアドレスで登録している場合には使用できません。
get $list4help ファイル名
指定したメーリングリストから指定したファイルを取得します。
index $list4help
指定したメーリングリストから get コマンドで取得出来るファイ
ルの一覧を取得します。
which [メールアドレス]
あなた (または指定したメールアドレス) が参加しているメーリン
グリストの一覧を取得します。
who $list4help
指定したメーリングリストに参加しているメンバー一覧を取得しま
す。
info $list4help
指定したメーリングリストを紹介したメッセージを取得します。
intro $list4help
新規ユーザへの案内メッセージを取得します。参加していない人は
取得できません。
lists
当 Majordomo サーバが運営しているメーリングリストの一覧を取
得します。
help
このメッセージを取得します。
end
コマンドの終端を意味します。署名を自動的に付加する場合に有効
です。
コマンドはメールの本文に記述して
$whoami
に送信します。"Subject: " 行に記述されたコマンドは処理されません。
質問や問題が発生した場合は、メーリングリストオーナー
$whoami_owner
にご連絡ください。
EOM
print REPLY Jcode::convert(\$do_help_msg, 'jis');
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");
my $auth_msg = <<"EOM";
あなた自身か他の誰かによって、あなたのメールアドレスの登録もしくは
登録解除がリクエストされています。($list\@$whereami)
このリクエストの処理を続けるには
$whoami
宛てに以下のコマンドのみ本文に記述して返信してください。
auth $cookie $cmd $list $subscriber
リクエストの処理を希望しない場合は無視してください。
ご利用のメールアプリケーションが上記コマンドを 1 行で記述出来ない
場合は、バックスラッシュを利用して以下の様に記述してください。
auth $cookie $cmd $list \\
$subscriber
このメーリングリストオーナーのメンバー登録ポリシーについては以下の
メールアドレスにご質問ください。
$list-approval\@$whereami
よろしくお願い致します。$whoami
EOM
print AUTH Jcode::convert(\$auth_msg, 'jis');
close(AUTH);
my $msg = <<"EOM";
$whoami 宛てに以下のリクエストを受け付けました。
$cmd $list $subscriber
このリクエストは認証が必要です。手続きを完了するには、認証鍵を含ん
だ別のリクエストを送ってください。
認証鍵は $subscriber に配送されています。
認証鍵を含んだメッセージを受け取っていない場合は、そのメールアドレ
スに問題がある可能性があります。その問題を連絡される前に、以下の点
をご確認ください。
subscribe コマンドにメールアドレスが必要な場合とは、コマンドを送信
するメールアドレスとは異なるメールアドレスでメーリングリストを受け
取りたい場合です。それ以外はメールアドレスは必要ありません。
subscribe コマンドにメールアドレスを指定した場合には、そのメールア
ドレスは正しいメールアドレスである必要があります。メールアドレスは
メーリングリストサーバから通信可能なサーバを指定している必要があり
ます。
このメーリングリストオーナーのメンバー登録ポリシーについては以下の
メールアドレスにご質問ください。
$list-approval\@$whereami
よろしくお願い致します。$whoami
EOM
print REPLY Jcode::convert(\$msg, 'jis');
&log("send_confirm $cmd $list $subscriber");
}
# Send a request for subscribe or unsubscribe approval to a list owner
# Usage: &request_approval($cmd, $list, @subscriber)
sub request_approval {
# Get the arguments
local($cmd) = shift;
local($list) = &valid_list($listdir, shift);
local($subscriber) = @_;
local(*APPROVE);
# open a sendmail process for the approval request
&sendmail(APPROVE, "$list-approval\@$whereami", "APPROVE $list");
# Generate the approval request
print APPROVE <<"EOM";
$reply_to requests that you approve the following:
$cmd $list $subscriber
If you approve, please send a message such as the following back to
$whoami (with the appropriate PASSWORD filled in, of course):
approve PASSWORD \\
$cmd $list \\
$subscriber
[The above is broken into multiple lines to avoid mail reader linewrap
problems. Commands can be on one line, or multi-line with '\\' escapes.]
If you disapprove, do nothing.
Thanks!
$whoami
EOM
# close (and thereby send) the approval request
close(APPROVE);
# tell the requestor that their request has been forwarded for approval.
print REPLY <<"EOM";
Your request to $whoami:
$cmd $list $subscriber
has been forwarded to the owner of the "$list" list for approval.
This could be for any of several reasons:
You might have asked to subscribe to a "closed" list, where all new
additions must be approved by the list owner.
You might have asked to subscribe or unsubscribe an address other than
the one that appears in the headers of your mail message.
When the list owner approves your request, you will be notified.
If you have any questions about the policy of the list owner, please
contact "$list-approval\@$whereami".
Thanks!
$whoami
EOM
&log("request $cmd $list $subscriber");
}
# We are done processing the request; append help if needed, send the reply
# to the requestor, clean up, and exit
sub done {
# append help, if needed.
if ($count == 0) {
print REPLY "**** No valid commands found.\n";
print REPLY "**** Commands must be in message BODY, not in HEADER.\n\n";
}
if ($needs_help || ($count == 0)) {
print REPLY "**** Help for $whoami:\n\n";
&do_help();
}
# close (and thereby send) the reply
close(REPLY);
# good bye!
exit(0);
}
# Welcome a new subscriber to the list, and tell the list owner of his/her
# existance.
sub welcome {
local($list) = shift;
local($subscriber) = join(" ", @_);
# welcome/intro message controlled by 'welcome=yes/no'
if ( &cf_ck_bool($list,"welcome")) {
# Set up the sendmail process to welcome the new subscriber
&set_mail_sender($config_opts{$list,"sender"} . "\@" . $whereami);
&sendmail(MSG, $subscriber, "Welcome to $list");
&set_mail_sender($whoami_owner);
my $msg0 = <<"EOM";
$list mailing list へようこそ。
このメッセージは今後の参考のために保存してください。
EOM
print MSG Jcode::convert(\$msg0, 'jis');
if ( $majordomo_request ) {
my $msg = <<"EOM";
このメーリングリストから登録解除を希望する場合は
${clean_list}-request\@$whereami
宛てに以下のコマンドを本文に記述して送信してください。
unsubscribe
または
$whoami
宛てに送信することも出来ます。
EOM
print MSG Jcode::convert(\$msg, 'jis');
} else {
my $msg = <<"EOM";
このメーリングリストから登録解除を希望する場合は
$whoami
宛てに以下のコマンドを本文に記述して送信してください。
EOM
print MSG Jcode::convert(\$msg, 'jis');
}
my $msg1 = <<"MSG1";
unsubscribe $list
操作したいメールアドレスと違うメールアドレスから送信する場合には、
unsubscribe $list $subscriber
と $subscriber を追加してください。
このメーリングリストオーナーに連絡を希望する場合は、以下のメールア
ドレスにご質問ください。
owner-$clean_list\@$whereami
MSG1
print MSG Jcode::convert(\$msg1, 'jis');
# 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 Jcode::convert(\$_, 'jis');
}
&lclose(INFO);
} elsif (&lopen(INFO, "", "$listdir/$list.info")) {
while (<INFO>) {
print MSG Jcode::convert(\$_, 'jis');
}
&lclose(INFO);
} else {
}
# 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;
return md5_hex( $combined );
}
# 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);
}