| Current Path : /compat/linux/proc/self/root/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 : //compat/linux/proc/self/root/usr/local/majordomo/sequencer |
#!/usr/bin/perl
use ADN::MIME;
use ADN::Utility;
$ENV{'PATH'} = "/bin:/usr/bin:/usr/sbin:/sbin";
#$tmp = "/tmp/majordomo.$$";
#$main'program_name = 'sequencer';
if ($ARGV[0] =~ /^@/) {
$fn = shift(@ARGV);
$fn =~ s/^@//;
open(AV, $fn) || die("open(AV, \"$fn\"): $!\nStopped");
undef($/); # set input field separator
$av = <AV>; # read whole file into string
close(AV);
@av = split(/\s+/, $av);
unshift(@ARGV, @av);
$/ = "\n";
}
# Read and execute the .cf file
$cf = $ENV{"MAJORDOMO_CF"} || "/etc/majordomo.cf";
if ($ARGV[0] eq "-C") {
$cf = $ARGV[1];
shift(@ARGV);
shift(@ARGV);
}
if (!-r $cf) {
die("$cf not readable; stopped");
}
require "$cf";
chdir($homedir) || die("Can't chdir(\"$homedir\"): $!");
unshift(@INC, $homedir);
require "majordomo.pl";
require "majordomo_version.pl";
require "getopts.pl";
require "config_parse.pl";
require "shlock.pl";
&Getopts("Aa:df:h:I:l:m:M:nNp:Rr:s") || die("sequencer: Getopts() failed: $!");
if (!defined($opt_l) || !defined($opt_h)) {
die("sequencer: must specify both '-l list' and '-h host' arguments");
}
# smash case for the list name
$opt_l =~ tr/A-Z/a-z/;
if (!@ARGV) {
die("sequencer: must specify outgoing list as last arg(s)");
}
$opt_r = "$opt_r@$opt_h" if (defined($opt_r));
&get_config($listdir, $opt_l);
$opt_A = &cf_ck_bool($opt_l,"moderate") if &cf_ck_bool($opt_l,"moderate");
$opt_h = $config_opts{$opt_l,"resend_host"}
if($config_opts{$opt_l,"resend_host"} ne '');
$opt_a = $config_opts{$opt_l,"approve_passwd"}
if ($config_opts{$opt_l,"approve_passwd"} ne '');
$opt_M = $config_opts{$opt_l,"maxlength"}
if ($config_opts{$opt_l,"maxlength"} ne '');
$opt_f = $config_opts{$opt_l,"sender"}
if ($config_opts{$opt_l,"sender"} ne '');
$opt_p = $config_opts{$opt_l,"precedence"}
if ($config_opts{$opt_l,"precedence"} ne '');
$opt_r = $config_opts{$opt_l,"reply_to"}
if ($config_opts{$opt_l,"reply_to"} ne '');
$opt_I = $config_opts{$opt_l,"restrict_post"}
if ($config_opts{$opt_l,"restrict_post"} ne '');
$opt_R = &cf_ck_bool($opt_l,"purge_received")
if &cf_ck_bool($opt_l,"purge_received");
$opt_s = &cf_ck_bool($opt_l,"administrivia")
if &cf_ck_bool($opt_l,"administrivia");
$opt_d = &cf_ck_bool($opt_l,"debug")
if &cf_ck_bool($opt_l,"debug");
if (defined($opt_f)) {
$sendmail_sender = $opt_f;
} else {
#$sendmail_sender = "$opt_l-request";
$sendmail_sender = "owner-$opt_m\@$opt_h";
}
$sendmail_path = "/usr/local/sbin/sendmail";
$sendmail_cmd = "$sendmail_path -f$sendmail_sender " . join(" ", @ARGV);
if (defined($opt_a)) {
if ($opt_a =~ /^\//) {
open(PWD, $opt_a) || die("sequencer: open(PWD, \"$opt_a\"): $!");
$opt_a = &chop_nl(<PWD>);
}
}
if (defined($opt_A) && !defined($opt_a)) {
die("sequencer: must also specify '-a passwd' if using '-A' flag");
}
# code added for getting new sequence number
if (defined($opt_N)) {
$opt_n = $opt_N;
}
if (defined($opt_n)) {
$seqfile = "$listdir/$opt_l.seq";
if (!-r $seqfile) { # if there is no sequence file, make one
open(SEQ, ">$seqfile") || die("sequencer: open of $seqfile failed: $!");
print SEQ "1\n";
close SEQ;
}
&main'lopen(SEQ, "<", "$seqfile") || die("sequencer: locked open of $seqfile failed: $!");
chop($seqnum = <SEQ>);
}
$sender = "$sendmail_sender@$opt_h";
&open_temp(OUT, "/tmp/sequencer.$$.out") ||
&abort("sequencer:1 Can't open /tmp/sequencer.$$.out: $!");
&open_temp(IN, "/tmp/sequencer.$$.in") ||
&abort("sequencer: Can't open /tmp/sequencer.$$.in: $!");
while (<STDIN>) {
if ((/^subject:/i) || (defined($subj_last))) {
if ((/^subject:/i) || (/^\s+(.+)/)) {
$_ = ADN::MIME::HeaderDecode($_, 'euc');
$_ = ADN::MIME::HeaderEncode($_);
s/R[eE]\:.*[\(\[].*\d+[\)\]]/Re\:/g;
s/R[eE]\:\s+R[eE]\:/Re\:/g;
$subj_last = 1;
} else {
undef($subj_last);
}
}
print IN $_;
}
close(IN);
open(IN, "/tmp/sequencer.$$.in") ||
die("sequencer: Can't open /tmp/sequencer.$$.tmp: $!");
do {
$restart = 0;
$pre_hdr = 1;
while (<IN>) {
if ($pre_hdr) {
next if (/^\s*$/);
$pre_hdr = 0;
$in_hdr = 1;
$kept_last = 0;
}
if ($in_hdr) {
if (/^\s*$/) {
# end of header; add new header fields
# if there is no subject, create one
if (!defined($subject)) {
local($foo);
if ($config_opts{$opt_l,"subject_prefix"} ne '') {
$foo = &config'substitute_values($config_opts{$opt_l,"subject_prefix"}, $opt_l);
# for sequencing we add a special keyword!
if (defined($opt_n)) {
$foo =~ s/\$SEQNUM/$seqnum/;
}
local($foo_pat) = $foo;
$foo_pat =~ s/(\W)/\\$1/g;
if (!/$foo_pat/) { $foo = $foo . " "; }
}
$subject = "Subject: " . $foo; $subject =~ s/ $//;
print OUT $subject, "\n";
}
print OUT "Sender: $sender\n";
if (defined($opt_p)) {
print OUT "Precedence: $opt_p\n";
}
if (defined($opt_r)) {
print OUT "Reply-To: " . &config'substitute_values($opt_r) . "\n";
}
# print out additonal headers
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;
print OUT $headers;
}
$ml = $opt_l;
print OUT "X-Sequence: " . &config'substitute_values($config_opts{$opt_l,"sequence_prefix"}, $opt_l) . " $seqnum\n";
$in_hdr = 0;
print OUT $_;
# print out front matter
if ($config_opts{$opt_l,"message_fronter"} ne '') {
local($fronter) = &config'substitute_values($config_opts{$opt_l,"message_fronter"}, $opt_l);
$fronter =~ s/\001|$/\n/g;
print OUT $fronter;
}
} elsif (/^approved:\s*(.*)/i && defined($opt_a)) {
$approved = &chop_nl($1);
if ($approved ne $opt_a &&
!(&main'valid_passwd($listdir, $opt_l, $approved))) {
&bounce("Invalid 'Approved:' header");
}
} elsif (/^from /i # skip all these headers
|| /^sender:/i
|| /^return-receipt-to:/i
|| /^errors-to:/i
|| /^return-path:/i
|| (/^reply-to:/i && defined($opt_r)) # skip only if "-r" set
|| (/^precedence:/i && defined($opt_p)) # skip only if "-p" set
|| (/^received:/i && defined($opt_R)) # skip only if "-R" set
|| (/^\s/ && !$kept_last)) {
# reset $kept_last in case next line is continuation
$kept_last = 0;
} else {
# check for administrivia requests
if (defined($opt_s) && !defined($approved)
&& (/^subject:\s*subscribe\b/i ||
/^subject:\s*unsubscribe\b/i ||
/^subject:\s*help\b/i ||
/^subject:\s*RCPT:\b/ ||
/^subject:\s*Delivery Confirmation\b/ ||
/^subject:\s*NON-DELIVERY of:/ ||
/^subject:\s*Undeliverable Message\b/ ||
/^subject:\s*Receipt Confirmation\b/ ||
/^subject:\s*Failed mail\b/ ||
/^subject:\s.*\bchange\b.*\baddress\b/ ||
/^subject:\s*request\b.*\baddition\b/i)) {
&bounce("Admin request");
}
# prepend subject prefix
if ((/^subject:\s*/i) &&
($config_opts{$opt_l,"subject_prefix"} ne '')) {
local($foo) = &config'substitute_values($config_opts{$opt_l,"subject_prefix"}, $opt_l);
# if ($config_opts{$opt_l,"subject_prefix"} ne '') {
# for sequencing we add a special keyword!
if (defined($opt_n)) {
$foo =~ s/\$SEQNUM/$seqnum/;
}
# }
$subject = $_;
$subject =~ s/^subject:\s*(.*)/$1/i;
$subject = &chop_nl($foo . " " . $subject);
local($foo_pat) = $foo;
$foo_pat =~ s/(\W)/\\$1/g;
s/^subject:\s*/Subject: $foo /i if !/$foo_pat/;
$subject_last = 1;
} elsif (defined($subject_last)) {
if (/^\s+(.+)/) {
$subject .= " $1";
} else {
undef($subject_last);
}
}
if (/^from:\s*(.+)/i) {
$from = $1;
$from_last = 1;
} elsif (defined($from_last)) {
if (/^\s+(.+)/) {
$from .= " $1";
} else {
undef($from_last);
}
}
&check_hdr_line($_); # check for length & balance
$kept_last = 1;
print OUT $_;
}
} else {
# this isn't a header line, so print it (maybe)
# first, though, is the first line of the body an "Approved:" line?
if (($body_len == 0) && /^approved:\s*(.*)/i && defined($opt_a)) {
# OK, is it a valid "Approved:" line?
$approved = &chop_nl($1);
if ($approved ne $opt_a &&
!(&main'valid_passwd($listdir, $opt_l, $approved))) {
&bounce("Invalid 'Approved:' header");
} else {
# Yes, it's a valid "Approved:" line...
# So, we start over
$restart = 1;
close(OUT);
unlink("/tmp/sequencer.$$.out");
&open_temp(OUT, "/tmp/sequencer.$$.out") ||
&abort("sequencer:2 Can't open /tmp/sequencer.$$.out: $!");
last;
}
}
$body_len += length($_);
# make sure it doesn't make the message too long
if (defined($opt_M) && ! defined($approved) && ($body_len > $opt_M)) {
&bounce("Message too long (>$opt_M)");
}
# add admin-request recognition heuristics here... (body)
if (defined($opt_s) && ! defined($approved) && ($body_line++ < 5) && (
/\badd me\b/i
|| /\bdelete me\b/i || /\bremove\s+me\b/i
|| /\bchange\b.*\baddress\b/
|| /\bsubscribe\b/i || /^sub\b/i
|| /\bunsubscribe\b/i || /^unsub\b/i
|| /^\s*help\s*$/i # help
|| /^\s*info\s*$/i # info
|| /^\s*info\s+\S+\s*$/i # info list
|| /^\s*lists\s*$/i # lists
|| /^\s*which\s*$/i # which
|| /^\s*which\s+\S+\s*$/i # which address
|| /^\s*index\s*$/i # index
|| /^\s*index\s+\S+\s*$/i # index list
|| /^\s*who\s*$/i # who
|| /^\s*who\s+\S+\s*$/i # who list
|| /^\s*get\s+\S+\s*$/i # get file
|| /^\s*get\s+\S+\s+\S+\s*$/i # get list file
|| /^\s*approve\b/i
|| /^\s*passwd\b/i
|| /^\s*newinfo\b/i
|| /^\s*config\b/i
|| /^\s*newconfig\b/i
|| /^\s*writeconfig\b/i
|| /^\s*mkdigest\b/i)) {
&bounce("Admin request");
}
print OUT $_;
}
}
} while ($restart);
if ($config_opts{$opt_l,"message_footer"} ne '') {
local($footer) = &config'substitute_values($config_opts{$opt_l,"message_footer"}, $opt_l);
$footer =~ s/\001/\n/g;
print OUT $footer;
}
close(OUT);
if (defined($opt_I) && defined($from) && ! defined($approved)) {
local($infile) = 0;
@files = split(/[:\t\n]+/, $opt_I);
foreach $file (@files) {
if ($file !~ /^\//) {
$file = "$listdir/$file";
}
if (open (LISTFD, "<${file}") != 0) {
@output = grep(&addr_match($from, $_), <LISTFD>);
close(LISTFD);
if ($#output != -1) {
$infile = 1;
last;
}
} else {
die("sequencer:Can't open $file: $!");
}
}
if ($infile == 0) {
&bounce ("Non-member submission from [$from]");
}
}
if (defined($opt_A) && ! defined($approved)) {
&bounce("Approval required");
}
if (defined($opt_d)) {
$| = 1;
print "Command: $sendmail_cmd\n";
$status = (system("cat /tmp/sequencer.$$.out") >> 8);
unlink(</tmp/sequencer.$$.*>);
#remember to unlock the sequence file here!
if (defined($opt_n)) { &main'lclose(SEQ); }
exit($status);
} else {
local(*MAILOUT, *MAILIN, @mailer);
@mailer = split(' ', "$sendmail_cmd");
open(MAILOUT, "|-") || &do_exec_sendmail(@mailer);
# create archival copy
if (defined($opt_N)) {
if (open(INDEX, ">>$filedir/$opt_l$filedir_suffix/INDEX")) {
$timenow = ADN::Utility::utime2date(time());
$de_subject = ADN::MIME::HeaderDecode($subject, 'euc');
$de_from = ADN::MIME::HeaderDecode($from, 'euc');
print INDEX "$de_subject\n\t$timenow\t$de_from\n\n";
close (INDEX);
}
open(ARCHIVE, ">$filedir/$opt_l$filedir_suffix/$seqnum");
}
open(MAILIN, "/tmp/sequencer.$$.out");
while (<MAILIN>) {
print MAILOUT $_;
if (defined($opt_N)) { print ARCHIVE $_; }
}
close(MAILOUT);
if (defined($opt_N)) {
`chmod 664 $filedir/$opt_l$filedir_suffix/$seqnum`;
close(ARCHIVE);
}
if (defined($opt_n)) {
$seqnum++;
&main'lreopen(SEQ, ">", "$seqfile");
print SEQ $seqnum, "\n";
&main'lclose(SEQ);
}
close(MAILIN);
unlink(</tmp/sequencer.$$.*>);
exit(0);
}
#// Sub routine
sub check_balance {
# set a temporary variable
local($t) = shift;
# strip out all nested parentheses
1 while $t =~ s/\([^\(\)]*\)//g;
# strip out all nested angle brackets
1 while $t =~ s/\<[^\<\>]*\>//g;
# if any parentheses or angle brackets remain, were imbalanced
if ($t =~ /[\(\)\<\>]/ && ! defined($approved)) {
&bounce("Imbalanced parentheses or angle brackets");
return(undef);
}
return(1);
}
sub check_hdr_line {
local($_) = shift;
if (!/^\s/) { # is this a continuation line?
# Not a continuation line.
# If $balanced_fld is defined, it means the last field was one
# that needed to have balanced "()" and "<>" (i.e., "To:", "From:",
# and "Cc:", so check it. We do it here in case the last field was
# multi-line.
if (defined($balanced_fld)) {
&check_balance($balanced_fld);
}
# we undefine $balanced_fld and reset $field_len; these may be set below
undef($balanced_fld);
$field_len = 0;
}
# is this a field that must be checked for balanced "()" and "<>"?
if (defined($balanced_fld) || /^from:/i || /^cc:/i || /^to:/i) {
# yes it is, but we can't check it yet because there might be
# continuation lines. Buffer it to be checked at the beginning
# of the next non-continuation line.
# is this line too long?
if ((length($_) > $MAX_HEADER_LINE_LENGTH) && ! defined($approved)) {
&bounce("Header line too long (>$MAX_HEADER_LINE_LENGTH)");
return(undef);
}
# is this field too long?
if ((($field_len += length($_)) > $MAX_TOTAL_HEADER_LENGTH) && ! defined($approved)) {
&bounce("Header field too long (>$MAX_TOTAL_HEADER_LENGTH)");
return(undef);
}
$balanced_fld .= $_;
chop($balanced_fld);
}
# if we get here, everything was OK.
return(1);
}
sub bounce {
local($reason) = shift;
local($_);
my $maddr0 = "$opt_m\@$opt_h";
my $maddr1 = "$opt_m-approval\@$opt_h";
&resend_sendmail(BOUNCE,
(($config_opts{$opt_l, 'moderator'} ne "") ?
#$config_opts{$opt_l, 'moderator'} : "$opt_l-approval\@$opt_h"),
#"BOUNCE $opt_l\@$opt_h: $reason");
$config_opts{$opt_l, 'moderator'} : $maddr1),
"BOUNCE $maddr0: $reason");
seek(IN, 0, 0);
while (<IN>) {
print BOUNCE $_;
}
close(BOUNCE);
unlink(</tmp/sequencer.$$.*>);
exit(0);
}
sub resend_sendmail {
local(*MAIL) = shift;
local($to) = shift;
local($subject) = shift;
local($isParent);
local($mailcmd);
$mailcmd = "$sendmail_path -f$sender -t";
# clean up the addresses, for use on the sendmail command line
local(@to) = &ParseAddrs($to);
$to = join(", ", @to);
# open the process
if (defined($opt_d)) {
# debugging, so just say it, don't do it
open(MAIL, ">-");
print MAIL ">>> $mailcmd\n";
} else {
if (defined($isParent = open(MAIL, "|-"))) {
&do_exec_sendmail(split(' ', $mailcmd))
unless $isParent;
} else {
&abort("Failed to fork prior to mailer exec");
}
}
# generate the header
print MAIL <<"EOM";
To: $to
From: $sender
Subject: $subject
EOM
return;
}