>>>>> On Sat, 18 Feb 1995 14:22:24 -0800 (PST), Joseph McDonald <joe@smartdocs.com> said:
Joe> Does anyone have a copy of digest with Paul Close's diff's
Joe> rolled in? It won't patch with 1.93 and it'd be easier to
Joe> get it working with 1.93 looking at the whole thing instead
Joe> of the diff file. Also if anyone has it working with 1.93
Joe> that would be even better!
I forget how much of this is Paul Close's work and how much is mine,
except that I remember (1) making the name of the digest program
be a configurable parameter, as well as (2) making the name of the
outgoing list configurable. However, here's the changes I have
running in Majordomo v1.93.
Apply (in the majordomo source directory) with ``patch -l -N -p0''.
--
Spider Boardman (at home) spider@Orb.Nashua.NH.US
speaking only for myself ...!decvax!orb!spider
*** majordomo.ORIG Wed Jan 4 14:37:43 1995
--- majordomo Sat Feb 18 21:56:49 1995
***************
*** 26,31 ****
--- 26,47 ----
# The mj_ prefix is reserved for tools that are part of majordomo proper.
$main'program_name = 'mj_majordomo';
+ # How to find the name of the digest-making utility (for mkdigest, mainly).
+ # Must come before reading the .cf file so that the latter can override
+ # this default.
+
+ $digester = 'digest';
+
+ # How to find the name of the outgoing alias for a list (for mkdigest, mainly).
+ # Must come before reading the .cf file so that the latter can override
+ # this default.
+
+ sub outgoing # ($listname)
+ {
+ local($list) = @_;
+ "$list-outgoing";
+ }
+
# Read and execute the .cf file
$cf = $ENV{"MAJORDOMO_CF"} || "/etc/majordomo.cf";
while ($ARGV[0]) { # parse for config file or default list
***************
*** 136,143 ****
print REPLY ">>>> $_"; # echo the line we are processing
$_ = &chop_nl($_); # strip any trailing newline
s/#.*//g; # strip comments
! s/^\s*//g; # strip leading whitespace
! s/\s*$//g; # strip trailing whitespace
s/\\ /\001/g; # protected escaped whitepace
@parts = split(" "); # split into component parts
grep(s/\001/ /, @parts); # replace protected whitespace with
--- 152,159 ----
print REPLY ">>>> $_"; # echo the line we are processing
$_ = &chop_nl($_); # strip any trailing newline
s/#.*//g; # strip comments
! s/^\s+//g; # strip leading whitespace
! s/\s+$//g; # strip trailing whitespace
s/\\ /\001/g; # protected escaped whitepace
@parts = split(" "); # split into component parts
grep(s/\001/ /, @parts); # replace protected whitespace with
***************
*** 811,816 ****
--- 847,853 ----
# Check to make sure we've got the right arguments
(local($list) = shift) || &squawk("config: which list?");
(local($passwd) = shift) || &squawk("config: needs password");
+ local($outgoing) = (shift || &outgoing($list));
local(@digest_errors) = ();
# Check that the list is valid
local($clean_list) = &valid_list($listdir, $list);
***************
*** 823,829 ****
# The password is valid, so run digest
open(DIGEST,
! "$homedir/digest -m -C -l $list $list-outgoing 2>&1 |");
@digest_errors = <DIGEST>;
close(DIGEST);
--- 860,866 ----
# The password is valid, so run digest
open(DIGEST,
! "$homedir/$digester -m -C -l $list $outgoing 2>&1 |");
@digest_errors = <DIGEST>;
close(DIGEST);
***************
*** 843,849 ****
}
} else {
&squawk("mkdigest: invalid password.");
! &log("FAILED mkdigest $clean_list PASSWORD");
}
} else {
&squawk("mkdigest: unknown list '$list'.");
--- 880,886 ----
}
} else {
&squawk("mkdigest: invalid password.");
! &log("FAILED mkdigest $clean_list PASSWORD $outgoing");
}
} else {
&squawk("mkdigest: unknown list '$list'.");
*** config_parse.pl.ORIG Sat Jan 7 12:30:56 1995
--- config_parse.pl Sat Feb 4 11:20:07 1995
***************
*** 12,18 ****
require 'majordomo.pl';
require 'shlock.pl';
! require 'majordomo.cf' ;
# here is the config package
package config;
--- 12,19 ----
require 'majordomo.pl';
require 'shlock.pl';
! # should no longer be necessary? If it is, make sure $cf is set in callers.
! # require $cf ;
# here is the config package
package config;
***************
*** 130,135 ****
--- 133,140 ----
'digest_archive', '',
'digest_rm_footer', '',
'digest_rm_fronter', '',
+ 'digest_maxlines', '',
+ 'digest_maxdays', '',
# general stuff below
'comments', '', # comments about config file
);
***************
*** 229,235 ****
'sender',
"The envelope and sender address for the
! resent mail. This string has \"@\" and the value
of resend_host appended to it to make a
complete address. For majordomo, it provides the sender address
for the welcome mail message generated as part of the subscribe command.",
--- 240,246 ----
'sender',
"The envelope and sender address for the
! resent mail. This string has \"\@\" and the value
of resend_host appended to it to make a
complete address. For majordomo, it provides the sender address
for the welcome mail message generated as part of the subscribe command.",
***************
*** 330,335 ****
--- 341,354 ----
'digest_rm_fronter',
'Works just like digest_rm_footer, except it removes the front material.
Just like digest_rm_footer, it is also non-operative.',
+
+ 'digest_maxlines',
+ 'Automatically generate a new digest message when the size of the digest
+ exceeds this number of lines.',
+
+ 'digest_maxdays',
+ 'Automatically generate a new digest issue when the age of the oldest article
+ in the queue exceeds this number of days.',
);
# match commands to their subsystem, by default only 4 subsystems
***************
*** 373,378 ****
--- 394,401 ----
'digest_archive', 'digest',
'digest_rm_footer', 'digest',
'digest_rm_fronter', 'digest',
+ 'digest_maxlines', 'digest',
+ 'digest_maxdays', 'digest',
# general stuff here
'comments', 'config',
);
***************
*** 419,424 ****
--- 444,451 ----
'digest_archive', 'grab_absolute_dir',
'digest_rm_footer', 'grab_word',
'digest_rm_fronter', 'grab_word',
+ 'digest_maxlines', 'grab_integer',
+ 'digest_maxdays', 'grab_float',
# general stuff below
'comments', 'grab_string_array',
);
***************
*** 501,508 ****
$lval =~ s/\001\001/\001-\001/g; # embedded blank line
# if there is space, protect it with a -
! $lval =~ s/^(\s)/-\1/g; # the first line
! $lval =~ s/\001(\s)/\001-\1/g; # embedded lines
# now that all of the escapes are processed, get it ready
# to be printed.
--- 528,535 ----
$lval =~ s/\001\001/\001-\001/g; # embedded blank line
# if there is space, protect it with a -
! $lval =~ s/^(\s)/-$1/g; # the first line
! $lval =~ s/\001(\s)/\001-$1/g; # embedded lines
# now that all of the escapes are processed, get it ready
# to be printed.
***************
*** 702,712 ****
# that it is a here document
}
! ($key) =~ tr/A-Z/a-z/; # cannonicalize key to lower case
! $key =~ s/^\s*//; # strip whitespace from front of key
! $key =~ s/\s*$//; # strip whitespace from rear of key
! $value =~ s/^\s*//; # strip whitespace from front of value
! $value =~ s/\s*$//; # strip whitespace from rear of value
# is the key defined ?
do { push(@errors,"unknown key |$key| in file $list.config at line $.\n");
--- 733,743 ----
# that it is a here document
}
! $key = "\L$key"; # cannonicalize key to lower case
! $key =~ s/^\s+//; # strip whitespace from front of key
! $key =~ s/\s+$//; # strip whitespace from rear of key
! $value =~ s/^\s+//; # strip whitespace from front of value
! $value =~ s/\s+$//; # strip whitespace from rear of value
# is the key defined ?
do { push(@errors,"unknown key |$key| in file $list.config at line $.\n");
***************
*** 740,747 ****
# This allows us to discover errors more easily.
while ($value = <CONFIG>) {
! $value =~ s/^\s*//; # strip whitespace front
! $value =~ s/\s*$//; # strip whitespace rear
$end = 0, last if $stop eq $value;
push(@errors,
"invalid blank line found at line ", $. - 1, "\n"), $end = 0,
--- 771,778 ----
# This allows us to discover errors more easily.
while ($value = <CONFIG>) {
! $value =~ s/^\s+//; # strip whitespace front
! $value =~ s/\s+$//; # strip whitespace rear
$end = 0, last if $stop eq $value;
push(@errors,
"invalid blank line found at line ", $. - 1, "\n"), $end = 0,
***************
*** 864,870 ****
sub grab_bool {
local($bool) = @_;
! $bool =~ tr/A-Z/a-z/;
return 1 if $bool eq "yes";
return 1 if $bool eq "y";
--- 895,901 ----
sub grab_bool {
local($bool) = @_;
! $bool = "\L$bool";
return 1 if $bool eq "yes";
return 1 if $bool eq "y";
***************
*** 928,934 ****
sub grab_float {
local($num)=@_;
! return($num) if $num =~ /^[0-9][0-9]*\.[0-9]+$/;
return($num) if $num =~ /^$/;
push(@errors, "$num is not a floating point number at line $.\n");
return "";
--- 959,965 ----
sub grab_float {
local($num)=@_;
! return($num) if $num =~ /^\d+(\.\d+)?$|^\.\d+$/;
return($num) if $num =~ /^$/;
push(@errors, "$num is not a floating point number at line $.\n");
return "";
***************
*** 944,950 ****
"integer |$num| contains a ^A at line $.\n"), next
if $re =~ /\001/;
! push(@return_array, $num) if $num =~ /^[1-9][0-9]*\.[0-9]+$/;
push(@return_array, $num) if $num =~ /^$/;
push(@local_errors,
"$num is not an floating point number at line $.\n");
--- 975,981 ----
"integer |$num| contains a ^A at line $.\n"), next
if $re =~ /\001/;
! push(@return_array, $num) if $num =~ /^\d+(\.\d+)?$|^\.\d+$/;
push(@return_array, $num) if $num =~ /^$/;
push(@local_errors,
"$num is not an floating point number at line $.\n");
***************
*** 1010,1016 ****
# a single - on a line means a blank character/line
$str = '' if ( $str eq '-' );
! $str =~ s/^-(\s+)/\1/; # a - saves space
$str =~ s/^--/-/; # a -- means -
push(@return_s, $str),
--- 1041,1047 ----
# a single - on a line means a blank character/line
$str = '' if ( $str eq '-' );
! $str =~ s/^-(\s+)/$1/; # a - saves space
$str =~ s/^--/-/; # a -- means -
push(@return_s, $str),
***************
*** 1114,1129 ****
die "new_keyword: subsystem is not defined" if !defined($subsystem);
die "new_keyword: comments are not defined" if !defined($comment);
! $key =~ s/^\s*//; # strip whitespace front
! $key =~ s/\s*$//; # strip whitespace rear
! $value =~ s/^\s*//; # strip whitespace front
! $value =~ s/\s*$//; # strip whitespace rear
! $function =~ s/^\s*//; # strip whitespace front
! $function =~ s/\s*$//; # strip whitespace rear
! $subsystem =~ s/^\s*//; # strip whitespace front
! $subsystem =~ s/\s*$//; # strip whitespace rear
! $comment =~ s/^\s*//; # strip whitespace front
! $comment =~ s/\s*$//; # strip whitespace rear
die "Keyword $key > 18 characters" if length($key) > 18;
--- 1145,1160 ----
die "new_keyword: subsystem is not defined" if !defined($subsystem);
die "new_keyword: comments are not defined" if !defined($comment);
! $key =~ s/^\s+//; # strip whitespace front
! $key =~ s/\s+$//; # strip whitespace rear
! $value =~ s/^\s+//; # strip whitespace front
! $value =~ s/\s+$//; # strip whitespace rear
! $function =~ s/^\s+//; # strip whitespace front
! $function =~ s/\s+$//; # strip whitespace rear
! $subsystem =~ s/^\s+//; # strip whitespace front
! $subsystem =~ s/\s+$//; # strip whitespace rear
! $comment =~ s/^\s+//; # strip whitespace front
! $comment =~ s/\s+$//; # strip whitespace rear
die "Keyword $key > 18 characters" if length($key) > 18;
***************
*** 1223,1229 ****
parse_function
The parse function is used to validate the data supplied by the list
maintainer and to try to point out problems with the data. There are a
! number of parse functions defined, all of the MUST be in the config
package. If you are writing a parse function of your own, make sure
that it is in the config package, otherwise the parser won't find it.
--- 1254,1260 ----
parse_function
The parse function is used to validate the data supplied by the list
maintainer and to try to point out problems with the data. There are a
! number of parse functions defined, all of which MUST be in the config
package. If you are writing a parse function of your own, make sure
that it is in the config package, otherwise the parser won't find it.
*** digest/digest.ORIG Wed Jan 4 15:04:05 1995
--- digest/digest Sat Feb 18 21:58:09 1995
***************
*** 90,101 ****
&set_lock;
! if (defined($opt_r)) {
&receive_message;
! } elsif (defined($opt_m)) {
&make_digest;
} else {
! &abort("Usage: digest {-r|-m} [-c config|(-C -l list)]\nStopped");
}
&free_lock;
--- 90,110 ----
&set_lock;
! sub END { &free_lock; }
!
! if ($opt_r) {
&receive_message;
! if (&should_be_sent()) {
&make_digest;
+ }
+ } elsif ($opt_m) {
+ &make_digest;
+ } elsif ($opt_p) {
+ if (&should_be_sent()) {
+ &make_digest;
+ }
} else {
! &abort("Usage: digest {-r|-m|-p} [-c config|-C -l list] outgoing\nStopped");
}
&free_lock;
***************
*** 102,131 ****
exit(0);
sub receive_message {
- $sum = 0;
$i = 0;
do {
! $i++;
! $file = sprintf("%s/%03d", $V{'INCOMING'}, $i);
! $sum += (-s $file);
} until (! -e $file);
print STDERR "Receiving $i\n";
&open_temp(MSG, "$file") || &abort("open(MSG, \">>$file\"): $!");
while (<STDIN>) {
print MSG $_;
}
close(MSG);
- $sum += (-s $file);
- if ($sum > $V{'DIGEST_SIZE'}) {
- &make_digest;
}
- return(1);
- }
sub make_digest {
! @files=<$V{'INCOMING'}/*>;
if ($#files < $[) {
&digest'abort("No messages to process.\n");
}
--- 111,185 ----
exit(0);
+ sub should_be_sent {
+ # fudge factors for headers and footers
+ $sum = 600 + length($HEADER) + length($HEADERS) + length($TRAILER);
+ $lines = 25;
+ $i = 0;
+ for (;;) {
+ $file = sprintf("%s/%03d", $V{'INCOMING'}, ++$i);
+ last unless (-e $file);
+ open(COUNT, "<$file") || &abort("open(COUNT, \"<$file\"): $!, at");
+
+ $/ = ''; # grab the header
+ $head = <COUNT>;
+
+ # only count From/Date/Subject/Message-ID header fields to get a more
+ # accurate size and line count.
+ $head =~ s/\n[ \t]+/ /g;
+ $head =~ /^(From:\s*.*)/i && ($sum += length($1)+1, $lines++);
+ $head =~ /^(Subject:\s*.*)/i && ($sum += length($1)+1, $lines++);
+ $head =~ /^(Date:\s*.*)/i && ($sum += length($1)+1, $lines++);
+ $head =~ /^(Message-ID:\s*.*)/i && ($sum += length($1)+1, $lines++);
+ $sum++, $lines++; # account for the separator line
+
+ # count the body of the message
+ undef $/;
+ $body = <COUNT>;
+ $sum += length($body);
+ $lines += ($body =~ m/\n/g); # count newlines
+
+ $/ = "\n";
+ close(COUNT);
+ $sum += length($EB) + 2, $lines += 2; # account for message delimiter
+
+ if ($V{'DIGEST_SIZE'} && $sum >= $V{'DIGEST_SIZE'}) {
+ return 1;
+ }
+ elsif ($V{'DIGEST_LINES'} && $lines >= $V{'DIGEST_LINES'}) {
+ return 1;
+ }
+ elsif ($V{'MAX_AGE'} && (-M $file) >= $V{'MAX_AGE'}) {
+ return 1;
+ }
+ }
+
+ 0;
+ }
+
+
sub receive_message {
$i = 0;
do {
! $file = sprintf("%s/%03d", $V{'INCOMING'}, ++$i);
} until (! -e $file);
+
print STDERR "Receiving $i\n";
&open_temp(MSG, "$file") || &abort("open(MSG, \">>$file\"): $!");
+
+ # copy the message
while (<STDIN>) {
print MSG $_;
}
+
close(MSG);
}
sub make_digest {
! opendir(RD_DIR,$V{'INCOMING'}) || &abort("opendir $V{'INCOMING'}: $!\n");
! @files = sort(grep(!/^\./,readdir(RD_DIR)));
! closedir(RD_DIR);
if ($#files < $[) {
&digest'abort("No messages to process.\n");
}
***************
*** 132,139 ****
&open_temp(TEMP, $TEMP) || &abort("$TEMP: $!\n");
print STDERR "producing $V{'NAME'} V$VOLUME #$NUMBER\n";
foreach $message (@files) {
! print STDERR "non digest input file $message", next
! if $message !~ m#/\d+$#;
open(message) || &abort("$message: $!\n");
#side note: "open message or die"?
print STDERR "\tprocessing $message\n";
--- 186,194 ----
&open_temp(TEMP, $TEMP) || &abort("$TEMP: $!\n");
print STDERR "producing $V{'NAME'} V$VOLUME #$NUMBER\n";
foreach $message (@files) {
! (print STDERR "non digest input file $message"), next
! if $message !~ m#^\d+$#;
! $message = "$V{'INCOMING'}/$message";
open(message) || &abort("$message: $!\n");
#side note: "open message or die"?
print STDERR "\tprocessing $message\n";
***************
*** 140,167 ****
$/ = '';
$head = <message>;
! $head =~ s/\n\s+/ /g;
! $body = "";
! ($subj) = ($head =~ /^subject:\s+(.*)/i);
$subj = "[none]" unless $subj;
! ($from) = ($head =~ /^from:\s+(.*)/i);
! ($date) = ($head =~ /^date:\s+(.*)/i);
!
! $/ = "\n";
! while (<message>) {
! s/^-/- -/; #escape encapsulation boundaries in message
! $body .= $_;
}
close(message);
! $body =~ s/\n+$/\n/;
push(@subj,$subj);
print TEMP <<EOF;
From: $from
Date: $date
Subject: $subj
$body
$EB
EOF
--- 195,230 ----
$/ = '';
$head = <message>;
! $head =~ s/\n[ \t]+/ /g;
! ($subj) = ($head =~ /^subject:\s*(.*)/i);
$subj = "[none]" unless $subj;
! ($from) = ($head =~ /^from:\s*(.*)/i);
! ($date) = ($head =~ /^date:\s*(.*)/i);
! ($mesgid) = ($head =~ /^message-id:\s*(.*)/i);
! if ($opt_C && ($pfx = $config_opts{$opt_l,'subject_prefix'})) {
! $pfx =~ s/(\W)/\\$1/g;
! $subj =~ s/^$pfx\s*//o;
}
+
+ undef $/;
+ $body = <message>;
+ $body =~ s/^-/- -/g; # escape encapsulation boundaries in message
close(message);
! $len = -1;
! $len-- while substr($body,$len,1) eq "\n";
! substr($body,$len+1) = "" if $len < -1;
+ $/ = "\n";
+
push(@subj,$subj);
print TEMP <<EOF;
From: $from
Date: $date
Subject: $subj
+ Message-ID: $mesgid
$body
+
$EB
EOF
***************
*** 214,220 ****
close(DIGEST);
! system("/usr/lib/sendmail -f$V{'ERRORS-TO'} $V{'REALLY-TO'} < $DIGEST");
if ( ! defined($opt_C) ) {
open(NUM_FILE, ">$V{'NUM_FILE'}") ||
--- 277,283 ----
close(DIGEST);
! system("/usr/lib/sendmail -oi -oee -f$V{'ERRORS-TO'} $V{'REALLY-TO'} nobody < $DIGEST");
if ( ! defined($opt_C) ) {
open(NUM_FILE, ">$V{'NUM_FILE'}") ||
***************
*** 235,242 ****
$* = 1;
$HOME = $ENV{"HOME"} || (getpwuid($>))[7];
chdir($HOME);
! &getopt("rmc:Cl:") ||
! &abort("Usage: digest {-r|-m} [-c config|(-C -l list)]\nStopped");
$config = $opt_c || "$HOME/.digestrc";
$TEMP = "/tmp/digest.$$";
$SIG{'INT'} = 'cleanup';
--- 298,305 ----
$* = 1;
$HOME = $ENV{"HOME"} || (getpwuid($>))[7];
chdir($HOME);
! &getopt("rmpc:Cl:") ||
! &abort("Usage: digest {-r|-m|-p} [-c config|-C -l list] outgoing\nStopped");
$config = $opt_c || "$HOME/.digestrc";
$TEMP = "/tmp/digest.$$";
$SIG{'INT'} = 'cleanup';
***************
*** 263,269 ****
chdir($homedir);
! $opt_l =~ tr/A-Z/a-z/;
require "config_parse.pl";
# get the digest config file
--- 326,332 ----
chdir($homedir);
! $opt_l = "\L$opt_l";
require "config_parse.pl";
# get the digest config file
***************
*** 280,285 ****
--- 343,350 ----
$Precedence = "bulk" if ($Precedence eq "");
$V{'ARCHIVE'} = "$filedir/$opt_l$filedir_suffix";
$V{'DIGEST_SIZE'} = $config_opts{$opt_l, "maxlength"};
+ $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"};
$V{'FROM'} = $config_opts{$opt_l, "sender"};
$V{'INCOMING'} = "$digest_work_dir/$opt_l";
***************
*** 286,292 ****
$V{'NAME'} = $config_opts{$opt_l,"digest_name"};
$V{'REALLY-TO'} = $ARGV[0];
$V{'REPLY-TO'} = $config_opts{$opt_l,"reply_to"};
! $V{'TO'} = "$opt_l@$whereami";
# make the headers keyword work
if ( $config_opts{$opt_l,"message_headers"} ne '' ) {
--- 351,357 ----
$V{'NAME'} = $config_opts{$opt_l,"digest_name"};
$V{'REALLY-TO'} = $ARGV[0];
$V{'REPLY-TO'} = $config_opts{$opt_l,"reply_to"};
! $V{'TO'} = "$opt_l\@$whereami";
# make the headers keyword work
if ( $config_opts{$opt_l,"message_headers"} ne '' ) {
***************
*** 360,366 ****
sub getdate {
local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
! return($DAYS[$wday] . ", $mday " . $MONTHS[$mon] . " 19$year");
}
sub set_lock {
--- 425,431 ----
sub getdate {
local($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
! return($DAYS[$wday] . ", $mday " . $MONTHS[$mon] . " " . ($year+1900));
}
sub set_lock {
References:
|
|
